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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Packages/D7/X2CLGLD.dof
View File

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

6
Packages/D7/X2CLMB.cfg
View File

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

27
Packages/D7/X2CLMB.dof
View File

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

6
Packages/D7/X2CLMBD.cfg
View File

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

29
Packages/D7/X2CLMBD.dof
View File

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

4
Packages/X2CLGraphicsEditor.dfm
View File

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

105
Packages/X2CLGraphicsEditor.pas
View File

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

132
Source/X2CLGraphics.pas
View File

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

184
Source/X2CLunaMenuBarPainter.pas
View File

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