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