diff --git a/components/jvcllaz/examples/JvOutlookBar/OLBarDemo.lpi b/components/jvcllaz/examples/JvOutlookBar/OLBarDemo.lpi index 9fcc95f58..b9b6770bb 100644 --- a/components/jvcllaz/examples/JvOutlookBar/OLBarDemo.lpi +++ b/components/jvcllaz/examples/JvOutlookBar/OLBarDemo.lpi @@ -22,7 +22,9 @@ - + + + @@ -56,6 +58,13 @@ + + + + + + + diff --git a/components/jvcllaz/examples/JvOutlookBar/OLBarDemo.lpr b/components/jvcllaz/examples/JvOutlookBar/OLBarDemo.lpr index 0e77308f1..ffb5248b2 100644 --- a/components/jvcllaz/examples/JvOutlookBar/OLBarDemo.lpr +++ b/components/jvcllaz/examples/JvOutlookBar/OLBarDemo.lpr @@ -7,9 +7,7 @@ uses {$R *.res} begin - {$IF LCL_FullVersion >= 1080000} - Application.Scaled := True; - {$ENDIF} + Application.Scaled:=True; // Please remove this if Lazarus is older than 1.8 Application.Initialize; Application.CreateForm(TOLBarMainForm, OLBarMainForm); Application.Run; diff --git a/components/jvcllaz/examples/JvOutlookBar/OLBarMainFormU.lfm b/components/jvcllaz/examples/JvOutlookBar/OLBarMainFormU.lfm index a9b4bbd69..62d4bffd0 100644 --- a/components/jvcllaz/examples/JvOutlookBar/OLBarMainFormU.lfm +++ b/components/jvcllaz/examples/JvOutlookBar/OLBarMainFormU.lfm @@ -1,12 +1,12 @@ object OLBarMainForm: TOLBarMainForm Left = 299 - Height = 366 + Height = 358 Top = 199 - Width = 771 + Width = 623 ActiveControl = Memo1 Caption = 'JvOutlookBar Demo' - ClientHeight = 366 - ClientWidth = 771 + ClientHeight = 358 + ClientWidth = 623 Color = clBtnFace Constraints.MinHeight = 300 Constraints.MinWidth = 220 @@ -16,27 +16,28 @@ object OLBarMainForm: TOLBarMainForm Position = poScreenCenter ShowHint = True LCLVersion = '1.9.0.0' - Scaled = False object Splitter1: TSplitter - Left = 135 - Height = 343 + Left = 130 + Height = 335 Top = 0 - Width = 5 + Width = 4 AutoSnap = False end object StatusBar: TStatusBar Left = 0 Height = 23 - Top = 343 - Width = 771 + Top = 335 + Width = 623 + Font.Color = clWindowText Panels = <> + ParentFont = False end object JvOutlookBar1: TJvOutlookBar Left = 0 - Height = 343 + Height = 335 Hint = 'Right-click the bar to see the options' Top = 0 - Width = 135 + Width = 130 Align = alLeft Pages = < item @@ -151,8 +152,8 @@ object OLBarMainForm: TOLBarMainForm ParentColor = False TopButtonIndex = 0 end> - LargeImages = ImageList1 - SmallImages = ImageList2 + LargeImages = LargeImages + SmallImages = SmallImages ActivePageIndex = 1 OnButtonClick = JvOutlookBar1ButtonClick OnPageChange = JvOutlookBar1PageChange @@ -163,108 +164,129 @@ object OLBarMainForm: TOLBarMainForm PopupMenu = popOL TabOrder = 1 OnContextPopup = JvOutlookBar1ContextPopup + LargeImagesWidth = 0 + SmallImagesWidth = 0 + PageImagesWidth = 0 end object Panel1: TPanel - Left = 140 - Height = 343 + Left = 134 + Height = 335 Top = 0 - Width = 631 + Width = 489 Align = alClient BevelOuter = bvNone - ClientHeight = 343 - ClientWidth = 631 + ClientHeight = 335 + ClientWidth = 489 + Font.Color = clWindowText + ParentFont = False TabOrder = 2 object Panel2: TPanel AnchorSideTop.Control = Panel1 AnchorSideTop.Side = asrBottom Left = 0 Height = 56 - Top = 287 - Width = 631 + Top = 279 + Width = 489 Align = alBottom Anchors = [akLeft, akRight] AutoSize = True BevelOuter = bvNone ClientHeight = 56 - ClientWidth = 631 + ClientWidth = 489 + Font.Color = clWindowText + ParentFont = False TabOrder = 0 object Button1: TButton AnchorSideLeft.Control = Panel2 AnchorSideTop.Control = Panel2 - Left = 0 + Left = 4 Height = 25 Top = 4 Width = 102 AutoSize = True + BorderSpacing.Left = 4 BorderSpacing.Top = 4 Caption = 'Assign images' + Font.Color = clWindowText OnClick = Button1Click + ParentFont = False TabOrder = 0 end object chkSmallImages: TCheckBox AnchorSideLeft.Control = Panel2 AnchorSideTop.Control = Button1 AnchorSideTop.Side = asrBottom - Left = 0 + Left = 5 Height = 19 Top = 33 Width = 93 Action = acSmallButtons + BorderSpacing.Left = 5 BorderSpacing.Top = 4 BorderSpacing.Bottom = 4 + Font.Color = clWindowText + ParentFont = False TabOrder = 1 end object Button2: TButton AnchorSideLeft.Control = Button1 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Button1 - Left = 106 + Left = 110 Height = 25 Top = 4 Width = 110 AutoSize = True BorderSpacing.Left = 4 Caption = 'Remove images' + Font.Color = clWindowText OnClick = Button2Click + ParentFont = False TabOrder = 2 end object Button3: TButton AnchorSideLeft.Control = Button2 AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Button1 - Left = 220 + Left = 224 Height = 25 Top = 4 Width = 59 AutoSize = True BorderSpacing.Left = 4 Caption = 'Font...' + Font.Color = clWindowText OnClick = Button3Click + ParentFont = False TabOrder = 3 end object chkButtonFont: TCheckBox AnchorSideLeft.Control = chkFlat AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = chkSmallImages - Left = 180 + Left = 185 Height = 19 Top = 33 Width = 125 BorderSpacing.Left = 24 Caption = 'Change button font' + Font.Color = clWindowText + ParentFont = False TabOrder = 4 end object chkFlat: TCheckBox AnchorSideLeft.Control = chkSmallImages AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = chkSmallImages - Left = 117 + Left = 122 Height = 19 Top = 33 Width = 39 BorderSpacing.Left = 24 Caption = 'Flat' + Font.Color = clWindowText OnClick = chkFlatClick + ParentFont = False TabOrder = 5 end object chkThemed: TCheckBox @@ -272,52 +294,59 @@ object OLBarMainForm: TOLBarMainForm AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Button1 AnchorSideTop.Side = asrCenter - Left = 329 + Left = 334 Height = 19 Top = 7 Width = 64 BorderSpacing.Left = 24 Caption = 'Themed' Checked = True + Font.Color = clWindowText OnChange = chkThemedChange + ParentFont = False State = cbChecked TabOrder = 6 end object ChkThemedBackground: TCheckBox AnchorSideLeft.Control = chkThemed AnchorSideTop.Control = chkSmallImages - Left = 329 + Left = 334 Height = 19 Top = 33 Width = 131 Caption = 'Themed background' Checked = True + Font.Color = clWindowText OnChange = ChkThemedBackgroundChange + ParentFont = False State = cbChecked TabOrder = 7 end end object Memo1: TMemo Left = 0 - Height = 287 + Height = 279 Top = 0 - Width = 631 + Width = 489 Align = alClient + Font.Color = clWindowText Lines.Strings = ( - 'Right-click in the outlookbar to see the popup menus. There is one menu for the outlook bar itself, one for the pages and one for the buttons.' + 'Right-click in the outlookbar to see the popup menus. There is one menu for the outlook bar itself, one for the pages ' + 'and one for the buttons.' '' 'See the code for an example on how to detect and assign the popup menus at run-time (the OnContextPopup event).' '' 'Use the buttons to modify the look of the outlookbar, pages and buttons.' ) + ParentFont = False ScrollBars = ssBoth TabOrder = 1 end end object popOL: TPopupMenu - Images = ImageList2 - left = 256 - top = 176 + Images = SmallImages + left = 160 + top = 136 object Defaultpopupmenu1: TMenuItem Caption = 'Default popup menu' end @@ -325,11 +354,11 @@ object OLBarMainForm: TOLBarMainForm Action = acSmallButtons end end - object ImageList1: TImageList + object LargeImages: TImageList Height = 32 Width = 32 - left = 448 - top = 88 + left = 160 + top = 192 Bitmap = { 4C69180000002000000020000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -3406,9 +3435,9 @@ object OLBarMainForm: TOLBarMainForm 0000000000000000000000000000 } end - object ImageList2: TImageList - left = 520 - top = 88 + object SmallImages: TImageList + left = 240 + top = 192 Bitmap = { 4C69180000001000000010000000000000000000000000000000000000000000 0000000000000000000000000000000000000000000000000000000000000000 @@ -4182,17 +4211,17 @@ object OLBarMainForm: TOLBarMainForm } end object popButton: TPopupMenu - Images = ImageList2 - left = 232 - top = 88 + Images = SmallImages + left = 240 + top = 136 object Editbuttoncaption1: TMenuItem Action = acEditButtonCaption end end object popPage: TPopupMenu - Images = ImageList2 - left = 296 - top = 88 + Images = SmallImages + left = 320 + top = 144 object Editpagecaption1: TMenuItem Action = acEditPageCaption end @@ -4201,8 +4230,8 @@ object OLBarMainForm: TOLBarMainForm end end object ActionList1: TActionList - left = 480 - top = 176 + left = 320 + top = 192 object acSmallButtons: TAction Caption = 'Small Buttons' OnExecute = acSmallButtonsExecute diff --git a/components/jvcllaz/examples/JvOutlookBar/OLBarMainFormU.pas b/components/jvcllaz/examples/JvOutlookBar/OLBarMainFormU.pas index 6e46d4cea..c8fe40cb1 100644 --- a/components/jvcllaz/examples/JvOutlookBar/OLBarMainFormU.pas +++ b/components/jvcllaz/examples/JvOutlookBar/OLBarMainFormU.pas @@ -33,7 +33,7 @@ interface uses SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls, Menus, ExtCtrls, ActnList, - JvExControls, JvOutlookBar; + JvOutlookBar; type @@ -44,8 +44,8 @@ type chkThemed: TCheckBox; popOL: TPopupMenu; Splitter1: TSplitter; - ImageList1: TImageList; - ImageList2: TImageList; + LargeImages: TImageList; + SmallImages: TImageList; Defaultpopupmenu1: TMenuItem; popButton: TPopupMenu; popPage: TPopupMenu; @@ -96,12 +96,12 @@ implementation {$R *.lfm} uses - Themes; + Themes, LCLVersion; procedure TOLBarMainForm.Button1Click(Sender: TObject); begin - JvOutlookBar1.LargeImages := ImageList1; - JvOutlookBar1.SmallImages := ImageList2; + JvOutlookBar1.LargeImages := LargeImages; + JvOutlookBar1.SmallImages := SmallImages; end; procedure TOLBarMainForm.Button2Click(Sender: TObject); @@ -213,6 +213,10 @@ end; procedure TOLBarMainForm.FormCreate(Sender: TObject); begin + {$IF LCL_FullVersion >= 1090000} + LargeImages.Scaled := true; + SmallImages.Scaled := true; + {$ENDIF} Memo1.Wordwrap := True; chkThemed.Visible := ThemeServices.ThemesEnabled; end; diff --git a/components/jvcllaz/run/JvCustomControls/JvOutlookBar.pas b/components/jvcllaz/run/JvCustomControls/JvOutlookBar.pas index ee1fbda44..05025ae48 100644 --- a/components/jvcllaz/run/JvCustomControls/JvOutlookBar.pas +++ b/components/jvcllaz/run/JvCustomControls/JvOutlookBar.pas @@ -51,20 +51,22 @@ uses Buttons, Controls, Graphics, ImgList, Forms, StdCtrls, ExtCtrls, Themes, JvJCLUtils, JvComponent; +(* +{$IF LCL_FullVersion >= 1090000} + {$DEFINE HAS_SCALED_IMAGELIST} +{$ENDIF} +*) + const CM_CAPTION_EDITING = CM_BASE + 756; CM_CAPTION_EDIT_ACCEPT = CM_CAPTION_EDITING + 1; CM_CAPTION_EDIT_CANCEL = CM_CAPTION_EDITING + 2; - cTextMargins = 3; - cMinTextWidth = 32; - type TJvBarButtonSize = (olbsLarge, olbsSmall); TJvCustomOutlookBar = class; TJvOutlookBarButton = class; - TJvOutlookBarButtonActionLink = class(TActionLink) private FClient: TJvOutlookBarButton; @@ -268,8 +270,10 @@ type FPageChangeLink: TChangeLink; FActivePageIndex: Integer; FButtonSize: TJvBarButtonSize; - FSmallImages: TCustomImageList; FLargeImages: TCustomImageList; + FLargeImagesWidth: Integer; + FSmallImages: TCustomImageList; + FSmallImagesWidth: Integer; FPageButtonHeight: Integer; FNextActivePage: Integer; FPressedPageBtn: Integer; @@ -288,12 +292,14 @@ type FOnEditPage: TOutlookBarEditCaption; FOnCustomDraw: TJvOutlookBarCustomDrawEvent; FPageImages: TCustomImageList; + FPageImagesWidth: Integer; FDisabledFontColor1: TColor; FDisabledFontColor2: TColor; FWordWrap: Boolean; function GetActivePage: TJvOutlookBarPage; function GetActivePageIndex: Integer; + function IsStoredPageButtonHeight: Boolean; procedure SetActivePageIndex(const Value: Integer); procedure SetButtonSize(const Value: TJvBarButtonSize); procedure SetDisabledFontColor1(const Value: TColor); @@ -318,11 +324,10 @@ type PreferredHeight: integer; WithThemeSpace: Boolean); override; procedure ColorChanged; override; procedure CreateHandle; override; - {$IF LCL_FullVersion >= 1080000} + {$IF LCL_FullVersion >= 1080000} procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override; - procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override; - {$ENDIF} + {$ENDIF} procedure DoButtonClick(Index: Integer); virtual; procedure DoButtonEdit(NewText: string; B: TJvOutlookBarButton); @@ -365,6 +370,7 @@ type function GetPageButtonRect(Index: Integer): TRect; function GetPageTextRect(Index: Integer): TRect; function GetPageRect(Index: Integer): TRect; + function GetRealImageSize(AImageList: TCustomImageList; AImagesWidth: Integer): TSize; function IsThemedStored: Boolean; procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseEnter(Control: TControl); override; @@ -389,7 +395,7 @@ type property SmallImages: TCustomImageList read FSmallImages write SetSmallImages; property PageImages: TCustomImageList read FPageImages write SetPageImages; property ButtonSize: TJvBarButtonSize read FButtonSize write SetButtonSize default olbsLarge; - property PageButtonHeight: Integer read FPageButtonHeight write SetPageButtonHeight default 0; //DEFAULT_PAGEBUTTONHEIGHT; + property PageButtonHeight: Integer read FPageButtonHeight write SetPageButtonHeight stored IsStoredPageButtonHeight; property ActivePageIndex: Integer read GetActivePageIndex write SetActivePageIndex default 0; property Themed: Boolean read FThemed write SetThemed stored IsThemedStored; property ThemedBackground: Boolean read FThemedBackGround write SetThemedBackground default True; @@ -403,10 +409,24 @@ type property DisabledFontColor1:TColor read FDisabledFontColor1 write SetDisabledFontColor1; //clWhite; property DisabledFontColor2:TColor read FDisabledFontColor2 write SetDisabledFontColor2; //clGrayText; + {$IF LCL_FullVersion >= 1090000} + private + procedure SetLargeImagesWidth(const AValue: Integer); + procedure SetPageImagesWidth(const AValue: Integer); + procedure SetSmallImagesWidth(const AValue: Integer); + protected + property LargeImagesWidth: Integer read FLargeImagesWidth write SetLargeImagesWidth default 0; + property SmallImagesWidth: Integer read FSmallImagesWidth write SetSmallImagesWidth default 0; + property PageImagesWidth: Integer read FPageImagesWidth write SetPageImagesWidth default 0; + {$ENDIF} + public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure InitiateAction; override; + {$IF LCL_FullVersion >= 1080000} + procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override; + {$ENDIF} function GetButtonAtPos(P: TPoint): TJvOutlookBarButton; function GetPageButtonAtPos(P: TPoint): TJvOutlookBarPage; public @@ -468,6 +488,12 @@ type property OnClick; property OnDblClick; property OnContextPopup; + + {$IF LCL_FullVersion >= 1090000} + property LargeImagesWidth; + property SmallImagesWidth; + property PageImagesWidth; + {$ENDIF} end; @@ -481,6 +507,8 @@ uses {$R ..\..\resource\JvOutlookBar.res} const + cTextMargins = 3; + cMinTextWidth = 32; cButtonLeftOffset = 4; cButtonTopOffset = 2; cInitRepeatPause = 400; @@ -1570,7 +1598,12 @@ var Flags: Cardinal; HasImage: Boolean; Details: TThemedElementDetails; - margin: Integer; + margin, w: Integer; + {$IF LCL_FullVersion >= 1090000} + pageImageRes: TScaledImageListResolution; + f: Double; + ppi: Integer; + {$ENDIF} begin Assert(Assigned(FPageBtnProps)); ATop := R.Top + 1; @@ -1579,17 +1612,11 @@ begin if Themed then begin if Pressed then Details := StyleServices.GetElementDetails(tbPushButtonPressed) -// Details := StyleServices.GetElementDetails(ttbButtonPressed) -// Details := StyleServices.GetElementDetails(tebNormalGroupHead) else if Index = FHotPageBtn then Details := StyleServices.GetElementDetails(tbPushButtonHot) -// Details := StyleServices.GetElementDetails(ttbButtonHot) -// Details := StyleServices.GetElementDetails(tebNormalGroupHead) else Details := StyleServices.GetElementDetails(tbPushButtonNormal); -// Details := StyleServices.GetElementDetails(ttbButtonNormal); -// Details := StyleServices.GetElementDetails(tebSpecialGroupHead); InflateRect(R, 1, 1); StyleServices.DrawElement(Canvas.Handle, Details, R); end else @@ -1620,34 +1647,33 @@ begin SavedDC := SaveDC(Canvas.Handle); try margin := Scale96ToForm(4); + if HasImage then begin + {$IF LCL_FullVersion >= 1090000} + f := GetCanvasScalefactor; + ppi := Font.PixelsPerInch; + if FPageImages <> nil then + pageImageRes := FPageImages.ResolutionForPPI[FPageImagesWidth, ppi, f]; + pageImageRes.Draw(Canvas, margin, ATop, Pages[Index].ImageIndex, Pages[Index].Enabled); + {$ELSE} + PageImages.Draw(Canvas, margin, ATop, Pages[Index].ImageIndex, Pages[Index].Enabled); + {$ENDIF} + end; case Pages[Index].Alignment of taLeftJustify: begin if HasImage then - begin - PageImages.Draw(Canvas, margin, ATop, Pages[Index].ImageIndex, - Pages[Index].Enabled); - Inc(R.Left, PageImages.Width + 2*margin); - end + Inc(R.Left, PageImages.Width + 2*margin) else Inc(R.Left, margin); Flags := DT_LEFT or DT_VCENTER or DT_SINGLELINE; end; taCenter: if HasImage then - begin - PageImages.Draw(Canvas, margin, ATop, Pages[Index].ImageIndex, - Pages[Index].Enabled); Inc(R.Left, PageImages.Width + margin); - end; taRightJustify: begin if HasImage then - begin - PageImages.Draw(Canvas, margin, ATop, Pages[Index].ImageIndex, - Pages[Index].Enabled); - Inc(R.Left, PageImages.Width + margin*2); - end; + Inc(R.Left, PageImages.Width + 2*margin); Dec(R.Right, margin); Flags := DT_RIGHT or DT_VCENTER or DT_SINGLELINE; end; @@ -1665,7 +1691,6 @@ begin if not Pages[Index].Enabled then begin OffsetRect(R, 1, 1); Details := StyleServices.GetElementDetails(tbPushButtonPressed) -// Details := StyleServices.GetElementDetails(ttbButtonDisabled) end; StyleServices.DrawText(Canvas, Details, Pages[Index].Caption, R, Flags or DT_END_ELLIPSIS, 0); end else begin @@ -1756,6 +1781,13 @@ var SavedColor: TColor; flags: Integer; Details: TThemedElementDetails; + w: Integer; + dist: Integer; + {$IF LCL_FullVersion >= 1090000} + LargeImageRes, SmallImageRes: TScaledImageListResolution; + f: Double; + ppi: Integer; + {$ENDIF} begin if csDestroying in ComponentState then Exit; @@ -1763,6 +1795,16 @@ begin (Pages[Index].Buttons.Count <= 0) then Exit; + + {$IF LCL_FullVersion >= 1090000} + f := GetCanvasScalefactor; + ppi := Font.PixelsPerInch; + if FLargeImages <> nil then + LargeImageRes := FLargeImages.ResolutionForPPI[FLargeImagesWidth, ppi, f]; + if FSmallImages <> nil then + smallImageRes := FSmallImages.ResolutionForPPI[SmallImagesWidth, ppi, f]; + {$ENDIF} + R2 := GetPageRect(Index); R := GetButtonRect(Index, Pages[Index].TopButtonIndex); C := Canvas.Pen.Color; @@ -1780,13 +1822,24 @@ begin try SavedDC := SaveDC(Canvas.Handle); try - if LargeImages <> nil then - LargeImages.Draw(Canvas, - R.Left + ((R.Right - R.Left) - LargeImages.Width) div 2, - R.Top + 4, + if LargeImages <> nil then begin + dist := Scale96ToForm(4); + {$IF LCL_FullVersion >= 1090000} + largeImageRes.Draw(Canvas, + R.Left + ((R.Right - R.Left) - largeImageRes.Width) div 2, + R.Top + dist, Pages[Index].Buttons[I].ImageIndex, Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled ); + {$ELSE} + LargeImages.Draw(Canvas, + R.Left + ((R.Right - R.Left) - LargeImages.Width) div 2, + R.Top + dist, + Pages[Index].Buttons[I].ImageIndex, + Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled + ); + {$ENDIF} + end; finally RestoreDC(Canvas.Handle, SavedDC); end; @@ -1827,15 +1880,27 @@ begin try SavedDC := SaveDC(Canvas.Handle); try - if SmallImages <> nil then - SmallImages.Draw(Canvas, R.Left + 2, R.Top + 2, + if SmallImages <> nil then begin + dist := Scale96ToForm(2); + {$IF LCL_FullVersion >= 1090000} + smallImageRes.Draw(Canvas, + R.Left + dist, R.Top + dist, Pages[Index].Buttons[I].ImageIndex, - Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled); + Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled + ); + {$ELSE} + SmallImages.Draw(Canvas, + R.Left + dist, R.Top + dist, + Pages[Index].Buttons[I].ImageIndex, + Pages[Index].Enabled and Pages[Index].Buttons[I].Enabled + ); + {$ENDIF} + end; finally RestoreDC(Canvas.Handle, SavedDC); end; R3 := GetButtonTextRect(ActivePageIndex, I); - InflateRect(R3, -4, 0); + // InflateRect(R3, -Scale96ToForm(4), 0); SetBkMode(Canvas.Handle, TRANSPARENT); Flags := DT_EXPANDTABS or DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_NOCLIP or DT_EDITCONTROL; if Themed and (Pages[Index].Color = clDefault) then @@ -2101,9 +2166,12 @@ begin end; function TJvCustomOutlookBar.GetPageTextRect(Index: Integer): TRect; +var + dist: Integer; begin Result := GetPageButtonRect(Index); - InflateRect(Result, -2, -2); + dist := Scale96ToForm(2); + InflateRect(Result, -dist, -dist); end; function TJvCustomOutlookBar.GetButtonTextSize( @@ -2113,6 +2181,7 @@ var DC: HDC; S: string; OldFont: HFONT; + txtMargins, minTxtWidth: Integer; begin DC := Canvas.Handle; OldFont := SelectObject(DC, Canvas.Font.Handle); @@ -2121,7 +2190,9 @@ begin S := Pages[PageIndex].Buttons[ButtonIndex].Caption; if (Pages[PageIndex].ButtonSize = olbsLarge) and FWordWrap then begin - R := Rect(0, 0, Max(ClientWidth - (2 * cTextMargins), cMinTextWidth), 0); + txtMargins := Scale96ToForm(cTextMargins); + minTxtWidth := Scale96ToForm(cMinTextWidth); + R := Rect(0, 0, Max(ClientWidth - (2 * txtMargins), minTxtWidth), 0); Result.cy := DrawText(DC, PChar(S), Length(S), R, DT_WORDBREAK or DT_CALCRECT or DT_CENTER or DT_VCENTER); Result.cx := R.Right; end else @@ -2149,6 +2220,23 @@ begin end; end; +function TJvCustomOutlookBar.GetRealImageSize(AImageList: TCustomImageList; + AImagesWidth: Integer): TSize; +{$IF LCL_FullVersion >= 1090000} +var + imgRes: TScaledImageListResolution; +begin + imgRes := AImageList.ResolutionForPPI[AImagesWidth, Font.PixelsPerInch, GetCanvasScaleFactor]; + Result.CX := imgRes.Width; + Result.CY := imgRes.Height; +end; +{$ELSE} +begin + Result.CX := AImageList.Width; + Result.CY := AImageList.Height; +end; +{$ENDIF} + function TJvCustomOutlookBar.GetButtonAtPos(P: TPoint): TJvOutlookBarButton; var I: Integer; @@ -2174,97 +2262,121 @@ end; function TJvCustomOutlookBar.GetButtonRect(PageIndex, ButtonIndex: Integer): TRect; var - H: Integer; + H, W: Integer; + dist: Integer; + leftOffs, topOffs: Integer; begin Result := Rect(0, 0, 0, 0); if (PageIndex < 0) or (PageIndex >= Pages.Count) or (ButtonIndex < 0) or (ButtonIndex >= Pages[PageIndex].Buttons.Count) then Exit; H := GetButtonHeight(PageIndex, ButtonIndex); + topOffs := Scale96ToForm(cButtonTopOffset); + leftOffs := Scale96ToForm(cButtonLeftOffset); case Pages[PageIndex].ButtonSize of olbsLarge: - if LargeImages <> nil then + if FLargeImages <> nil then begin - Result := Rect(0, 0, Max(LargeImages.Width, GetButtonTextSize(PageIndex, ButtonIndex).cx) + - 4, H); - OffsetRect(Result, (ClientWidth - (Result.Right - Result.Left)) div 2, cButtonTopOffset); - end - else + W := GetRealImageSize(FLargeImages, FLargeImagesWidth).CX; + dist := Scale96ToForm(4); + Result := Rect(0, 0, Max(W, GetButtonTextSize(PageIndex, ButtonIndex).cx) + dist, H); + OffsetRect(Result, (ClientWidth - (Result.Right - Result.Left)) div 2, topOffs); + end else Result := Rect(0, 0, ClientWidth, cButtonTopOffset + H); + olbsSmall: - if SmallImages <> nil then + if FSmallImages <> nil then begin - Result := Rect(0, 0, SmallImages.Width + GetButtonTextSize(PageIndex, ButtonIndex).cx + 8, - H); - OffsetRect(Result, cButtonLeftOffset, cButtonTopOffset); - end - else - Result := Rect(0, 0, ClientWidth, cButtonTopOffset + H); + W := GetRealImageSize(FSmallImages, FSmallImagesWidth).CX; + dist := Scale96ToForm(8); + Result := Rect(0, 0, W + GetButtonTextSize(PageIndex, ButtonIndex).cx + dist, H); + OffsetRect(Result, leftOffs, topOffs); + end else + Result := Rect(0, 0, ClientWidth, topOffs + H); end; OffsetRect(Result, 0, GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top); end; function TJvCustomOutlookBar.GetButtonFrameRect(PageIndex, ButtonIndex: Integer): TRect; +var + imgSize: TSize; + delta: Integer; + btnTopOffs, btnLeftOffs: Integer; begin Result := Rect(0, 0, 0, 0); if (PageIndex < 0) or (PageIndex >= Pages.Count) or (ButtonIndex < 0) or (ButtonIndex >= Pages[PageIndex].Buttons.Count) then Exit; + btnTopOffs := Scale96ToForm(cButtonTopOffset); + btnLeftOffs := Scale96ToForm(cButtonLeftOffset); case Pages[PageIndex].ButtonSize of olbsLarge: - if LargeImages <> nil then + if FLargeImages <> nil then begin - Result := Rect(0, 0, LargeImages.Width + 6, LargeImages.Height + 6); - OffsetRect(Result, (ClientWidth - (Result.Right - Result.Left)) div 2, - cButtonTopOffset + GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top + 1); - end - else + imgSize := GetRealImageSize(FLargeImages, FLargeImagesWidth); + delta := Scale96ToForm(6); + Result := Rect(0, 0, imgSize.CX + delta, imgSize.CY + delta); + OffsetRect(Result, + (ClientWidth - (Result.Right - Result.Left)) div 2, + btnTopOffs + GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top + 1 + ); + end else begin Result := Rect(0, 0, ClientWidth, GetButtonHeight(PageIndex, ButtonIndex)); OffsetRect(Result, 0, - cButtonTopOffset + GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top + 1); + btnTopOffs + GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top + 1); end; + olbsSmall: - if SmallImages <> nil then + if FSmallImages <> nil then begin - Result := Rect(0, 0, SmallImages.Width + 4, SmallImages.Height + 4); - OffsetRect(Result, cButtonLeftOffset, cButtonTopOffset + GetButtonTopHeight(PageIndex, ButtonIndex) + - GetPageRect(PageIndex).Top); - end - else + imgSize := GetRealImageSize(FSmallImages, FSmallImagesWidth); + delta := Scale96ToForm(4); + Result := Rect(0, 0, imgSize.CX + delta, imgSize.CY + delta); + OffsetRect(Result, + btnLeftOffs, + btnTopOffs + GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top + ); + end else begin Result := Rect(0, 0, ClientWidth, GetButtonHeight(PageIndex, ButtonIndex)); - OffsetRect(Result, 0, cButtonTopOffset + GetButtonTopHeight(PageIndex, ButtonIndex) + - GetPageRect(PageIndex).Top); + OffsetRect(Result, + 0, + btnTopOffs + GetButtonTopHeight(PageIndex, ButtonIndex) + GetPageRect(PageIndex).Top + ); end; end; end; function TJvCustomOutlookBar.GetButtonTextRect(PageIndex, ButtonIndex: Integer): TRect; var - TextSize: TSize; + textSize, imgSize: TSize; ButtonHeight: Integer; + dist2, dist4: Integer; begin Result := Rect(0, 0, 0, 0); if Pages[PageIndex].Buttons.Count <= ButtonIndex then Exit; Result := GetButtonRect(PageIndex, ButtonIndex); + dist2 := Scale96ToForm(2); + dist4 := Scale96ToForm(4); case Pages[PageIndex].ButtonSize of olbsLarge: - if LargeImages <> nil then + if FLargeImages <> nil then begin - Result.Top := Result.Bottom - GetButtonTextSize(PageIndex, ButtonIndex).cy - 2; - OffsetRect(Result, 0, -4); + Result.Top := Result.Bottom - GetButtonTextSize(PageIndex, ButtonIndex).CY - dist2; + OffsetRect(Result, 0, -dist4); end; olbsSmall: - if SmallImages <> nil then + if FSmallImages <> nil then begin - TextSize := GetButtonTextSize(PageIndex, ButtonIndex); + textSize := GetButtonTextSize(PageIndex, ButtonIndex); + imgSize := GetRealImageSize(FSmallImages, FSmallImagesWidth); ButtonHeight := GetButtonHeight(PageIndex, ButtonIndex); - Result.Left := SmallImages.Width + 10; - Result.Top := Result.Top + (ButtonHeight - TextSize.cy) div 2; - Result.Bottom := Result.Top + TextSize.cy + 2; - Result.Right := Result.Left + TextSize.cx + 4; + Result.Left := imgSize.CX + Scale96ToForm(14); + Result.Top := Result.Top + (ButtonHeight - textSize.cy) div 2; + Result.Bottom := Result.Top + textSize.cy + dist2; + Result.Right := Result.Left + textSize.cx + dist4; OffsetRect(Result, 0, -(ButtonHeight - (Result.Bottom - Result.Top)) div 4); end; end; @@ -2433,6 +2545,20 @@ begin Invalidate; end; +{$IF LCL_FullVersion >= 1090000} +procedure TJvCustomOutlookBar.SetLargeImagesWidth(const AValue: Integer); +begin + if AValue = FLargeImagesWidth then exit; + FLargeImagesWidth := AValue; + Invalidate; +end; +{$ENDIF} + +function TJvCustomOutlookBar.IsStoredPageButtonHeight: Boolean; +begin + Result := FPageButtonHeight <> 0; +end; + procedure TJvCustomOutlookBar.SetPageButtonHeight(const Value: Integer); begin if FPageButtonHeight <> Value then @@ -2453,6 +2579,15 @@ begin Invalidate; end; +{$IF LCL_FullVersion >= 1090000} +procedure TJvCustomOutlookBar.SetSmallImagesWidth(const AValue: Integer); +begin + if AValue = FSmallImagesWidth then exit; + FSmallImagesWidth := AValue; + Invalidate; +end; +{$ENDIF} + procedure TJvCustomOutlookBar.SetThemed(const Value: Boolean); begin if Value and (not ThemeServices.ThemesEnabled) then @@ -2691,13 +2826,13 @@ begin end; function TJvCustomOutlookBar.GetButtonHeight(PageIndex, ButtonIndex: Integer): Integer; -const - cLargeOffset = 8; - cSmallOffset = 4; var TM: TTextMetric; - TextSize: TSize; + textSize: TSize; + imgSize: TSize; OldFont: HFONT; + LargeOffset: Integer; + SmallOffset: Integer; begin OldFont := SelectObject(Canvas.Handle, Canvas.Font.Handle); try @@ -2706,23 +2841,26 @@ begin Result := TM.tmHeight + TM.tmExternalLeading; if (PageIndex >= 0) and (PageIndex < Pages.Count) then begin - TextSize := GetButtonTextSize(PageIndex, ButtonIndex); + textSize := GetButtonTextSize(PageIndex, ButtonIndex); + largeOffset := Scale96ToForm(8); + smallOffset := Scale96ToForm(4); case Pages[PageIndex].ButtonSize of olbsLarge: - begin - if LargeImages <> nil then - Result := Max(Result, LargeImages.Height + TextSize.cy + cLargeOffset) - else - Result := TextSize.cy + cLargeOffset; - end; + if FLargeImages <> nil then begin + imgSize := GetRealImageSize(FLargeImages, FLargeImagesWidth); + Result := Max(Result, imgSize.CY + textSize.CY + largeOffset) + end else + Result := textSize.cy + largeOffset; + olbsSmall: - if SmallImages <> nil then - Result := Max(SmallImages.Height, TextSize.cy) + cSmallOffset - else - Result := TextSize.cy + cSmallOffset; + if SmallImages <> nil then begin + imgSize := GetRealImageSize(FSmallImages, FSmallImagesWidth); + Result := Max(imgSize.CY, textSize.cy) + smallOffset + end else + Result := textSize.cy + smallOffset; end; end; - Inc(Result, 4); + Inc(Result, smallOffset); finally SelectObject(Canvas.Handle, OldFont); end; @@ -2758,7 +2896,7 @@ begin B := TJvOutlookBarButton(Msg.WParam); R := GetButtonTextRect(ActivePageIndex, B.Index); R.Left := Max(R.Left, 0); - R.Right := Min(R.Right, ClientWidth); + R.Right := ClientWidth; //Min(R.Right, ClientWidth); TJvOutlookBarEdit(FEdit).ShowEdit(B.Caption, R); end; 1: // page @@ -2930,10 +3068,15 @@ end; procedure TJvCustomOutlookBar.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); begin - inherited; - if AMode = lapAutoAdjustForDPI then begin - if FPageButtonHeight <> 0 then - FPageButtonHeight := round(FPageButtonHeight * AYProportion); + inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion); + if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then + begin + DisableAutoSizing; + try + if IsStoredPageButtonHeight then + FPageButtonHeight := round(FPageButtonHeight * AYProportion); + finally + end; end; end; @@ -2994,6 +3137,15 @@ begin Invalidate; end; +{$IF LCL_FullVersion >= 1090000} +procedure TJvCustomOutlookBar.SetPageImagesWidth(const AValue: Integer); +begin + if AValue = FPageImagesWidth then exit; + FPageImagesWidth := AValue; + Invalidate; +end; +{$ENDIF} + procedure TJvCustomOutlookBar.InitiateAction; var I, J: Integer;