1
0
mirror of synced 2024-11-14 06:59:16 +00:00

Added: image index to graphiclist editor

Added: gradient support to unaMenuBarPainter
Added: ImageOffset support to unaMenuBarPainter
This commit is contained in:
Mark van Renswoude 2008-06-06 14:22:00 +00:00
parent 280e5f669b
commit 18b17e3487
9 changed files with 386 additions and 108 deletions

View File

@ -136,6 +136,7 @@ ProductVersion=1.0.0.0
Comments= Comments=
[Excluded Packages] [Excluded Packages]
C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors
C:\Program Files\madCollection\madExcept\Delphi 7\madExceptIde_.bpl=madExceptIde 1.1 - www.madshi.net
[HistoryLists\hlUnitAliases] [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;

View File

@ -31,9 +31,9 @@
-M -M
-$M16384,1048576 -$M16384,1048576
-K$00400000 -K$00400000
-N"..\..\Lib\D7" -N"P:\algemeen\lib"
-LE"..\..\Lib\D7" -LE"P:\algemeen\bin"
-LN"..\..\Lib\D7" -LN"P:\algemeen\lib"
-Z -Z
-w-UNSAFE_TYPE -w-UNSAFE_TYPE
-w-UNSAFE_CODE -w-UNSAFE_CODE

View File

@ -91,9 +91,9 @@ ImageBase=4194304
ExeDescription=X²CL MenuBar ExeDescription=X²CL MenuBar
[Directories] [Directories]
OutputDir= OutputDir=
UnitOutputDir=..\..\Lib\D7 UnitOutputDir=$(DELPHILIB)
PackageDLLOutputDir=..\..\Lib\D7 PackageDLLOutputDir=$(DELPHIBIN)
PackageDCPOutputDir=..\..\Lib\D7 PackageDCPOutputDir=$(DELPHILIB)
SearchPath= 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 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= Conditionals=
@ -143,14 +143,17 @@ Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
Count=1 Count=1
Item0=P:\Algemeen\Indy10;P:\Algemeen\Indy10\Core;P:\Algemeen\Indy10\Protocols;P:\Algemeen\Indy10\SuperCore;P:\Algemeen\Indy10\System 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=4
Item0=..\..\Lib\D7 Item0=$(DELPHILIB)
Item1=..\Lib\D7 Item1=..\..\Lib\D7
Item2=Lib\D7 Item2=..\Lib\D7
Item3=Lib\D7
[HistoryLists\hlBPLOutput] [HistoryLists\hlBPLOutput]
Count=2 Count=3
Item0=..\..\Lib\D7 Item0=$(DELPHIBIN)
Item1=Lib\D7 Item1=..\..\Lib\D7
Item2=Lib\D7
[HistoryLists\hlDCPOutput] [HistoryLists\hlDCPOutput]
Count=1 Count=2
Item0=..\..\Lib\D7 Item0=$(DELPHILIB)
Item1=..\..\Lib\D7

View File

@ -31,9 +31,9 @@
-M -M
-$M16384,1048576 -$M16384,1048576
-K$00400000 -K$00400000
-N"..\..\Lib\D7" -N"P:\algemeen\lib"
-LE"..\..\Lib\D7" -LE"P:\algemeen\bin"
-LN"..\..\Lib\D7" -LN"P:\algemeen\lib"
-Z -Z
-w-UNSAFE_TYPE -w-UNSAFE_TYPE
-w-UNSAFE_CODE -w-UNSAFE_CODE

View File

@ -91,9 +91,9 @@ ImageBase=4194304
ExeDescription=X²CL MenuBar (Designtime) ExeDescription=X²CL MenuBar (Designtime)
[Directories] [Directories]
OutputDir= OutputDir=
UnitOutputDir=..\..\Lib\D7 UnitOutputDir=$(DELPHILIB)
PackageDLLOutputDir=..\..\Lib\D7 PackageDLLOutputDir=$(DELPHIBIN)
PackageDCPOutputDir=..\..\Lib\D7 PackageDCPOutputDir=$(DELPHILIB)
SearchPath= 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 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= Conditionals=
@ -135,8 +135,6 @@ ProductName=
ProductVersion=1.0.0.0 ProductVersion=1.0.0.0
Comments= Comments=
[Excluded Packages] [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 C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors
[HistoryLists\hlUnitAliases] [HistoryLists\hlUnitAliases]
Count=1 Count=1
@ -145,14 +143,17 @@ Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
Count=1 Count=1
Item0=P:\Algemeen\Indy10;P:\Algemeen\Indy10\Core;P:\Algemeen\Indy10\Protocols;P:\Algemeen\Indy10\SuperCore;P:\Algemeen\Indy10\System 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=4
Item0=..\..\Lib\D7 Item0=$(DELPHILIB)
Item1=..\Lib\D7 Item1=..\..\Lib\D7
Item2=Lib\D7 Item2=..\Lib\D7
Item3=Lib\D7
[HistoryLists\hlBPLOutput] [HistoryLists\hlBPLOutput]
Count=2 Count=3
Item0=..\..\Lib\D7 Item0=$(DELPHIBIN)
Item1=Lib\D7 Item1=..\..\Lib\D7
Item2=Lib\D7
[HistoryLists\hlDCPOutput] [HistoryLists\hlDCPOutput]
Count=1 Count=2
Item0=..\..\Lib\D7 Item0=$(DELPHILIB)
Item1=..\..\Lib\D7

View File

@ -119,10 +119,14 @@ object GraphicsEditorForm: TGraphicsEditorForm
Top = 26 Top = 26
Width = 189 Width = 189
Height = 398 Height = 398
Style = lbVirtual
Align = alClient Align = alClient
ItemHeight = 13 ItemHeight = 13
TabOrder = 1 TabOrder = 1
OnClick = lstGraphicsClick OnClick = lstGraphicsClick
OnData = lstGraphicsData
OnDataFind = lstGraphicsDataFind
OnKeyPress = lstGraphicsKeyPress
end end
object tbGraphics: TToolBar object tbGraphics: TToolBar
Left = 0 Left = 0

View File

@ -67,6 +67,11 @@ type
procedure actOpenExecute(Sender: TObject); procedure actOpenExecute(Sender: TObject);
procedure actSaveExecute(Sender: TObject); procedure actSaveExecute(Sender: TObject);
procedure actClearExecute(Sender: TObject); procedure actClearExecute(Sender: TObject);
procedure lstGraphicsData(Control: TWinControl; Index: Integer;
var Data: String);
function lstGraphicsDataFind(Control: TWinControl;
FindString: String): Integer;
procedure lstGraphicsKeyPress(Sender: TObject; var Key: Char);
private private
FComponent: TX2GraphicContainer; FComponent: TX2GraphicContainer;
FComponentDesigner: IDesigner; FComponentDesigner: IDesigner;
@ -74,7 +79,7 @@ type
procedure InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner); procedure InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner);
procedure LoadGraphic(AIndex: Integer; AGraphic: TX2GraphicContainerItem; const AFileName: string); procedure LoadGraphic(AGraphic: TX2GraphicContainerItem; const AFileName: string);
procedure ItemChanged(AUpdatePreview: Boolean = True); procedure ItemChanged(AUpdatePreview: Boolean = True);
procedure UpdateUI(); procedure UpdateUI();
@ -90,7 +95,8 @@ type
implementation implementation
uses uses
Graphics, Graphics,
SysUtils; SysUtils,
Windows;
var var
@ -110,9 +116,6 @@ begin
end; end;
procedure TGraphicsEditorForm.InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner); procedure TGraphicsEditorForm.InternalExecute(const AComponent: TComponent; const ADesigner: IDesigner);
var
graphicIndex: Integer;
begin begin
FComponent := TX2GraphicContainer(AComponent); FComponent := TX2GraphicContainer(AComponent);
FComponent.FreeNotification(Self); FComponent.FreeNotification(Self);
@ -120,22 +123,8 @@ begin
FComponentDesigner := ADesigner; FComponentDesigner := ADesigner;
Caption := Format('%s Graphics', [FComponent.Name]); Caption := Format('%s Graphics', [FComponent.Name]);
// Fill graphics list lstGraphics.Count := FComponent.GraphicCount;
with lstGraphics.Items do lstGraphics.ItemIndex := 0;
begin
BeginUpdate();
try
Clear();
for graphicIndex := 0 to FComponent.GraphicCount - 1 do
AddObject(FComponent.Graphics[graphicIndex].PictureName,
FComponent.Graphics[graphicIndex]);
finally
EndUpdate();
end;
lstGraphics.ItemIndex := 0;
end;
UpdateUI(); UpdateUI();
UpdatePreview(); UpdatePreview();
@ -155,13 +144,13 @@ begin
end; end;
procedure TGraphicsEditorForm.LoadGraphic(AIndex: Integer; AGraphic: TX2GraphicContainerItem; const AFileName: string); procedure TGraphicsEditorForm.LoadGraphic(AGraphic: TX2GraphicContainerItem; const AFileName: string);
begin begin
AGraphic.Picture.LoadFromFile(AFileName); AGraphic.Picture.LoadFromFile(AFileName);
if Length(AGraphic.PictureName) = 0 then if Length(AGraphic.PictureName) = 0 then
begin begin
AGraphic.PictureName := ChangeFileExt(ExtractFileName(AFileName), ''); AGraphic.PictureName := ChangeFileExt(ExtractFileName(AFileName), '');
lstGraphics.Items[AIndex] := AGraphic.PictureName; lstGraphics.Invalidate;
end; end;
end; end;
@ -169,12 +158,12 @@ end;
procedure TGraphicsEditorForm.ItemChanged(AUpdatePreview: Boolean); procedure TGraphicsEditorForm.ItemChanged(AUpdatePreview: Boolean);
begin begin
if Assigned(FComponentDesigner) then if Assigned(FComponentDesigner) then
FComponentDesigner.Modified(); FComponentDesigner.Modified;
UpdateUI(); UpdateUI();
if AUpdatePreview then if AUpdatePreview then
UpdatePreview(); UpdatePreview;
end; end;
@ -198,7 +187,7 @@ begin
actClear.Enabled := enabled; actClear.Enabled := enabled;
actUp.Enabled := enabled and (index > 0); actUp.Enabled := enabled and (index > 0);
actDown.Enabled := enabled and (index < Pred(lstGraphics.Items.Count)); actDown.Enabled := enabled and (index < Pred(FComponent.GraphicCount));
end; end;
@ -213,8 +202,8 @@ begin
if Active(index, graphic) then if Active(index, graphic) then
begin begin
imgPreview.Picture.Assign(graphic.Picture); imgPreview.Picture.Assign(graphic.Picture);
txtName.Text := graphic.PictureName; txtName.Text := graphic.PictureName;
lstGraphics.Items[index] := graphic.PictureName; lstGraphics.Invalidate;
end else end else
begin begin
imgPreview.Picture.Assign(nil); imgPreview.Picture.Assign(nil);
@ -234,7 +223,7 @@ begin
if AIndex = -1 then if AIndex = -1 then
exit; exit;
AGraphic := TX2GraphicContainerItem(lstGraphics.Items.Objects[AIndex]); AGraphic := FComponent.Graphics[AIndex];
Result := Assigned(AGraphic); Result := Assigned(AGraphic);
end; end;
@ -257,8 +246,8 @@ begin
if Active(index, graphic) then if Active(index, graphic) then
begin begin
graphic.PictureName := txtName.Text; graphic.PictureName := txtName.Text;
lstGraphics.Items[index] := graphic.PictureName; lstGraphics.Invalidate;
ItemChanged(False); ItemChanged(False);
end; end;
@ -267,7 +256,6 @@ end;
procedure TGraphicsEditorForm.actAddExecute(Sender: TObject); procedure TGraphicsEditorForm.actAddExecute(Sender: TObject);
var var
index: Integer;
graphic: TX2GraphicContainerItem; graphic: TX2GraphicContainerItem;
fileIndex: Integer; fileIndex: Integer;
@ -285,11 +273,10 @@ begin
if Assigned(graphic) then if Assigned(graphic) then
begin begin
graphic.Container := FComponent; graphic.Container := FComponent;
index := lstGraphics.Items.AddObject('', graphic); lstGraphics.Count := FComponent.GraphicCount;
lstGraphics.ItemIndex := index;
LoadGraphic(index, graphic, dlgOpen.Files[fileIndex]); LoadGraphic(graphic, dlgOpen.Files[fileIndex]);
end else end else
raise Exception.Create('Failed to create TX2GraphicContainerItem!'); raise Exception.Create('Failed to create TX2GraphicContainerItem!');
end; end;
@ -313,10 +300,10 @@ begin
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. }
graphic.Free(); graphic.Free();
lstGraphics.Items.Delete(index); lstGraphics.Count := FComponent.GraphicCount;
if index > Pred(lstGraphics.Items.Count) then if index > Pred(FComponent.GraphicCount) then
index := Pred(lstGraphics.Items.Count); index := Pred(FComponent.GraphicCount);
lstGraphics.ItemIndex := index; lstGraphics.ItemIndex := index;
@ -334,9 +321,9 @@ begin
if Active(index, graphic) then if Active(index, graphic) then
if index > 0 then if index > 0 then
begin begin
lstGraphics.Items.Move(index, Pred(index));
graphic.Index := Pred(index); graphic.Index := Pred(index);
lstGraphics.ItemIndex := Pred(index); lstGraphics.ItemIndex := Pred(index);
lstGraphics.Invalidate;
ItemChanged(False); ItemChanged(False);
end; end;
@ -350,11 +337,11 @@ var
begin begin
if Active(index, graphic) then if Active(index, graphic) then
if index < Pred(lstGraphics.Items.Count) then if index < Pred(FComponent.GraphicCount) then
begin begin
lstGraphics.Items.Move(index, index + 1);
graphic.Index := Succ(index); graphic.Index := Succ(index);
lstGraphics.ItemIndex := Succ(index); lstGraphics.ItemIndex := Succ(index);
lstGraphics.Invalidate;
ItemChanged(False); ItemChanged(False);
end; end;
@ -374,7 +361,7 @@ begin
if dlgOpen.Execute() then if dlgOpen.Execute() then
begin begin
LoadGraphic(index, graphic, dlgOpen.FileName); LoadGraphic(graphic, dlgOpen.FileName);
ItemChanged(); ItemChanged();
end; end;
end; end;
@ -423,4 +410,34 @@ begin
end; end;
end; end;
procedure TGraphicsEditorForm.lstGraphicsData(Control: TWinControl; Index: Integer; var Data: String);
begin
Data := Format('%d - %s', [Index, FComponent.Graphics[Index].PictureName]);
end;
function TGraphicsEditorForm.lstGraphicsDataFind(Control: TWinControl; FindString: String): Integer;
var
graphicIndex: Integer;
begin
Result := -1;
for graphicIndex := 0 to Pred(FComponent.GraphicCount) do
if SameText(Copy(FComponent.Graphics[graphicIndex].PictureName, 1, Length(FindString)), FindString) then
begin
Result := graphicIndex;
Break;
end;
end;
procedure TGraphicsEditorForm.lstGraphicsKeyPress(Sender: TObject; var Key: Char);
begin
{ Because the listbox is virtual, Return causes the ItemIndex to reset to 0 }
if Ord(Key) = VK_RETURN then
Key := #0;
end;
end. end.

View File

@ -83,6 +83,24 @@ type
procedure DrawBlended(ABackground, AForeground: Graphics.TBitmap; AAlpha: Byte); procedure DrawBlended(ABackground, AForeground: Graphics.TBitmap; AAlpha: Byte);
{
:$ Draws a rectangle with a vertical gradient.
}
procedure GradientFillRect(ACanvas: TCanvas; ARect: TRect; AStartColor, AEndColor: TColor);
{
:$ Darkens a color with the specified value
}
function DarkenColor(const AColor: TColor; const AValue: Byte): TColor;
{
:$ Lightens a color with the specified value
}
function LightenColor(const AColor: TColor; const AValue: Byte): TColor;
implementation implementation
@ -231,4 +249,118 @@ begin
end; end;
end; end;
procedure GradientFillRect(ACanvas: TCanvas; ARect: TRect; AStartColor, AEndColor: TColor);
function FixValue(AValue: Single): Single;
begin
Result := AValue;
if Result < 0 then
Result := 0;
if Result > 255 then
Result := 255;
end;
var
startColor: Cardinal;
endColor: Cardinal;
stepCount: Integer;
redValue: Single;
greenValue: Single;
blueValue: Single;
redStep: Single;
greenStep: Single;
blueStep: Single;
line: Integer;
begin
startColor := ColorToRGB(AStartColor);
endColor := ColorToRGB(AEndColor);
if startColor = endColor then
begin
ACanvas.Brush.Style := bsSolid;
ACanvas.Brush.Color := startColor;
ACanvas.FillRect(ARect);
end else
begin
redValue := GetRValue(startColor);
greenValue := GetGValue(startColor);
blueValue := GetBValue(startColor);
stepCount := ARect.Bottom - ARect.Top;
redStep := (GetRValue(endColor) - redValue) / stepCount;
greenStep := (GetGValue(endColor) - greenValue) / stepCount;
blueStep := (GetBValue(endColor) - blueValue) / stepCount;
ACanvas.Pen.Style := psSolid;
for line := ARect.Top to ARect.Bottom do
begin
ACanvas.Pen.Color := RGB(Trunc(redValue), Trunc(greenValue), Trunc(blueValue));
ACanvas.MoveTo(ARect.Left, line);
ACanvas.LineTo(ARect.Right, line);
redValue := FixValue(redValue + redStep);
greenValue := FixValue(greenValue + greenStep);
blueValue := FixValue(blueValue + blueStep);
end;
end;
end;
function DarkenColor(const AColor: TColor; const AValue: Byte): TColor;
var
cColor: Cardinal;
iRed: Integer;
iGreen: Integer;
iBlue: Integer;
begin
cColor := ColorToRGB(AColor);
iRed := (cColor and $FF0000) shr 16;;
iGreen := (cColor and $00FF00) shr 8;
iBlue := cColor and $0000FF;
Dec(iRed, AValue);
Dec(iGreen, AValue);
Dec(iBlue, AValue);
if iRed < 0 then iRed := 0;
if iGreen < 0 then iGreen := 0;
if iBlue < 0 then iBlue := 0;
Result := (iRed shl 16) + (iGreen shl 8) + iBlue;
end;
function LightenColor(const AColor: TColor; const AValue: Byte): TColor;
var
cColor: Cardinal;
iRed: Integer;
iGreen: Integer;
iBlue: Integer;
begin
cColor := ColorToRGB(AColor);
iRed := (cColor and $FF0000) shr 16;;
iGreen := (cColor and $00FF00) shr 8;
iBlue := cColor and $0000FF;
Inc(iRed, AValue);
Inc(iGreen, AValue);
Inc(iBlue, AValue);
if iRed > 255 then iRed := 255;
if iGreen > 255 then iGreen := 255;
if iBlue > 255 then iBlue := 255;
Result := (iRed shl 16) + (iGreen shl 8) + iBlue;
end;
end. end.

View File

@ -14,6 +14,7 @@ interface
uses uses
Classes, Classes,
Graphics, Graphics,
ImgList,
Windows, Windows,
X2CLMenuBar; X2CLMenuBar;
@ -28,6 +29,7 @@ type
property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnChange: TNotifyEvent read FOnChange write FOnChange;
end; end;
TX2MenuBarunaColor = class(TX2MenuBarunaProperty) TX2MenuBarunaColor = class(TX2MenuBarunaProperty)
private private
FDefaultDisabled: TColor; FDefaultDisabled: TColor;
@ -63,6 +65,7 @@ type
property Selected: TColor read FSelected write SetSelected stored IsSelectedStored; property Selected: TColor read FSelected write SetSelected stored IsSelectedStored;
end; end;
TX2MenuBarunaGroupColors = class(TX2MenuBarunaProperty) TX2MenuBarunaGroupColors = class(TX2MenuBarunaProperty)
private private
FFill: TX2MenuBarunaColor; FFill: TX2MenuBarunaColor;
@ -85,6 +88,7 @@ type
property Text: TX2MenuBarunaColor read FText write SetText; property Text: TX2MenuBarunaColor read FText write SetText;
end; end;
TX2MenuBarunaMetrics = class(TX2MenuBarunaProperty) TX2MenuBarunaMetrics = class(TX2MenuBarunaProperty)
private private
FAfterGroupHeader: Integer; FAfterGroupHeader: Integer;
@ -128,6 +132,7 @@ type
property ImageOffsetY: Integer read FImageOffsetY write SetImageOffsetY default 0; property ImageOffsetY: Integer read FImageOffsetY write SetImageOffsetY default 0;
end; end;
TX2MenuBarunaPainter = class(TX2CustomMenuBarPainter) TX2MenuBarunaPainter = class(TX2CustomMenuBarPainter)
private private
FArrowColor: TColor; FArrowColor: TColor;
@ -138,6 +143,9 @@ type
FMetrics: TX2MenuBarunaMetrics; FMetrics: TX2MenuBarunaMetrics;
FShadowColor: TColor; FShadowColor: TColor;
FShadowOffset: Integer; FShadowOffset: Integer;
FGroupGradient: Integer;
FArrowImages: TCustomImageList;
FArrowImageIndex: TImageIndex;
procedure SetBlurShadow(const Value: Boolean); procedure SetBlurShadow(const Value: Boolean);
procedure SetGroupColors(const Value: TX2MenuBarunaGroupColors); procedure SetGroupColors(const Value: TX2MenuBarunaGroupColors);
@ -145,7 +153,14 @@ type
procedure SetMetrics(const Value: TX2MenuBarunaMetrics); procedure SetMetrics(const Value: TX2MenuBarunaMetrics);
procedure SetShadowColor(const Value: TColor); procedure SetShadowColor(const Value: TColor);
procedure SetShadowOffset(const Value: Integer); procedure SetShadowOffset(const Value: Integer);
procedure SetGroupGradient(const Value: Integer);
procedure SetArrowImageIndex(const Value: TImageIndex);
procedure SetArrowImages(const Value: TCustomImageList);
protected protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
function HasArrowImage(): Boolean;
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;
function GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer; override; function GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer; override;
@ -154,6 +169,7 @@ 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 DrawArrow(ACanvas: TCanvas; ABounds: TRect);
procedure ColorChange(Sender: TObject); procedure ColorChange(Sender: TObject);
public public
@ -162,24 +178,30 @@ type
procedure ResetColors(); procedure ResetColors();
published published
property ArrowColor: TColor read FArrowColor write FArrowColor default clBlue; property ArrowImageIndex: TImageIndex read FArrowImageIndex write SetArrowImageIndex default -1;
property BlurShadow: Boolean read FBlurShadow write SetBlurShadow default True; property ArrowImages: TCustomImageList read FArrowImages write SetArrowImages;
property Color: TColor read FColor write FColor default clWindow; property ArrowColor: TColor read FArrowColor write FArrowColor default clBlue;
property GroupColors: TX2MenuBarunaGroupColors read FGroupColors write SetGroupColors; property BlurShadow: Boolean read FBlurShadow write SetBlurShadow default True;
property ItemColors: TX2MenuBarunaColor read FItemColors write SetItemColors; property Color: TColor read FColor write FColor default clWindow;
property Metrics: TX2MenuBarunaMetrics read FMetrics write SetMetrics; property GroupColors: TX2MenuBarunaGroupColors read FGroupColors write SetGroupColors;
property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow; property ItemColors: TX2MenuBarunaColor read FItemColors write SetItemColors;
property ShadowOffset: Integer read FShadowOffset write SetShadowOffset default 2; property Metrics: TX2MenuBarunaMetrics read FMetrics write SetMetrics;
property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow;
property ShadowOffset: Integer read FShadowOffset write SetShadowOffset default 2;
property GroupGradient: Integer read FGroupGradient write SetGroupGradient default 0;
end; end;
implementation implementation
uses uses
ImgList,
SysUtils, SysUtils,
X2CLGraphics; X2CLGraphics;
const
ArrowMargin = 2;
ArrowWidth = 8;
procedure Blur(ASource: Graphics.TBitmap); procedure Blur(ASource: Graphics.TBitmap);
var var
@ -418,11 +440,12 @@ constructor TX2MenuBarunaPainter.Create(AOwner: TComponent);
begin begin
inherited; inherited;
FBlurShadow := True; FArrowImageIndex := -1;
FGroupColors := TX2MenuBarunaGroupColors.Create(); FBlurShadow := True;
FItemColors := TX2MenuBarunaColor.Create(); FGroupColors := TX2MenuBarunaGroupColors.Create();
FMetrics := TX2MenuBarunaMetrics.Create(); FItemColors := TX2MenuBarunaColor.Create();
FShadowOffset := 2; FMetrics := TX2MenuBarunaMetrics.Create();
FShadowOffset := 2;
FGroupColors.OnChange := ColorChange; FGroupColors.OnChange := ColorChange;
FItemColors.OnChange := ColorChange; FItemColors.OnChange := ColorChange;
@ -433,6 +456,7 @@ end;
destructor TX2MenuBarunaPainter.Destroy(); destructor TX2MenuBarunaPainter.Destroy();
begin begin
SetArrowImages(nil);
FreeAndNil(FMetrics); FreeAndNil(FMetrics);
FreeAndNil(FItemColors); FreeAndNil(FItemColors);
FreeAndNil(FGroupColors); FreeAndNil(FGroupColors);
@ -552,6 +576,9 @@ var
shadowBitmap: Graphics.TBitmap; shadowBitmap: Graphics.TBitmap;
shadowBounds: TRect; shadowBounds: TRect;
textRect: TRect; textRect: TRect;
clipRegion: HRGN;
startColor: TColor;
endColor: TColor;
begin begin
if not ((mdsSelected in AState) or (mdsGroupSelected in AState)) then if not ((mdsSelected in AState) or (mdsGroupSelected in AState)) then
@ -584,12 +611,32 @@ begin
end; end;
{ Rounded rectangle } { Rounded rectangle }
ACanvas.Brush.Color := GetColor(GroupColors.Fill); startColor := GetColor(GroupColors.Fill);
endColor := startColor;
if GroupGradient > 0 then
endColor := LightenColor(startColor, GroupGradient)
else if GroupGradient < 0 then
endColor := DarkenColor(startColor, -GroupGradient);
clipRegion := CreateRoundRectRgn(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5);
SelectClipRgn(ACanvas.Handle, clipRegion);
GradientFillRect(ACanvas, ABounds, startColor, endColor);
SelectClipRgn(ACanvas.Handle, 0);
DeleteObject(clipRegion);
ACanvas.Brush.Style := bsClear;
ACanvas.Pen.Color := GetColor(GroupColors.Border); ACanvas.Pen.Color := GetColor(GroupColors.Border);
ACanvas.Pen.Style := psSolid;
ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5);
ACanvas.Brush.Style := bsSolid;
ACanvas.Font.Color := GetColor(GroupColors.Text); ACanvas.Font.Color := GetColor(GroupColors.Text);
ACanvas.RoundRect(ABounds.Left, ABounds.Top, ABounds.Right, ABounds.Bottom, 5, 5);
textRect := ABounds; textRect := ABounds;
Inc(textRect.Left, 4); Inc(textRect.Left, 4);
Dec(textRect.Right, 4); Dec(textRect.Right, 4);
@ -635,31 +682,24 @@ procedure TX2MenuBarunaPainter.DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem;
Result := AColor.Disabled; Result := AColor.Disabled;
end; end;
var var
focusBounds: TRect; focusBounds: TRect;
textBounds: TRect; textBounds: TRect;
arrowPoints: array[0..2] of TPoint;
begin begin
focusBounds := ABounds; focusBounds := ABounds;
Dec(focusBounds.Right, Metrics.Margin);
if HasArrowImage() then
Dec(focusBounds.Right, ArrowImages.Width + ArrowMargin)
else
Dec(focusBounds.Right, ArrowWidth + ArrowMargin);
if (mdsSelected in AState) then if (mdsSelected in AState) then
begin begin
{ Focus rectangle } { Focus rectangle and arrow }
DrawFocusRect(ACanvas, focusBounds); DrawFocusRect(ACanvas, focusBounds);
DrawArrow(ACanvas, ABounds);
{ Arrow }
ACanvas.Brush.Color := ArrowColor;
ACanvas.Pen.Color := ArrowColor;
arrowPoints[0].X := ABounds.Right - 8;
arrowPoints[0].Y := ABounds.Top + ((ABounds.Bottom - ABounds.Top - 15) div 2) + 7;
arrowPoints[1].X := Pred(ABounds.Right);
arrowPoints[1].Y := arrowPoints[0].Y - 7;
arrowPoints[2].X := Pred(ABounds.Right);
arrowPoints[2].Y := arrowPoints[0].Y + 7;
ACanvas.Polygon(arrowPoints);
end; end;
{ Text } { Text }
@ -680,12 +720,55 @@ begin
end; end;
procedure TX2MenuBarunaPainter.DrawArrow(ACanvas: TCanvas; ABounds: TRect);
var
arrowX: Integer;
arrowY: Integer;
arrowPoints: array[0..2] of TPoint;
begin
if HasArrowImage() then
begin
arrowX := ABounds.Right - ArrowImages.Width;
arrowY := ABounds.Top + ((ABounds.Bottom - ABounds.Top - ArrowImages.Height) div 2);
ArrowImages.Draw(ACanvas, arrowX, arrowY, ArrowImageIndex);
end else
begin
ACanvas.Brush.Color := ArrowColor;
ACanvas.Pen.Color := ArrowColor;
arrowPoints[0].X := ABounds.Right - 8;
arrowPoints[0].Y := ABounds.Top + ((ABounds.Bottom - ABounds.Top - 15) div 2) + 7;
arrowPoints[1].X := Pred(ABounds.Right);
arrowPoints[1].Y := arrowPoints[0].Y - 7;
arrowPoints[2].X := Pred(ABounds.Right);
arrowPoints[2].Y := arrowPoints[0].Y + 7;
ACanvas.Polygon(arrowPoints);
end;
end;
procedure TX2MenuBarunaPainter.ColorChange(Sender: TObject); procedure TX2MenuBarunaPainter.ColorChange(Sender: TObject);
begin begin
NotifyObservers(); NotifyObservers();
end; end;
function TX2MenuBarunaPainter.HasArrowImage(): Boolean;
begin
Result := Assigned(ArrowImages) and (ArrowImageIndex > -1);
end;
procedure TX2MenuBarunaPainter.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FArrowImages) then
SetArrowImages(nil);
inherited;
end;
procedure TX2MenuBarunaPainter.SetGroupColors(const Value: TX2MenuBarunaGroupColors); procedure TX2MenuBarunaPainter.SetGroupColors(const Value: TX2MenuBarunaGroupColors);
begin begin
if Value <> FGroupColors then if Value <> FGroupColors then
@ -732,6 +815,43 @@ begin
end; end;
procedure TX2MenuBarunaPainter.SetGroupGradient(const Value: Integer);
begin
if Value <> FGroupGradient then
begin
FGroupGradient := Value;
NotifyObservers();
end;
end;
procedure TX2MenuBarunaPainter.SetArrowImageIndex(const Value: TImageIndex);
begin
if Value <> FArrowImageIndex then
begin
FArrowImageIndex := Value;
NotifyObservers();
end;
end;
procedure TX2MenuBarunaPainter.SetArrowImages(const Value: TCustomImageList);
begin
if Value <> FArrowImages then
begin
if Assigned(FArrowImages) then
FArrowImages.RemoveFreeNotification(Self);
FArrowImages := Value;
if Assigned(FArrowImages) then
FArrowImages.FreeNotification(Self);
NotifyObservers();
end;
end;
{ TX2MenuBarunaProperty } { TX2MenuBarunaProperty }
procedure TX2MenuBarunaProperty.Changed(); procedure TX2MenuBarunaProperty.Changed();
begin begin