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

20
Packages/D7/X2CLGL.dof
View File

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

4
Packages/D7/X2CLGLD.cfg
View File

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

20
Packages/D7/X2CLGLD.dof
View File

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

2
Packages/D7/X2CLGLD.dpk
View File

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

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);
{============== TX2GraphicContainerEditor
Editor
========================================}
{ TX2GraphicContainerEditor }
procedure TX2GraphicContainerEditor.Edit();
begin
TfrmGraphicsEditor.Execute(Component, Self.Designer);
TGraphicsEditorForm.Execute(Component, Self.Designer);
end;
procedure TX2GraphicContainerEditor.ExecuteVerb(Index: Integer);
@ -109,9 +107,7 @@ begin
end;
{=================== TX2GraphicListEditor
Editor
========================================}
{ TX2GraphicContainerEditor }
procedure TX2GraphicListEditor.Edit;
var
ifEditor: IComponentEditor;

30
Packages/X2CLGraphicsEditor.dfm
View File

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

293
Packages/X2CLGraphicsEditor.pas
View File

@ -25,7 +25,7 @@ uses
X2CLGraphicList;
type
TfrmGraphicsEditor = class(TForm)
TGraphicsEditorForm = class(TForm)
actAdd: TAction;
actClear: TAction;
actDelete: TAction;
@ -68,11 +68,14 @@ type
procedure actSaveExecute(Sender: TObject);
procedure actClearExecute(Sender: TObject);
private
FComponent: TX2GraphicContainer;
FComponentDesigner: IDesigner;
FComponent: TX2GraphicContainer;
FComponentDesigner: IDesigner;
FUpdating: Boolean;
procedure InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner);
procedure Administrate();
procedure ItemChanged(AUpdatePreview: Boolean = True);
procedure UpdateUI();
procedure UpdatePreview();
function Active(out AIndex: Integer; out AGraphic: TX2GraphicContainerItem): Boolean;
@ -86,33 +89,32 @@ implementation
uses
Graphics,
SysUtils;
var
GEditor: TfrmGraphicsEditor;
EditorInstance: TGraphicsEditorForm;
{$R *.dfm}
{===================== TfrmGraphicsEditor
Initialization
========================================}
class procedure TfrmGraphicsEditor.Execute(const AComponent: TComponent; const ADesigner: IDesigner);
{ TGraphicsEditorForm }
class procedure TGraphicsEditorForm.Execute(const AComponent: TComponent; const ADesigner: IDesigner);
begin
if not Assigned(GEditor) then
GEditor := TfrmGraphicsEditor.Create(Application);
if not Assigned(EditorInstance) then
EditorInstance := TGraphicsEditorForm.Create(Application);
GEditor.InternalExecute(AComponent, ADesigner);
EditorInstance.InternalExecute(AComponent, ADesigner);
end;
procedure TfrmGraphicsEditor.InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner);
procedure TGraphicsEditorForm.InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner);
var
iGraphic: Integer;
graphicIndex: Integer;
begin
FComponent := TX2GraphicContainer(AComponent);
FComponent.FreeNotification(Self);
FComponentDesigner := ADesigner;
Caption := Format('%s Graphics', [FComponent.Name]);
@ -123,79 +125,91 @@ begin
try
Clear();
for iGraphic := 0 to FComponent.GraphicCount - 1 do
AddObject(FComponent.Graphics[iGraphic].PictureName,
FComponent.Graphics[iGraphic]);
for graphicIndex := 0 to FComponent.GraphicCount - 1 do
AddObject(FComponent.Graphics[graphicIndex].PictureName,
FComponent.Graphics[graphicIndex]);
finally
EndUpdate();
end;
lstGraphics.ItemIndex := 0;
UpdatePreview();
end;
Administrate();
UpdateUI();
UpdatePreview();
Show();
end;
procedure TfrmGraphicsEditor.FormClose(Sender: TObject; var Action: TCloseAction);
procedure TGraphicsEditorForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
GEditor := nil;
if Self = EditorInstance then
EditorInstance := nil;
if Assigned(FComponent) then
FComponent.RemoveFreeNotification(Self);
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
bEnabled: Boolean;
iIndex: Integer;
pGraphic: TX2GraphicContainerItem;
enabled: Boolean;
index: Integer;
graphic: TX2GraphicContainerItem;
begin
bEnabled := Active(iIndex, pGraphic);
actDelete.Enabled := bEnabled;
actOpen.Enabled := bEnabled;
enabled := Active(index, graphic);
actDelete.Enabled := enabled;
actOpen.Enabled := enabled;
if bEnabled then
bEnabled := Assigned(pGraphic.Picture.Graphic)
if enabled then
enabled := Assigned(graphic.Picture.Graphic)
else
bEnabled := False;
actSave.Enabled := bEnabled;
actClear.Enabled := bEnabled;
enabled := False;
actUp.Enabled := bEnabled and (iIndex > 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;

3
Packages/X2CLMBReg.pas
View File

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

2
Packages/X2CLMenuBarEditor.pas
View File

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

448
Source/X2CLMenuBar.pas
View File

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

650
Source/X2CLunaMenuBarPainter.pas
View File

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

8
X2CL.bpg
View File

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