From ced0de69b16ae67ed575c38bd84450c1ee736e72 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Wed, 31 Jan 2007 09:41:11 +0000 Subject: [PATCH] Added: MenuBar package Changed: proper UnameIT MenuBar Painter implementation Fixed: GraphicList editor notifies designer of changes --- Packages/D7/X2CLGL.cfg | 4 +- Packages/D7/X2CLGL.dof | 20 +- Packages/D7/X2CLGLD.cfg | 4 +- Packages/D7/X2CLGLD.dof | 20 +- Packages/D7/X2CLGLD.dpk | 2 +- Packages/D7/X2CLMB.cfg | 40 ++ Packages/D7/X2CLMB.dof | 156 ++++++++ Packages/D7/X2CLMB.dpk | 44 +++ Packages/D7/X2CLMB.res | Bin 0 -> 1536 bytes Packages/D7/X2CLMBD.cfg | 40 ++ Packages/D7/X2CLMBD.dof | 158 ++++++++ Packages/D7/X2CLMBD.dpk | 43 ++ Packages/D7/X2CLMBD.res | Bin 0 -> 1536 bytes Packages/X2CLGLEditors.pas | 10 +- Packages/X2CLGraphicsEditor.dfm | 30 +- Packages/X2CLGraphicsEditor.pas | 293 +++++++------- Packages/X2CLMBReg.pas | 3 + Packages/X2CLMenuBarEditor.pas | 2 + Source/X2CLMenuBar.pas | 448 ++++++++++++++++----- Source/X2CLunaMenuBarPainter.pas | 650 ++++++++++++++++++++++++++++--- X2CL.bpg | 8 +- 21 files changed, 1653 insertions(+), 322 deletions(-) create mode 100644 Packages/D7/X2CLMB.cfg create mode 100644 Packages/D7/X2CLMB.dof create mode 100644 Packages/D7/X2CLMB.dpk create mode 100644 Packages/D7/X2CLMB.res create mode 100644 Packages/D7/X2CLMBD.cfg create mode 100644 Packages/D7/X2CLMBD.dof create mode 100644 Packages/D7/X2CLMBD.dpk create mode 100644 Packages/D7/X2CLMBD.res diff --git a/Packages/D7/X2CLGL.cfg b/Packages/D7/X2CLGL.cfg index a3c9962..45fffc7 100644 --- a/Packages/D7/X2CLGL.cfg +++ b/Packages/D7/X2CLGL.cfg @@ -33,5 +33,5 @@ -$M16384,1048576 -K$00400000 -N"..\..\Lib\D7" --LE"c:\program files\borland\delphi7\Projects\Bpl" --LN"c:\program files\borland\delphi7\Projects\Bpl" +-LE"..\..\Lib\D7" +-LN"..\..\Lib\D7" diff --git a/Packages/D7/X2CLGL.dof b/Packages/D7/X2CLGL.dof index 2c2d614..0ba8e21 100644 --- a/Packages/D7/X2CLGL.dof +++ b/Packages/D7/X2CLGL.dof @@ -92,8 +92,8 @@ ExeDescription=X [Directories] OutputDir= UnitOutputDir=..\..\Lib\D7 -PackageDLLOutputDir= -PackageDCPOutputDir= +PackageDLLOutputDir=..\..\Lib\D7 +PackageDCPOutputDir=..\..\Lib\D7 SearchPath= Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter Conditionals= @@ -105,6 +105,10 @@ HostApplication= Launcher= UseLauncher=0 DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= [Version Info] IncludeVerInfo=1 AutoIncBuild=0 @@ -131,16 +135,22 @@ ProductName= ProductVersion=1.0.0.0 Comments= [Excluded Packages] -c:\program files\borland\delphi7\Projects\Bpl\VirtualShellToolsD7D.bpl=Virtual Shell Tools Designtime Package -c:\program files\borland\delphi7\Projects\Bpl\VirtualExplorerListviewExD7D.bpl=Virtual ExplorerListviewEx Designtime Package +C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors [HistoryLists\hlUnitAliases] Count=1 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +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 [HistoryLists\hlBPLOutput] +Count=2 +Item0=..\..\Lib\D7 +Item1=Lib\D7 +[HistoryLists\hlDCPOutput] Count=1 -Item0=Lib\D7 +Item0=..\..\Lib\D7 diff --git a/Packages/D7/X2CLGLD.cfg b/Packages/D7/X2CLGLD.cfg index a3c9962..45fffc7 100644 --- a/Packages/D7/X2CLGLD.cfg +++ b/Packages/D7/X2CLGLD.cfg @@ -33,5 +33,5 @@ -$M16384,1048576 -K$00400000 -N"..\..\Lib\D7" --LE"c:\program files\borland\delphi7\Projects\Bpl" --LN"c:\program files\borland\delphi7\Projects\Bpl" +-LE"..\..\Lib\D7" +-LN"..\..\Lib\D7" diff --git a/Packages/D7/X2CLGLD.dof b/Packages/D7/X2CLGLD.dof index 119bf56..e94c696 100644 --- a/Packages/D7/X2CLGLD.dof +++ b/Packages/D7/X2CLGLD.dof @@ -92,8 +92,8 @@ ExeDescription=X [Directories] OutputDir= UnitOutputDir=..\..\Lib\D7 -PackageDLLOutputDir= -PackageDCPOutputDir= +PackageDLLOutputDir=..\..\Lib\D7 +PackageDCPOutputDir=..\..\Lib\D7 SearchPath= Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter Conditionals= @@ -105,6 +105,10 @@ HostApplication= Launcher= UseLauncher=0 DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir= [Version Info] IncludeVerInfo=1 AutoIncBuild=0 @@ -131,16 +135,22 @@ ProductName= ProductVersion=1.0.0.0 Comments= [Excluded Packages] -c:\program files\borland\delphi7\Projects\Bpl\VirtualShellToolsD7D.bpl=Virtual Shell Tools Designtime Package -c:\program files\borland\delphi7\Projects\Bpl\VirtualExplorerListviewExD7D.bpl=Virtual ExplorerListviewEx Designtime Package +C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors [HistoryLists\hlUnitAliases] Count=1 Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +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 [HistoryLists\hlBPLOutput] +Count=2 +Item0=..\..\Lib\D7 +Item1=Lib\D7 +[HistoryLists\hlDCPOutput] Count=1 -Item0=Lib\D7 +Item0=..\..\Lib\D7 diff --git a/Packages/D7/X2CLGLD.dpk b/Packages/D7/X2CLGLD.dpk index 29ff1f7..62cfadc 100644 --- a/Packages/D7/X2CLGLD.dpk +++ b/Packages/D7/X2CLGLD.dpk @@ -34,6 +34,6 @@ requires contains X2CLGLReg in '..\X2CLGLReg.pas', X2CLGLEditors in '..\X2CLGLEditors.pas', - X2CLGraphicsEditor in '..\X2CLGraphicsEditor.pas' {frmGraphicsEditor}; + X2CLGraphicsEditor in '..\X2CLGraphicsEditor.pas' {GraphicsEditorForm}; end. diff --git a/Packages/D7/X2CLMB.cfg b/Packages/D7/X2CLMB.cfg new file mode 100644 index 0000000..5b840e3 --- /dev/null +++ b/Packages/D7/X2CLMB.cfg @@ -0,0 +1,40 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-N"..\..\Lib\D7" +-LE"..\..\Lib\D7" +-LN"..\..\Lib\D7" +-Z +-w-UNSAFE_TYPE +-w-UNSAFE_CODE +-w-UNSAFE_CAST diff --git a/Packages/D7/X2CLMB.dof b/Packages/D7/X2CLMB.dof new file mode 100644 index 0000000..b236d25 --- /dev/null +++ b/Packages/D7/X2CLMB.dof @@ -0,0 +1,156 @@ +[FileVersion] +Version=7.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=0 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=0 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +NamespacePrefix= +SymbolDeprecated=1 +SymbolLibrary=1 +SymbolPlatform=1 +UnitLibrary=1 +UnitPlatform=1 +UnitDeprecated=1 +HResultCompat=1 +HidingMember=1 +HiddenVirtual=1 +Garbage=1 +BoundsError=1 +ZeroNilCompat=1 +StringConstTruncated=1 +ForLoopVarVarPar=1 +TypedConstVarPar=1 +AsgToTypedConst=1 +CaseLabelRange=1 +ForVariable=1 +ConstructingAbstract=1 +ComparisonFalse=1 +ComparisonTrue=1 +ComparingSignedUnsigned=1 +CombiningSignedUnsigned=1 +UnsupportedConstruct=1 +FileOpen=1 +FileOpenUnitSrc=1 +BadGlobalSymbol=1 +DuplicateConstructorDestructor=1 +InvalidDirective=1 +PackageNoLink=1 +PackageThreadVar=1 +ImplicitImport=1 +HPPEMITIgnored=1 +NoRetVal=1 +UseBeforeDef=1 +ForLoopVarUndef=1 +UnitNameMismatch=1 +NoCFGFileFound=1 +MessageDirective=1 +ImplicitVariants=1 +UnicodeToLocale=1 +LocaleToUnicode=1 +ImagebaseMultiple=1 +SuspiciousTypecast=1 +PrivatePropAccessor=1 +UnsafeType=0 +UnsafeCode=0 +UnsafeCast=0 +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription=X²CL MenuBar +[Directories] +OutputDir= +UnitOutputDir=..\..\Lib\D7 +PackageDLLOutputDir=..\..\Lib\D7 +PackageDCPOutputDir=..\..\Lib\D7 +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= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Language] +ActiveLang= +ProjectLang= +RootDir=C:\Program Files\Borland\Delphi7\Bin\ +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1043 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +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 +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +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 +[HistoryLists\hlBPLOutput] +Count=2 +Item0=..\..\Lib\D7 +Item1=Lib\D7 +[HistoryLists\hlDCPOutput] +Count=1 +Item0=..\..\Lib\D7 diff --git a/Packages/D7/X2CLMB.dpk b/Packages/D7/X2CLMB.dpk new file mode 100644 index 0000000..79a932b --- /dev/null +++ b/Packages/D7/X2CLMB.dpk @@ -0,0 +1,44 @@ +package X2CLMB; + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST OFF} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'X²CL MenuBar'} +{$RUNONLY} +{$IMPLICITBUILD OFF} + +requires + rtl, + vcl, + designide, + vclactnband, + vclx; + +contains + X2CLunaMenuBarPainter in '..\..\Source\X2CLunaMenuBarPainter.pas', + X2CLGraphics in '..\..\Source\X2CLGraphics.pas', + X2CLMenuBarAnimators in '..\..\Source\X2CLMenuBarAnimators.pas', + X2CLMenuBar in '..\..\Source\X2CLMenuBar.pas', + X2CLmusikCubeMenuBarPainter in '..\..\Source\X2CLmusikCubeMenuBarPainter.pas'; + +end. + diff --git a/Packages/D7/X2CLMB.res b/Packages/D7/X2CLMB.res new file mode 100644 index 0000000000000000000000000000000000000000..6b01f73760a1fbad52111d983ebcc8bcad0aa0ca GIT binary patch literal 1536 zcmZuw&ubGw7=1|=3`A;5g%&RjOKHV}cG=zpTQOD&YQ;*grP_8arfG;Vix*Al!G#?9 zpGZqC!XU(xcmD!G58lkJg2nNDGdoEd`jMBJH{YA@$IK1@lnAXYI6Y^-vd*8QCS!cX z;)Lf!*EuN>OGF0gGWT3;Er36?T6W++r$h_gZkG-zLI!OI{@c1V3cPK0XKpGUb&pEwN>W?-g2{G5H_~>J0eTvs?mB&c*(%%f9*chjz_j3O2>&=I76tsg1k?K9@JP4x zSKU3!>F&FX{(k2QU6+U)aX@s5FT@Y6_32esF;8echDW%I6+9;HVU?q^;dddgA%jxM zGp|BkQ3j3vTPj}omKxawhFZrOHu!%ZPdQsL88%G5WzNMud%xL=yhVYS9TzQud=Ji( zF5#P5SVIGK?4pVY%N#4%X5=b%uutJfqnXD70)*^#fi*})KBHyW>pu2S!zT4_+4Uyb zwhNCNM&n|Z>3NM8CRdF)ce%IP*UlqPwbQOsTc>)U32>9y9bA5?vthJV=B|uXFl+KZ zq(3rVskX*CrP~NExzn1hbD(=h#U{46Z;xXguULsQt6fcF$f-$QSGTai3D`4wLhU}I zyOGF0gGWT3;Er36?T6W++r$h_gZkG-zLI!OI{@c1V3cPK0XKpGUb&pEwN>W?-g2{G5H_~>J0eTvs?mB&c*(%%f9*chjz_j3O2>&=I76tsg1k?K9@JP4x zSKU3!>F&FX{(k2QU6+U)aX@s5FT@Y6_32esF;8echDW%I6+9;HVU?q^;dddgA%jxM zGp|BkQ3j3vTPj}omKxawhFZrOHu!%ZPdQsL88%G5WzNMud%xL=yhVYS9TzQud=Ji( zF5#P5SVIGK?4pVY%N#4%X5=b%uutJfqnXD70)*^#fi*})KBHyW>pu2S!zT4_+4Uyb zwhNCNM&n|Z>3NM8CRdF)ce%IP*UlqPwbQOsTc>)U32>9y9bA5?vthJV=B|uXFl+KZ zq(3rVskX*CrP~NExzn1hbD(=h#U{46Z;xXguULsQt6fcF$f-$QSGTai3D`4wLhU}I zy 0); - actDown.Enabled := bEnabled and (iIndex < lstGraphics.Items.Count - 1); + actSave.Enabled := enabled; + actClear.Enabled := enabled; + + actUp.Enabled := enabled and (index > 0); + actDown.Enabled := enabled and (index < Pred(lstGraphics.Items.Count)); end; -procedure TfrmGraphicsEditor.UpdatePreview(); + +procedure TGraphicsEditorForm.UpdatePreview(); var - iIndex: Integer; - pGraphic: TX2GraphicContainerItem; + index: Integer; + graphic: TX2GraphicContainerItem; begin - if Active(iIndex, pGraphic) then - begin - imgPreview.Picture.Assign(pGraphic.Picture); - txtName.Text := pGraphic.PictureName; - Administrate(); - - if Assigned(FComponentDesigner) then - FComponentDesigner.SelectComponent(pGraphic); - end else - if Assigned(FComponentDesigner) then - FComponentDesigner.SelectComponent(FComponent); + FUpdating := True; + try + if Active(index, graphic) then + begin + imgPreview.Picture.Assign(graphic.Picture); + txtName.Text := graphic.PictureName; + end; + finally + FUpdating := False; + end; end; -{===================== TfrmGraphicsEditor - Graphic Management -========================================} -function TfrmGraphicsEditor.Active(out AIndex: Integer; out AGraphic: TX2GraphicContainerItem): Boolean; +function TGraphicsEditorForm.Active(out AIndex: Integer; out AGraphic: TX2GraphicContainerItem): Boolean; begin Result := False; AIndex := lstGraphics.ItemIndex; @@ -207,43 +221,50 @@ begin end; -procedure TfrmGraphicsEditor.lstGraphicsClick(Sender: TObject); +procedure TGraphicsEditorForm.lstGraphicsClick(Sender: TObject); begin + UpdateUI(); UpdatePreview(); end; -procedure TfrmGraphicsEditor.txtNameChange(Sender: TObject); + +procedure TGraphicsEditorForm.txtNameChange(Sender: TObject); var - iIndex: Integer; - pGraphic: TX2GraphicContainerItem; + index: Integer; + graphic: TX2GraphicContainerItem; begin - if Active(iIndex, pGraphic) then + if FUpdating then + Exit; + + if Active(index, graphic) then begin - pGraphic.PictureName := txtName.Text; - lstGraphics.Items[iIndex] := pGraphic.PictureName; + graphic.PictureName := txtName.Text; + lstGraphics.Items[index] := graphic.PictureName; + + ItemChanged(False); end; end; -procedure TfrmGraphicsEditor.actAddExecute(Sender: TObject); +procedure TGraphicsEditorForm.actAddExecute(Sender: TObject); var - iIndex: Integer; - pGraphic: TX2GraphicContainerItem; + index: Integer; + graphic: TX2GraphicContainerItem; begin if Assigned(FComponentDesigner) then begin - pGraphic := TX2GraphicContainerItem(FComponentDesigner.CreateComponent(TX2GraphicContainerItem, nil, 0, 0, 0, 0)); + graphic := TX2GraphicContainerItem(FComponentDesigner.CreateComponent(TX2GraphicContainerItem, nil, 0, 0, 0, 0)); - if Assigned(pGraphic) then + if Assigned(graphic) then begin - pGraphic.Container := FComponent; - iIndex := lstGraphics.Items.AddObject(pGraphic.PictureName, - pGraphic); + graphic.Container := FComponent; + index := lstGraphics.Items.AddObject(graphic.PictureName, + graphic); - lstGraphics.ItemIndex := iIndex; - UpdatePreview(); + lstGraphics.ItemIndex := index; + ItemChanged(); actOpen.Execute(); end else @@ -252,114 +273,120 @@ begin raise Exception.Create('Designer not found!'); end; -procedure TfrmGraphicsEditor.actDeleteExecute(Sender: TObject); + +procedure TGraphicsEditorForm.actDeleteExecute(Sender: TObject); var - iIndex: Integer; - pGraphic: TX2GraphicContainerItem; + index: Integer; + graphic: TX2GraphicContainerItem; begin - if Active(iIndex, pGraphic) then + if Active(index, graphic) then begin { First attempt to remove the component; this will raise an exception if it's not allowed, for example due to it being introduced in an ancestor. } - pGraphic.Free(); - lstGraphics.Items.Delete(iIndex); + graphic.Free(); + lstGraphics.Items.Delete(index); - if iIndex > lstGraphics.Items.Count - 1 then - iIndex := lstGraphics.Items.Count - 1; + if index > Pred(lstGraphics.Items.Count) then + index := Pred(lstGraphics.Items.Count); - lstGraphics.ItemIndex := iIndex; - UpdatePreview(); + lstGraphics.ItemIndex := index; + + ItemChanged(); end; end; -procedure TfrmGraphicsEditor.actUpExecute(Sender: TObject); + +procedure TGraphicsEditorForm.actUpExecute(Sender: TObject); var - iIndex: Integer; - pGraphic: TX2GraphicContainerItem; + index: Integer; + graphic: TX2GraphicContainerItem; begin - if Active(iIndex, pGraphic) then - if iIndex > 0 then + if Active(index, graphic) then + if index > 0 then begin - lstGraphics.Items.Move(iIndex, iIndex - 1); - pGraphic.Index := iIndex - 1; - lstGraphics.ItemIndex := iIndex - 1; - Administrate(); - end; -end; + lstGraphics.Items.Move(index, Pred(index)); + graphic.Index := Pred(index); + lstGraphics.ItemIndex := Pred(index); -procedure TfrmGraphicsEditor.actDownExecute(Sender: TObject); -var - iIndex: Integer; - pGraphic: TX2GraphicContainerItem; - -begin - if Active(iIndex, pGraphic) then - if iIndex < lstGraphics.Items.Count - 1 then - begin - lstGraphics.Items.Move(iIndex, iIndex + 1); - pGraphic.Index := iIndex + 1; - lstGraphics.ItemIndex := iIndex + 1; - Administrate(); + ItemChanged(False); end; end; -procedure TfrmGraphicsEditor.actOpenExecute(Sender: TObject); +procedure TGraphicsEditorForm.actDownExecute(Sender: TObject); var - iIndex: Integer; - pGraphic: TX2GraphicContainerItem; + index: Integer; + graphic: TX2GraphicContainerItem; begin - if Active(iIndex, pGraphic) then + if Active(index, graphic) then + if index < Pred(lstGraphics.Items.Count) then + begin + lstGraphics.Items.Move(index, index + 1); + graphic.Index := Succ(index); + lstGraphics.ItemIndex := Succ(index); + + ItemChanged(False); + end; +end; + + +procedure TGraphicsEditorForm.actOpenExecute(Sender: TObject); +var + index: Integer; + graphic: TX2GraphicContainerItem; + +begin + if Active(index, graphic) then begin dlgOpen.Filter := GraphicFilter(TGraphic); if dlgOpen.Execute() then begin - pGraphic.Picture.LoadFromFile(dlgOpen.FileName); - if Length(pGraphic.PictureName) = 0 then - pGraphic.PictureName := ChangeFileExt(ExtractFileName(dlgOpen.FileName), ''); + graphic.Picture.LoadFromFile(dlgOpen.FileName); + if Length(graphic.PictureName) = 0 then + graphic.PictureName := ChangeFileExt(ExtractFileName(dlgOpen.FileName), ''); - UpdatePreview(); + ItemChanged(); end; end; end; -procedure TfrmGraphicsEditor.actSaveExecute(Sender: TObject); +procedure TGraphicsEditorForm.actSaveExecute(Sender: TObject); var - iIndex: Integer; - pClass: TGraphicClass; - pGraphic: TX2GraphicContainerItem; + index: Integer; + graphic: TX2GraphicContainerItem; + graphicClass: TGraphicClass; begin - if Active(iIndex, pGraphic) then - if Assigned(pGraphic.Picture.Graphic) then begin - pClass := TGraphicClass(pGraphic.Picture.Graphic.ClassType); - dlgSave.Filter := GraphicFilter(pClass); - dlgSave.FileName := ChangeFileExt(pGraphic.PictureName, '.' + GraphicExtension(pClass)); - + if Active(index, graphic) then + if Assigned(graphic.Picture.Graphic) then begin + graphicClass := TGraphicClass(graphic.Picture.Graphic.ClassType); + dlgSave.Filter := GraphicFilter(graphicClass); + dlgSave.FileName := ChangeFileExt(graphic.PictureName, '.' + GraphicExtension(graphicClass)); + if dlgSave.Execute() then - pGraphic.Picture.SaveToFile(dlgSave.FileName); + graphic.Picture.SaveToFile(dlgSave.FileName); end; end; -procedure TfrmGraphicsEditor.actClearExecute(Sender: TObject); +procedure TGraphicsEditorForm.actClearExecute(Sender: TObject); var - iIndex: Integer; - pGraphic: TX2GraphicContainerItem; + index: Integer; + graphic: TX2GraphicContainerItem; begin - if Active(iIndex, pGraphic) then + if Active(index, graphic) then begin - pGraphic.Picture.Assign(nil); - UpdatePreview(); + graphic.Picture.Assign(nil); + ItemChanged(); end; end; -procedure TfrmGraphicsEditor.Notification(AComponent: TComponent; Operation: TOperation); +procedure TGraphicsEditorForm.Notification(AComponent: TComponent; Operation: TOperation); begin inherited; diff --git a/Packages/X2CLMBReg.pas b/Packages/X2CLMBReg.pas index f5bc439..4579e5e 100644 --- a/Packages/X2CLMBReg.pas +++ b/Packages/X2CLMBReg.pas @@ -10,6 +10,7 @@ unit X2CLMBReg; interface procedure Register; + implementation uses Classes, @@ -19,8 +20,10 @@ uses X2CLunaMenuBarPainter, X2CLMBEditors; + {.$R ..\Resources\MenuBar.dcr} + procedure Register; begin RegisterComponents('X2Software', [TX2MenuBar, diff --git a/Packages/X2CLMenuBarEditor.pas b/Packages/X2CLMenuBarEditor.pas index d63a7ea..caeddde 100644 --- a/Packages/X2CLMenuBarEditor.pas +++ b/Packages/X2CLMenuBarEditor.pas @@ -112,6 +112,8 @@ begin // Delphi (BDS) 2006 tbMenu.EdgeBorders := []; tbMenu.DrawingStyle := dsGradient; + {$ELSE} + tbMenu.Flat := True; {$ENDIF} end; diff --git a/Source/X2CLMenuBar.pas b/Source/X2CLMenuBar.pas index b944a88..e16ee19 100644 --- a/Source/X2CLMenuBar.pas +++ b/Source/X2CLMenuBar.pas @@ -28,14 +28,20 @@ type TX2MenuBarAnimationStyle = (asNone, asSlide, asDissolve, asFade, asSlideFade); + TX2MenuBarDirection = (mbdUp, mbdDown); + const DefaultAnimationStyle = asSlide; DefaultAnimationTime = 250; type + {$IFNDEF VER180} + // #ToDo1 (MvR) 24-5-2006: check how D2006 defines these + TVerticalAlignment = (taTop, taBottom, taVerticalCenter); + {$ENDIF} + // #ToDo1 (MvR) 25-3-2006: various Select methods for key support // #ToDo1 (MvR) 1-4-2006: scroll wheel support - // #ToDo1 (MvR) 29-4-2006: action support TX2CustomMenuBarAnimatorClass = class of TX2CustomMenuBarAnimator; TX2CustomMenuBarAnimator = class; TX2CustomMenuBarPainterClass = class of TX2CustomMenuBarPainter; @@ -79,6 +85,11 @@ type Data: Pointer; var Abort: Boolean) of object; + TX2MenuBarIterateProc = procedure(Sender: TObject; + Item: TX2CustomMenuBarItem; + Data: Pointer; + var Abort: Boolean) of object; + TCollectionNotifyEvent = procedure(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification) of object; TCollectionUpdateEvent = procedure(Sender: TObject; Item: TCollectionItem) of object; @@ -209,6 +220,7 @@ type FEnabled: Boolean; FImageIndex: TImageIndex; FOwnsData: Boolean; + FTag: Integer; FVisible: Boolean; FNotification: TX2ComponentNotification; @@ -240,6 +252,7 @@ type property Caption: String read FCaption write SetCaption stored IsCaptionStored; property Enabled: Boolean read FEnabled write SetEnabled default True; property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; + property Tag: Integer read FTag write FTag default 0; property Visible: Boolean read FVisible write SetVisible default True; end; @@ -299,7 +312,6 @@ type function GetSelectedItem(): Integer; procedure SetExpanded(const Value: Boolean); procedure SetItems(const Value: TX2MenuBarItems); - protected protected function IsCaptionStored(): Boolean; override; procedure SetEnabled(const Value: Boolean); override; @@ -350,6 +362,7 @@ type FAutoCollapse: Boolean; FAutoSelectItem: Boolean; FBorderStyle: TBorderStyle; + FBuffer: Graphics.TBitmap; FCursorGroup: TCursor; FCursorItem: TCursor; FDesigner: IX2MenuBarDesigner; @@ -382,6 +395,7 @@ type procedure SetSelectedItem(const Value: TX2CustomMenuBarItem); protected procedure CreateParams(var Params: TCreateParams); override; + procedure CreateHandle(); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure PainterUpdate(Sender: TX2CustomMenuBarPainter); procedure GroupsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification); @@ -415,6 +429,7 @@ type function IterateItemBounds(ACallback: TX2MenuBarItemBoundsProc; AData: Pointer = nil): TX2CustomMenuBarItem; function AllowInteraction(): Boolean; virtual; + function ItemEnabled(AItem: TX2CustomMenuBarItem): Boolean; virtual; function ItemVisible(AItem: TX2CustomMenuBarItem): Boolean; virtual; property AllowCollapseAll: Boolean read FAllowCollapseAll write SetAllowCollapseAll default True; @@ -442,6 +457,8 @@ type procedure DoExpandedChanged(AGroup: TX2MenuBarGroup); virtual; procedure DoSelectedChanging(ANewItem: TX2CustomMenuBarItem; var AAllowed: Boolean); virtual; procedure DoSelectedChanged(); virtual; + + procedure FindEnabledItem(Sender: TObject; Item: TX2CustomMenuBarItem; Data: Pointer; var Abort: Boolean); public constructor Create(AOwner: TComponent); override; destructor Destroy(); override; @@ -449,14 +466,22 @@ type function HitTest(const APoint: TPoint): TX2MenuBarHitTest; overload; function HitTest(AX, AY: Integer): TX2MenuBarHitTest; overload; + function Iterate(ACallback: TX2MenuBarIterateProc; + ADirection: TX2MenuBarDirection = mbdDown; + AData: Pointer = nil; + AStart: TX2CustomMenuBarItem = nil): TX2CustomMenuBarItem; + function SelectFirst(): TX2CustomMenuBarItem; function SelectLast(): TX2CustomMenuBarItem; function SelectNext(): TX2CustomMenuBarItem; function SelectPrior(): TX2CustomMenuBarItem; function SelectGroup(AIndex: Integer): TX2MenuBarGroup; - function SelectItem(AIndex: Integer; AGroup: TX2MenuBarGroup = nil): TX2CustomMenuBarItem; overload; - function SelectItem(AIndex: Integer; AGroup: Integer = -1): TX2CustomMenuBarItem; overload; + function SelectItem(AIndex: Integer; AGroup: TX2MenuBarGroup): TX2CustomMenuBarItem; overload; + function SelectItem(AIndex: Integer; AGroup: Integer): TX2CustomMenuBarItem; overload; + function SelectItem(AIndex: Integer): TX2CustomMenuBarItem; overload; + + procedure ResetGroupsSelectedItem(); property Groups: TX2MenuBarGroups read FGroups write SetGroups; property Images: TCustomImageList read FImages write SetImages; @@ -483,9 +508,11 @@ type property BorderWidth; property CursorGroup; property CursorItem; + property Font; property Groups; property HideScrollbar; property Images; + property ParentFont; property OnClick; property OnCollapsed; property OnCollapsing; @@ -494,12 +521,14 @@ type property OnExit; property OnExpanded; property OnExpanding; - property OnSelectedChanged; + property OnSelectedChanged; property OnSelectedChanging; + {$IFDEF VER180} property OnMouseActivate; - property OnMouseDown; property OnMouseEnter; property OnMouseLeave; + {$ENDIF} + property OnMouseDown; property OnMouseMove; property OnMouseUp; property OnResize; @@ -1179,7 +1208,7 @@ end; function TX2MenuBarGroup.GetSelectedItem(): Integer; begin Result := -1; - + if Items.Count > 0 then begin if (FSelectedItem >= 0) and (FSelectedItem < Items.Count) then @@ -1328,12 +1357,22 @@ begin end; end; +procedure TX2CustomMenuBar.CreateHandle(); +begin + inherited; + + UpdateScrollbar(); +end; + + destructor TX2CustomMenuBar.Destroy(); begin Animator := nil; + Painter := nil; FreeAndNil(FExpandingGroups); FreeAndNil(FGroups); + FreeAndNil(FBuffer); inherited; end; @@ -1345,7 +1384,6 @@ end; procedure TX2CustomMenuBar.Paint(); var - buffer: Graphics.TBitmap; bufferRect: TRect; expand: Boolean; group: TX2MenuBarGroup; @@ -1353,30 +1391,36 @@ var begin if Assigned(Painter) then begin - buffer := Graphics.TBitmap.Create(); - try - buffer.PixelFormat := pf32bit; - buffer.Width := Self.ClientWidth; - buffer.Height := Self.ClientHeight; - bufferRect := Rect(0, 0, buffer.Width, buffer.Height); - buffer.Canvas.Font.Assign(Self.Font); - - if Assigned(Animator) then - Animator.Update(); - - UpdateScrollbar(); - Painter.BeginPaint(Self); - try - Painter.DrawBackground(buffer.Canvas, bufferRect); - DrawMenu(buffer.Canvas); - finally - Painter.EndPaint(); - end; - finally - Self.Canvas.Draw(0, 0, buffer); - FreeAndNil(buffer); + if not Assigned(FBuffer) then + begin + FBuffer := Graphics.TBitmap.Create(); + FBuffer.PixelFormat := pf32bit; end; + if (FBuffer.Width <> Self.ClientWidth) or + (FBuffer.Height <> Self.ClientHeight) then + begin + FBuffer.Width := Self.ClientWidth; + FBuffer.Height := Self.ClientHeight; + end; + + bufferRect := Rect(0, 0, FBuffer.Width, FBuffer.Height); + FBuffer.Canvas.Font.Assign(Self.Font); + + if Assigned(Animator) then + Animator.Update(); + + UpdateScrollbar(); + Painter.BeginPaint(Self); + try + Painter.DrawBackground(FBuffer.Canvas, bufferRect); + DrawMenu(FBuffer.Canvas); + finally + Painter.EndPaint(); + end; + + Self.Canvas.Draw(0, 0, FBuffer); + if Assigned(Animator) then begin if Animator.Terminated then @@ -1582,7 +1626,7 @@ begin begin { Animated group } Inc(itemBounds.Top, Animator.Height); - end else if group.Expanded then + end else if group.Expanded and (group.Items.Count > 0) then begin Inc(itemBounds.Top, Painter.GetSpacing(seBeforeFirstItem)); @@ -1639,35 +1683,49 @@ begin exit; end; - allowed := True; - if AExpanding then + if AGroup.Items.Count > 0 then begin - if Assigned(FOnExpanding) then - FOnExpanding(Self, AGroup, allowed); - end else - if Assigned(FOnCollapsing) then - FOnCollapsing(Self, AGroup, allowed); + allowed := True; + if AExpanding then + begin + if Assigned(FOnExpanding) then + FOnExpanding(Self, AGroup, allowed); + end else + if Assigned(FOnCollapsing) then + FOnCollapsing(Self, AGroup, allowed); - if not allowed then - exit; - - { Pretend to auto select item - required for proper functioning of - the OnSelectedChanging event } - if AutoSelectItem then - if not DoAutoSelectItem(AGroup, saBefore) then + if not allowed then exit; - { Allow collapse all } - if not (AExpanding or AllowCollapseAll) then - if ExpandedGroupsCount() = 1 then - exit; + { Pretend to auto select item - required for proper functioning of + the OnSelectedChanging event } + if AutoSelectItem then + if not DoAutoSelectItem(AGroup, saBefore) then + exit; + + { Allow collapse all } + if not (AExpanding or AllowCollapseAll) then + if ExpandedGroupsCount() = 1 then + begin + if AExpanding and (not Assigned(SelectedItem)) then + SelectedItem := AGroup; + + exit; + end; + end; { Auto collapse } if AutoCollapse then if AExpanding then DoAutoCollapse(AGroup); - DoExpand(AGroup, AExpanding); + if AGroup.Items.Count > 0 then + DoExpand(AGroup, AExpanding) + else + begin + AGroup.InternalSetExpanded(AExpanding); + SelectedItem := AGroup + end; end; procedure TX2CustomMenuBar.DoExpandedChanged(AGroup: TX2MenuBarGroup); @@ -1704,6 +1762,11 @@ begin Result := not Assigned(Animator); end; +function TX2CustomMenuBar.ItemEnabled(AItem: TX2CustomMenuBarItem): Boolean; +begin + Result := AItem.Enabled and AItem.Visible; +end; + function TX2CustomMenuBar.ItemVisible(AItem: TX2CustomMenuBarItem): Boolean; begin Result := AItem.Visible or (csDesigning in ComponentState); @@ -1721,6 +1784,12 @@ begin if not Assigned(Painter) then exit; + if AGroup.Items.Count = 0 then + begin + AGroup.InternalSetExpanded(AExpanding); + Exit; + end; + if Assigned(Animator) then begin FExpandingGroups.AddObject(Chr(Ord(AExpanding)), AGroup); @@ -1804,6 +1873,7 @@ var group: TX2MenuBarGroup; groupIndex: Integer; newItem: TX2CustomMenuBarItem; + itemIndex: Integer; begin Result := True; @@ -1830,24 +1900,40 @@ begin if group.Items.Count > 0 then begin newItem := group.Items[group.SelectedItem]; + if not ItemEnabled(newItem) then + begin + newItem := nil; - if newItem <> SelectedItem then + for itemIndex := 0 to Pred(group.Items.Count) do + if ItemEnabled(group.Items[itemIndex]) then + begin + newItem := group.Items[itemIndex]; + Break; + end; + end; + + if Assigned(newItem) and (newItem <> SelectedItem) then begin if AAction in [saBefore, saBoth] then DoSelectedChanging(newItem, Result); if Result and (AAction in [saAfter, saBoth]) then - begin - FSelectedItem := newItem; - DoSelectedChanged(); - - Invalidate(); - end; + SelectedItem := newItem; end; end; end; +procedure TX2CustomMenuBar.ResetGroupsSelectedItem; +var + groupIndex: Integer; + +begin + for groupIndex := 0 to Pred(Groups.Count) do + Groups[groupIndex].SelectedItem := -1; +end; + + function TX2CustomMenuBar.HitTest(const APoint: TPoint): TX2MenuBarHitTest; var hitPoint: TPoint; @@ -1874,42 +1960,196 @@ begin end; +function TX2CustomMenuBar.Iterate(ACallback: TX2MenuBarIterateProc; + ADirection: TX2MenuBarDirection; + AData: Pointer; + AStart: TX2CustomMenuBarItem): TX2CustomMenuBarItem; + procedure MoveIndex(var AIndex: Integer); + begin + case ADirection of + mbdUp: Dec(AIndex); + mbdDown: Inc(AIndex); + end; + end; + +var + abort: Boolean; + groupIndex: Integer; + group: TX2MenuBarGroup; + itemIndex: Integer; + item: TX2MenuBarItem; + +begin + Result := nil; + groupIndex := 0; + itemIndex := -2; + abort := False; + + if Assigned(AStart) then + begin + if AStart is TX2MenuBarItem then + begin + groupIndex := TX2MenuBarItem(AStart).Group.Index; + itemIndex := AStart.Index; + MoveIndex(itemIndex); + end else + groupIndex := AStart.Index; + end; + + while (groupIndex >= 0) and (groupIndex < Groups.Count) do + begin + group := Groups[groupIndex]; + + if group.Items.Count = 0 then + begin + if group <> AStart then + begin + ACallback(Self, group, AData, abort); + if abort then + begin + Result := group; + Break; + end; + end; + end else + begin + if itemIndex = -2 then + case ADirection of + mbdUp: itemIndex := Pred(group.Items.Count); + mbdDown: itemIndex := 0; + end; + + while (itemIndex >= 0) and (itemIndex < group.Items.Count) do + begin + item := group.Items[itemIndex]; + + ACallback(Self, item, AData, abort); + if abort then + begin + Result := item; + Break; + end; + + MoveIndex(itemIndex); + end; + end; + + if Assigned(Result) then + Break; + + itemIndex := -2; + MoveIndex(groupIndex); + end; +end; + + +procedure TX2CustomMenuBar.FindEnabledItem(Sender: TObject; + Item: TX2CustomMenuBarItem; + Data: Pointer; + var Abort: Boolean); +begin + Abort := ItemEnabled(Item); +end; + + function TX2CustomMenuBar.SelectFirst(): TX2CustomMenuBarItem; begin - // #ToDo1 (MvR) 29-4-2006: implement this - Result := nil; + Result := nil; + + if AllowInteraction then + begin + Result := Iterate(FindEnabledItem); + if Assigned(Result) then + SelectedItem := Result; + end; end; function TX2CustomMenuBar.SelectLast(): TX2CustomMenuBarItem; begin - // #ToDo1 (MvR) 29-4-2006: implement this - Result := nil; + Result := nil; + + if AllowInteraction then + begin + Result := Iterate(FindEnabledItem, mbdDown); + if Assigned(Result) then + SelectedItem := Result; + end; end; function TX2CustomMenuBar.SelectNext(): TX2CustomMenuBarItem; begin - // #ToDo1 (MvR) 29-4-2006: implement this - Result := nil; + Result := nil; + + if AllowInteraction then + begin + Result := Iterate(FindEnabledItem, mbdDown, nil, FSelectedItem); + if Assigned(Result) then + SelectedItem := Result; + end; end; function TX2CustomMenuBar.SelectPrior(): TX2CustomMenuBarItem; begin - // #ToDo1 (MvR) 29-4-2006: implement this - Result := nil; + Result := nil; + + if AllowInteraction then + begin + Result := Iterate(FindEnabledItem, mbdUp, nil, FSelectedItem); + if Assigned(Result) then + SelectedItem := Result; + end; end; function TX2CustomMenuBar.SelectGroup(AIndex: Integer): TX2MenuBarGroup; begin - // #ToDo1 (MvR) 29-4-2006: implement this Result := nil; + + if AllowInteraction then + begin + if (AIndex >= 0) and (AIndex < Groups.Count) then + begin + Result := Groups[AIndex]; + SelectedItem := Result; + end; + end; end; function TX2CustomMenuBar.SelectItem(AIndex: Integer; AGroup: TX2MenuBarGroup): TX2CustomMenuBarItem; +var + group: TX2MenuBarGroup; + groupIndex: Integer; + begin - // #ToDo1 (MvR) 29-4-2006: implement this Result := nil; + + if AllowInteraction then + begin + group := AGroup; + if not Assigned(group) then + begin + if Assigned(SelectedItem) then + begin + if SelectedItem is TX2MenuBarItem then + group := TX2MenuBarItem(SelectedItem).Group + else + group := (SelectedItem as TX2MenuBarGroup); + end else + for groupIndex := 0 to Pred(Groups.Count) do + if Groups[groupIndex].Expanded then + begin + group := Groups[groupIndex]; + break; + end; + end; + + if Assigned(group) and (AIndex >= 0) and (AIndex < group.Items.Count) then + begin + Result := group.Items[AIndex]; + SelectedItem := Result; + end; + end; end; function TX2CustomMenuBar.SelectItem(AIndex, AGroup: Integer): TX2CustomMenuBarItem; @@ -1924,6 +2164,11 @@ begin Result := SelectItem(AIndex, group); end; +function TX2CustomMenuBar.SelectItem(AIndex: Integer): TX2CustomMenuBarItem; +begin + Result := SelectItem(AIndex, nil); +end; + procedure TX2CustomMenuBar.Notification(AComponent: TComponent; Operation: TOperation); @@ -1967,7 +2212,7 @@ end; procedure TX2CustomMenuBar.GroupsUpdate(Sender: TObject; Item: TCollectionItem); begin - if Assigned(SelectedItem) and (not SelectedItem.Enabled) then + if Assigned(SelectedItem) and (not ItemEnabled(SelectedItem)) then SelectedItem := nil; if Assigned(Designer) then @@ -1992,7 +2237,7 @@ begin if hitTest.HitTestCode = htGroup then begin group := TX2MenuBarGroup(hitTest.Item); - if group.Enabled and (group.Items.Count > 0) then + if ItemEnabled(group) then begin group.Expanded := not group.Expanded; hitTest.Item := SelectedItem; @@ -2000,11 +2245,8 @@ begin end; end; - if Assigned(hitTest.Item) and (hitTest.Item <> SelectedItem) and - hitTest.Item.Enabled then - begin + if Assigned(hitTest.Item) then SelectedItem := hitTest.Item; - end; end; inherited; @@ -2025,7 +2267,7 @@ begin else if FHotItem is TX2MenuBarItem then cursor := CursorItem; - if (cursor <> crDefault) and FHotItem.Enabled then + if (cursor <> crDefault) and ItemEnabled(FHotItem) then begin Windows.SetCursor(Screen.Cursors[cursor]); exit; @@ -2348,31 +2590,51 @@ var begin if Value <> FSelectedItem then begin - allowed := True; - DoSelectedChanging(Value, allowed); - - if allowed then + if Assigned(Value) then begin - FSelectedItem := Value; - - if Value is TX2MenuBarItem then + allowed := ItemEnabled(Value); + if allowed then begin - group := TX2MenuBarItem(Value).Group; - if Assigned(group) then + DoSelectedChanging(Value, allowed); + + if allowed then begin - group.SelectedItem := Value.Index; - - if not group.Expanded then - group.Expanded := True; + if Value is TX2MenuBarGroup then + begin + group := TX2MenuBarGroup(Value); + + if group.Items.Count > 0 then + begin + // Item is a group, expand it (triggers autoselect too if appropriate) + group.Expanded := True; + Exit; + end else + DoAutoCollapse(group); + end; + + FSelectedItem := Value; + + if Value is TX2MenuBarItem then + begin + group := TX2MenuBarItem(Value).Group; + if Assigned(group) then + begin + group.SelectedItem := Value.Index; + + if not group.Expanded then + group.Expanded := True; + end; + end; + + if Assigned(FSelectedItem) and Assigned(FSelectedItem.Action) then + FSelectedItem.ActionLink.Execute(Self); end; end; + end else + FSelectedItem := Value; - if Assigned(FSelectedItem) and Assigned(FSelectedItem.Action) then - FSelectedItem.ActionLink.Execute(Self); - - DoSelectedChanged(); - Invalidate(); - end; + DoSelectedChanged(); + Invalidate(); end; end; diff --git a/Source/X2CLunaMenuBarPainter.pas b/Source/X2CLunaMenuBarPainter.pas index 420370e..bfdea66 100644 --- a/Source/X2CLunaMenuBarPainter.pas +++ b/Source/X2CLunaMenuBarPainter.pas @@ -12,17 +12,133 @@ unit X2CLunaMenuBarPainter; interface uses + Classes, Graphics, Windows, X2CLMenuBar; type + TX2MenuBarunaProperty = class(TPersistent) + private + FOnChange: TNotifyEvent; + protected + procedure Changed(); + public + property OnChange: TNotifyEvent read FOnChange write FOnChange; + end; + + TX2MenuBarunaColor = class(TX2MenuBarunaProperty) + private + FDefaultDisabled: TColor; + FDefaultHot: TColor; + FDefaultNormal: TColor; + FDefaultSelected: TColor; + FDisabled: TColor; + FHot: TColor; + FNormal: TColor; + FSelected: TColor; + + function IsDisabledStored(): Boolean; + function IsHotStored(): Boolean; + function IsNormalStored(): Boolean; + function IsSelectedStored(): Boolean; + procedure SetDisabled(const Value: TColor); + procedure SetHot(const Value: TColor); + procedure SetNormal(const Value: TColor); + procedure SetSelected(const Value: TColor); + protected + procedure SetDefaultColors(AHot, ANormal, ASelected, ADisabled: TColor); + + property DefaultDisabled: TColor read FDefaultDisabled write FDefaultDisabled; + property DefaultHot: TColor read FDefaultHot write FDefaultHot; + property DefaultNormal: TColor read FDefaultNormal write FDefaultNormal; + property DefaultSelected: TColor read FDefaultSelected write FDefaultSelected; + public + procedure Assign(Source: TPersistent); override; + published + property Disabled: TColor read FDisabled write SetDisabled stored IsDisabledStored; + property Hot: TColor read FHot write SetHot stored IsHotStored; + property Normal: TColor read FNormal write SetNormal stored IsNormalStored; + property Selected: TColor read FSelected write SetSelected stored IsSelectedStored; + end; + + TX2MenuBarunaGroupColors = class(TX2MenuBarunaProperty) + private + FFill: TX2MenuBarunaColor; + FText: TX2MenuBarunaColor; + FBorder: TX2MenuBarunaColor; + + procedure SetBorder(const Value: TX2MenuBarunaColor); + procedure SetFill(const Value: TX2MenuBarunaColor); + procedure SetText(const Value: TX2MenuBarunaColor); + protected + procedure ColorChange(Sender: TObject); + public + constructor Create(); + destructor Destroy; override; + + procedure Assign(Source: TPersistent); override; + published + property Border: TX2MenuBarunaColor read FBorder write SetBorder; + property Fill: TX2MenuBarunaColor read FFill write SetFill; + property Text: TX2MenuBarunaColor read FText write SetText; + end; + + TX2MenuBarunaMetrics = class(TX2MenuBarunaProperty) + private + FAfterGroupHeader: Integer; + FAfterItem: Integer; + FAfterLastItem: Integer; + FBeforeFirstItem: Integer; + FBeforeGroupHeader: Integer; + FBeforeItem: Integer; + FGroupHeight: Integer; + FItemHeight: Integer; + FMargin: Integer; + + procedure SetAfterGroupHeader(const Value: Integer); + procedure SetAfterItem(const Value: Integer); + procedure SetAfterLastItem(const Value: Integer); + procedure SetBeforeFirstItem(const Value: Integer); + procedure SetBeforeGroupHeader(const Value: Integer); + procedure SetBeforeItem(const Value: Integer); + procedure SetGroupHeight(const Value: Integer); + procedure SetItemHeight(const Value: Integer); + procedure SetMargin(const Value: Integer); + public + constructor Create(); + + procedure Assign(Source: TPersistent); override; + published + property AfterGroupHeader: Integer read FAfterGroupHeader write SetAfterGroupHeader default 8; + property AfterItem: Integer read FAfterItem write SetAfterItem default 2; + property AfterLastItem: Integer read FAfterLastItem write SetAfterLastItem default 10; + property BeforeFirstItem: Integer read FBeforeFirstItem write SetBeforeFirstItem default 0; + property BeforeGroupHeader: Integer read FBeforeGroupHeader write SetBeforeGroupHeader default 8; + property BeforeItem: Integer read FBeforeItem write SetBeforeItem default 2; + property GroupHeight: Integer read FGroupHeight write SetGroupHeight default 22; + property ItemHeight: Integer read FItemHeight write SetItemHeight default 21; + property Margin: Integer read FMargin write SetMargin default 10; + end; + TX2MenuBarunaPainter = class(TX2CustomMenuBarPainter) private - FBlurShadow: Boolean; - + FArrowColor: TColor; + FBlurShadow: Boolean; + FColor: TColor; + FGroupColors: TX2MenuBarunaGroupColors; + FItemColors: TX2MenuBarunaColor; + FMetrics: TX2MenuBarunaMetrics; + FShadowColor: TColor; + FShadowOffset: Integer; + procedure SetBlurShadow(const Value: Boolean); + procedure SetGroupColors(const Value: TX2MenuBarunaGroupColors); + procedure SetItemColors(const Value: TX2MenuBarunaColor); + procedure SetMetrics(const Value: TX2MenuBarunaMetrics); + procedure SetShadowColor(const Value: TColor); + procedure SetShadowOffset(const Value: Integer); protected function ApplyMargins(const ABounds: TRect): TRect; override; function GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; override; @@ -32,15 +148,30 @@ 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 ColorChange(Sender: TObject); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy(); override; + + procedure ResetColors(); published - property BlurShadow: Boolean read FBlurShadow write SetBlurShadow; + 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; end; implementation uses - Classes, ImgList, - SysUtils; + SysUtils, + + X2CLGraphics; @@ -137,7 +268,180 @@ begin end; +{ TX2MenuBarunaMetrics } +constructor TX2MenuBarunaMetrics.Create(); +begin + inherited; + + FAfterGroupHeader := 8; + FAfterItem := 2; + FAfterLastItem := 10; + FBeforeFirstItem := 0; + FBeforeGroupHeader := 8; + FBeforeItem := 2; + FGroupHeight := 22; + FItemHeight := 21; + FMargin := 10; +end; + + +procedure TX2MenuBarunaMetrics.Assign(Source: TPersistent); +begin + if Source is TX2MenuBarunaMetrics then + with TX2MenuBarunaMetrics(Source) do + begin + Self.AfterGroupHeader := AfterGroupHeader; + Self.AfterItem := AfterItem; + Self.AfterLastItem := AfterLastItem; + Self.BeforeFirstItem := BeforeFirstItem; + Self.BeforeGroupHeader := BeforeGroupHeader; + Self.BeforeItem := BeforeItem; + Self.GroupHeight := GroupHeight; + Self.ItemHeight := ItemHeight; + Self.Margin := Margin; + end + else + inherited; +end; + + +procedure TX2MenuBarunaMetrics.SetAfterGroupHeader(const Value: Integer); +begin + if Value <> FAfterGroupHeader then + begin + FAfterGroupHeader := Value; + Changed(); + end; +end; + +procedure TX2MenuBarunaMetrics.SetAfterItem(const Value: Integer); +begin + if Value <> FAfterItem then + begin + FAfterItem := Value; + Changed(); + end; +end; + +procedure TX2MenuBarunaMetrics.SetAfterLastItem(const Value: Integer); +begin + if Value <> FAfterLastItem then + begin + FAfterLastItem := Value; + Changed(); + end; +end; + +procedure TX2MenuBarunaMetrics.SetBeforeFirstItem(const Value: Integer); +begin + if Value <> FBeforeFirstItem then + begin + FBeforeFirstItem := Value; + Changed(); + end; +end; + +procedure TX2MenuBarunaMetrics.SetBeforeGroupHeader(const Value: Integer); +begin + if Value <> FBeforeGroupHeader then + begin + FBeforeGroupHeader := Value; + Changed(); + end; +end; + +procedure TX2MenuBarunaMetrics.SetBeforeItem(const Value: Integer); +begin + if Value <> FBeforeItem then + begin + FBeforeItem := Value; + Changed(); + end; +end; + +procedure TX2MenuBarunaMetrics.SetGroupHeight(const Value: Integer); +begin + if Value <> FGroupHeight then + begin + FGroupHeight := Value; + Changed(); + end; +end; + +procedure TX2MenuBarunaMetrics.SetItemHeight(const Value: Integer); +begin + if Value <> FItemHeight then + begin + FItemHeight := Value; + Changed(); + end; +end; + +procedure TX2MenuBarunaMetrics.SetMargin(const Value: Integer); +begin + if Value <> FMargin then + begin + FMargin := Value; + Changed(); + end; +end; + + { TX2MenuBarunaPainter } +constructor TX2MenuBarunaPainter.Create(AOwner: TComponent); +begin + inherited; + + FBlurShadow := True; + FGroupColors := TX2MenuBarunaGroupColors.Create(); + FItemColors := TX2MenuBarunaColor.Create(); + FMetrics := TX2MenuBarunaMetrics.Create(); + FShadowOffset := 2; + + FGroupColors.OnChange := ColorChange; + FItemColors.OnChange := ColorChange; + FMetrics.OnChange := ColorChange; + + ResetColors(); +end; + +destructor TX2MenuBarunaPainter.Destroy(); +begin + FreeAndNil(FMetrics); + FreeAndNil(FItemColors); + FreeAndNil(FGroupColors); + + inherited; +end; + + +procedure TX2MenuBarunaPainter.ResetColors(); +const + PurpleBlue = $00BE6363; + +var + groupColor: TColor; + textColor: TColor; + disabledColor: TColor; + +begin + ArrowColor := clBlue; + Color := clWindow; + ShadowColor := clBtnShadow; + + { Group buttons } + groupColor := Blend(Color, Color32(clBtnFace, 128)); + GroupColors.Border.SetDefaultColors(PurpleBlue, clBlack, PurpleBlue, clBlack); + GroupColors.Fill.SetDefaultColors(groupColor, groupColor, groupColor, groupColor); + GroupColors.Text.SetDefaultColors(PurpleBlue, clWindowText, PurpleBlue, clGrayText); + + { Items } + textColor := Blend(clGrayText, Color32(clWindowText, 128)); + disabledColor := Blend(Color, Color32(clGrayText, 128)); + ItemColors.SetDefaultColors(clWindowText, textColor, clWindowText, disabledColor); +end; + + procedure TX2MenuBarunaPainter.SetBlurShadow(const Value: Boolean); begin if Value <> FBlurShadow then @@ -151,7 +455,7 @@ end; function TX2MenuBarunaPainter.ApplyMargins(const ABounds: TRect): TRect; begin Result := inherited ApplyMargins(ABounds); - InflateRect(Result, -10, -10); + InflateRect(Result, -Metrics.Margin, -Metrics.Margin); end; function TX2MenuBarunaPainter.GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; @@ -159,29 +463,30 @@ begin Result := inherited GetSpacing(AElement); case AElement of - seBeforeGroupHeader, - seAfterGroupHeader: Result := 5; - seAfterLastItem: Result := 10; - seBeforeItem, - seAfterItem: Result := 4; + seBeforeGroupHeader: Result := Metrics.BeforeGroupHeader; + seAfterGroupHeader: Result := Metrics.AfterGroupHeader; + seBeforeFirstItem: Result := Metrics.BeforeFirstItem; + seAfterLastItem: Result := Metrics.AfterLastItem; + seBeforeItem: Result := Metrics.BeforeItem; + seAfterItem: Result := Metrics.AfterItem; end; end; function TX2MenuBarunaPainter.GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer; begin - Result := 22; + Result := Metrics.GroupHeight; end; function TX2MenuBarunaPainter.GetItemHeight(AItem: TX2MenuBarItem): Integer; begin - Result := 21; + Result := Metrics.ItemHeight end; procedure TX2MenuBarunaPainter.DrawBackground(ACanvas: TCanvas; const ABounds: TRect); begin - ACanvas.Brush.Color := clWindow; + ACanvas.Brush.Color := Self.Color; ACanvas.FillRect(ABounds); end; @@ -189,30 +494,38 @@ procedure TX2MenuBarunaPainter.DrawGroupHeader(ACanvas: TCanvas; AGroup: TX2MenuBarGroup; const ABounds: TRect; AState: TX2MenuBarDrawStates); +const + ShadowMargin = 2; + procedure DrawShadowOutline(AShadowCanvas: TCanvas; AShadowBounds: TRect); begin - // #ToDo1 (MvR) 27-3-2006: make the color a property - if BlurShadow then - begin - AShadowCanvas.Brush.Color := $00c3c3c3; - AShadowCanvas.Pen.Color := $00c3c3c3; - end else - begin - AShadowCanvas.Brush.Color := $00404040; - AShadowCanvas.Pen.Color := $00404040; - end; + AShadowCanvas.Brush.Color := ShadowColor; + AShadowCanvas.Pen.Color := ShadowColor; + AShadowCanvas.RoundRect(AShadowBounds.Left + ShadowMargin, + AShadowBounds.Top + ShadowMargin, + AShadowBounds.Right + ShadowMargin, + AShadowBounds.Bottom + ShadowMargin, 5, 5); + end; - AShadowCanvas.RoundRect(AShadowBounds.Left + 2, - AShadowBounds.Top + 2, - AShadowBounds.Right + 2, - AShadowBounds.Bottom + 2, 5, 5); + function GetColor(AColor: TX2MenuBarunaColor): TColor; + begin + if AGroup.Enabled then + if (mdsSelected in AState) or (mdsGroupSelected in AState) then + Result := AColor.Selected + else if mdsHot in AState then + Result := AColor.Hot + else + Result := AColor.Normal + else + Result := AColor.Disabled; end; var - textRect: TRect; imageList: TCustomImageList; imagePos: TPoint; shadowBitmap: Graphics.TBitmap; + shadowBounds: TRect; + textRect: TRect; begin if not ((mdsSelected in AState) or (mdsGroupSelected in AState)) then @@ -223,13 +536,13 @@ begin shadowBitmap := Graphics.TBitmap.Create(); try shadowBitmap.PixelFormat := pf32bit; - shadowBitmap.Width := (ABounds.Right - ABounds.Left + 4); - shadowBitmap.Height := (ABounds.Bottom - ABounds.Top + 4); + shadowBitmap.Width := (ABounds.Right - ABounds.Left + (ShadowMargin * 2)); + shadowBitmap.Height := (ABounds.Bottom - ABounds.Top + (ShadowMargin * 2)); DrawBackground(shadowBitmap.Canvas, Rect(0, 0, shadowBitmap.Width, shadowBitmap.Height)); - DrawShadowOutline(shadowBitmap.Canvas, Rect(0, 0, shadowBitmap.Width - 4, - shadowBitmap.Height - 4)); + DrawShadowOutline(shadowBitmap.Canvas, Rect(0, 0, shadowBitmap.Width - (ShadowMargin * 2), + shadowBitmap.Height - (ShadowMargin * 2))); Blur(shadowBitmap); ACanvas.Draw(ABounds.Left, ABounds.Top, shadowBitmap); @@ -237,26 +550,21 @@ begin FreeAndNil(shadowBitmap); end end else + begin + shadowBounds := ABounds; + OffsetRect(shadowBounds, -ShadowMargin, -ShadowMargin); DrawShadowOutline(ACanvas, ABounds); + end; end; - ACanvas.Brush.Color := $00E9E9E9; - { Rounded rectangle } - if AGroup.Enabled and ((mdsSelected in AState) or (mdsHot in AState) or - (mdsGroupSelected in AState)) then - ACanvas.Pen.Color := $00BE6363 - else - ACanvas.Pen.Color := clBlack; + ACanvas.Brush.Color := GetColor(GroupColors.Fill); + ACanvas.Pen.Color := GetColor(GroupColors.Border); + ACanvas.Font.Color := GetColor(GroupColors.Text); ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5); - - if AGroup.Enabled then - ACanvas.Font.Color := ACanvas.Pen.Color - else - ACanvas.Font.Color := clGray; - - textRect := ABounds; + + textRect := ABounds; Inc(textRect.Left, 4); Dec(textRect.Right, 4); @@ -283,6 +591,19 @@ end; procedure TX2MenuBarunaPainter.DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem; const ABounds: TRect; AState: TX2MenuBarDrawStates); + function GetColor(AColor: TX2MenuBarunaColor): TColor; + begin + if AItem.Enabled then + if mdsSelected in AState then + Result := AColor.Selected + else if mdsHot in AState then + Result := AColor.Hot + else + Result := AColor.Normal + else + Result := AColor.Disabled; + end; + var focusBounds: TRect; textBounds: TRect; @@ -290,7 +611,7 @@ var begin focusBounds := ABounds; - Dec(focusBounds.Right, 10); + Dec(focusBounds.Right, Metrics.Margin); if (mdsSelected in AState) then begin @@ -298,8 +619,8 @@ begin DrawFocusRect(ACanvas, focusBounds); { Arrow } - ACanvas.Brush.Color := clBlue; - ACanvas.Pen.Color := clBlue; + 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; @@ -311,14 +632,7 @@ begin end; { Text } - if AItem.Enabled then - if (mdsSelected in AState) or (mdsHot in AState) then - ACanvas.Font.Color := clBlack - else - ACanvas.Font.Color := $00404040 - else - ACanvas.Font.Color := clSilver; - + ACanvas.Font.Color := GetColor(ItemColors); textBounds := focusBounds; Inc(textBounds.Left, 4); Dec(textBounds.Right, 4); @@ -335,4 +649,224 @@ begin False, csEllipsis); end; + +procedure TX2MenuBarunaPainter.ColorChange(Sender: TObject); +begin + NotifyObservers(); +end; + + +procedure TX2MenuBarunaPainter.SetGroupColors(const Value: TX2MenuBarunaGroupColors); +begin + if Value <> FGroupColors then + begin + FGroupColors.Assign(Value); + NotifyObservers(); + end; +end; + +procedure TX2MenuBarunaPainter.SetItemColors(const Value: TX2MenuBarunaColor); +begin + if Value <> FItemColors then + begin + FItemColors.Assign(Value); + NotifyObservers(); + end; +end; + +procedure TX2MenuBarunaPainter.SetMetrics(const Value: TX2MenuBarunaMetrics); +begin + if Value <> FMetrics then + begin + FMetrics.Assign(Value); + NotifyObservers(); + end; +end; + +procedure TX2MenuBarunaPainter.SetShadowColor(const Value: TColor); +begin + if Value <> FShadowColor then + begin + FShadowColor := Value; + NotifyObservers(); + end; +end; + +procedure TX2MenuBarunaPainter.SetShadowOffset(const Value: Integer); +begin + if Value <> FShadowOffset then + begin + FShadowOffset := Value; + NotifyObservers(); + end; +end; + + +{ TX2MenuBarunaProperty } +procedure TX2MenuBarunaProperty.Changed(); +begin + if Assigned(FOnChange) then + FOnChange(Self); +end; + + +{ TX2MenuBarunaColor } +procedure TX2MenuBarunaColor.Assign(Source: TPersistent); +begin + if Source is TX2MenuBarunaColor then + with TX2MenuBarunaColor(Source) do + begin + Self.DefaultDisabled := DefaultDisabled; + Self.DefaultHot := DefaultHot; + Self.DefaultNormal := DefaultNormal; + self.DefaultSelected := DefaultSelected; + Self.Disabled := Disabled; + Self.Hot := Hot; + Self.Normal := Normal; + self.Selected := Selected; + end + else + inherited; +end; + +function TX2MenuBarunaColor.IsDisabledStored(): Boolean; +begin + Result := (FDisabled <> FDefaultDisabled); +end; + +function TX2MenuBarunaColor.IsHotStored(): Boolean; +begin + Result := (FHot <> FDefaultHot); +end; + +function TX2MenuBarunaColor.IsNormalStored(): Boolean; +begin + Result := (FNormal <> FDefaultNormal); +end; + +function TX2MenuBarunaColor.IsSelectedStored(): Boolean; +begin + Result := (FSelected <> FDefaultSelected); +end; + +procedure TX2MenuBarunaColor.SetDefaultColors(AHot, ANormal, ASelected, ADisabled: TColor); +begin + FDefaultDisabled := ADisabled; + FDefaultHot := AHot; + FDefaultNormal := ANormal; + FDefaultSelected := ASelected; + FDisabled := ADisabled; + FHot := AHot; + FNormal := ANormal; + FSelected := ASelected; +end; + +procedure TX2MenuBarunaColor.SetDisabled(const Value: TColor); +begin + if Value <> FDisabled then + begin + FDisabled := Value; + Changed(); + end; +end; + +procedure TX2MenuBarunaColor.SetHot(const Value: TColor); +begin + if Value <> FHot then + begin + FHot := Value; + Changed(); + end; +end; + +procedure TX2MenuBarunaColor.SetNormal(const Value: TColor); +begin + if Value <> FNormal then + begin + FNormal := Value; + Changed(); + end; +end; + +procedure TX2MenuBarunaColor.SetSelected(const Value: TColor); +begin + if Value <> FSelected then + begin + FSelected := Value; + Changed(); + end; +end; + + +{ TX2MenuBarunaGroupColors } +constructor TX2MenuBarunaGroupColors.Create(); +begin + inherited; + + FBorder := TX2MenuBarunaColor.Create(); + FFill := TX2MenuBarunaColor.Create(); + FText := TX2MenuBarunaColor.Create(); + + FBorder.OnChange := ColorChange; + FFill.OnChange := ColorChange; + FText.OnChange := ColorChange; +end; + +destructor TX2MenuBarunaGroupColors.Destroy(); +begin + FreeAndNil(FText); + FreeAndNil(FFill); + FreeAndNil(FBorder); + + inherited; +end; + + +procedure TX2MenuBarunaGroupColors.Assign(Source: TPersistent); +begin + if Source is TX2MenuBarunaGroupColors then + with TX2MenuBarunaGroupColors(Source) do + begin + Self.Border.Assign(Border); + Self.Fill.Assign(Fill); + Self.Text.Assign(Text); + end + else + inherited; +end; + + +procedure TX2MenuBarunaGroupColors.ColorChange(Sender: TObject); +begin + Changed(); +end; + + +procedure TX2MenuBarunaGroupColors.SetBorder(const Value: TX2MenuBarunaColor); +begin + if Value <> FBorder then + begin + FBorder.Assign(Value); + Changed(); + end; +end; + +procedure TX2MenuBarunaGroupColors.SetFill(const Value: TX2MenuBarunaColor); +begin + if Value <> FFill then + begin + FFill.Assign(Value); + Changed(); + end; +end; + +procedure TX2MenuBarunaGroupColors.SetText(const Value: TX2MenuBarunaColor); +begin + if Value <> FText then + begin + FText.Assign(Value); + Changed(); + end; +end; + end. diff --git a/X2CL.bpg b/X2CL.bpg index 442f77b..731900c 100644 --- a/X2CL.bpg +++ b/X2CL.bpg @@ -9,7 +9,7 @@ MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** DCC = $(ROOT)\bin\dcc32.exe $** BRCC = $(ROOT)\bin\brcc32.exe $** #------------------------------------------------------------------------------ -PROJECTS = X2CLGLD.bpl X2CLGL.bpl +PROJECTS = X2CLGL.bpl X2CLGLD.bpl X2CLMB.bpl X2CLMBDX.bpl #------------------------------------------------------------------------------ default: $(PROJECTS) #------------------------------------------------------------------------------ @@ -21,4 +21,10 @@ X2CLGLD.bpl: Packages\D7\X2CLGLD.dpk X2CLGL.bpl: Packages\D7\X2CLGL.dpk $(DCC) +X2CLMB.bpl: Packages\D7\X2CLMB.dpk + $(DCC) + +X2CLMBDX.bpl: Packages\D7\X2CLMBD.dpk + $(DCC) +