From 18b17e3487058a03614665eb6a416913f8ad804b Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Fri, 6 Jun 2008 14:22:00 +0000 Subject: [PATCH] Added: image index to graphiclist editor Added: gradient support to unaMenuBarPainter Added: ImageOffset support to unaMenuBarPainter --- Packages/D7/X2CLGLD.dof | 1 + Packages/D7/X2CLMB.cfg | 6 +- Packages/D7/X2CLMB.dof | 27 +++-- Packages/D7/X2CLMBD.cfg | 6 +- Packages/D7/X2CLMBD.dof | 29 ++--- Packages/X2CLGraphicsEditor.dfm | 4 + Packages/X2CLGraphicsEditor.pas | 105 ++++++++++-------- Source/X2CLGraphics.pas | 132 ++++++++++++++++++++++ Source/X2CLunaMenuBarPainter.pas | 184 +++++++++++++++++++++++++------ 9 files changed, 386 insertions(+), 108 deletions(-) diff --git a/Packages/D7/X2CLGLD.dof b/Packages/D7/X2CLGLD.dof index e94c696..723ab24 100644 --- a/Packages/D7/X2CLGLD.dof +++ b/Packages/D7/X2CLGLD.dof @@ -136,6 +136,7 @@ ProductVersion=1.0.0.0 Comments= [Excluded Packages] C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors +C:\Program Files\madCollection\madExcept\Delphi 7\madExceptIde_.bpl=madExceptIde 1.1 - www.madshi.net [HistoryLists\hlUnitAliases] Count=1 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; diff --git a/Packages/D7/X2CLMB.cfg b/Packages/D7/X2CLMB.cfg index 5b840e3..524454c 100644 --- a/Packages/D7/X2CLMB.cfg +++ b/Packages/D7/X2CLMB.cfg @@ -31,9 +31,9 @@ -M -$M16384,1048576 -K$00400000 --N"..\..\Lib\D7" --LE"..\..\Lib\D7" --LN"..\..\Lib\D7" +-N"P:\algemeen\lib" +-LE"P:\algemeen\bin" +-LN"P:\algemeen\lib" -Z -w-UNSAFE_TYPE -w-UNSAFE_CODE diff --git a/Packages/D7/X2CLMB.dof b/Packages/D7/X2CLMB.dof index b236d25..9290434 100644 --- a/Packages/D7/X2CLMB.dof +++ b/Packages/D7/X2CLMB.dof @@ -91,9 +91,9 @@ ImageBase=4194304 ExeDescription=X²CL MenuBar [Directories] OutputDir= -UnitOutputDir=..\..\Lib\D7 -PackageDLLOutputDir=..\..\Lib\D7 -PackageDCPOutputDir=..\..\Lib\D7 +UnitOutputDir=$(DELPHILIB) +PackageDLLOutputDir=$(DELPHIBIN) +PackageDCPOutputDir=$(DELPHILIB) SearchPath= Packages=vcl;rtl;vclx;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;CLXIB;ibxpress;VCLIB;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;dclOfficeXP;Indy70;cxLibraryVCLD7;dxBarD7;dxComnD7;dxBarDBNavD7;dxBarExtDBItemsD7;dxBarExtItemsD7;dxDockingD7;dxsbD7;cxEditorsVCLD7;dxThemeD7;cxDataD7;cxExtEditorsVCLD7;cxPageControlVCLD7;cxGridVCLD7;cxSchedulerVCLD7;dxMasterViewD7;dxmdsD7;dxPSCoreD7;dxPSTeeChartD7;dxPsPrVwAdvD7;dxPSLnksD7;dxPSdxMVLnkD7;dxPSDBTeeChartD7;dxPScxCommonD7;dxPScxPCProdD7;dxPScxGridLnkD7;dxPScxExtCommonD7;dxPScxScheduler2LnkD7;wpViewPDF_D7;Rave50CLX;Rave50VCL;xtx_d7;IBSQLProperty;SamPackage;rbTCUI107;rbTC107;rbRCL107;rbIDE107;rbBDE107;rbUSERDesign107;rbUSER107;madBasic_;madDisAsm_;madExcept_;unageneral_d7 Conditionals= @@ -143,14 +143,17 @@ Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; Count=1 Item0=P:\Algemeen\Indy10;P:\Algemeen\Indy10\Core;P:\Algemeen\Indy10\Protocols;P:\Algemeen\Indy10\SuperCore;P:\Algemeen\Indy10\System [HistoryLists\hlUnitOutputDirectory] -Count=3 -Item0=..\..\Lib\D7 -Item1=..\Lib\D7 -Item2=Lib\D7 +Count=4 +Item0=$(DELPHILIB) +Item1=..\..\Lib\D7 +Item2=..\Lib\D7 +Item3=Lib\D7 [HistoryLists\hlBPLOutput] -Count=2 -Item0=..\..\Lib\D7 -Item1=Lib\D7 +Count=3 +Item0=$(DELPHIBIN) +Item1=..\..\Lib\D7 +Item2=Lib\D7 [HistoryLists\hlDCPOutput] -Count=1 -Item0=..\..\Lib\D7 +Count=2 +Item0=$(DELPHILIB) +Item1=..\..\Lib\D7 diff --git a/Packages/D7/X2CLMBD.cfg b/Packages/D7/X2CLMBD.cfg index 5b840e3..524454c 100644 --- a/Packages/D7/X2CLMBD.cfg +++ b/Packages/D7/X2CLMBD.cfg @@ -31,9 +31,9 @@ -M -$M16384,1048576 -K$00400000 --N"..\..\Lib\D7" --LE"..\..\Lib\D7" --LN"..\..\Lib\D7" +-N"P:\algemeen\lib" +-LE"P:\algemeen\bin" +-LN"P:\algemeen\lib" -Z -w-UNSAFE_TYPE -w-UNSAFE_CODE diff --git a/Packages/D7/X2CLMBD.dof b/Packages/D7/X2CLMBD.dof index 3456ef5..fd53e9c 100644 --- a/Packages/D7/X2CLMBD.dof +++ b/Packages/D7/X2CLMBD.dof @@ -91,9 +91,9 @@ ImageBase=4194304 ExeDescription=X²CL MenuBar (Designtime) [Directories] OutputDir= -UnitOutputDir=..\..\Lib\D7 -PackageDLLOutputDir=..\..\Lib\D7 -PackageDCPOutputDir=..\..\Lib\D7 +UnitOutputDir=$(DELPHILIB) +PackageDLLOutputDir=$(DELPHIBIN) +PackageDCPOutputDir=$(DELPHILIB) SearchPath= Packages=vcl;rtl;vclx;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;dsnapcon;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;websnap;adortl;CLXIB;ibxpress;VCLIB;teeui;teedb;tee;dss;visualclx;visualdbclx;vclactnband;vclshlctrls;IntrawebDB_50_70;Intraweb_50_70;dclOfficeXP;Indy70;cxLibraryVCLD7;dxBarD7;dxComnD7;dxBarDBNavD7;dxBarExtDBItemsD7;dxBarExtItemsD7;dxDockingD7;dxsbD7;cxEditorsVCLD7;dxThemeD7;cxDataD7;cxExtEditorsVCLD7;cxPageControlVCLD7;cxGridVCLD7;cxSchedulerVCLD7;dxMasterViewD7;dxmdsD7;dxPSCoreD7;dxPSTeeChartD7;dxPsPrVwAdvD7;dxPSLnksD7;dxPSdxMVLnkD7;dxPSDBTeeChartD7;dxPScxCommonD7;dxPScxPCProdD7;dxPScxGridLnkD7;dxPScxExtCommonD7;dxPScxScheduler2LnkD7;wpViewPDF_D7;Rave50CLX;Rave50VCL;xtx_d7;IBSQLProperty;SamPackage;rbTCUI107;rbTC107;rbRCL107;rbIDE107;rbBDE107;rbUSERDesign107;rbUSER107;madBasic_;madDisAsm_;madExcept_;unageneral_d7 Conditionals= @@ -135,8 +135,6 @@ ProductName= ProductVersion=1.0.0.0 Comments= [Excluded Packages] -P:\Algemeen\components\X2CL\Lib\D7\X2CLMBD.bpl=X²CL MenuBar (Designtime) -P:\Algemeen\components\X2CL\Lib\D7\X2CLGLD.bpl=X²CL GraphicList (Designtime) C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors [HistoryLists\hlUnitAliases] Count=1 @@ -145,14 +143,17 @@ Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; Count=1 Item0=P:\Algemeen\Indy10;P:\Algemeen\Indy10\Core;P:\Algemeen\Indy10\Protocols;P:\Algemeen\Indy10\SuperCore;P:\Algemeen\Indy10\System [HistoryLists\hlUnitOutputDirectory] -Count=3 -Item0=..\..\Lib\D7 -Item1=..\Lib\D7 -Item2=Lib\D7 +Count=4 +Item0=$(DELPHILIB) +Item1=..\..\Lib\D7 +Item2=..\Lib\D7 +Item3=Lib\D7 [HistoryLists\hlBPLOutput] -Count=2 -Item0=..\..\Lib\D7 -Item1=Lib\D7 +Count=3 +Item0=$(DELPHIBIN) +Item1=..\..\Lib\D7 +Item2=Lib\D7 [HistoryLists\hlDCPOutput] -Count=1 -Item0=..\..\Lib\D7 +Count=2 +Item0=$(DELPHILIB) +Item1=..\..\Lib\D7 diff --git a/Packages/X2CLGraphicsEditor.dfm b/Packages/X2CLGraphicsEditor.dfm index a6488fe..d3d4fa8 100644 --- a/Packages/X2CLGraphicsEditor.dfm +++ b/Packages/X2CLGraphicsEditor.dfm @@ -119,10 +119,14 @@ object GraphicsEditorForm: TGraphicsEditorForm Top = 26 Width = 189 Height = 398 + Style = lbVirtual Align = alClient ItemHeight = 13 TabOrder = 1 OnClick = lstGraphicsClick + OnData = lstGraphicsData + OnDataFind = lstGraphicsDataFind + OnKeyPress = lstGraphicsKeyPress end object tbGraphics: TToolBar Left = 0 diff --git a/Packages/X2CLGraphicsEditor.pas b/Packages/X2CLGraphicsEditor.pas index 48817be..324ce26 100644 --- a/Packages/X2CLGraphicsEditor.pas +++ b/Packages/X2CLGraphicsEditor.pas @@ -67,6 +67,11 @@ type procedure actOpenExecute(Sender: TObject); procedure actSaveExecute(Sender: TObject); procedure actClearExecute(Sender: TObject); + procedure lstGraphicsData(Control: TWinControl; Index: Integer; + var Data: String); + function lstGraphicsDataFind(Control: TWinControl; + FindString: String): Integer; + procedure lstGraphicsKeyPress(Sender: TObject; var Key: Char); private FComponent: TX2GraphicContainer; FComponentDesigner: IDesigner; @@ -74,7 +79,7 @@ type procedure InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner); - procedure LoadGraphic(AIndex: Integer; AGraphic: TX2GraphicContainerItem; const AFileName: string); + procedure LoadGraphic(AGraphic: TX2GraphicContainerItem; const AFileName: string); procedure ItemChanged(AUpdatePreview: Boolean = True); procedure UpdateUI(); @@ -90,7 +95,8 @@ type implementation uses Graphics, - SysUtils; + SysUtils, + Windows; var @@ -110,9 +116,6 @@ begin end; procedure TGraphicsEditorForm.InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner); -var - graphicIndex: Integer; - begin FComponent := TX2GraphicContainer(AComponent); FComponent.FreeNotification(Self); @@ -120,22 +123,8 @@ begin FComponentDesigner := ADesigner; Caption := Format('%s Graphics', [FComponent.Name]); - // Fill graphics list - with lstGraphics.Items do - begin - BeginUpdate(); - try - Clear(); - - for graphicIndex := 0 to FComponent.GraphicCount - 1 do - AddObject(FComponent.Graphics[graphicIndex].PictureName, - FComponent.Graphics[graphicIndex]); - finally - EndUpdate(); - end; - - lstGraphics.ItemIndex := 0; - end; + lstGraphics.Count := FComponent.GraphicCount; + lstGraphics.ItemIndex := 0; UpdateUI(); UpdatePreview(); @@ -155,13 +144,13 @@ begin end; -procedure TGraphicsEditorForm.LoadGraphic(AIndex: Integer; AGraphic: TX2GraphicContainerItem; const AFileName: string); +procedure TGraphicsEditorForm.LoadGraphic(AGraphic: TX2GraphicContainerItem; const AFileName: string); begin AGraphic.Picture.LoadFromFile(AFileName); if Length(AGraphic.PictureName) = 0 then begin - AGraphic.PictureName := ChangeFileExt(ExtractFileName(AFileName), ''); - lstGraphics.Items[AIndex] := AGraphic.PictureName; + AGraphic.PictureName := ChangeFileExt(ExtractFileName(AFileName), ''); + lstGraphics.Invalidate; end; end; @@ -169,12 +158,12 @@ end; procedure TGraphicsEditorForm.ItemChanged(AUpdatePreview: Boolean); begin if Assigned(FComponentDesigner) then - FComponentDesigner.Modified(); + FComponentDesigner.Modified; UpdateUI(); if AUpdatePreview then - UpdatePreview(); + UpdatePreview; end; @@ -198,7 +187,7 @@ begin actClear.Enabled := enabled; actUp.Enabled := enabled and (index > 0); - actDown.Enabled := enabled and (index < Pred(lstGraphics.Items.Count)); + actDown.Enabled := enabled and (index < Pred(FComponent.GraphicCount)); end; @@ -213,8 +202,8 @@ begin if Active(index, graphic) then begin imgPreview.Picture.Assign(graphic.Picture); - txtName.Text := graphic.PictureName; - lstGraphics.Items[index] := graphic.PictureName; + txtName.Text := graphic.PictureName; + lstGraphics.Invalidate; end else begin imgPreview.Picture.Assign(nil); @@ -234,7 +223,7 @@ begin if AIndex = -1 then exit; - AGraphic := TX2GraphicContainerItem(lstGraphics.Items.Objects[AIndex]); + AGraphic := FComponent.Graphics[AIndex]; Result := Assigned(AGraphic); end; @@ -257,8 +246,8 @@ begin if Active(index, graphic) then begin - graphic.PictureName := txtName.Text; - lstGraphics.Items[index] := graphic.PictureName; + graphic.PictureName := txtName.Text; + lstGraphics.Invalidate; ItemChanged(False); end; @@ -267,7 +256,6 @@ end; procedure TGraphicsEditorForm.actAddExecute(Sender: TObject); var - index: Integer; graphic: TX2GraphicContainerItem; fileIndex: Integer; @@ -285,11 +273,10 @@ begin if Assigned(graphic) then begin - graphic.Container := FComponent; - index := lstGraphics.Items.AddObject('', graphic); - lstGraphics.ItemIndex := index; + graphic.Container := FComponent; + lstGraphics.Count := FComponent.GraphicCount; - LoadGraphic(index, graphic, dlgOpen.Files[fileIndex]); + LoadGraphic(graphic, dlgOpen.Files[fileIndex]); end else raise Exception.Create('Failed to create TX2GraphicContainerItem!'); end; @@ -313,10 +300,10 @@ begin if it's not allowed, for example due to it being introduced in an ancestor. } graphic.Free(); - lstGraphics.Items.Delete(index); + lstGraphics.Count := FComponent.GraphicCount; - if index > Pred(lstGraphics.Items.Count) then - index := Pred(lstGraphics.Items.Count); + if index > Pred(FComponent.GraphicCount) then + index := Pred(FComponent.GraphicCount); lstGraphics.ItemIndex := index; @@ -334,9 +321,9 @@ begin if Active(index, graphic) then if index > 0 then begin - lstGraphics.Items.Move(index, Pred(index)); graphic.Index := Pred(index); lstGraphics.ItemIndex := Pred(index); + lstGraphics.Invalidate; ItemChanged(False); end; @@ -350,11 +337,11 @@ var begin if Active(index, graphic) then - if index < Pred(lstGraphics.Items.Count) then + if index < Pred(FComponent.GraphicCount) then begin - lstGraphics.Items.Move(index, index + 1); graphic.Index := Succ(index); lstGraphics.ItemIndex := Succ(index); + lstGraphics.Invalidate; ItemChanged(False); end; @@ -374,7 +361,7 @@ begin if dlgOpen.Execute() then begin - LoadGraphic(index, graphic, dlgOpen.FileName); + LoadGraphic(graphic, dlgOpen.FileName); ItemChanged(); end; end; @@ -423,4 +410,34 @@ begin end; end; + +procedure TGraphicsEditorForm.lstGraphicsData(Control: TWinControl; Index: Integer; var Data: String); +begin + Data := Format('%d - %s', [Index, FComponent.Graphics[Index].PictureName]); +end; + + +function TGraphicsEditorForm.lstGraphicsDataFind(Control: TWinControl; FindString: String): Integer; +var + graphicIndex: Integer; + +begin + Result := -1; + + for graphicIndex := 0 to Pred(FComponent.GraphicCount) do + if SameText(Copy(FComponent.Graphics[graphicIndex].PictureName, 1, Length(FindString)), FindString) then + begin + Result := graphicIndex; + Break; + end; +end; + + +procedure TGraphicsEditorForm.lstGraphicsKeyPress(Sender: TObject; var Key: Char); +begin + { Because the listbox is virtual, Return causes the ItemIndex to reset to 0 } + if Ord(Key) = VK_RETURN then + Key := #0; +end; + end. diff --git a/Source/X2CLGraphics.pas b/Source/X2CLGraphics.pas index 247b082..f1a8e85 100644 --- a/Source/X2CLGraphics.pas +++ b/Source/X2CLGraphics.pas @@ -83,6 +83,24 @@ type procedure DrawBlended(ABackground, AForeground: Graphics.TBitmap; AAlpha: Byte); + { + :$ Draws a rectangle with a vertical gradient. + } + procedure GradientFillRect(ACanvas: TCanvas; ARect: TRect; AStartColor, AEndColor: TColor); + + + { + :$ Darkens a color with the specified value + } + function DarkenColor(const AColor: TColor; const AValue: Byte): TColor; + + + { + :$ Lightens a color with the specified value + } + function LightenColor(const AColor: TColor; const AValue: Byte): TColor; + + implementation @@ -231,4 +249,118 @@ begin end; end; + +procedure GradientFillRect(ACanvas: TCanvas; ARect: TRect; AStartColor, AEndColor: TColor); + + function FixValue(AValue: Single): Single; + begin + Result := AValue; + + if Result < 0 then + Result := 0; + + if Result > 255 then + Result := 255; + end; + + +var + startColor: Cardinal; + endColor: Cardinal; + stepCount: Integer; + redValue: Single; + greenValue: Single; + blueValue: Single; + redStep: Single; + greenStep: Single; + blueStep: Single; + line: Integer; + +begin + startColor := ColorToRGB(AStartColor); + endColor := ColorToRGB(AEndColor); + + if startColor = endColor then + begin + ACanvas.Brush.Style := bsSolid; + ACanvas.Brush.Color := startColor; + ACanvas.FillRect(ARect); + end else + begin + redValue := GetRValue(startColor); + greenValue := GetGValue(startColor); + blueValue := GetBValue(startColor); + + stepCount := ARect.Bottom - ARect.Top; + redStep := (GetRValue(endColor) - redValue) / stepCount; + greenStep := (GetGValue(endColor) - greenValue) / stepCount; + blueStep := (GetBValue(endColor) - blueValue) / stepCount; + + ACanvas.Pen.Style := psSolid; + + for line := ARect.Top to ARect.Bottom do + begin + ACanvas.Pen.Color := RGB(Trunc(redValue), Trunc(greenValue), Trunc(blueValue)); + ACanvas.MoveTo(ARect.Left, line); + ACanvas.LineTo(ARect.Right, line); + + redValue := FixValue(redValue + redStep); + greenValue := FixValue(greenValue + greenStep); + blueValue := FixValue(blueValue + blueStep); + end; + end; +end; + + +function DarkenColor(const AColor: TColor; const AValue: Byte): TColor; +var + cColor: Cardinal; + iRed: Integer; + iGreen: Integer; + iBlue: Integer; + +begin + cColor := ColorToRGB(AColor); + iRed := (cColor and $FF0000) shr 16;; + iGreen := (cColor and $00FF00) shr 8; + iBlue := cColor and $0000FF; + + Dec(iRed, AValue); + Dec(iGreen, AValue); + Dec(iBlue, AValue); + + if iRed < 0 then iRed := 0; + if iGreen < 0 then iGreen := 0; + if iBlue < 0 then iBlue := 0; + + Result := (iRed shl 16) + (iGreen shl 8) + iBlue; +end; + + +function LightenColor(const AColor: TColor; const AValue: Byte): TColor; +var + cColor: Cardinal; + iRed: Integer; + iGreen: Integer; + iBlue: Integer; + +begin + cColor := ColorToRGB(AColor); + iRed := (cColor and $FF0000) shr 16;; + iGreen := (cColor and $00FF00) shr 8; + iBlue := cColor and $0000FF; + + Inc(iRed, AValue); + Inc(iGreen, AValue); + Inc(iBlue, AValue); + + if iRed > 255 then iRed := 255; + if iGreen > 255 then iGreen := 255; + if iBlue > 255 then iBlue := 255; + + Result := (iRed shl 16) + (iGreen shl 8) + iBlue; +end; + end. + + diff --git a/Source/X2CLunaMenuBarPainter.pas b/Source/X2CLunaMenuBarPainter.pas index 86c398f..26e8592 100644 --- a/Source/X2CLunaMenuBarPainter.pas +++ b/Source/X2CLunaMenuBarPainter.pas @@ -14,6 +14,7 @@ interface uses Classes, Graphics, + ImgList, Windows, X2CLMenuBar; @@ -28,6 +29,7 @@ type property OnChange: TNotifyEvent read FOnChange write FOnChange; end; + TX2MenuBarunaColor = class(TX2MenuBarunaProperty) private FDefaultDisabled: TColor; @@ -63,6 +65,7 @@ type property Selected: TColor read FSelected write SetSelected stored IsSelectedStored; end; + TX2MenuBarunaGroupColors = class(TX2MenuBarunaProperty) private FFill: TX2MenuBarunaColor; @@ -85,6 +88,7 @@ type property Text: TX2MenuBarunaColor read FText write SetText; end; + TX2MenuBarunaMetrics = class(TX2MenuBarunaProperty) private FAfterGroupHeader: Integer; @@ -128,6 +132,7 @@ type property ImageOffsetY: Integer read FImageOffsetY write SetImageOffsetY default 0; end; + TX2MenuBarunaPainter = class(TX2CustomMenuBarPainter) private FArrowColor: TColor; @@ -138,6 +143,9 @@ type FMetrics: TX2MenuBarunaMetrics; FShadowColor: TColor; FShadowOffset: Integer; + FGroupGradient: Integer; + FArrowImages: TCustomImageList; + FArrowImageIndex: TImageIndex; procedure SetBlurShadow(const Value: Boolean); procedure SetGroupColors(const Value: TX2MenuBarunaGroupColors); @@ -145,7 +153,14 @@ type procedure SetMetrics(const Value: TX2MenuBarunaMetrics); procedure SetShadowColor(const Value: TColor); procedure SetShadowOffset(const Value: Integer); + procedure SetGroupGradient(const Value: Integer); + procedure SetArrowImageIndex(const Value: TImageIndex); + procedure SetArrowImages(const Value: TCustomImageList); protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + + function HasArrowImage(): Boolean; + function ApplyMargins(const ABounds: TRect): TRect; override; function GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; override; function GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer; override; @@ -154,6 +169,7 @@ type procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect); override; procedure DrawGroupHeader(ACanvas: TCanvas; AGroup: TX2MenuBarGroup; const ABounds: TRect; AState: TX2MenuBarDrawStates); override; procedure DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem; const ABounds: TRect; AState: TX2MenuBarDrawStates); override; + procedure DrawArrow(ACanvas: TCanvas; ABounds: TRect); procedure ColorChange(Sender: TObject); public @@ -162,24 +178,30 @@ type procedure ResetColors(); published - property ArrowColor: TColor read FArrowColor write FArrowColor default clBlue; - property BlurShadow: Boolean read FBlurShadow write SetBlurShadow default True; - property Color: TColor read FColor write FColor default clWindow; - property GroupColors: TX2MenuBarunaGroupColors read FGroupColors write SetGroupColors; - property ItemColors: TX2MenuBarunaColor read FItemColors write SetItemColors; - property Metrics: TX2MenuBarunaMetrics read FMetrics write SetMetrics; - property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow; - property ShadowOffset: Integer read FShadowOffset write SetShadowOffset default 2; + property ArrowImageIndex: TImageIndex read FArrowImageIndex write SetArrowImageIndex default -1; + property ArrowImages: TCustomImageList read FArrowImages write SetArrowImages; + property ArrowColor: TColor read FArrowColor write FArrowColor default clBlue; + property BlurShadow: Boolean read FBlurShadow write SetBlurShadow default True; + property Color: TColor read FColor write FColor default clWindow; + property GroupColors: TX2MenuBarunaGroupColors read FGroupColors write SetGroupColors; + property ItemColors: TX2MenuBarunaColor read FItemColors write SetItemColors; + property Metrics: TX2MenuBarunaMetrics read FMetrics write SetMetrics; + property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow; + property ShadowOffset: Integer read FShadowOffset write SetShadowOffset default 2; + property GroupGradient: Integer read FGroupGradient write SetGroupGradient default 0; end; implementation uses - ImgList, SysUtils, X2CLGraphics; +const + ArrowMargin = 2; + ArrowWidth = 8; + procedure Blur(ASource: Graphics.TBitmap); var @@ -418,11 +440,12 @@ constructor TX2MenuBarunaPainter.Create(AOwner: TComponent); begin inherited; - FBlurShadow := True; - FGroupColors := TX2MenuBarunaGroupColors.Create(); - FItemColors := TX2MenuBarunaColor.Create(); - FMetrics := TX2MenuBarunaMetrics.Create(); - FShadowOffset := 2; + FArrowImageIndex := -1; + FBlurShadow := True; + FGroupColors := TX2MenuBarunaGroupColors.Create(); + FItemColors := TX2MenuBarunaColor.Create(); + FMetrics := TX2MenuBarunaMetrics.Create(); + FShadowOffset := 2; FGroupColors.OnChange := ColorChange; FItemColors.OnChange := ColorChange; @@ -433,6 +456,7 @@ end; destructor TX2MenuBarunaPainter.Destroy(); begin + SetArrowImages(nil); FreeAndNil(FMetrics); FreeAndNil(FItemColors); FreeAndNil(FGroupColors); @@ -552,6 +576,9 @@ var shadowBitmap: Graphics.TBitmap; shadowBounds: TRect; textRect: TRect; + clipRegion: HRGN; + startColor: TColor; + endColor: TColor; begin if not ((mdsSelected in AState) or (mdsGroupSelected in AState)) then @@ -584,12 +611,32 @@ begin end; { Rounded rectangle } - ACanvas.Brush.Color := GetColor(GroupColors.Fill); + startColor := GetColor(GroupColors.Fill); + endColor := startColor; + + if GroupGradient > 0 then + endColor := LightenColor(startColor, GroupGradient) + + else if GroupGradient < 0 then + endColor := DarkenColor(startColor, -GroupGradient); + + + clipRegion := CreateRoundRectRgn(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5); + SelectClipRgn(ACanvas.Handle, clipRegion); + + GradientFillRect(ACanvas, ABounds, startColor, endColor); + + SelectClipRgn(ACanvas.Handle, 0); + DeleteObject(clipRegion); + + ACanvas.Brush.Style := bsClear; ACanvas.Pen.Color := GetColor(GroupColors.Border); + ACanvas.Pen.Style := psSolid; + ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5); + + ACanvas.Brush.Style := bsSolid; ACanvas.Font.Color := GetColor(GroupColors.Text); - ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5); - textRect := ABounds; Inc(textRect.Left, 4); Dec(textRect.Right, 4); @@ -635,31 +682,24 @@ procedure TX2MenuBarunaPainter.DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem; Result := AColor.Disabled; end; + var focusBounds: TRect; textBounds: TRect; - arrowPoints: array[0..2] of TPoint; begin focusBounds := ABounds; - Dec(focusBounds.Right, Metrics.Margin); + + if HasArrowImage() then + Dec(focusBounds.Right, ArrowImages.Width + ArrowMargin) + else + Dec(focusBounds.Right, ArrowWidth + ArrowMargin); if (mdsSelected in AState) then begin - { Focus rectangle } + { Focus rectangle and arrow } DrawFocusRect(ACanvas, focusBounds); - - { Arrow } - ACanvas.Brush.Color := ArrowColor; - ACanvas.Pen.Color := ArrowColor; - - arrowPoints[0].X := ABounds.Right - 8; - arrowPoints[0].Y := ABounds.Top + ((ABounds.Bottom - ABounds.Top - 15) div 2) + 7; - arrowPoints[1].X := Pred(ABounds.Right); - arrowPoints[1].Y := arrowPoints[0].Y - 7; - arrowPoints[2].X := Pred(ABounds.Right); - arrowPoints[2].Y := arrowPoints[0].Y + 7; - ACanvas.Polygon(arrowPoints); + DrawArrow(ACanvas, ABounds); end; { Text } @@ -680,12 +720,55 @@ begin end; +procedure TX2MenuBarunaPainter.DrawArrow(ACanvas: TCanvas; ABounds: TRect); +var + arrowX: Integer; + arrowY: Integer; + arrowPoints: array[0..2] of TPoint; + +begin + if HasArrowImage() then + begin + arrowX := ABounds.Right - ArrowImages.Width; + arrowY := ABounds.Top + ((ABounds.Bottom - ABounds.Top - ArrowImages.Height) div 2); + ArrowImages.Draw(ACanvas, arrowX, arrowY, ArrowImageIndex); + end else + begin + ACanvas.Brush.Color := ArrowColor; + ACanvas.Pen.Color := ArrowColor; + + arrowPoints[0].X := ABounds.Right - 8; + arrowPoints[0].Y := ABounds.Top + ((ABounds.Bottom - ABounds.Top - 15) div 2) + 7; + arrowPoints[1].X := Pred(ABounds.Right); + arrowPoints[1].Y := arrowPoints[0].Y - 7; + arrowPoints[2].X := Pred(ABounds.Right); + arrowPoints[2].Y := arrowPoints[0].Y + 7; + ACanvas.Polygon(arrowPoints); + end; +end; + + procedure TX2MenuBarunaPainter.ColorChange(Sender: TObject); begin NotifyObservers(); end; +function TX2MenuBarunaPainter.HasArrowImage(): Boolean; +begin + Result := Assigned(ArrowImages) and (ArrowImageIndex > -1); +end; + + +procedure TX2MenuBarunaPainter.Notification(AComponent: TComponent; Operation: TOperation); +begin + if (Operation = opRemove) and (AComponent = FArrowImages) then + SetArrowImages(nil); + + inherited; +end; + + procedure TX2MenuBarunaPainter.SetGroupColors(const Value: TX2MenuBarunaGroupColors); begin if Value <> FGroupColors then @@ -732,6 +815,43 @@ begin end; +procedure TX2MenuBarunaPainter.SetGroupGradient(const Value: Integer); +begin + if Value <> FGroupGradient then + begin + FGroupGradient := Value; + NotifyObservers(); + end; +end; + + +procedure TX2MenuBarunaPainter.SetArrowImageIndex(const Value: TImageIndex); +begin + if Value <> FArrowImageIndex then + begin + FArrowImageIndex := Value; + NotifyObservers(); + end; +end; + + +procedure TX2MenuBarunaPainter.SetArrowImages(const Value: TCustomImageList); +begin + if Value <> FArrowImages then + begin + if Assigned(FArrowImages) then + FArrowImages.RemoveFreeNotification(Self); + + FArrowImages := Value; + + if Assigned(FArrowImages) then + FArrowImages.FreeNotification(Self); + + NotifyObservers(); + end; +end; + + { TX2MenuBarunaProperty } procedure TX2MenuBarunaProperty.Changed(); begin