GitHub-Mirror
/
x2cl
mirror of
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Added: MenuBar package 

Changed: proper UnameIT MenuBar Painter implementation
Fixed: GraphicList editor notifies designer of changes
This commit is contained in:
Mark van Renswoude 2007-01-31 09:41:11 +00:00
parent a60c185db1
commit ced0de69b1
21 changed files with 1653 additions and 322 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Packages/D7/X2CLGL.cfg
View File

@ -33,5 +33,5 @@
-$M16384,1048576 -$M16384,1048576
-K$00400000 -K$00400000
-N"..\..\Lib\D7" -N"..\..\Lib\D7"
-LE"c:\program files\borland\delphi7\Projects\Bpl" -LE"..\..\Lib\D7"
-LN"c:\program files\borland\delphi7\Projects\Bpl" -LN"..\..\Lib\D7"

20
Packages/D7/X2CLGL.dof
View File

@ -92,8 +92,8 @@ ExeDescription=X
[Directories] [Directories]
OutputDir= OutputDir=
UnitOutputDir=..\..\Lib\D7 UnitOutputDir=..\..\Lib\D7
PackageDLLOutputDir= PackageDLLOutputDir=..\..\Lib\D7
PackageDCPOutputDir= PackageDCPOutputDir=..\..\Lib\D7
SearchPath= SearchPath=
Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter
Conditionals= Conditionals=
@ -105,6 +105,10 @@ HostApplication=
Launcher= Launcher=
UseLauncher=0 UseLauncher=0
DebugCWD= DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info] [Version Info]
IncludeVerInfo=1 IncludeVerInfo=1
AutoIncBuild=0 AutoIncBuild=0
@ -131,16 +135,22 @@ ProductName=
ProductVersion=1.0.0.0 ProductVersion=1.0.0.0
Comments= Comments=
[Excluded Packages] [Excluded Packages]
c:\program files\borland\delphi7\Projects\Bpl\VirtualShellToolsD7D.bpl=Virtual Shell Tools Designtime Package C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors
c:\program files\borland\delphi7\Projects\Bpl\VirtualExplorerListviewExD7D.bpl=Virtual ExplorerListviewEx Designtime Package
[HistoryLists\hlUnitAliases] [HistoryLists\hlUnitAliases]
Count=1 Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 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] [HistoryLists\hlUnitOutputDirectory]
Count=3 Count=3
Item0=..\..\Lib\D7 Item0=..\..\Lib\D7
Item1=..\Lib\D7 Item1=..\Lib\D7
Item2=Lib\D7 Item2=Lib\D7
[HistoryLists\hlBPLOutput] [HistoryLists\hlBPLOutput]
Count=2
Item0=..\..\Lib\D7
Item1=Lib\D7
[HistoryLists\hlDCPOutput]
Count=1 Count=1
Item0=Lib\D7 Item0=..\..\Lib\D7

4
Packages/D7/X2CLGLD.cfg
View File

@ -33,5 +33,5 @@
-$M16384,1048576 -$M16384,1048576
-K$00400000 -K$00400000
-N"..\..\Lib\D7" -N"..\..\Lib\D7"
-LE"c:\program files\borland\delphi7\Projects\Bpl" -LE"..\..\Lib\D7"
-LN"c:\program files\borland\delphi7\Projects\Bpl" -LN"..\..\Lib\D7"

20
Packages/D7/X2CLGLD.dof
View File

@ -92,8 +92,8 @@ ExeDescription=X
[Directories] [Directories]
OutputDir= OutputDir=
UnitOutputDir=..\..\Lib\D7 UnitOutputDir=..\..\Lib\D7
PackageDLLOutputDir= PackageDLLOutputDir=..\..\Lib\D7
PackageDCPOutputDir= PackageDCPOutputDir=..\..\Lib\D7
SearchPath= SearchPath=
Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter
Conditionals= Conditionals=
@ -105,6 +105,10 @@ HostApplication=
Launcher= Launcher=
UseLauncher=0 UseLauncher=0
DebugCWD= DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info] [Version Info]
IncludeVerInfo=1 IncludeVerInfo=1
AutoIncBuild=0 AutoIncBuild=0
@ -131,16 +135,22 @@ ProductName=
ProductVersion=1.0.0.0 ProductVersion=1.0.0.0
Comments= Comments=
[Excluded Packages] [Excluded Packages]
c:\program files\borland\delphi7\Projects\Bpl\VirtualShellToolsD7D.bpl=Virtual Shell Tools Designtime Package C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors
c:\program files\borland\delphi7\Projects\Bpl\VirtualExplorerListviewExD7D.bpl=Virtual ExplorerListviewEx Designtime Package
[HistoryLists\hlUnitAliases] [HistoryLists\hlUnitAliases]
Count=1 Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; 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] [HistoryLists\hlUnitOutputDirectory]
Count=3 Count=3
Item0=..\..\Lib\D7 Item0=..\..\Lib\D7
Item1=..\Lib\D7 Item1=..\Lib\D7
Item2=Lib\D7 Item2=Lib\D7
[HistoryLists\hlBPLOutput] [HistoryLists\hlBPLOutput]
Count=2
Item0=..\..\Lib\D7
Item1=Lib\D7
[HistoryLists\hlDCPOutput]
Count=1 Count=1
Item0=Lib\D7 Item0=..\..\Lib\D7

2
Packages/D7/X2CLGLD.dpk
View File

@ -34,6 +34,6 @@ requires
contains contains
X2CLGLReg in '..\X2CLGLReg.pas', X2CLGLReg in '..\X2CLGLReg.pas',
X2CLGLEditors in '..\X2CLGLEditors.pas', X2CLGLEditors in '..\X2CLGLEditors.pas',
X2CLGraphicsEditor in '..\X2CLGraphicsEditor.pas' {frmGraphicsEditor}; X2CLGraphicsEditor in '..\X2CLGraphicsEditor.pas' {GraphicsEditorForm};
end. end.

40
Packages/D7/X2CLMB.cfg Normal file
View File

@ -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

156
Packages/D7/X2CLMB.dof Normal file
View File

@ -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

44
Packages/D7/X2CLMB.dpk Normal file
View File

@ -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.

BIN
Packages/D7/X2CLMB.res Normal file
View File

Binary file not shown.

40
Packages/D7/X2CLMBD.cfg Normal file
View File

@ -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

158
Packages/D7/X2CLMBD.dof Normal file
View File

@ -0,0 +1,158 @@
[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 (Designtime)
[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]
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
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

43
Packages/D7/X2CLMBD.dpk Normal file
View File

@ -0,0 +1,43 @@
package X2CLMBD;
{$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 (Designtime)'}
{$DESIGNONLY}
{$IMPLICITBUILD OFF}
requires
rtl,
vcl,
designide,
vclactnband,
vclx,
X2CLMB;
contains
X2CLMBReg in '..\X2CLMBReg.pas',
X2CLMenuBarEditor in '..\X2CLMenuBarEditor.pas' {frmMenuBarEditor},
X2CLMBEditors in '..\X2CLMBEditors.pas';
end.

BIN
Packages/D7/X2CLMBD.res Normal file
View File

Binary file not shown.

10
Packages/X2CLGLEditors.pas
View File

@ -41,12 +41,10 @@ type
TProtectedX2GraphicContainer = class(TX2GraphicContainer); TProtectedX2GraphicContainer = class(TX2GraphicContainer);
{============== TX2GraphicContainerEditor { TX2GraphicContainerEditor }
Editor
========================================}
procedure TX2GraphicContainerEditor.Edit(); procedure TX2GraphicContainerEditor.Edit();
begin begin
TfrmGraphicsEditor.Execute(Component, Self.Designer); TGraphicsEditorForm.Execute(Component, Self.Designer);
end; end;
procedure TX2GraphicContainerEditor.ExecuteVerb(Index: Integer); procedure TX2GraphicContainerEditor.ExecuteVerb(Index: Integer);
@ -109,9 +107,7 @@ begin
end; end;
{=================== TX2GraphicListEditor { TX2GraphicContainerEditor }
Editor
========================================}
procedure TX2GraphicListEditor.Edit; procedure TX2GraphicListEditor.Edit;
var var
ifEditor: IComponentEditor; ifEditor: IComponentEditor;

30
Packages/X2CLGraphicsEditor.dfm
View File

@ -1,4 +1,4 @@
object frmGraphicsEditor: TfrmGraphicsEditor object GraphicsEditorForm: TGraphicsEditorForm
Left = 325 Left = 325
Top = 363 Top = 363
Width = 534 Width = 534
@ -20,13 +20,13 @@ object frmGraphicsEditor: TfrmGraphicsEditor
Left = 189 Left = 189
Top = 0 Top = 0
Width = 4 Width = 4
Height = 422 Height = 424
end end
object pnlImage: TPanel object pnlImage: TPanel
Left = 193 Left = 193
Top = 0 Top = 0
Width = 333 Width = 333
Height = 422 Height = 424
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 1 TabOrder = 1
@ -60,7 +60,7 @@ object frmGraphicsEditor: TfrmGraphicsEditor
Left = 0 Left = 0
Top = 26 Top = 26
Width = 333 Width = 333
Height = 368 Height = 370
Align = alClient Align = alClient
BevelInner = bvNone BevelInner = bvNone
BevelKind = bkTile BevelKind = bkTile
@ -78,7 +78,7 @@ object frmGraphicsEditor: TfrmGraphicsEditor
end end
object pnlProperties: TPanel object pnlProperties: TPanel
Left = 0 Left = 0
Top = 394 Top = 396
Width = 333 Width = 333
Height = 28 Height = 28
Align = alBottom Align = alBottom
@ -110,7 +110,7 @@ object frmGraphicsEditor: TfrmGraphicsEditor
Left = 0 Left = 0
Top = 0 Top = 0
Width = 189 Width = 189
Height = 422 Height = 424
Align = alLeft Align = alLeft
BevelOuter = bvNone BevelOuter = bvNone
TabOrder = 0 TabOrder = 0
@ -118,7 +118,7 @@ object frmGraphicsEditor: TfrmGraphicsEditor
Left = 0 Left = 0
Top = 26 Top = 26
Width = 189 Width = 189
Height = 396 Height = 398
Align = alClient Align = alClient
ItemHeight = 13 ItemHeight = 13
TabOrder = 1 TabOrder = 1
@ -164,8 +164,8 @@ object frmGraphicsEditor: TfrmGraphicsEditor
end end
end end
object ilsIcons: TImageList object ilsIcons: TImageList
Left = 8 Left = 20
Top = 388 Top = 360
Bitmap = { Bitmap = {
494C010107000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600 494C010107000900040010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
0000000000003600000028000000400000003000000001002000000000000030 0000000000003600000028000000400000003000000001002000000000000030
@ -572,8 +572,8 @@ object frmGraphicsEditor: TfrmGraphicsEditor
end end
object alGraphics: TActionList object alGraphics: TActionList
Images = ilsIcons Images = ilsIcons
Left = 36 Left = 104
Top = 388 Top = 360
object actAdd: TAction object actAdd: TAction
Caption = '&New' Caption = '&New'
Hint = 'New Graphic' Hint = 'New Graphic'
@ -625,11 +625,11 @@ object frmGraphicsEditor: TfrmGraphicsEditor
end end
end end
object dlgOpen: TOpenPictureDialog object dlgOpen: TOpenPictureDialog
Left = 8 Left = 20
Top = 360 Top = 304
end end
object dlgSave: TSavePictureDialog object dlgSave: TSavePictureDialog
Left = 36 Left = 104
Top = 360 Top = 304
end end
end end

293
Packages/X2CLGraphicsEditor.pas
View File

@ -25,7 +25,7 @@ uses
X2CLGraphicList; X2CLGraphicList;
type type
TfrmGraphicsEditor = class(TForm) TGraphicsEditorForm = class(TForm)
actAdd: TAction; actAdd: TAction;
actClear: TAction; actClear: TAction;
actDelete: TAction; actDelete: TAction;
@ -68,11 +68,14 @@ type
procedure actSaveExecute(Sender: TObject); procedure actSaveExecute(Sender: TObject);
procedure actClearExecute(Sender: TObject); procedure actClearExecute(Sender: TObject);
private private
FComponent: TX2GraphicContainer; FComponent: TX2GraphicContainer;
FComponentDesigner: IDesigner; FComponentDesigner: IDesigner;
FUpdating: Boolean;
procedure InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner); procedure InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner);
procedure Administrate();
procedure ItemChanged(AUpdatePreview: Boolean = True);
procedure UpdateUI();
procedure UpdatePreview(); procedure UpdatePreview();
function Active(out AIndex: Integer; out AGraphic: TX2GraphicContainerItem): Boolean; function Active(out AIndex: Integer; out AGraphic: TX2GraphicContainerItem): Boolean;
@ -86,33 +89,32 @@ implementation
uses uses
Graphics, Graphics,
SysUtils; SysUtils;
var var
GEditor: TfrmGraphicsEditor; EditorInstance: TGraphicsEditorForm;
{$R *.dfm} {$R *.dfm}
{===================== TfrmGraphicsEditor { TGraphicsEditorForm }
Initialization class procedure TGraphicsEditorForm.Execute(const AComponent: TComponent; const ADesigner: IDesigner);
========================================}
class procedure TfrmGraphicsEditor.Execute(const AComponent: TComponent; const ADesigner: IDesigner);
begin begin
if not Assigned(GEditor) then if not Assigned(EditorInstance) then
GEditor := TfrmGraphicsEditor.Create(Application); EditorInstance := TGraphicsEditorForm.Create(Application);
GEditor.InternalExecute(AComponent, ADesigner); EditorInstance.InternalExecute(AComponent, ADesigner);
end; end;
procedure TfrmGraphicsEditor.InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner); procedure TGraphicsEditorForm.InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner);
var var
iGraphic: Integer; graphicIndex: Integer;
begin begin
FComponent := TX2GraphicContainer(AComponent); FComponent := TX2GraphicContainer(AComponent);
FComponent.FreeNotification(Self); FComponent.FreeNotification(Self);
FComponentDesigner := ADesigner; FComponentDesigner := ADesigner;
Caption := Format('%s Graphics', [FComponent.Name]); Caption := Format('%s Graphics', [FComponent.Name]);
@ -123,79 +125,91 @@ begin
try try
Clear(); Clear();
for iGraphic := 0 to FComponent.GraphicCount - 1 do for graphicIndex := 0 to FComponent.GraphicCount - 1 do
AddObject(FComponent.Graphics[iGraphic].PictureName, AddObject(FComponent.Graphics[graphicIndex].PictureName,
FComponent.Graphics[iGraphic]); FComponent.Graphics[graphicIndex]);
finally finally
EndUpdate(); EndUpdate();
end; end;
lstGraphics.ItemIndex := 0; lstGraphics.ItemIndex := 0;
UpdatePreview();
end; end;
Administrate(); UpdateUI();
UpdatePreview();
Show(); Show();
end; end;
procedure TfrmGraphicsEditor.FormClose(Sender: TObject; var Action: TCloseAction);
procedure TGraphicsEditorForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin begin
Action := caFree; Action := caFree;
GEditor := nil;
if Self = EditorInstance then
EditorInstance := nil;
if Assigned(FComponent) then if Assigned(FComponent) then
FComponent.RemoveFreeNotification(Self); FComponent.RemoveFreeNotification(Self);
end; end;
procedure TfrmGraphicsEditor.Administrate(); procedure TGraphicsEditorForm.ItemChanged(AUpdatePreview: Boolean);
begin
if Assigned(FComponentDesigner) then
FComponentDesigner.Modified();
UpdateUI();
if AUpdatePreview then
UpdatePreview();
end;
procedure TGraphicsEditorForm.UpdateUI();
var var
bEnabled: Boolean; enabled: Boolean;
iIndex: Integer; index: Integer;
pGraphic: TX2GraphicContainerItem; graphic: TX2GraphicContainerItem;
begin begin
bEnabled := Active(iIndex, pGraphic); enabled := Active(index, graphic);
actDelete.Enabled := bEnabled; actDelete.Enabled := enabled;
actOpen.Enabled := bEnabled; actOpen.Enabled := enabled;
if bEnabled then if enabled then
bEnabled := Assigned(pGraphic.Picture.Graphic) enabled := Assigned(graphic.Picture.Graphic)
else else
bEnabled := False; enabled := False;
actSave.Enabled := bEnabled;
actClear.Enabled := bEnabled;
actUp.Enabled := bEnabled and (iIndex > 0); actSave.Enabled := enabled;
actDown.Enabled := bEnabled and (iIndex < lstGraphics.Items.Count - 1); actClear.Enabled := enabled;
actUp.Enabled := enabled and (index > 0);
actDown.Enabled := enabled and (index < Pred(lstGraphics.Items.Count));
end; end;
procedure TfrmGraphicsEditor.UpdatePreview();
procedure TGraphicsEditorForm.UpdatePreview();
var var
iIndex: Integer; index: Integer;
pGraphic: TX2GraphicContainerItem; graphic: TX2GraphicContainerItem;
begin begin
if Active(iIndex, pGraphic) then FUpdating := True;
begin try
imgPreview.Picture.Assign(pGraphic.Picture); if Active(index, graphic) then
txtName.Text := pGraphic.PictureName; begin
Administrate(); imgPreview.Picture.Assign(graphic.Picture);
txtName.Text := graphic.PictureName;
if Assigned(FComponentDesigner) then end;
FComponentDesigner.SelectComponent(pGraphic); finally
end else FUpdating := False;
if Assigned(FComponentDesigner) then end;
FComponentDesigner.SelectComponent(FComponent);
end; end;
{===================== TfrmGraphicsEditor function TGraphicsEditorForm.Active(out AIndex: Integer; out AGraphic: TX2GraphicContainerItem): Boolean;
Graphic Management
========================================}
function TfrmGraphicsEditor.Active(out AIndex: Integer; out AGraphic: TX2GraphicContainerItem): Boolean;
begin begin
Result := False; Result := False;
AIndex := lstGraphics.ItemIndex; AIndex := lstGraphics.ItemIndex;
@ -207,43 +221,50 @@ begin
end; end;
procedure TfrmGraphicsEditor.lstGraphicsClick(Sender: TObject); procedure TGraphicsEditorForm.lstGraphicsClick(Sender: TObject);
begin begin
UpdateUI();
UpdatePreview(); UpdatePreview();
end; end;
procedure TfrmGraphicsEditor.txtNameChange(Sender: TObject);
procedure TGraphicsEditorForm.txtNameChange(Sender: TObject);
var var
iIndex: Integer; index: Integer;
pGraphic: TX2GraphicContainerItem; graphic: TX2GraphicContainerItem;
begin begin
if Active(iIndex, pGraphic) then if FUpdating then
Exit;
if Active(index, graphic) then
begin begin
pGraphic.PictureName := txtName.Text; graphic.PictureName := txtName.Text;
lstGraphics.Items[iIndex] := pGraphic.PictureName; lstGraphics.Items[index] := graphic.PictureName;
ItemChanged(False);
end; end;
end; end;
procedure TfrmGraphicsEditor.actAddExecute(Sender: TObject); procedure TGraphicsEditorForm.actAddExecute(Sender: TObject);
var var
iIndex: Integer; index: Integer;
pGraphic: TX2GraphicContainerItem; graphic: TX2GraphicContainerItem;
begin begin
if Assigned(FComponentDesigner) then if Assigned(FComponentDesigner) then
begin 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 begin
pGraphic.Container := FComponent; graphic.Container := FComponent;
iIndex := lstGraphics.Items.AddObject(pGraphic.PictureName, index := lstGraphics.Items.AddObject(graphic.PictureName,
pGraphic); graphic);
lstGraphics.ItemIndex := iIndex; lstGraphics.ItemIndex := index;
UpdatePreview(); ItemChanged();
actOpen.Execute(); actOpen.Execute();
end else end else
@ -252,114 +273,120 @@ begin
raise Exception.Create('Designer not found!'); raise Exception.Create('Designer not found!');
end; end;
procedure TfrmGraphicsEditor.actDeleteExecute(Sender: TObject);
procedure TGraphicsEditorForm.actDeleteExecute(Sender: TObject);
var var
iIndex: Integer; index: Integer;
pGraphic: TX2GraphicContainerItem; graphic: TX2GraphicContainerItem;
begin begin
if Active(iIndex, pGraphic) then if Active(index, graphic) then
begin begin
{ First attempt to remove the component; this will raise an exception { First attempt to remove the component; this will raise an exception
if it's not allowed, for example due to it being introduced in if it's not allowed, for example due to it being introduced in
an ancestor. } an ancestor. }
pGraphic.Free(); graphic.Free();
lstGraphics.Items.Delete(iIndex); lstGraphics.Items.Delete(index);
if iIndex > lstGraphics.Items.Count - 1 then if index > Pred(lstGraphics.Items.Count) then
iIndex := lstGraphics.Items.Count - 1; index := Pred(lstGraphics.Items.Count);
lstGraphics.ItemIndex := iIndex; lstGraphics.ItemIndex := index;
UpdatePreview();
ItemChanged();
end; end;
end; end;
procedure TfrmGraphicsEditor.actUpExecute(Sender: TObject);
procedure TGraphicsEditorForm.actUpExecute(Sender: TObject);
var var
iIndex: Integer; index: Integer;
pGraphic: TX2GraphicContainerItem; graphic: TX2GraphicContainerItem;
begin begin
if Active(iIndex, pGraphic) then if Active(index, graphic) then
if iIndex > 0 then if index > 0 then
begin begin
lstGraphics.Items.Move(iIndex, iIndex - 1); lstGraphics.Items.Move(index, Pred(index));
pGraphic.Index := iIndex - 1; graphic.Index := Pred(index);
lstGraphics.ItemIndex := iIndex - 1; lstGraphics.ItemIndex := Pred(index);
Administrate();
end;
end;
procedure TfrmGraphicsEditor.actDownExecute(Sender: TObject); ItemChanged(False);
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();
end; end;
end; end;
procedure TfrmGraphicsEditor.actOpenExecute(Sender: TObject); procedure TGraphicsEditorForm.actDownExecute(Sender: TObject);
var var
iIndex: Integer; index: Integer;
pGraphic: TX2GraphicContainerItem; graphic: TX2GraphicContainerItem;
begin 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 begin
dlgOpen.Filter := GraphicFilter(TGraphic); dlgOpen.Filter := GraphicFilter(TGraphic);
if dlgOpen.Execute() then if dlgOpen.Execute() then
begin begin
pGraphic.Picture.LoadFromFile(dlgOpen.FileName); graphic.Picture.LoadFromFile(dlgOpen.FileName);
if Length(pGraphic.PictureName) = 0 then if Length(graphic.PictureName) = 0 then
pGraphic.PictureName := ChangeFileExt(ExtractFileName(dlgOpen.FileName), ''); graphic.PictureName := ChangeFileExt(ExtractFileName(dlgOpen.FileName), '');
UpdatePreview(); ItemChanged();
end; end;
end; end;
end; end;
procedure TfrmGraphicsEditor.actSaveExecute(Sender: TObject); procedure TGraphicsEditorForm.actSaveExecute(Sender: TObject);
var var
iIndex: Integer; index: Integer;
pClass: TGraphicClass; graphic: TX2GraphicContainerItem;
pGraphic: TX2GraphicContainerItem; graphicClass: TGraphicClass;
begin begin
if Active(iIndex, pGraphic) then if Active(index, graphic) then
if Assigned(pGraphic.Picture.Graphic) then begin if Assigned(graphic.Picture.Graphic) then begin
pClass := TGraphicClass(pGraphic.Picture.Graphic.ClassType); graphicClass := TGraphicClass(graphic.Picture.Graphic.ClassType);
dlgSave.Filter := GraphicFilter(pClass); dlgSave.Filter := GraphicFilter(graphicClass);
dlgSave.FileName := ChangeFileExt(pGraphic.PictureName, '.' + GraphicExtension(pClass)); dlgSave.FileName := ChangeFileExt(graphic.PictureName, '.' + GraphicExtension(graphicClass));
if dlgSave.Execute() then if dlgSave.Execute() then
pGraphic.Picture.SaveToFile(dlgSave.FileName); graphic.Picture.SaveToFile(dlgSave.FileName);
end; end;
end; end;
procedure TfrmGraphicsEditor.actClearExecute(Sender: TObject); procedure TGraphicsEditorForm.actClearExecute(Sender: TObject);
var var
iIndex: Integer; index: Integer;
pGraphic: TX2GraphicContainerItem; graphic: TX2GraphicContainerItem;
begin begin
if Active(iIndex, pGraphic) then if Active(index, graphic) then
begin begin
pGraphic.Picture.Assign(nil); graphic.Picture.Assign(nil);
UpdatePreview(); ItemChanged();
end; end;
end; end;
procedure TfrmGraphicsEditor.Notification(AComponent: TComponent; Operation: TOperation); procedure TGraphicsEditorForm.Notification(AComponent: TComponent; Operation: TOperation);
begin begin
inherited; inherited;

3
Packages/X2CLMBReg.pas
View File

@ -10,6 +10,7 @@ unit X2CLMBReg;
interface interface
procedure Register; procedure Register;
implementation implementation
uses uses
Classes, Classes,
@ -19,8 +20,10 @@ uses
X2CLunaMenuBarPainter, X2CLunaMenuBarPainter,
X2CLMBEditors; X2CLMBEditors;
{.$R ..\Resources\MenuBar.dcr} {.$R ..\Resources\MenuBar.dcr}
procedure Register; procedure Register;
begin begin
RegisterComponents('X2Software', [TX2MenuBar, RegisterComponents('X2Software', [TX2MenuBar,

2
Packages/X2CLMenuBarEditor.pas
View File

@ -112,6 +112,8 @@ begin
// Delphi (BDS) 2006 // Delphi (BDS) 2006
tbMenu.EdgeBorders := []; tbMenu.EdgeBorders := [];
tbMenu.DrawingStyle := dsGradient; tbMenu.DrawingStyle := dsGradient;
{$ELSE}
tbMenu.Flat := True;
{$ENDIF} {$ENDIF}
end; end;

448
Source/X2CLMenuBar.pas
View File

@ -28,14 +28,20 @@ type
TX2MenuBarAnimationStyle = (asNone, asSlide, asDissolve, asFade, TX2MenuBarAnimationStyle = (asNone, asSlide, asDissolve, asFade,
asSlideFade); asSlideFade);
TX2MenuBarDirection = (mbdUp, mbdDown);
const const
DefaultAnimationStyle = asSlide; DefaultAnimationStyle = asSlide;
DefaultAnimationTime = 250; DefaultAnimationTime = 250;
type 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) 25-3-2006: various Select methods for key support
// #ToDo1 (MvR) 1-4-2006: scroll wheel support // #ToDo1 (MvR) 1-4-2006: scroll wheel support
// #ToDo1 (MvR) 29-4-2006: action support
TX2CustomMenuBarAnimatorClass = class of TX2CustomMenuBarAnimator; TX2CustomMenuBarAnimatorClass = class of TX2CustomMenuBarAnimator;
TX2CustomMenuBarAnimator = class; TX2CustomMenuBarAnimator = class;
TX2CustomMenuBarPainterClass = class of TX2CustomMenuBarPainter; TX2CustomMenuBarPainterClass = class of TX2CustomMenuBarPainter;
@ -79,6 +85,11 @@ type
Data: Pointer; Data: Pointer;
var Abort: Boolean) of object; 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; TCollectionNotifyEvent = procedure(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification) of object;
TCollectionUpdateEvent = procedure(Sender: TObject; Item: TCollectionItem) of object; TCollectionUpdateEvent = procedure(Sender: TObject; Item: TCollectionItem) of object;
@ -209,6 +220,7 @@ type
FEnabled: Boolean; FEnabled: Boolean;
FImageIndex: TImageIndex; FImageIndex: TImageIndex;
FOwnsData: Boolean; FOwnsData: Boolean;
FTag: Integer;
FVisible: Boolean; FVisible: Boolean;
FNotification: TX2ComponentNotification; FNotification: TX2ComponentNotification;
@ -240,6 +252,7 @@ type
property Caption: String read FCaption write SetCaption stored IsCaptionStored; property Caption: String read FCaption write SetCaption stored IsCaptionStored;
property Enabled: Boolean read FEnabled write SetEnabled default True; property Enabled: Boolean read FEnabled write SetEnabled default True;
property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1; 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; property Visible: Boolean read FVisible write SetVisible default True;
end; end;
@ -299,7 +312,6 @@ type
function GetSelectedItem(): Integer; function GetSelectedItem(): Integer;
procedure SetExpanded(const Value: Boolean); procedure SetExpanded(const Value: Boolean);
procedure SetItems(const Value: TX2MenuBarItems); procedure SetItems(const Value: TX2MenuBarItems);
protected
protected protected
function IsCaptionStored(): Boolean; override; function IsCaptionStored(): Boolean; override;
procedure SetEnabled(const Value: Boolean); override; procedure SetEnabled(const Value: Boolean); override;
@ -350,6 +362,7 @@ type
FAutoCollapse: Boolean; FAutoCollapse: Boolean;
FAutoSelectItem: Boolean; FAutoSelectItem: Boolean;
FBorderStyle: TBorderStyle; FBorderStyle: TBorderStyle;
FBuffer: Graphics.TBitmap;
FCursorGroup: TCursor; FCursorGroup: TCursor;
FCursorItem: TCursor; FCursorItem: TCursor;
FDesigner: IX2MenuBarDesigner; FDesigner: IX2MenuBarDesigner;
@ -382,6 +395,7 @@ type
procedure SetSelectedItem(const Value: TX2CustomMenuBarItem); procedure SetSelectedItem(const Value: TX2CustomMenuBarItem);
protected protected
procedure CreateParams(var Params: TCreateParams); override; procedure CreateParams(var Params: TCreateParams); override;
procedure CreateHandle(); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure PainterUpdate(Sender: TX2CustomMenuBarPainter); procedure PainterUpdate(Sender: TX2CustomMenuBarPainter);
procedure GroupsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification); procedure GroupsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification);
@ -415,6 +429,7 @@ type
function IterateItemBounds(ACallback: TX2MenuBarItemBoundsProc; AData: Pointer = nil): TX2CustomMenuBarItem; function IterateItemBounds(ACallback: TX2MenuBarItemBoundsProc; AData: Pointer = nil): TX2CustomMenuBarItem;
function AllowInteraction(): Boolean; virtual; function AllowInteraction(): Boolean; virtual;
function ItemEnabled(AItem: TX2CustomMenuBarItem): Boolean; virtual;
function ItemVisible(AItem: TX2CustomMenuBarItem): Boolean; virtual; function ItemVisible(AItem: TX2CustomMenuBarItem): Boolean; virtual;
property AllowCollapseAll: Boolean read FAllowCollapseAll write SetAllowCollapseAll default True; property AllowCollapseAll: Boolean read FAllowCollapseAll write SetAllowCollapseAll default True;
@ -442,6 +457,8 @@ type
procedure DoExpandedChanged(AGroup: TX2MenuBarGroup); virtual; procedure DoExpandedChanged(AGroup: TX2MenuBarGroup); virtual;
procedure DoSelectedChanging(ANewItem: TX2CustomMenuBarItem; var AAllowed: Boolean); virtual; procedure DoSelectedChanging(ANewItem: TX2CustomMenuBarItem; var AAllowed: Boolean); virtual;
procedure DoSelectedChanged(); virtual; procedure DoSelectedChanged(); virtual;
procedure FindEnabledItem(Sender: TObject; Item: TX2CustomMenuBarItem; Data: Pointer; var Abort: Boolean);
public public
constructor Create(AOwner: TComponent); override; constructor Create(AOwner: TComponent); override;
destructor Destroy(); override; destructor Destroy(); override;
@ -449,14 +466,22 @@ type
function HitTest(const APoint: TPoint): TX2MenuBarHitTest; overload; function HitTest(const APoint: TPoint): TX2MenuBarHitTest; overload;
function HitTest(AX, AY: Integer): 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 SelectFirst(): TX2CustomMenuBarItem;
function SelectLast(): TX2CustomMenuBarItem; function SelectLast(): TX2CustomMenuBarItem;
function SelectNext(): TX2CustomMenuBarItem; function SelectNext(): TX2CustomMenuBarItem;
function SelectPrior(): TX2CustomMenuBarItem; function SelectPrior(): TX2CustomMenuBarItem;
function SelectGroup(AIndex: Integer): TX2MenuBarGroup; function SelectGroup(AIndex: Integer): TX2MenuBarGroup;
function SelectItem(AIndex: Integer; AGroup: TX2MenuBarGroup = nil): TX2CustomMenuBarItem; overload; function SelectItem(AIndex: Integer; AGroup: TX2MenuBarGroup): TX2CustomMenuBarItem; overload;
function SelectItem(AIndex: Integer; AGroup: Integer = -1): 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 Groups: TX2MenuBarGroups read FGroups write SetGroups;
property Images: TCustomImageList read FImages write SetImages; property Images: TCustomImageList read FImages write SetImages;
@ -483,9 +508,11 @@ type
property BorderWidth; property BorderWidth;
property CursorGroup; property CursorGroup;
property CursorItem; property CursorItem;
property Font;
property Groups; property Groups;
property HideScrollbar; property HideScrollbar;
property Images; property Images;
property ParentFont;
property OnClick; property OnClick;
property OnCollapsed; property OnCollapsed;
property OnCollapsing; property OnCollapsing;
@ -494,12 +521,14 @@ type
property OnExit; property OnExit;
property OnExpanded; property OnExpanded;
property OnExpanding; property OnExpanding;
property OnSelectedChanged; property OnSelectedChanged;
property OnSelectedChanging; property OnSelectedChanging;
{$IFDEF VER180}
property OnMouseActivate; property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter; property OnMouseEnter;
property OnMouseLeave; property OnMouseLeave;
{$ENDIF}
property OnMouseDown;
property OnMouseMove; property OnMouseMove;
property OnMouseUp; property OnMouseUp;
property OnResize; property OnResize;
@ -1179,7 +1208,7 @@ end;
function TX2MenuBarGroup.GetSelectedItem(): Integer; function TX2MenuBarGroup.GetSelectedItem(): Integer;
begin begin
Result := -1; Result := -1;
if Items.Count > 0 then if Items.Count > 0 then
begin begin
if (FSelectedItem >= 0) and (FSelectedItem < Items.Count) then if (FSelectedItem >= 0) and (FSelectedItem < Items.Count) then
@ -1328,12 +1357,22 @@ begin
end; end;
end; end;
procedure TX2CustomMenuBar.CreateHandle();
begin
inherited;
UpdateScrollbar();
end;
destructor TX2CustomMenuBar.Destroy(); destructor TX2CustomMenuBar.Destroy();
begin begin
Animator := nil; Animator := nil;
Painter := nil;
FreeAndNil(FExpandingGroups); FreeAndNil(FExpandingGroups);
FreeAndNil(FGroups); FreeAndNil(FGroups);
FreeAndNil(FBuffer);
inherited; inherited;
end; end;
@ -1345,7 +1384,6 @@ end;
procedure TX2CustomMenuBar.Paint(); procedure TX2CustomMenuBar.Paint();
var var
buffer: Graphics.TBitmap;
bufferRect: TRect; bufferRect: TRect;
expand: Boolean; expand: Boolean;
group: TX2MenuBarGroup; group: TX2MenuBarGroup;
@ -1353,30 +1391,36 @@ var
begin begin
if Assigned(Painter) then if Assigned(Painter) then
begin begin
buffer := Graphics.TBitmap.Create(); if not Assigned(FBuffer) then
try begin
buffer.PixelFormat := pf32bit; FBuffer := Graphics.TBitmap.Create();
buffer.Width := Self.ClientWidth; FBuffer.PixelFormat := pf32bit;
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);
end; 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 if Assigned(Animator) then
begin begin
if Animator.Terminated then if Animator.Terminated then
@ -1582,7 +1626,7 @@ begin
begin begin
{ Animated group } { Animated group }
Inc(itemBounds.Top, Animator.Height); Inc(itemBounds.Top, Animator.Height);
end else if group.Expanded then end else if group.Expanded and (group.Items.Count > 0) then
begin begin
Inc(itemBounds.Top, Painter.GetSpacing(seBeforeFirstItem)); Inc(itemBounds.Top, Painter.GetSpacing(seBeforeFirstItem));
@ -1639,35 +1683,49 @@ begin
exit; exit;
end; end;
allowed := True; if AGroup.Items.Count > 0 then
if AExpanding then
begin begin
if Assigned(FOnExpanding) then allowed := True;
FOnExpanding(Self, AGroup, allowed); if AExpanding then
end else begin
if Assigned(FOnCollapsing) then if Assigned(FOnExpanding) then
FOnCollapsing(Self, AGroup, allowed); FOnExpanding(Self, AGroup, allowed);
end else
if Assigned(FOnCollapsing) then
FOnCollapsing(Self, AGroup, allowed);
if not allowed then 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
exit; exit;
{ Allow collapse all } { Pretend to auto select item - required for proper functioning of
if not (AExpanding or AllowCollapseAll) then the OnSelectedChanging event }
if ExpandedGroupsCount() = 1 then if AutoSelectItem then
exit; 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 } { Auto collapse }
if AutoCollapse then if AutoCollapse then
if AExpanding then if AExpanding then
DoAutoCollapse(AGroup); DoAutoCollapse(AGroup);
DoExpand(AGroup, AExpanding); if AGroup.Items.Count > 0 then
DoExpand(AGroup, AExpanding)
else
begin
AGroup.InternalSetExpanded(AExpanding);
SelectedItem := AGroup
end;
end; end;
procedure TX2CustomMenuBar.DoExpandedChanged(AGroup: TX2MenuBarGroup); procedure TX2CustomMenuBar.DoExpandedChanged(AGroup: TX2MenuBarGroup);
@ -1704,6 +1762,11 @@ begin
Result := not Assigned(Animator); Result := not Assigned(Animator);
end; end;
function TX2CustomMenuBar.ItemEnabled(AItem: TX2CustomMenuBarItem): Boolean;
begin
Result := AItem.Enabled and AItem.Visible;
end;
function TX2CustomMenuBar.ItemVisible(AItem: TX2CustomMenuBarItem): Boolean; function TX2CustomMenuBar.ItemVisible(AItem: TX2CustomMenuBarItem): Boolean;
begin begin
Result := AItem.Visible or (csDesigning in ComponentState); Result := AItem.Visible or (csDesigning in ComponentState);
@ -1721,6 +1784,12 @@ begin
if not Assigned(Painter) then if not Assigned(Painter) then
exit; exit;
if AGroup.Items.Count = 0 then
begin
AGroup.InternalSetExpanded(AExpanding);
Exit;
end;
if Assigned(Animator) then if Assigned(Animator) then
begin begin
FExpandingGroups.AddObject(Chr(Ord(AExpanding)), AGroup); FExpandingGroups.AddObject(Chr(Ord(AExpanding)), AGroup);
@ -1804,6 +1873,7 @@ var
group: TX2MenuBarGroup; group: TX2MenuBarGroup;
groupIndex: Integer; groupIndex: Integer;
newItem: TX2CustomMenuBarItem; newItem: TX2CustomMenuBarItem;
itemIndex: Integer;
begin begin
Result := True; Result := True;
@ -1830,24 +1900,40 @@ begin
if group.Items.Count > 0 then if group.Items.Count > 0 then
begin begin
newItem := group.Items[group.SelectedItem]; 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 begin
if AAction in [saBefore, saBoth] then if AAction in [saBefore, saBoth] then
DoSelectedChanging(newItem, Result); DoSelectedChanging(newItem, Result);
if Result and (AAction in [saAfter, saBoth]) then if Result and (AAction in [saAfter, saBoth]) then
begin SelectedItem := newItem;
FSelectedItem := newItem;
DoSelectedChanged();
Invalidate();
end;
end; end;
end; 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; function TX2CustomMenuBar.HitTest(const APoint: TPoint): TX2MenuBarHitTest;
var var
hitPoint: TPoint; hitPoint: TPoint;
@ -1874,42 +1960,196 @@ begin
end; 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; function TX2CustomMenuBar.SelectFirst(): TX2CustomMenuBarItem;
begin 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; end;
function TX2CustomMenuBar.SelectLast(): TX2CustomMenuBarItem; function TX2CustomMenuBar.SelectLast(): TX2CustomMenuBarItem;
begin 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; end;
function TX2CustomMenuBar.SelectNext(): TX2CustomMenuBarItem; function TX2CustomMenuBar.SelectNext(): TX2CustomMenuBarItem;
begin 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; end;
function TX2CustomMenuBar.SelectPrior(): TX2CustomMenuBarItem; function TX2CustomMenuBar.SelectPrior(): TX2CustomMenuBarItem;
begin 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; end;
function TX2CustomMenuBar.SelectGroup(AIndex: Integer): TX2MenuBarGroup; function TX2CustomMenuBar.SelectGroup(AIndex: Integer): TX2MenuBarGroup;
begin begin
// #ToDo1 (MvR) 29-4-2006: implement this
Result := nil; Result := nil;
if AllowInteraction then
begin
if (AIndex >= 0) and (AIndex < Groups.Count) then
begin
Result := Groups[AIndex];
SelectedItem := Result;
end;
end;
end; end;
function TX2CustomMenuBar.SelectItem(AIndex: Integer; function TX2CustomMenuBar.SelectItem(AIndex: Integer;
AGroup: TX2MenuBarGroup): TX2CustomMenuBarItem; AGroup: TX2MenuBarGroup): TX2CustomMenuBarItem;
var
group: TX2MenuBarGroup;
groupIndex: Integer;
begin begin
// #ToDo1 (MvR) 29-4-2006: implement this
Result := nil; 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; end;
function TX2CustomMenuBar.SelectItem(AIndex, AGroup: Integer): TX2CustomMenuBarItem; function TX2CustomMenuBar.SelectItem(AIndex, AGroup: Integer): TX2CustomMenuBarItem;
@ -1924,6 +2164,11 @@ begin
Result := SelectItem(AIndex, group); Result := SelectItem(AIndex, group);
end; end;
function TX2CustomMenuBar.SelectItem(AIndex: Integer): TX2CustomMenuBarItem;
begin
Result := SelectItem(AIndex, nil);
end;
procedure TX2CustomMenuBar.Notification(AComponent: TComponent; Operation: TOperation); procedure TX2CustomMenuBar.Notification(AComponent: TComponent; Operation: TOperation);
@ -1967,7 +2212,7 @@ end;
procedure TX2CustomMenuBar.GroupsUpdate(Sender: TObject; Item: TCollectionItem); procedure TX2CustomMenuBar.GroupsUpdate(Sender: TObject; Item: TCollectionItem);
begin begin
if Assigned(SelectedItem) and (not SelectedItem.Enabled) then if Assigned(SelectedItem) and (not ItemEnabled(SelectedItem)) then
SelectedItem := nil; SelectedItem := nil;
if Assigned(Designer) then if Assigned(Designer) then
@ -1992,7 +2237,7 @@ begin
if hitTest.HitTestCode = htGroup then if hitTest.HitTestCode = htGroup then
begin begin
group := TX2MenuBarGroup(hitTest.Item); group := TX2MenuBarGroup(hitTest.Item);
if group.Enabled and (group.Items.Count > 0) then if ItemEnabled(group) then
begin begin
group.Expanded := not group.Expanded; group.Expanded := not group.Expanded;
hitTest.Item := SelectedItem; hitTest.Item := SelectedItem;
@ -2000,11 +2245,8 @@ begin
end; end;
end; end;
if Assigned(hitTest.Item) and (hitTest.Item <> SelectedItem) and if Assigned(hitTest.Item) then
hitTest.Item.Enabled then
begin
SelectedItem := hitTest.Item; SelectedItem := hitTest.Item;
end;
end; end;
inherited; inherited;
@ -2025,7 +2267,7 @@ begin
else if FHotItem is TX2MenuBarItem then else if FHotItem is TX2MenuBarItem then
cursor := CursorItem; cursor := CursorItem;
if (cursor <> crDefault) and FHotItem.Enabled then if (cursor <> crDefault) and ItemEnabled(FHotItem) then
begin begin
Windows.SetCursor(Screen.Cursors[cursor]); Windows.SetCursor(Screen.Cursors[cursor]);
exit; exit;
@ -2348,31 +2590,51 @@ var
begin begin
if Value <> FSelectedItem then if Value <> FSelectedItem then
begin begin
allowed := True; if Assigned(Value) then
DoSelectedChanging(Value, allowed);
if allowed then
begin begin
FSelectedItem := Value; allowed := ItemEnabled(Value);
if allowed then
if Value is TX2MenuBarItem then
begin begin
group := TX2MenuBarItem(Value).Group; DoSelectedChanging(Value, allowed);
if Assigned(group) then
if allowed then
begin begin
group.SelectedItem := Value.Index; if Value is TX2MenuBarGroup then
begin
if not group.Expanded then group := TX2MenuBarGroup(Value);
group.Expanded := True;
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; end;
end else
FSelectedItem := Value;
if Assigned(FSelectedItem) and Assigned(FSelectedItem.Action) then DoSelectedChanged();
FSelectedItem.ActionLink.Execute(Self); Invalidate();
DoSelectedChanged();
Invalidate();
end;
end; end;
end; end;

650
Source/X2CLunaMenuBarPainter.pas
View File

@ -12,17 +12,133 @@ unit X2CLunaMenuBarPainter;
interface interface
uses uses
Classes,
Graphics, Graphics,
Windows, Windows,
X2CLMenuBar; X2CLMenuBar;
type 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) TX2MenuBarunaPainter = class(TX2CustomMenuBarPainter)
private 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 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 protected
function ApplyMargins(const ABounds: TRect): TRect; override; function ApplyMargins(const ABounds: TRect): TRect; override;
function GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; override; function GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; override;
@ -32,15 +148,30 @@ type
procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect); override; procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect); override;
procedure DrawGroupHeader(ACanvas: TCanvas; AGroup: TX2MenuBarGroup; const ABounds: TRect; AState: TX2MenuBarDrawStates); 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 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 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; end;
implementation implementation
uses uses
Classes,
ImgList, ImgList,
SysUtils; SysUtils,
X2CLGraphics;
@ -137,7 +268,180 @@ begin
end; 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 } { 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); procedure TX2MenuBarunaPainter.SetBlurShadow(const Value: Boolean);
begin begin
if Value <> FBlurShadow then if Value <> FBlurShadow then
@ -151,7 +455,7 @@ end;
function TX2MenuBarunaPainter.ApplyMargins(const ABounds: TRect): TRect; function TX2MenuBarunaPainter.ApplyMargins(const ABounds: TRect): TRect;
begin begin
Result := inherited ApplyMargins(ABounds); Result := inherited ApplyMargins(ABounds);
InflateRect(Result, -10, -10); InflateRect(Result, -Metrics.Margin, -Metrics.Margin);
end; end;
function TX2MenuBarunaPainter.GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; function TX2MenuBarunaPainter.GetSpacing(AElement: TX2MenuBarSpacingElement): Integer;
@ -159,29 +463,30 @@ begin
Result := inherited GetSpacing(AElement); Result := inherited GetSpacing(AElement);
case AElement of case AElement of
seBeforeGroupHeader, seBeforeGroupHeader: Result := Metrics.BeforeGroupHeader;
seAfterGroupHeader: Result := 5; seAfterGroupHeader: Result := Metrics.AfterGroupHeader;
seAfterLastItem: Result := 10; seBeforeFirstItem: Result := Metrics.BeforeFirstItem;
seBeforeItem, seAfterLastItem: Result := Metrics.AfterLastItem;
seAfterItem: Result := 4; seBeforeItem: Result := Metrics.BeforeItem;
seAfterItem: Result := Metrics.AfterItem;
end; end;
end; end;
function TX2MenuBarunaPainter.GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer; function TX2MenuBarunaPainter.GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer;
begin begin
Result := 22; Result := Metrics.GroupHeight;
end; end;
function TX2MenuBarunaPainter.GetItemHeight(AItem: TX2MenuBarItem): Integer; function TX2MenuBarunaPainter.GetItemHeight(AItem: TX2MenuBarItem): Integer;
begin begin
Result := 21; Result := Metrics.ItemHeight
end; end;
procedure TX2MenuBarunaPainter.DrawBackground(ACanvas: TCanvas; procedure TX2MenuBarunaPainter.DrawBackground(ACanvas: TCanvas;
const ABounds: TRect); const ABounds: TRect);
begin begin
ACanvas.Brush.Color := clWindow; ACanvas.Brush.Color := Self.Color;
ACanvas.FillRect(ABounds); ACanvas.FillRect(ABounds);
end; end;
@ -189,30 +494,38 @@ procedure TX2MenuBarunaPainter.DrawGroupHeader(ACanvas: TCanvas;
AGroup: TX2MenuBarGroup; AGroup: TX2MenuBarGroup;
const ABounds: TRect; const ABounds: TRect;
AState: TX2MenuBarDrawStates); AState: TX2MenuBarDrawStates);
const
ShadowMargin = 2;
procedure DrawShadowOutline(AShadowCanvas: TCanvas; AShadowBounds: TRect); procedure DrawShadowOutline(AShadowCanvas: TCanvas; AShadowBounds: TRect);
begin begin
// #ToDo1 (MvR) 27-3-2006: make the color a property AShadowCanvas.Brush.Color := ShadowColor;
if BlurShadow then AShadowCanvas.Pen.Color := ShadowColor;
begin AShadowCanvas.RoundRect(AShadowBounds.Left + ShadowMargin,
AShadowCanvas.Brush.Color := $00c3c3c3; AShadowBounds.Top + ShadowMargin,
AShadowCanvas.Pen.Color := $00c3c3c3; AShadowBounds.Right + ShadowMargin,
end else AShadowBounds.Bottom + ShadowMargin, 5, 5);
begin end;
AShadowCanvas.Brush.Color := $00404040;
AShadowCanvas.Pen.Color := $00404040;
end;
AShadowCanvas.RoundRect(AShadowBounds.Left + 2, function GetColor(AColor: TX2MenuBarunaColor): TColor;
AShadowBounds.Top + 2, begin
AShadowBounds.Right + 2, if AGroup.Enabled then
AShadowBounds.Bottom + 2, 5, 5); 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; end;
var var
textRect: TRect;
imageList: TCustomImageList; imageList: TCustomImageList;
imagePos: TPoint; imagePos: TPoint;
shadowBitmap: Graphics.TBitmap; shadowBitmap: Graphics.TBitmap;
shadowBounds: TRect;
textRect: TRect;
begin begin
if not ((mdsSelected in AState) or (mdsGroupSelected in AState)) then if not ((mdsSelected in AState) or (mdsGroupSelected in AState)) then
@ -223,13 +536,13 @@ begin
shadowBitmap := Graphics.TBitmap.Create(); shadowBitmap := Graphics.TBitmap.Create();
try try
shadowBitmap.PixelFormat := pf32bit; shadowBitmap.PixelFormat := pf32bit;
shadowBitmap.Width := (ABounds.Right - ABounds.Left + 4); shadowBitmap.Width := (ABounds.Right - ABounds.Left + (ShadowMargin * 2));
shadowBitmap.Height := (ABounds.Bottom - ABounds.Top + 4); shadowBitmap.Height := (ABounds.Bottom - ABounds.Top + (ShadowMargin * 2));
DrawBackground(shadowBitmap.Canvas, Rect(0, 0, shadowBitmap.Width, DrawBackground(shadowBitmap.Canvas, Rect(0, 0, shadowBitmap.Width,
shadowBitmap.Height)); shadowBitmap.Height));
DrawShadowOutline(shadowBitmap.Canvas, Rect(0, 0, shadowBitmap.Width - 4, DrawShadowOutline(shadowBitmap.Canvas, Rect(0, 0, shadowBitmap.Width - (ShadowMargin * 2),
shadowBitmap.Height - 4)); shadowBitmap.Height - (ShadowMargin * 2)));
Blur(shadowBitmap); Blur(shadowBitmap);
ACanvas.Draw(ABounds.Left, ABounds.Top, shadowBitmap); ACanvas.Draw(ABounds.Left, ABounds.Top, shadowBitmap);
@ -237,26 +550,21 @@ begin
FreeAndNil(shadowBitmap); FreeAndNil(shadowBitmap);
end end
end else end else
begin
shadowBounds := ABounds;
OffsetRect(shadowBounds, -ShadowMargin, -ShadowMargin);
DrawShadowOutline(ACanvas, ABounds); DrawShadowOutline(ACanvas, ABounds);
end;
end; end;
ACanvas.Brush.Color := $00E9E9E9;
{ Rounded rectangle } { Rounded rectangle }
if AGroup.Enabled and ((mdsSelected in AState) or (mdsHot in AState) or ACanvas.Brush.Color := GetColor(GroupColors.Fill);
(mdsGroupSelected in AState)) then ACanvas.Pen.Color := GetColor(GroupColors.Border);
ACanvas.Pen.Color := $00BE6363 ACanvas.Font.Color := GetColor(GroupColors.Text);
else
ACanvas.Pen.Color := clBlack;
ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5); ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5);
if AGroup.Enabled then textRect := ABounds;
ACanvas.Font.Color := ACanvas.Pen.Color
else
ACanvas.Font.Color := clGray;
textRect := ABounds;
Inc(textRect.Left, 4); Inc(textRect.Left, 4);
Dec(textRect.Right, 4); Dec(textRect.Right, 4);
@ -283,6 +591,19 @@ end;
procedure TX2MenuBarunaPainter.DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem; procedure TX2MenuBarunaPainter.DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem;
const ABounds: TRect; const ABounds: TRect;
AState: TX2MenuBarDrawStates); 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 var
focusBounds: TRect; focusBounds: TRect;
textBounds: TRect; textBounds: TRect;
@ -290,7 +611,7 @@ var
begin begin
focusBounds := ABounds; focusBounds := ABounds;
Dec(focusBounds.Right, 10); Dec(focusBounds.Right, Metrics.Margin);
if (mdsSelected in AState) then if (mdsSelected in AState) then
begin begin
@ -298,8 +619,8 @@ begin
DrawFocusRect(ACanvas, focusBounds); DrawFocusRect(ACanvas, focusBounds);
{ Arrow } { Arrow }
ACanvas.Brush.Color := clBlue; ACanvas.Brush.Color := ArrowColor;
ACanvas.Pen.Color := clBlue; ACanvas.Pen.Color := ArrowColor;
arrowPoints[0].X := ABounds.Right - 8; arrowPoints[0].X := ABounds.Right - 8;
arrowPoints[0].Y := ABounds.Top + ((ABounds.Bottom - ABounds.Top - 15) div 2) + 7; arrowPoints[0].Y := ABounds.Top + ((ABounds.Bottom - ABounds.Top - 15) div 2) + 7;
@ -311,14 +632,7 @@ begin
end; end;
{ Text } { Text }
if AItem.Enabled then ACanvas.Font.Color := GetColor(ItemColors);
if (mdsSelected in AState) or (mdsHot in AState) then
ACanvas.Font.Color := clBlack
else
ACanvas.Font.Color := $00404040
else
ACanvas.Font.Color := clSilver;
textBounds := focusBounds; textBounds := focusBounds;
Inc(textBounds.Left, 4); Inc(textBounds.Left, 4);
Dec(textBounds.Right, 4); Dec(textBounds.Right, 4);
@ -335,4 +649,224 @@ begin
False, csEllipsis); False, csEllipsis);
end; 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. end.

8
X2CL.bpg
View File

@ -9,7 +9,7 @@ MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$**
DCC = $(ROOT)\bin\dcc32.exe $** DCC = $(ROOT)\bin\dcc32.exe $**
BRCC = $(ROOT)\bin\brcc32.exe $** BRCC = $(ROOT)\bin\brcc32.exe $**
#------------------------------------------------------------------------------ #------------------------------------------------------------------------------
PROJECTS = X2CLGLD.bpl X2CLGL.bpl PROJECTS = X2CLGL.bpl X2CLGLD.bpl X2CLMB.bpl X2CLMBDX.bpl
#------------------------------------------------------------------------------ #------------------------------------------------------------------------------
default: $(PROJECTS) default: $(PROJECTS)
#------------------------------------------------------------------------------ #------------------------------------------------------------------------------
@ -21,4 +21,10 @@ X2CLGLD.bpl: Packages\D7\X2CLGLD.dpk
X2CLGL.bpl: Packages\D7\X2CLGL.dpk X2CLGL.bpl: Packages\D7\X2CLGL.dpk
$(DCC) $(DCC)
X2CLMB.bpl: Packages\D7\X2CLMB.dpk
$(DCC)
X2CLMBDX.bpl: Packages\D7\X2CLMBD.dpk
$(DCC)