diff --git a/Packages/D7/X2CLMB.cfg b/Packages/D7/X2CLMB.cfg index 524454c..3a770fe 100644 --- a/Packages/D7/X2CLMB.cfg +++ b/Packages/D7/X2CLMB.cfg @@ -31,9 +31,9 @@ -M -$M16384,1048576 -K$00400000 --N"P:\algemeen\lib" --LE"P:\algemeen\bin" --LN"P:\algemeen\lib" +-N"P:\algemeen\lib\D7" +-LE"P:\algemeen\bin\D7" +-LN"P:\algemeen\lib\D7" -Z -w-UNSAFE_TYPE -w-UNSAFE_CODE diff --git a/Packages/D7/X2CLMB.dof b/Packages/D7/X2CLMB.dof index 9290434..03a3653 100644 --- a/Packages/D7/X2CLMB.dof +++ b/Packages/D7/X2CLMB.dof @@ -105,10 +105,6 @@ HostApplication= Launcher= UseLauncher=0 DebugCWD= -[Language] -ActiveLang= -ProjectLang= -RootDir=C:\Program Files\Borland\Delphi7\Bin\ [Version Info] IncludeVerInfo=1 AutoIncBuild=0 @@ -154,6 +150,7 @@ Item0=$(DELPHIBIN) Item1=..\..\Lib\D7 Item2=Lib\D7 [HistoryLists\hlDCPOutput] -Count=2 -Item0=$(DELPHILIB) -Item1=..\..\Lib\D7 +Count=3 +Item0=$(DELPHIBIN) +Item1=$(DELPHILIB) +Item2=..\..\Lib\D7 diff --git a/Packages/D7/X2CLMBD.dof b/Packages/D7/X2CLMBD.dof index a47e0be..a3a8a0b 100644 --- a/Packages/D7/X2CLMBD.dof +++ b/Packages/D7/X2CLMBD.dof @@ -130,8 +130,6 @@ 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; diff --git a/Source/X2CLMenuBar.pas b/Source/X2CLMenuBar.pas index 66bde7c..e35ba16 100644 --- a/Source/X2CLMenuBar.pas +++ b/Source/X2CLMenuBar.pas @@ -24,10 +24,11 @@ uses SysUtils, Types, Windows; - + type EInvalidItem = class(Exception); + EMenuBarInternalError = class(Exception); TX2MenuBarAnimationStyle = (asNone, asSlide, asDissolve, asFade, asSlideFade, asCustom); @@ -102,6 +103,28 @@ type end; + { + :$ Abstract animation buffer provider + + :: Provides on-demand retrieval of the buffer required for animation. + } + TX2CustomMenuBarAnimatorBuffer = class(TObject) + private + FBitmap: Graphics.TBitmap; + protected + procedure PrepareBitmap(ABitmap: Graphics.TBitmap); virtual; abstract; + + function GetBitmap: Graphics.TBitmap; virtual; + function GetHeight: Integer; virtual; + function GetWidth: Integer; virtual; + public + destructor Destroy; override; + + property Bitmap: Graphics.TBitmap read GetBitmap; + property Height: Integer read GetHeight; + property Width: Integer read GetWidth; + end; + { :$ Abstract animation class @@ -112,24 +135,24 @@ type FAnimationTime: Cardinal; FExpanding: Boolean; FStartTime: Cardinal; - FItemsBuffer: Graphics.TBitmap; + FItemsBuffer: TX2CustomMenuBarAnimatorBuffer; FTerminated: Boolean; protected - function GetTimeElapsed(): Cardinal; virtual; - function GetHeight(): Integer; virtual; + function GetTimeElapsed: Cardinal; virtual; + function GetHeight: Integer; virtual; procedure SetExpanding(const Value: Boolean); virtual; - procedure Terminate(); virtual; + procedure Terminate; virtual; - property ItemsBuffer: Graphics.TBitmap read FItemsBuffer; - property TimeElapsed: Cardinal read GetTimeElapsed; + property ItemsBuffer: TX2CustomMenuBarAnimatorBuffer read FItemsBuffer; + property TimeElapsed: Cardinal read GetTimeElapsed; public - constructor Create(AItemsBuffer: Graphics.TBitmap); virtual; - destructor Destroy(); override; + constructor Create(AItemsBuffer: TX2CustomMenuBarAnimatorBuffer); virtual; + destructor Destroy; override; - procedure ResetStartTime(); + procedure ResetStartTime; - procedure Update(); virtual; + procedure Update; virtual; procedure Draw(ACanvas: TCanvas; const ABounds: TRect); virtual; abstract; property AnimationTime: Cardinal read FAnimationTime write FAnimationTime; @@ -148,30 +171,33 @@ type TX2CustomMenuBarPainter = class(TComponent) private FMenuBar: TX2CustomMenuBar; + FPaintCount: Integer; FObservers: TInterfaceList; - function GetMenuBar(): TX2CustomMenuBar; + function GetMenuBar: TX2CustomMenuBar; protected procedure BeginPaint(const AMenuBar: TX2CustomMenuBar); - procedure EndPaint(); + procedure EndPaint; function ApplyMargins(const ABounds: TRect): TRect; virtual; + function UndoMargins(const ABounds: TRect): TRect; virtual; + function GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; virtual; function GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer; virtual; abstract; function GetGroupHeight(AGroup: TX2MenuBarGroup): Integer; virtual; function GetItemHeight(AItem: TX2MenuBarItem): Integer; virtual; abstract; - procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect); virtual; abstract; + procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect; const AOffset: TPoint); virtual; abstract; procedure DrawGroupHeader(ACanvas: TCanvas; AGroup: TX2MenuBarGroup; const ABounds: TRect; AState: TX2MenuBarDrawStates); virtual; abstract; procedure DrawItem(ACanvas: TCanvas; AItem: TX2MenuBarItem; const ABounds: TRect; AState: TX2MenuBarDrawStates); virtual; abstract; procedure FindHit(Sender: TObject; Item: TX2CustomMenuBarItem; const MenuBounds: TRect; const ItemBounds: TRect; Data: Pointer; var Abort: Boolean); - procedure NotifyObservers(); + procedure NotifyObservers; property MenuBar: TX2CustomMenuBar read GetMenuBar; public constructor Create(AOwner: TComponent); override; - destructor Destroy(); override; + destructor Destroy; override; function HitTest(const APoint: TPoint): TX2MenuBarHitTest; overload; virtual; function HitTest(AX, AY: Integer): TX2MenuBarHitTest; overload; @@ -193,32 +219,49 @@ type FStarted: Boolean; FTerminated: Boolean; protected - function GetTerminated(): Boolean; virtual; - procedure Terminate(); virtual; + function GetTerminated: Boolean; virtual; + procedure Terminate; virtual; property MenuBar: TX2CustomMenuBar read FMenuBar; public constructor Create(AMenuBar: TX2CustomMenuBar); - function AllowUpdateScrollbar(): Boolean; virtual; - function AllowInteraction(): Boolean; virtual; + function AllowUpdateScrollbar: Boolean; virtual; + function AllowInteraction: Boolean; virtual; - procedure Start(); virtual; - procedure Stop(); virtual; + procedure Start; virtual; + procedure Stop; virtual; - procedure BeforePaint(); virtual; + procedure BeforePaint; virtual; procedure GetItemHeight(AItem: TX2CustomMenuBarItem; var AHeight: Integer; var AHandled: Boolean); virtual; procedure DrawMenuItem(ACanvas: TCanvas; APainter: TX2CustomMenuBarPainter; AItem: TX2CustomMenuBarItem; const AMenuBounds, AItemBounds: TRect; AState: TX2MenuBarDrawStates; var AHandled: Boolean); virtual; - procedure AfterPaint(); virtual; + procedure AfterPaint; virtual; property Started: Boolean read FStarted; property Terminated: Boolean read GetTerminated; end; + { + :$ Animation buffer menu bar link. + } + TX2MenuBarAnimatorBuffer = class(TX2CustomMenuBarAnimatorBuffer) + private + FGroup: TX2MenuBarGroup; + FMenuBar: TX2CustomMenuBar; + protected + procedure PrepareBitmap(ABitmap: Graphics.TBitmap); override; + public + constructor Create(AMenuBar: TX2CustomMenuBar; AGroup: TX2MenuBarGroup); + + property Group: TX2MenuBarGroup read FGroup write FGroup; + property MenuBar: TX2CustomMenuBar read FMenuBar write FMenuBar; + end; + + { :$ Action link for menu items and groups. } @@ -228,10 +271,10 @@ type protected procedure AssignClient(AClient: TObject); override; - function IsCaptionLinked(): Boolean; override; - function IsEnabledLinked(): Boolean; override; - function IsImageIndexLinked(): Boolean; override; - function IsVisibleLinked(): Boolean; override; + function IsCaptionLinked: Boolean; override; + function IsEnabledLinked: Boolean; override; + function IsImageIndexLinked: Boolean; override; + function IsVisibleLinked: Boolean; override; procedure SetCaption(const Value: string); override; procedure SetEnabled(Value: Boolean); override; procedure SetImageIndex(Value: Integer); override; @@ -276,8 +319,8 @@ type protected procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); virtual; - function IsCaptionStored(): Boolean; virtual; - function GetMenuBar(): TX2CustomMenuBar; virtual; + function IsCaptionStored: Boolean; virtual; + function GetMenuBar: TX2CustomMenuBar; virtual; procedure SetAction(const Value: TBasicAction); procedure SetCaption(const Value: String); virtual; procedure SetData(const Value: TObject); virtual; @@ -286,7 +329,7 @@ type procedure SetVisible(const Value: Boolean); virtual; public constructor Create(Collection: TCollection); override; - destructor Destroy(); override; + destructor Destroy; override; procedure Assign(Source: TPersistent); override; @@ -325,9 +368,9 @@ type } TX2MenuBarItem = class(TX2CustomMenuBarItem) private - function GetGroup(): TX2MenuBarGroup; + function GetGroup: TX2MenuBarGroup; protected - function IsCaptionStored(): Boolean; override; + function IsCaptionStored: Boolean; override; public constructor Create(Collection: TCollection); override; @@ -360,11 +403,11 @@ type FItems: TX2MenuBarItems; FSelectedItem: Integer; - function GetSelectedItem(): Integer; + function GetSelectedItem: Integer; procedure SetExpanded(const Value: Boolean); procedure SetItems(const Value: TX2MenuBarItems); protected - function IsCaptionStored(): Boolean; override; + function IsCaptionStored: Boolean; override; procedure SetEnabled(const Value: Boolean); override; procedure InternalSetExpanded(const Value: Boolean); @@ -372,7 +415,7 @@ type procedure ItemsUpdate(Sender: TObject; Item: TCollectionItem); public constructor Create(Collection: TCollection); override; - destructor Destroy(); override; + destructor Destroy; override; procedure Assign(Source: TPersistent); override; @@ -450,12 +493,12 @@ type procedure SetSelectedItem(const Value: TX2CustomMenuBarItem); protected procedure CreateParams(var Params: TCreateParams); override; - procedure Loaded(); override; + procedure Loaded; override; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure PainterUpdate(Sender: TX2CustomMenuBarPainter); procedure GroupsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification); procedure GroupsUpdate(Sender: TObject; Item: TCollectionItem); - procedure UpdateScrollbar(); + procedure UpdateScrollbar; procedure ImagesChange(Sender: TObject); procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; @@ -466,16 +509,18 @@ type // procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL; // procedure CMMouseWheel(var Message: TCMMouseWheel); message CM_MOUSEWHEEL; - procedure TestMousePos(); virtual; - function GetMenuHeight(): Integer; virtual; + procedure TestMousePos; virtual; + function GetMenuHeight: Integer; virtual; protected procedure SetPainter(const Value: TX2CustomMenuBarPainter); virtual; { Painting } procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND; - procedure Paint(); override; + procedure Paint; override; + procedure FindGroupBounds(Sender: TObject; Item: TX2CustomMenuBarItem; const MenuBounds: TRect; const ItemBounds: TRect; Data: Pointer; var Abort: Boolean); + function GetGroupBounds(AGroup: TX2MenuBarGroup): TRect; function GetDrawState(AItem: TX2CustomMenuBarItem): TX2MenuBarDrawStates; procedure DrawMenu(ACanvas: TCanvas); virtual; @@ -483,19 +528,20 @@ type procedure DrawMenuItems(ACanvas: TCanvas; AGroup: TX2MenuBarGroup; const ABounds: TRect); virtual; procedure DrawNoPainter(ACanvas: TCanvas; const ABounds: TRect); virtual; - function GetAnimatorClass(): TX2CustomMenuBarAnimatorClass; virtual; + function GetAnimatorClass: TX2CustomMenuBarAnimatorClass; virtual; function GetAnimateAction(AGroup: TX2MenuBarGroup; AExpanding: Boolean): TX2CustomMenuBarAction; virtual; + procedure GetAnimateGroup(AGroup: TX2MenuBarGroup; ABitmap: Graphics.TBitmap); virtual; function IterateItemBounds(ACallback: TX2MenuBarItemBoundsProc; AData: Pointer = nil): TX2CustomMenuBarItem; - function AllowInteraction(): Boolean; virtual; + function AllowInteraction: Boolean; virtual; function ItemEnabled(AItem: TX2CustomMenuBarItem): Boolean; virtual; function ItemVisible(AItem: TX2CustomMenuBarItem): Boolean; virtual; { Action queue } - function GetCurrentAction(): TX2CustomMenuBarAction; + function GetCurrentAction: TX2CustomMenuBarAction; procedure PushAction(AAction: TX2CustomMenuBarAction); - procedure PopCurrentAction(); + procedure PopCurrentAction; property ActionQueue: TObjectList read FActionQueue; @@ -541,12 +587,12 @@ type procedure DoExpandedChanging(AGroup: TX2MenuBarGroup; AExpanding: Boolean); virtual; procedure DoExpandedChanged(AGroup: TX2MenuBarGroup); virtual; procedure DoSelectedChanging(ANewItem: TX2CustomMenuBarItem; var AAllowed: Boolean); virtual; - procedure DoSelectedChanged(); virtual; + procedure DoSelectedChanged; virtual; procedure FindEnabledItem(Sender: TObject; Item: TX2CustomMenuBarItem; Data: Pointer; var Abort: Boolean); public constructor Create(AOwner: TComponent); override; - destructor Destroy(); override; + destructor Destroy; override; function HitTest(const APoint: TPoint): TX2MenuBarHitTest; overload; function HitTest(AX, AY: Integer): TX2MenuBarHitTest; overload; @@ -556,17 +602,17 @@ type AData: Pointer = nil; AStart: TX2CustomMenuBarItem = nil): TX2CustomMenuBarItem; - function SelectFirst(): TX2CustomMenuBarItem; - function SelectLast(): TX2CustomMenuBarItem; - function SelectNext(): TX2CustomMenuBarItem; - function SelectPrior(): TX2CustomMenuBarItem; + function SelectFirst: TX2CustomMenuBarItem; + function SelectLast: TX2CustomMenuBarItem; + function SelectNext: TX2CustomMenuBarItem; + function SelectPrior: TX2CustomMenuBarItem; function SelectGroup(AIndex: Integer): TX2MenuBarGroup; function SelectItem(AIndex: Integer; AGroup: TX2MenuBarGroup): TX2CustomMenuBarItem; overload; function SelectItem(AIndex: Integer; AGroup: Integer): TX2CustomMenuBarItem; overload; function SelectItem(AIndex: Integer): TX2CustomMenuBarItem; overload; - procedure ResetGroupsSelectedItem(); + procedure ResetGroupsSelectedItem; property Groups: TX2MenuBarGroups read FGroups write SetGroups; property Images: TCustomImageList read FImages write SetImages; @@ -648,11 +694,18 @@ const SDefaultGroupCaption = 'Group'; SNoPainter = 'Painter property not set'; SInvalidItem = 'Item does not belong to this MenuBar'; - + SBeginPaintConflict = 'BeginPaint already called for a different MenuBar'; + SEndPaintWithoutBegin = 'EndPaint called without BeginPaint'; type TProtectedCollection = class(TCollection); + PFindGroupBoundsInfo = ^TFindGroupBoundsInfo; + TFindGroupBoundsInfo = record + Group: TX2MenuBarGroup; + Bounds: TRect; + end; + { TX2CustomMenuBarPainter } @@ -665,7 +718,7 @@ begin end; -destructor TX2CustomMenuBarPainter.Destroy(); +destructor TX2CustomMenuBarPainter.Destroy; begin FreeAndNil(FObservers); inherited; @@ -675,7 +728,7 @@ end; procedure TX2CustomMenuBarPainter.AttachObserver(AObserver: IX2MenuBarPainterObserver); begin if not Assigned(FObservers) then - FObservers := TInterfaceList.Create(); + FObservers := TInterfaceList.Create; if FObservers.IndexOf(AObserver) = -1 then FObservers.Add(AObserver); @@ -690,19 +743,26 @@ end; procedure TX2CustomMenuBarPainter.BeginPaint(const AMenuBar: TX2CustomMenuBar); begin - Assert(not Assigned(FMenuBar), 'BeginPaint already called'); + if (FPaintCount > 0) and (AMenuBar <> FMenuBar) then + raise EMenuBarInternalError.Create(SBeginPaintConflict); + FMenuBar := AMenuBar; + Inc(FPaintCount); end; -procedure TX2CustomMenuBarPainter.EndPaint(); +procedure TX2CustomMenuBarPainter.EndPaint; begin - Assert(Assigned(FMenuBar), 'EndPaint without BeginPaint'); - FMenuBar := nil; + if FPaintCount = 0 then + raise EMenuBarInternalError.Create(SEndPaintWithoutBegin); + + Dec(FPaintCount); + if FPaintCount = 0 then + FMenuBar := nil; end; -procedure TX2CustomMenuBarPainter.NotifyObservers(); +procedure TX2CustomMenuBarPainter.NotifyObservers; var observerIndex: Integer; @@ -719,6 +779,12 @@ begin end; +function TX2CustomMenuBarPainter.UndoMargins(const ABounds: TRect): TRect; +begin + Result := ABounds; +end; + + function TX2CustomMenuBarPainter.GetGroupHeight(AGroup: TX2MenuBarGroup): Integer; var itemIndex: Integer; @@ -768,7 +834,7 @@ begin end; -function TX2CustomMenuBarPainter.GetMenuBar(): TX2CustomMenuBar; +function TX2CustomMenuBarPainter.GetMenuBar: TX2CustomMenuBar; begin Assert(Assigned(FMenuBar), 'BeginPaint not called'); Result := FMenuBar; @@ -781,17 +847,49 @@ begin end; -{ TX2CustomMenuBarAnimator } -constructor TX2CustomMenuBarAnimator.Create(AItemsBuffer: Graphics.TBitmap); +{ TX2CustomMenuBarAnimatorBuffer } +destructor TX2CustomMenuBarAnimatorBuffer.Destroy; begin - inherited Create(); + FreeAndNil(FBitmap); - ResetStartTime(); - FItemsBuffer := Graphics.TBitmap.Create(); - FItemsBuffer.Assign(AItemsBuffer); + inherited; end; -destructor TX2CustomMenuBarAnimator.Destroy(); + +function TX2CustomMenuBarAnimatorBuffer.GetBitmap: Graphics.TBitmap; +begin + if not Assigned(FBitmap) then + begin + FBitmap := Graphics.TBitmap.Create; + FBitmap.PixelFormat := pf32bit; + PrepareBitmap(FBitmap); + end; + + Result := FBitmap; +end; + +function TX2CustomMenuBarAnimatorBuffer.GetHeight: Integer; +begin + Result := Bitmap.Height; +end; + + +function TX2CustomMenuBarAnimatorBuffer.GetWidth: Integer; +begin + Result := Bitmap.Width; +end; + + +{ TX2CustomMenuBarAnimator } +constructor TX2CustomMenuBarAnimator.Create(AItemsBuffer: TX2CustomMenuBarAnimatorBuffer); +begin + inherited Create; + + ResetStartTime; + FItemsBuffer := AItemsBuffer; +end; + +destructor TX2CustomMenuBarAnimator.Destroy; begin FreeAndNil(FItemsBuffer); @@ -799,24 +897,24 @@ begin end; -procedure TX2CustomMenuBarAnimator.ResetStartTime(); +procedure TX2CustomMenuBarAnimator.ResetStartTime; begin - FStartTime := GetTickCount(); + FStartTime := GetTickCount; end; -function TX2CustomMenuBarAnimator.GetHeight(): Integer; +function TX2CustomMenuBarAnimator.GetHeight: Integer; begin Result := ItemsBuffer.Height; end; -function TX2CustomMenuBarAnimator.GetTimeElapsed(): Cardinal; +function TX2CustomMenuBarAnimator.GetTimeElapsed: Cardinal; var currentTime: Cardinal; begin - currentTime := GetTickCount(); + currentTime := GetTickCount; Result := currentTime - FStartTime; if currentTime < FStartTime then @@ -830,13 +928,13 @@ begin end; -procedure TX2CustomMenuBarAnimator.Terminate(); +procedure TX2CustomMenuBarAnimator.Terminate; begin FTerminated := True; end; -procedure TX2CustomMenuBarAnimator.Update(); +procedure TX2CustomMenuBarAnimator.Update; begin end; @@ -851,37 +949,37 @@ begin end; -procedure TX2CustomMenuBarAction.Terminate(); +procedure TX2CustomMenuBarAction.Terminate; begin FTerminated := True; end; -function TX2CustomMenuBarAction.AllowInteraction(): Boolean; +function TX2CustomMenuBarAction.AllowInteraction: Boolean; begin Result := False; end; -function TX2CustomMenuBarAction.AllowUpdateScrollbar(): Boolean; +function TX2CustomMenuBarAction.AllowUpdateScrollbar: Boolean; begin Result := False; end; -procedure TX2CustomMenuBarAction.Start(); +procedure TX2CustomMenuBarAction.Start; begin FStarted := True; end; -procedure TX2CustomMenuBarAction.Stop(); +procedure TX2CustomMenuBarAction.Stop; begin FStarted := False; end; -procedure TX2CustomMenuBarAction.BeforePaint(); +procedure TX2CustomMenuBarAction.BeforePaint; begin end; @@ -899,17 +997,33 @@ begin end; -procedure TX2CustomMenuBarAction.AfterPaint(); +procedure TX2CustomMenuBarAction.AfterPaint; begin end; -function TX2CustomMenuBarAction.GetTerminated(): Boolean; +function TX2CustomMenuBarAction.GetTerminated: Boolean; begin Result := FTerminated; end; +{ TX2MenuBarAnimatorBuffer } +constructor TX2MenuBarAnimatorBuffer.Create(AMenuBar: TX2CustomMenuBar; AGroup: TX2MenuBarGroup); +begin + inherited Create; + + FGroup := AGroup; + FMenuBar := AMenuBar; +end; + + +procedure TX2MenuBarAnimatorBuffer.PrepareBitmap(ABitmap: Graphics.TBitmap); +begin + MenuBar.GetAnimateGroup(Group, ABitmap); +end; + + { TX2MenuBarActionLink } procedure TX2MenuBarActionLink.AssignClient(AClient: TObject); begin @@ -917,58 +1031,58 @@ begin end; -function TX2MenuBarActionLink.IsCaptionLinked(): Boolean; +function TX2MenuBarActionLink.IsCaptionLinked: Boolean; begin - Result := inherited IsCaptionLinked() and + Result := inherited IsCaptionLinked and (Client.Caption = (Action as TCustomAction).Caption); end; -function TX2MenuBarActionLink.IsEnabledLinked(): Boolean; +function TX2MenuBarActionLink.IsEnabledLinked: Boolean; begin - Result := inherited IsCaptionLinked() and + Result := inherited IsCaptionLinked and (Client.Enabled = (Action as TCustomAction).Enabled); end; -function TX2MenuBarActionLink.IsImageIndexLinked(): Boolean; +function TX2MenuBarActionLink.IsImageIndexLinked: Boolean; begin - Result := inherited IsCaptionLinked() and + Result := inherited IsCaptionLinked and (Client.ImageIndex = (Action as TCustomAction).ImageIndex); end; -function TX2MenuBarActionLink.IsVisibleLinked(): Boolean; +function TX2MenuBarActionLink.IsVisibleLinked: Boolean; begin - Result := inherited IsCaptionLinked() and + Result := inherited IsCaptionLinked and (Client.Visible = (Action as TCustomAction).Visible); end; procedure TX2MenuBarActionLink.SetCaption(const Value: string); begin - if IsCaptionLinked() then + if IsCaptionLinked then Client.Caption := Value; end; procedure TX2MenuBarActionLink.SetEnabled(Value: Boolean); begin - if IsEnabledLinked() then + if IsEnabledLinked then Client.Enabled := Value; end; procedure TX2MenuBarActionLink.SetImageIndex(Value: Integer); begin - if IsImageIndexLinked() then + if IsImageIndexLinked then Client.ImageIndex := Value; end; procedure TX2MenuBarActionLink.SetVisible(Value: Boolean); begin - if IsVisibleLinked() then + if IsVisibleLinked then Client.Visible := Value; end; @@ -995,7 +1109,7 @@ begin inherited; end; -destructor TX2CustomMenuBarItem.Destroy(); +destructor TX2CustomMenuBarItem.Destroy; begin Data := nil; FreeAndNil(FActionLink); @@ -1032,7 +1146,7 @@ begin if Sender is TCustomAction then with TCustomAction(Sender) do begin - if (not CheckDefaults) or (not Self.IsCaptionStored()) then + if (not CheckDefaults) or (not Self.IsCaptionStored) then Self.Caption := Caption; if (not CheckDefaults) or Self.Enabled then @@ -1047,13 +1161,13 @@ begin end; -function TX2CustomMenuBarItem.IsCaptionStored(): Boolean; +function TX2CustomMenuBarItem.IsCaptionStored: Boolean; begin Result := (Length(Caption) > 0); end; -function TX2CustomMenuBarItem.GetMenuBar(): TX2CustomMenuBar; +function TX2CustomMenuBarItem.GetMenuBar: TX2CustomMenuBar; var parentCollection: TCollection; parentOwner: TPersistent; @@ -1194,13 +1308,13 @@ begin end; -function TX2MenuBarItem.IsCaptionStored(): Boolean; +function TX2MenuBarItem.IsCaptionStored: Boolean; begin Result := (Caption <> SDefaultItemCaption); end; -function TX2MenuBarItem.GetGroup(): TX2MenuBarGroup; +function TX2MenuBarItem.GetGroup: TX2MenuBarGroup; begin Result := nil; @@ -1219,7 +1333,7 @@ end; function TX2MenuBarItems.Add(const ACaption: TCaption): TX2MenuBarItem; begin - Result := TX2MenuBarItem(inherited Add()); + Result := TX2MenuBarItem(inherited Add); if Length(ACaption) > 0 then Result.Caption := ACaption; @@ -1252,7 +1366,7 @@ begin end; -destructor TX2MenuBarGroup.Destroy(); +destructor TX2MenuBarGroup.Destroy; begin FreeAndNil(FItems); @@ -1273,7 +1387,7 @@ begin end; -function TX2MenuBarGroup.GetSelectedItem(): Integer; +function TX2MenuBarGroup.GetSelectedItem: Integer; begin Result := -1; @@ -1316,7 +1430,7 @@ begin end; -function TX2MenuBarGroup.IsCaptionStored(): Boolean; +function TX2MenuBarGroup.IsCaptionStored: Boolean; begin Result := (Caption <> SDefaultGroupCaption); end; @@ -1367,7 +1481,7 @@ end; function TX2MenuBarGroups.Add(const ACaption: TCaption): TX2MenuBarGroup; begin - Result := TX2MenuBarGroup(inherited Add()); + Result := TX2MenuBarGroup(inherited Add); if Length(ACaption) > 0 then Result.Caption := ACaption; @@ -1402,7 +1516,7 @@ begin FGroups.OnNotify := GroupsNotify; FGroups.OnUpdate := GroupsUpdate; FHideScrollbar := True; - FImagesChangeLink := TChangeLink.Create(); + FImagesChangeLink := TChangeLink.Create; FScrollbar := True; TabStop := True; @@ -1432,15 +1546,15 @@ begin end; -procedure TX2CustomMenuBar.Loaded(); +procedure TX2CustomMenuBar.Loaded; begin inherited; - UpdateScrollbar(); + UpdateScrollbar; end; -destructor TX2CustomMenuBar.Destroy(); +destructor TX2CustomMenuBar.Destroy; begin Images := nil; Painter := nil; @@ -1460,7 +1574,7 @@ begin end; -procedure TX2CustomMenuBar.Paint(); +procedure TX2CustomMenuBar.Paint; var bufferRect: TRect; currentAction: TX2CustomMenuBarAction; @@ -1471,7 +1585,7 @@ begin { Prepare buffer } if not Assigned(FBuffer) then begin - FBuffer := Graphics.TBitmap.Create(); + FBuffer := Graphics.TBitmap.Create; FBuffer.PixelFormat := pf32bit; end; @@ -1487,26 +1601,26 @@ begin { Update action } - currentAction := GetCurrentAction(); + currentAction := GetCurrentAction; if Assigned(currentAction) then begin if not currentAction.Started then - currentAction.Start(); + currentAction.Start; - currentAction.BeforePaint(); + currentAction.BeforePaint; end; - UpdateScrollbar(); + UpdateScrollbar; { Draw menu } Painter.BeginPaint(Self); try - Painter.DrawBackground(FBuffer.Canvas, bufferRect); + Painter.DrawBackground(FBuffer.Canvas, bufferRect, Point(0, 0)); DrawMenu(FBuffer.Canvas); finally - Painter.EndPaint(); + Painter.EndPaint; end; Self.Canvas.Draw(0, 0, FBuffer); @@ -1516,28 +1630,28 @@ begin if Assigned(currentAction) then begin { Make sure Paint is called again while there's an action queue } - Invalidate(); + Invalidate; - currentAction.AfterPaint(); + currentAction.AfterPaint; if currentAction.Terminated then begin - currentAction.Stop(); - PopCurrentAction(); + currentAction.Stop; + PopCurrentAction; { Start the next action in the queue, continue until we find an action which doesn't terminate immediately. See PushAction. } - currentAction := GetCurrentAction(); + currentAction := GetCurrentAction; while Assigned(currentAction) do begin - currentAction.Start(); + currentAction.Start; if currentAction.Terminated then begin - currentAction.Stop(); - PopCurrentAction(); + currentAction.Stop; + PopCurrentAction; - currentAction := GetCurrentAction(); + currentAction := GetCurrentAction; end else Break; end; @@ -1549,6 +1663,41 @@ begin end; +procedure TX2CustomMenuBar.FindGroupBounds(Sender: TObject; Item: TX2CustomMenuBarItem; + const MenuBounds, ItemBounds: TRect; + Data: Pointer; var Abort: Boolean); +var + findInfo: PFindGroupBoundsInfo; + +begin + findInfo := Data; + + if Item = findInfo^.Group then + begin + findInfo^.Bounds := ItemBounds; + Abort := True; + end; +end; + + +function TX2CustomMenuBar.GetGroupBounds(AGroup: TX2MenuBarGroup): TRect; +var + findInfo: TFindGroupBoundsInfo; + +begin + findInfo.Group := AGroup; + if Assigned(IterateItemBounds(FindGroupBounds, @findInfo)) then + begin + Result := findInfo.Bounds; + + { We receive the bounds of the group item, start with the first + menu item. } + Result.Top := Result.Bottom; + Result.Bottom := Result.Top + Painter.GetGroupHeight(AGroup); + end; +end; + + function TX2CustomMenuBar.GetDrawState(AItem: TX2CustomMenuBarItem): TX2MenuBarDrawStates; function ItemGroup(AGroupItem: TX2CustomMenuBarItem): TX2MenuBarGroup; begin @@ -1593,7 +1742,7 @@ begin canvas := TCanvas(Data); drawState := GetDrawState(Item); - currentAction := GetCurrentAction(); + currentAction := GetCurrentAction; handled := False; if Assigned(currentAction) then @@ -1666,7 +1815,7 @@ begin end; -function TX2CustomMenuBar.GetAnimatorClass(): TX2CustomMenuBarAnimatorClass; +function TX2CustomMenuBar.GetAnimatorClass: TX2CustomMenuBarAnimatorClass; begin Result := nil; @@ -1683,47 +1832,54 @@ function TX2CustomMenuBar.GetAnimateAction(AGroup: TX2MenuBarGroup; AExpanding: var animatorClass: TX2CustomMenuBarAnimatorClass; animator: TX2CustomMenuBarAnimator; - itemsBuffer: Graphics.TBitmap; - itemsBounds: TRect; begin Result := nil; if not Assigned(Painter) then Exit; - animatorClass := GetAnimatorClass(); + animatorClass := GetAnimatorClass; if Assigned(animatorClass) and not (csDesigning in ComponentState) then begin - Painter.BeginPaint(Self); - try - itemsBuffer := Graphics.TBitmap.Create(); - try - itemsBounds := Painter.ApplyMargins(Self.ClientRect); - itemsBuffer.PixelFormat := pf32bit; - itemsBuffer.Width := itemsBounds.Right - itemsBounds.Left; - itemsBuffer.Height := Painter.GetGroupHeight(AGroup); - itemsBounds := Rect(0, 0, itemsBuffer.Width, itemsBuffer.Height); - itemsBuffer.Canvas.Font.Assign(Self.Font); + animator := animatorClass.Create(TX2MenuBarAnimatorBuffer.Create(Self, AGroup)); + animator.AnimationTime := AnimationTime; + animator.Expanding := AExpanding; - // #ToDo3 (MvR) 23-3-2006: this will probably cause problems if we ever - // want a bitmapped/customdrawn background. - // Maybe we can trick around a bit with the - // canvas offset? think about it later. - Painter.DrawBackground(itemsBuffer.Canvas, itemsBounds); - DrawMenuItems(itemsBuffer.Canvas, AGroup, itemsBounds); + Result := TX2MenuBarAnimateAction.Create(Self, AGroup, animator); + Invalidate; + end; +end; - animator := animatorClass.Create(itemsBuffer); - animator.AnimationTime := AnimationTime; - animator.Expanding := AExpanding; - Result := TX2MenuBarAnimateAction.Create(Self, AGroup, animator); - finally - FreeAndNil(itemsBuffer); - end; - finally - Painter.EndPaint(); - Invalidate(); - end; +procedure TX2CustomMenuBar.GetAnimateGroup(AGroup: TX2MenuBarGroup; ABitmap: Graphics.TBitmap); +var + itemsBounds: TRect; + groupOffset: TPoint; + +begin + Painter.BeginPaint(Self); + try + itemsBounds := GetGroupBounds(AGroup); + ABitmap.PixelFormat := pf32bit; + ABitmap.Width := itemsBounds.Right - itemsBounds.Left; + ABitmap.Height := itemsBounds.Bottom - itemsBounds.Top; + + { Pass the original position of the group to the painter, so it + can do proper custom backgrounds. } + Painter.UndoMargins(itemsBounds); + groupOffset := itemsBounds.TopLeft; + + // #ToDo1 (MvR) 17-04-2009: even tijdelijk; een van de metrics moet meegenomen worden in de berekening + Inc(groupOffset.Y, 8); + + itemsBounds := Rect(0, 0, ABitmap.Width, ABitmap.Height); + + ABitmap.Canvas.Font.Assign(Self.Font); + + Painter.DrawBackground(ABitmap.Canvas, itemsBounds, groupOffset); + DrawMenuItems(ABitmap.Canvas, AGroup, itemsBounds); + finally + Painter.EndPaint; end; end; @@ -1772,7 +1928,7 @@ begin itemBounds.Top := itemBounds.Bottom + Painter.GetSpacing(seAfterGroupHeader); - currentAction := GetCurrentAction(); + currentAction := GetCurrentAction; handled := False; if Assigned(currentAction) then @@ -1820,7 +1976,7 @@ end; procedure TX2CustomMenuBar.DoExpandedChanging(AGroup: TX2MenuBarGroup; AExpanding: Boolean); - function ExpandedGroupsCount(): Integer; + function ExpandedGroupsCount: Integer; var groupIndex: Integer; @@ -1864,7 +2020,7 @@ begin { Allow collapse all } if not (AExpanding or AllowCollapseAll) then - if ExpandedGroupsCount() = 1 then + if ExpandedGroupsCount = 1 then begin if AExpanding and (not Assigned(SelectedItem)) then SelectedItem := AGroup; @@ -1913,7 +2069,7 @@ begin end; -procedure TX2CustomMenuBar.DoSelectedChanged(); +procedure TX2CustomMenuBar.DoSelectedChanged; begin if Assigned(FOnSelectedChanged) then FOnSelectedChanged(Self, SelectedItem); @@ -1949,16 +2105,16 @@ end; -function TX2CustomMenuBar.AllowInteraction(): Boolean; +function TX2CustomMenuBar.AllowInteraction: Boolean; var currentAction: TX2CustomMenuBarAction; begin Result := True; - currentAction := GetCurrentAction(); + currentAction := GetCurrentAction; if Assigned(currentAction) then - Result := currentAction.AllowInteraction(); + Result := currentAction.AllowInteraction; end; @@ -1975,7 +2131,7 @@ end; -function TX2CustomMenuBar.GetCurrentAction(): TX2CustomMenuBarAction; +function TX2CustomMenuBar.GetCurrentAction: TX2CustomMenuBarAction; begin Result := nil; if ActionQueue.Count > 0 then @@ -1995,11 +2151,11 @@ begin { Start the action; if it's terminated immediately don't add it to the queue. This enables actions like selecting an item without requiring animation to fire straight away. } - action.Start(); + action.Start; if action.Terminated then begin - action.Stop(); + action.Stop; FreeAndNil(action); end; end; @@ -2007,11 +2163,11 @@ begin if Assigned(action) then ActionQueue.Add(action); - Invalidate(); + Invalidate; end; -procedure TX2CustomMenuBar.PopCurrentAction(); +procedure TX2CustomMenuBar.PopCurrentAction; begin if ActionQueue.Count > 0 then ActionQueue.Delete(0); @@ -2024,7 +2180,7 @@ begin AGroup.InternalSetExpanded(AExpanded); DoExpandedChanged(AGroup); - Invalidate(); + Invalidate; end; @@ -2034,7 +2190,7 @@ var begin FSelectedItem := AItem; - DoSelectedChanged(); + DoSelectedChanged; if Assigned(AItem) then begin @@ -2098,7 +2254,7 @@ begin end; end; - collapseGroups := TList.Create(); + collapseGroups := TList.Create; try { Determine which groups to collapse } for groupIndex := 0 to Pred(Groups.Count) do @@ -2321,7 +2477,7 @@ begin try Result := Painter.HitTest(hitPoint); finally - Painter.EndPaint(); + Painter.EndPaint; end; end; end; @@ -2425,7 +2581,7 @@ begin end; -function TX2CustomMenuBar.SelectFirst(): TX2CustomMenuBarItem; +function TX2CustomMenuBar.SelectFirst: TX2CustomMenuBarItem; begin Result := nil; @@ -2438,7 +2594,7 @@ begin end; -function TX2CustomMenuBar.SelectLast(): TX2CustomMenuBarItem; +function TX2CustomMenuBar.SelectLast: TX2CustomMenuBarItem; begin Result := nil; @@ -2451,7 +2607,7 @@ begin end; -function TX2CustomMenuBar.SelectNext(): TX2CustomMenuBarItem; +function TX2CustomMenuBar.SelectNext: TX2CustomMenuBarItem; begin Result := nil; @@ -2464,7 +2620,7 @@ begin end; -function TX2CustomMenuBar.SelectPrior(): TX2CustomMenuBarItem; +function TX2CustomMenuBar.SelectPrior: TX2CustomMenuBarItem; begin Result := nil; @@ -2555,11 +2711,11 @@ begin if AComponent = FPainter then begin FPainter := nil; - Invalidate(); + Invalidate; end else if AComponent = FImages then begin FImages := nil; - Invalidate(); + Invalidate; end; inherited; @@ -2568,7 +2724,7 @@ end; procedure TX2CustomMenuBar.PainterUpdate(Sender: TX2CustomMenuBarPainter); begin - Invalidate(); + Invalidate; end; @@ -2587,7 +2743,7 @@ begin end; if TProtectedCollection(Item.Collection).UpdateCount = 0 then - Invalidate(); + Invalidate; end; @@ -2599,7 +2755,7 @@ begin if Assigned(Designer) then Designer.ItemModified(Item as TX2CustomMenuBarItem); - Invalidate(); + Invalidate; end; @@ -2629,7 +2785,7 @@ var begin FLastMousePos := Point(X, Y); - TestMousePos(); + TestMousePos; cursor := crDefault; if Assigned(HotItem) then @@ -2654,7 +2810,7 @@ procedure TX2CustomMenuBar.CMMouseLeave(var Msg: TMessage); begin FLastMousePos := Point(-1, -1); FHotItem := nil; - Invalidate(); + Invalidate; end; @@ -2726,12 +2882,12 @@ begin scrollInfo.nPos := scrollPos; SetScrollInfo(Self.Handle, SB_VERT, scrollInfo, False); - Invalidate(); + Invalidate; end; end; -procedure TX2CustomMenuBar.TestMousePos(); +procedure TX2CustomMenuBar.TestMousePos; var hitTest: TX2MenuBarHitTest; @@ -2740,12 +2896,12 @@ begin if hitTest.Item <> FHotItem then begin HotItem := hitTest.Item; - Invalidate(); + Invalidate; end; end; -function TX2CustomMenuBar.GetMenuHeight(): Integer; +function TX2CustomMenuBar.GetMenuHeight: Integer; var currentAction: TX2CustomMenuBarAction; group: TX2MenuBarGroup; @@ -2778,7 +2934,7 @@ begin Painter.GetSpacing(seAfterGroupHeader)); handled := False; - currentAction := GetCurrentAction(); + currentAction := GetCurrentAction; if Assigned(currentAction) then begin currentAction.GetItemHeight(group, itemHeight, handled); @@ -2809,7 +2965,7 @@ begin end; -procedure TX2CustomMenuBar.UpdateScrollbar(); +procedure TX2CustomMenuBar.UpdateScrollbar; var currentAction: TX2CustomMenuBarAction; scrollInfo: TScrollInfo; @@ -2817,8 +2973,8 @@ var begin { Don't update the scrollbar while animating, prevents issues with the items buffer width if the scrollbar happens to show/hide during animation. } - currentAction := GetCurrentAction(); - if Assigned(currentAction) and (not currentAction.AllowUpdateScrollbar()) then + currentAction := GetCurrentAction; + if Assigned(currentAction) and (not currentAction.AllowUpdateScrollbar) then exit; FillChar(scrollInfo, SizeOf(TScrollInfo), #0); @@ -2828,7 +2984,7 @@ begin if Scrollbar then begin scrollInfo.nMin := 0; - scrollInfo.nMax := GetMenuHeight(); + scrollInfo.nMax := GetMenuHeight; scrollInfo.nPage := Self.ClientHeight; if not HideScrollbar then @@ -2854,7 +3010,7 @@ end; procedure TX2CustomMenuBar.ImagesChange(Sender: TObject); begin - Invalidate(); + Invalidate; end; @@ -2897,7 +3053,7 @@ begin if Value <> FBorderStyle then begin FBorderStyle := Value; - RecreateWnd(); + RecreateWnd; end; end; @@ -2914,7 +3070,7 @@ begin if Value <> FHideScrollbar then begin FHideScrollbar := Value; - RecreateWnd(); + RecreateWnd; end; end; @@ -2937,7 +3093,7 @@ begin FImages.RegisterChanges(FImagesChangeLink); end; - Invalidate(); + Invalidate; end; end; @@ -2961,7 +3117,7 @@ begin FPainter.AttachObserver(Self); end; - Invalidate(); + Invalidate; end; end; @@ -2971,7 +3127,7 @@ begin if Value <> FScrollbar then begin FScrollbar := Value; - RecreateWnd(); + RecreateWnd; end; end; @@ -3048,4 +3204,3 @@ end; //end; end. - diff --git a/Source/X2CLMenuBarActions.pas b/Source/X2CLMenuBarActions.pas index 5e73f1b..b0bfa38 100644 --- a/Source/X2CLMenuBarActions.pas +++ b/Source/X2CLMenuBarActions.pas @@ -25,18 +25,18 @@ type public constructor Create(AMenuBar: TX2CustomMenuBar; AGroup: TX2MenuBarGroup; AAnimator: TX2CustomMenuBarAnimator); - destructor Destroy(); override; + destructor Destroy; override; - procedure Start(); override; + procedure Start; override; - procedure BeforePaint(); override; + procedure BeforePaint; override; procedure GetItemHeight(AItem: TX2CustomMenuBarItem; var AHeight: Integer; var AHandled: Boolean); override; procedure DrawMenuItem(ACanvas: TCanvas; APainter: TX2CustomMenuBarPainter; AItem: TX2CustomMenuBarItem; const AMenuBounds: TRect; const AItemBounds: TRect; AState: TX2MenuBarDrawStates; var AHandled: Boolean); override; - procedure AfterPaint(); override; + procedure AfterPaint; override; end; @@ -49,26 +49,26 @@ type private FAnimateActions: TObjectList; - function GetCount(): Integer; + function GetCount: Integer; protected function GetAnimateAction(AIndex: Integer): TX2MenuBarAnimateAction; - function GetTerminated(): Boolean; override; + function GetTerminated: Boolean; override; property AnimateActions: TObjectList read FAnimateActions; public constructor Create(AMenuBar: TX2CustomMenuBar); - destructor Destroy(); override; + destructor Destroy; override; procedure Add(AAction: TX2MenuBarAnimateAction); - procedure BeforePaint(); override; + procedure BeforePaint; override; procedure GetItemHeight(AItem: TX2CustomMenuBarItem; var AHeight: Integer; var AHandled: Boolean); override; procedure DrawMenuItem(ACanvas: TCanvas; APainter: TX2CustomMenuBarPainter; AItem: TX2CustomMenuBarItem; const AMenuBounds: TRect; const AItemBounds: TRect; AState: TX2MenuBarDrawStates; var AHandled: Boolean); override; - procedure AfterPaint(); override; + procedure AfterPaint; override; property Count: Integer read GetCount; end; @@ -88,7 +88,7 @@ type constructor Create(AMenuBar: TX2CustomMenuBar; AGroup: TX2MenuBarGroup; AExpanding: Boolean); - procedure Start(); override; + procedure Start; override; end; @@ -104,7 +104,7 @@ type public constructor Create(AMenuBar: TX2CustomMenuBar; AItem: TX2CustomMenuBarItem); - procedure Start(); override; + procedure Start; override; end; @@ -131,7 +131,7 @@ begin end; -destructor TX2MenuBarAnimateAction.Destroy(); +destructor TX2MenuBarAnimateAction.Destroy; begin FreeAndNil(FAnimator); @@ -139,21 +139,21 @@ begin end; -procedure TX2MenuBarAnimateAction.Start(); +procedure TX2MenuBarAnimateAction.Start; begin inherited; - Animator.ResetStartTime(); + Animator.ResetStartTime; end; -procedure TX2MenuBarAnimateAction.BeforePaint(); +procedure TX2MenuBarAnimateAction.BeforePaint; begin inherited; - Animator.Update(); + Animator.Update; if Animator.Terminated then - Terminate(); + Terminate; end; @@ -196,7 +196,7 @@ begin end; -procedure TX2MenuBarAnimateAction.AfterPaint(); +procedure TX2MenuBarAnimateAction.AfterPaint; begin inherited; @@ -205,8 +205,8 @@ begin { Prevent 100% CPU usage } Sleep(5); - TProtectedX2CustomMenuBar(MenuBar).TestMousePos(); - MenuBar.Invalidate(); + TProtectedX2CustomMenuBar(MenuBar).TestMousePos; + MenuBar.Invalidate; end; end; @@ -220,7 +220,7 @@ begin end; -destructor TX2MenuBarAnimateMultipleAction.Destroy(); +destructor TX2MenuBarAnimateMultipleAction.Destroy; begin FreeAndNil(FAnimateActions); @@ -234,7 +234,7 @@ begin end; -procedure TX2MenuBarAnimateMultipleAction.BeforePaint(); +procedure TX2MenuBarAnimateMultipleAction.BeforePaint; var actionIndex: Integer; @@ -242,7 +242,7 @@ begin inherited; for actionIndex := 0 to Pred(AnimateActions.Count) do - GetAnimateAction(actionIndex).BeforePaint(); + GetAnimateAction(actionIndex).BeforePaint; end; @@ -289,7 +289,7 @@ begin end; -procedure TX2MenuBarAnimateMultipleAction.AfterPaint(); +procedure TX2MenuBarAnimateMultipleAction.AfterPaint; var actionIndex: Integer; @@ -297,7 +297,7 @@ begin inherited; for actionIndex := 0 to Pred(AnimateActions.Count) do - GetAnimateAction(actionIndex).AfterPaint(); + GetAnimateAction(actionIndex).AfterPaint; end; @@ -307,18 +307,18 @@ begin end; -function TX2MenuBarAnimateMultipleAction.GetCount(): Integer; +function TX2MenuBarAnimateMultipleAction.GetCount: Integer; begin Result := FAnimateActions.Count; end; -function TX2MenuBarAnimateMultipleAction.GetTerminated(): Boolean; +function TX2MenuBarAnimateMultipleAction.GetTerminated: Boolean; var actionIndex: Integer; begin - Result := inherited GetTerminated(); + Result := inherited GetTerminated; if not Result then begin @@ -344,12 +344,12 @@ begin end; -procedure TX2MenuBarExpandAction.Start(); +procedure TX2MenuBarExpandAction.Start; begin inherited; TProtectedX2CustomMenuBar(MenuBar).InternalSetExpanded(FGroup, FExpanding); - Terminate(); + Terminate; end; @@ -363,13 +363,12 @@ begin end; -procedure TX2MenuBarSelectAction.Start(); +procedure TX2MenuBarSelectAction.Start; begin inherited; TProtectedX2CustomMenuBar(MenuBar).InternalSetSelected(FItem); - Terminate(); + Terminate; end; end. - diff --git a/Source/X2CLMenuBarAnimators.pas b/Source/X2CLMenuBarAnimators.pas index 68b2e2d..3a7a98a 100644 --- a/Source/X2CLMenuBarAnimators.pas +++ b/Source/X2CLMenuBarAnimators.pas @@ -27,9 +27,9 @@ type private FSlideHeight: Integer; protected - function GetHeight(): Integer; override; + function GetHeight: Integer; override; public - procedure Update(); override; + procedure Update; override; procedure Draw(ACanvas: TCanvas; const ABounds: TRect); override; end; @@ -47,10 +47,10 @@ type property ItemsState: Graphics.TBitmap read FItemsState; property Mask: Graphics.TBitmap read FMask; public - constructor Create(AItemsBuffer: Graphics.TBitmap); override; - destructor Destroy(); override; + constructor Create(AItemsBuffer: TX2CustomMenuBarAnimatorBuffer); override; + destructor Destroy; override; - procedure Update(); override; + procedure Update; override; procedure Draw(ACanvas: TCanvas; const ABounds: TRect); override; end; @@ -61,9 +61,7 @@ type private FAlpha: Byte; public - constructor Create(AItemsBuffer: Graphics.TBitmap); override; - - procedure Update(); override; + procedure Update; override; procedure Draw(ACanvas: TCanvas; const ABounds: TRect); override; end; @@ -74,9 +72,9 @@ type private FSlideHeight: Integer; protected - function GetHeight(): Integer; override; + function GetHeight: Integer; override; public - procedure Update(); override; + procedure Update; override; end; implementation @@ -87,12 +85,12 @@ uses { TX2MenuBarSlideAnimator } -function TX2MenuBarSlideAnimator.GetHeight(): Integer; +function TX2MenuBarSlideAnimator.GetHeight: Integer; begin Result := FSlideHeight; end; -procedure TX2MenuBarSlideAnimator.Update(); +procedure TX2MenuBarSlideAnimator.Update; var elapsed: Cardinal; @@ -108,7 +106,7 @@ begin FSlideHeight := 0; if elapsed >= AnimationTime then - Terminate(); + Terminate; end; procedure TX2MenuBarSlideAnimator.Draw(ACanvas: TCanvas; const ABounds: TRect); @@ -121,12 +119,12 @@ begin destRect := ABounds; destRect.Bottom := destRect.Top + FSlideHeight; - ACanvas.CopyRect(destRect, ItemsBuffer.Canvas, sourceRect); + ACanvas.CopyRect(destRect, ItemsBuffer.Bitmap.Canvas, sourceRect); end; { TX2MenuBarDissolveAnimator } -constructor TX2MenuBarDissolveAnimator.Create(AItemsBuffer: Graphics.TBitmap); +constructor TX2MenuBarDissolveAnimator.Create(AItemsBuffer: TX2CustomMenuBarAnimatorBuffer); var pixelIndex: Integer; pixelPos: Integer; @@ -138,20 +136,20 @@ begin { The bitmaps need to be 32-bits since we'll be accessing the scanlines as one big array, not by using Scanline on each row. In 24-bit mode, the scanlines are still aligned on a 32-bits boundary, thus causing problems. } - ItemsBuffer.PixelFormat := pf32bit; + ItemsBuffer.Bitmap.PixelFormat := pf32bit; - FMask := Graphics.TBitmap.Create(); + FMask := Graphics.TBitmap.Create; FMask.PixelFormat := pf32bit; FMask.Width := AItemsBuffer.Width; FMask.Height := AItemsBuffer.Height; - FItemsState := Graphics.TBitmap.Create(); + FItemsState := Graphics.TBitmap.Create; FItemsState.PixelFormat := pf32bit; FItemsState.Width := AItemsBuffer.Width; FItemsState.Height := AItemsBuffer.Height; if RandSeed = 0 then - Randomize(); + Randomize; { Prepare an array of pixel indices which will be used to pick random unique pixels in the Update method. @@ -160,7 +158,7 @@ begin be randomly picked and deleted in Update. Now we pre-shuffle the list, then Delete only from the end, which does not reallocate or move any memory (TList.Count decreases, Capacity stays the same), a LOT faster. } - FPixels := TList.Create(); + FPixels := TList.Create; FPixels.Count := AItemsBuffer.Width * AItemsBuffer.Height; for pixelIndex := Pred(FPixels.Count) downto 0 do @@ -178,7 +176,7 @@ begin end; end; -destructor TX2MenuBarDissolveAnimator.Destroy(); +destructor TX2MenuBarDissolveAnimator.Destroy; begin FreeAndNil(FItemsState); FreeAndNil(FMask); @@ -187,7 +185,7 @@ begin end; -procedure TX2MenuBarDissolveAnimator.Update(); +procedure TX2MenuBarDissolveAnimator.Update; const RGBBlack: TRGBQuad = (rgbBlue: 0; rgbGreen: 0; @@ -225,7 +223,7 @@ begin itemsPixels := nil; if Expanding then - itemsPixels := GetScanlinePointer(ItemsBuffer); + itemsPixels := GetScanlinePointer(ItemsBuffer.Bitmap); for pixel := Pred(FPixels.Count - pixelsRemaining) downto 0 do begin @@ -248,7 +246,7 @@ begin end; if elapsed >= AnimationTime then - Terminate(); + Terminate; end; procedure TX2MenuBarDissolveAnimator.Draw(ACanvas: TCanvas; const ABounds: TRect); @@ -290,7 +288,7 @@ begin begin { Start with a visible group } FMask.Canvas.Brush.Color := clBlack; - FItemsState.Canvas.Draw(0, 0, ItemsBuffer); + FItemsState.Canvas.Draw(0, 0, ItemsBuffer.Bitmap); end; FMask.Canvas.FillRect(Rect(0, 0, FMask.Width, FMask.Height)); @@ -300,15 +298,7 @@ end; { TX2MenuBarFadeAnimator } -constructor TX2MenuBarFadeAnimator.Create(AItemsBuffer: Graphics.TBitmap); -begin - inherited; - - ItemsBuffer.PixelFormat := pf32bit; -end; - - -procedure TX2MenuBarFadeAnimator.Update(); +procedure TX2MenuBarFadeAnimator.Update; var elapsed: Cardinal; newAlpha: Integer; @@ -326,7 +316,7 @@ begin FAlpha := newAlpha; if elapsed >= AnimationTime then - Terminate(); + Terminate; end; procedure TX2MenuBarFadeAnimator.Draw(ACanvas: TCanvas; const ABounds: TRect); @@ -339,20 +329,21 @@ begin if ABounds.Bottom - ABounds.Top <= 0 then exit; - backBuffer := Graphics.TBitmap.Create(); + backBuffer := Graphics.TBitmap.Create; try backBuffer.PixelFormat := pf32bit; backBuffer.Width := ItemsBuffer.Width; backBuffer.Height := ItemsBuffer.Height; - destRect := Rect(0, 0, backBuffer.Width, backBuffer.Height); + destRect := Rect(0, 0, backBuffer.Width, ABounds.Bottom - ABounds.Top); backBuffer.Canvas.CopyRect(destRect, ACanvas, ABounds); - X2CLGraphics.DrawBlended(backBuffer, ItemsBuffer, FAlpha); + X2CLGraphics.DrawBlended(backBuffer, ItemsBuffer.Bitmap, FAlpha); sourceRect := Rect(0, 0, ItemsBuffer.Width, Self.Height); destRect := ABounds; destRect.Bottom := destRect.Top + Self.Height; + ACanvas.CopyRect(destRect, backBuffer.Canvas, sourceRect); finally FreeAndNil(backBuffer); @@ -361,12 +352,12 @@ end; { TX2MenuBarSlideFadeAnimator } -function TX2MenuBarSlideFadeAnimator.GetHeight(): Integer; +function TX2MenuBarSlideFadeAnimator.GetHeight: Integer; begin Result := FSlideHeight; end; -procedure TX2MenuBarSlideFadeAnimator.Update(); +procedure TX2MenuBarSlideFadeAnimator.Update; var elapsed: Cardinal; diff --git a/Source/X2CLmusikCubeMenuBarPainter.pas b/Source/X2CLmusikCubeMenuBarPainter.pas index 11b29be..8c8f70b 100644 --- a/Source/X2CLmusikCubeMenuBarPainter.pas +++ b/Source/X2CLmusikCubeMenuBarPainter.pas @@ -31,10 +31,10 @@ type procedure SetBorder(const Value: TX2Color32); procedure SetFill(const Value: TX2Color32); - function IsBorderStored(): Boolean; - function IsFillStored(): Boolean; + function IsBorderStored: Boolean; + function IsFillStored: Boolean; protected - procedure DoChange(); + procedure DoChange; procedure SetDefaultColors(ABorder, AFill: TX2Color32); @@ -59,13 +59,13 @@ type procedure SetNormal(const Value: TX2MenuBarmCColor); procedure SetSelected(const Value: TX2MenuBarmCColor); protected - procedure DoChange(); + procedure DoChange; procedure ColorChange(Sender: TObject); property OnChange: TNotifyEvent read FOnChange write FOnChange; public - constructor Create(); - destructor Destroy(); override; + constructor Create; + destructor Destroy; override; procedure Assign(Source: TPersistent); override; published @@ -99,14 +99,14 @@ type function GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer; override; function GetItemHeight(AItem: TX2MenuBarItem): Integer; override; - procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect); override; + procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect; const AOffset: TPoint); 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; public constructor Create(AOwner: TComponent); override; - destructor Destroy(); override; + destructor Destroy; override; - procedure ResetColors(); + procedure ResetColors; published property Color: TColor read FColor write SetColor stored False; property GroupColors: TX2MenuBarmCColors read FGroupColors write SetGroupColors stored False; @@ -127,20 +127,20 @@ begin inherited; FColor := clBtnFace; - FGroupColors := TX2MenuBarmCColors.Create(); + FGroupColors := TX2MenuBarmCColors.Create; FGroupHeight := 22; - FIndicatorColors := TX2MenuBarmCColors.Create(); - FItemColors := TX2MenuBarmCColors.Create(); + FIndicatorColors := TX2MenuBarmCColors.Create; + FItemColors := TX2MenuBarmCColors.Create; FItemHeight := 22; FGroupColors.OnChange := ColorChange; FIndicatorColors.OnChange := ColorChange; FItemColors.OnChange := ColorChange; - ResetColors(); + ResetColors; end; -destructor TX2MenuBarmusikCubePainter.Destroy(); +destructor TX2MenuBarmusikCubePainter.Destroy; begin FreeAndNil(FItemColors); FreeAndNil(FIndicatorColors); @@ -150,7 +150,7 @@ begin end; -procedure TX2MenuBarmusikCubePainter.ResetColors(); +procedure TX2MenuBarmusikCubePainter.ResetColors; begin { Group buttons } GroupColors.Hot.SetDefaultColors( Color32(clBtnShadow), @@ -200,7 +200,7 @@ var destRect: TRect; begin - backBuffer := Graphics.TBitmap.Create(); + backBuffer := Graphics.TBitmap.Create; try backBuffer.PixelFormat := pf32bit; backBuffer.Width := AImageList.Width; @@ -211,7 +211,7 @@ begin OffsetRect(sourceRect, AX, AY); backBuffer.Canvas.CopyRect(destRect, ACanvas, sourceRect); - iconBuffer := Graphics.TBitmap.Create(); + iconBuffer := Graphics.TBitmap.Create; try iconBuffer.Assign(backBuffer); AImageList.Draw(iconBuffer.Canvas, 0, 0, AImageIndex); @@ -240,7 +240,8 @@ end; procedure TX2MenuBarmusikCubePainter.DrawBackground(ACanvas: TCanvas; - const ABounds: TRect); + const ABounds: TRect; + const AOffset: TPoint); begin with ACanvas do begin @@ -355,7 +356,7 @@ end; procedure TX2MenuBarmusikCubePainter.ColorChange(Sender: TObject); begin - NotifyObservers(); + NotifyObservers; end; @@ -364,7 +365,7 @@ begin if Value <> FIndicatorColors then begin FIndicatorColors.Assign(Value); - NotifyObservers(); + NotifyObservers; end; end; @@ -373,7 +374,7 @@ begin if Value <> FItemColors then begin FItemColors.Assign(Value); - NotifyObservers(); + NotifyObservers; end; end; @@ -382,7 +383,7 @@ begin if Value <> FItemHeight then begin FItemHeight := Value; - NotifyObservers(); + NotifyObservers; end; end; @@ -391,7 +392,7 @@ begin if Value <> FColor then begin FColor := Value; - NotifyObservers(); + NotifyObservers; end; end; @@ -400,7 +401,7 @@ begin if Value <> FGroupColors then begin FGroupColors.Assign(Value); - NotifyObservers(); + NotifyObservers; end; end; @@ -409,7 +410,7 @@ begin if Value <> FGroupHeight then begin FGroupHeight := Value; - NotifyObservers(); + NotifyObservers; end; end; @@ -430,7 +431,7 @@ begin end; -procedure TX2MenuBarmCColor.DoChange(); +procedure TX2MenuBarmCColor.DoChange; begin if Assigned(FOnChange) then FOnChange(Self); @@ -445,12 +446,12 @@ begin end; -function TX2MenuBarmCColor.IsBorderStored(): Boolean; +function TX2MenuBarmCColor.IsBorderStored: Boolean; begin Result := (FBorder <> FDefaultBorder); end; -function TX2MenuBarmCColor.IsFillStored(): Boolean; +function TX2MenuBarmCColor.IsFillStored: Boolean; begin Result := (FFill <> FDefaultFill); end; @@ -460,7 +461,7 @@ begin if Value <> FBorder then begin FBorder := Value; - DoChange(); + DoChange; end; end; @@ -469,26 +470,26 @@ begin if Value <> FFill then begin FFill := Value; - DoChange(); + DoChange; end; end; { TX2MenuBarmCColors } -constructor TX2MenuBarmCColors.Create(); +constructor TX2MenuBarmCColors.Create; begin inherited; - FHot := TX2MenuBarmCColor.Create(); - FNormal := TX2MenuBarmCColor.Create(); - FSelected := TX2MenuBarmCColor.Create(); + FHot := TX2MenuBarmCColor.Create; + FNormal := TX2MenuBarmCColor.Create; + FSelected := TX2MenuBarmCColor.Create; FHot.OnChange := ColorChange; FNormal.OnChange := ColorChange; FSelected.OnChange := ColorChange; end; -destructor TX2MenuBarmCColors.Destroy(); +destructor TX2MenuBarmCColors.Destroy; begin FreeAndNil(FSelected); FreeAndNil(FNormal); @@ -511,7 +512,7 @@ begin end; -procedure TX2MenuBarmCColors.DoChange(); +procedure TX2MenuBarmCColors.DoChange; begin if Assigned(FOnChange) then FOnChange(Self); @@ -519,7 +520,7 @@ end; procedure TX2MenuBarmCColors.ColorChange(Sender: TObject); begin - DoChange(); + DoChange; end; @@ -528,7 +529,7 @@ begin if FHot <> Value then begin FHot.Assign(Value); - DoChange(); + DoChange; end; end; @@ -537,7 +538,7 @@ begin if FNormal <> Value then begin FNormal.Assign(Value); - DoChange(); + DoChange; end; end; @@ -546,8 +547,8 @@ begin if FNormal <> Value then begin FSelected.Assign(Value); - DoChange(); + DoChange; end; end; -end. +end. \ No newline at end of file diff --git a/Source/X2CLunaMenuBarPainter.pas b/Source/X2CLunaMenuBarPainter.pas index 26e8592..fed3097 100644 --- a/Source/X2CLunaMenuBarPainter.pas +++ b/Source/X2CLunaMenuBarPainter.pas @@ -1,3 +1,215 @@ +{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} +{$MINSTACKSIZE $00004000} +{$MAXSTACKSIZE $00100000} +{$IMAGEBASE $00400000} +{$APPTYPE GUI} +{$WARN SYMBOL_DEPRECATED ON} +{$WARN SYMBOL_LIBRARY ON} +{$WARN SYMBOL_PLATFORM ON} +{$WARN UNIT_LIBRARY ON} +{$WARN UNIT_PLATFORM ON} +{$WARN UNIT_DEPRECATED ON} +{$WARN HRESULT_COMPAT ON} +{$WARN HIDING_MEMBER ON} +{$WARN HIDDEN_VIRTUAL ON} +{$WARN GARBAGE ON} +{$WARN BOUNDS_ERROR ON} +{$WARN ZERO_NIL_COMPAT ON} +{$WARN STRING_CONST_TRUNCED ON} +{$WARN FOR_LOOP_VAR_VARPAR ON} +{$WARN TYPED_CONST_VARPAR ON} +{$WARN ASG_TO_TYPED_CONST ON} +{$WARN CASE_LABEL_RANGE ON} +{$WARN FOR_VARIABLE ON} +{$WARN CONSTRUCTING_ABSTRACT ON} +{$WARN COMPARISON_FALSE ON} +{$WARN COMPARISON_TRUE ON} +{$WARN COMPARING_SIGNED_UNSIGNED ON} +{$WARN COMBINING_SIGNED_UNSIGNED ON} +{$WARN UNSUPPORTED_CONSTRUCT ON} +{$WARN FILE_OPEN ON} +{$WARN FILE_OPEN_UNITSRC ON} +{$WARN BAD_GLOBAL_SYMBOL ON} +{$WARN DUPLICATE_CTOR_DTOR ON} +{$WARN INVALID_DIRECTIVE ON} +{$WARN PACKAGE_NO_LINK ON} +{$WARN PACKAGED_THREADVAR ON} +{$WARN IMPLICIT_IMPORT ON} +{$WARN HPPEMIT_IGNORED ON} +{$WARN NO_RETVAL ON} +{$WARN USE_BEFORE_DEF ON} +{$WARN FOR_LOOP_VAR_UNDEF ON} +{$WARN UNIT_NAME_MISMATCH ON} +{$WARN NO_CFG_FILE_FOUND ON} +{$WARN MESSAGE_DIRECTIVE ON} +{$WARN IMPLICIT_VARIANTS ON} +{$WARN UNICODE_TO_LOCALE ON} +{$WARN LOCALE_TO_UNICODE ON} +{$WARN IMAGEBASE_MULTIPLE ON} +{$WARN SUSPICIOUS_TYPECAST ON} +{$WARN PRIVATE_PROPACCESSOR ON} +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CODE OFF} +{$WARN UNSAFE_CAST OFF} +{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} +{$MINSTACKSIZE $00004000} +{$MAXSTACKSIZE $00100000} +{$IMAGEBASE $00400000} +{$APPTYPE GUI} +{$WARN SYMBOL_DEPRECATED ON} +{$WARN SYMBOL_LIBRARY ON} +{$WARN SYMBOL_PLATFORM ON} +{$WARN UNIT_LIBRARY ON} +{$WARN UNIT_PLATFORM ON} +{$WARN UNIT_DEPRECATED ON} +{$WARN HRESULT_COMPAT ON} +{$WARN HIDING_MEMBER ON} +{$WARN HIDDEN_VIRTUAL ON} +{$WARN GARBAGE ON} +{$WARN BOUNDS_ERROR ON} +{$WARN ZERO_NIL_COMPAT ON} +{$WARN STRING_CONST_TRUNCED ON} +{$WARN FOR_LOOP_VAR_VARPAR ON} +{$WARN TYPED_CONST_VARPAR ON} +{$WARN ASG_TO_TYPED_CONST ON} +{$WARN CASE_LABEL_RANGE ON} +{$WARN FOR_VARIABLE ON} +{$WARN CONSTRUCTING_ABSTRACT ON} +{$WARN COMPARISON_FALSE ON} +{$WARN COMPARISON_TRUE ON} +{$WARN COMPARING_SIGNED_UNSIGNED ON} +{$WARN COMBINING_SIGNED_UNSIGNED ON} +{$WARN UNSUPPORTED_CONSTRUCT ON} +{$WARN FILE_OPEN ON} +{$WARN FILE_OPEN_UNITSRC ON} +{$WARN BAD_GLOBAL_SYMBOL ON} +{$WARN DUPLICATE_CTOR_DTOR ON} +{$WARN INVALID_DIRECTIVE ON} +{$WARN PACKAGE_NO_LINK ON} +{$WARN PACKAGED_THREADVAR ON} +{$WARN IMPLICIT_IMPORT ON} +{$WARN HPPEMIT_IGNORED ON} +{$WARN NO_RETVAL ON} +{$WARN USE_BEFORE_DEF ON} +{$WARN FOR_LOOP_VAR_UNDEF ON} +{$WARN UNIT_NAME_MISMATCH ON} +{$WARN NO_CFG_FILE_FOUND ON} +{$WARN MESSAGE_DIRECTIVE ON} +{$WARN IMPLICIT_VARIANTS ON} +{$WARN UNICODE_TO_LOCALE ON} +{$WARN LOCALE_TO_UNICODE ON} +{$WARN IMAGEBASE_MULTIPLE ON} +{$WARN SUSPICIOUS_TYPECAST ON} +{$WARN PRIVATE_PROPACCESSOR ON} +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CODE OFF} +{$WARN UNSAFE_CAST OFF} +{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} +{$MINSTACKSIZE $00004000} +{$MAXSTACKSIZE $00100000} +{$IMAGEBASE $00400000} +{$APPTYPE GUI} +{$WARN SYMBOL_DEPRECATED ON} +{$WARN SYMBOL_LIBRARY ON} +{$WARN SYMBOL_PLATFORM ON} +{$WARN UNIT_LIBRARY ON} +{$WARN UNIT_PLATFORM ON} +{$WARN UNIT_DEPRECATED ON} +{$WARN HRESULT_COMPAT ON} +{$WARN HIDING_MEMBER ON} +{$WARN HIDDEN_VIRTUAL ON} +{$WARN GARBAGE ON} +{$WARN BOUNDS_ERROR ON} +{$WARN ZERO_NIL_COMPAT ON} +{$WARN STRING_CONST_TRUNCED ON} +{$WARN FOR_LOOP_VAR_VARPAR ON} +{$WARN TYPED_CONST_VARPAR ON} +{$WARN ASG_TO_TYPED_CONST ON} +{$WARN CASE_LABEL_RANGE ON} +{$WARN FOR_VARIABLE ON} +{$WARN CONSTRUCTING_ABSTRACT ON} +{$WARN COMPARISON_FALSE ON} +{$WARN COMPARISON_TRUE ON} +{$WARN COMPARING_SIGNED_UNSIGNED ON} +{$WARN COMBINING_SIGNED_UNSIGNED ON} +{$WARN UNSUPPORTED_CONSTRUCT ON} +{$WARN FILE_OPEN ON} +{$WARN FILE_OPEN_UNITSRC ON} +{$WARN BAD_GLOBAL_SYMBOL ON} +{$WARN DUPLICATE_CTOR_DTOR ON} +{$WARN INVALID_DIRECTIVE ON} +{$WARN PACKAGE_NO_LINK ON} +{$WARN PACKAGED_THREADVAR ON} +{$WARN IMPLICIT_IMPORT ON} +{$WARN HPPEMIT_IGNORED ON} +{$WARN NO_RETVAL ON} +{$WARN USE_BEFORE_DEF ON} +{$WARN FOR_LOOP_VAR_UNDEF ON} +{$WARN UNIT_NAME_MISMATCH ON} +{$WARN NO_CFG_FILE_FOUND ON} +{$WARN MESSAGE_DIRECTIVE ON} +{$WARN IMPLICIT_VARIANTS ON} +{$WARN UNICODE_TO_LOCALE ON} +{$WARN LOCALE_TO_UNICODE ON} +{$WARN IMAGEBASE_MULTIPLE ON} +{$WARN SUSPICIOUS_TYPECAST ON} +{$WARN PRIVATE_PROPACCESSOR ON} +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CODE OFF} +{$WARN UNSAFE_CAST OFF} +{$A8,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} +{$MINSTACKSIZE $00004000} +{$MAXSTACKSIZE $00100000} +{$IMAGEBASE $00400000} +{$APPTYPE GUI} +{$WARN SYMBOL_DEPRECATED ON} +{$WARN SYMBOL_LIBRARY ON} +{$WARN SYMBOL_PLATFORM ON} +{$WARN UNIT_LIBRARY ON} +{$WARN UNIT_PLATFORM ON} +{$WARN UNIT_DEPRECATED ON} +{$WARN HRESULT_COMPAT ON} +{$WARN HIDING_MEMBER ON} +{$WARN HIDDEN_VIRTUAL ON} +{$WARN GARBAGE ON} +{$WARN BOUNDS_ERROR ON} +{$WARN ZERO_NIL_COMPAT ON} +{$WARN STRING_CONST_TRUNCED ON} +{$WARN FOR_LOOP_VAR_VARPAR ON} +{$WARN TYPED_CONST_VARPAR ON} +{$WARN ASG_TO_TYPED_CONST ON} +{$WARN CASE_LABEL_RANGE ON} +{$WARN FOR_VARIABLE ON} +{$WARN CONSTRUCTING_ABSTRACT ON} +{$WARN COMPARISON_FALSE ON} +{$WARN COMPARISON_TRUE ON} +{$WARN COMPARING_SIGNED_UNSIGNED ON} +{$WARN COMBINING_SIGNED_UNSIGNED ON} +{$WARN UNSUPPORTED_CONSTRUCT ON} +{$WARN FILE_OPEN ON} +{$WARN FILE_OPEN_UNITSRC ON} +{$WARN BAD_GLOBAL_SYMBOL ON} +{$WARN DUPLICATE_CTOR_DTOR ON} +{$WARN INVALID_DIRECTIVE ON} +{$WARN PACKAGE_NO_LINK ON} +{$WARN PACKAGED_THREADVAR ON} +{$WARN IMPLICIT_IMPORT ON} +{$WARN HPPEMIT_IGNORED ON} +{$WARN NO_RETVAL ON} +{$WARN USE_BEFORE_DEF ON} +{$WARN FOR_LOOP_VAR_UNDEF ON} +{$WARN UNIT_NAME_MISMATCH ON} +{$WARN NO_CFG_FILE_FOUND ON} +{$WARN MESSAGE_DIRECTIVE ON} +{$WARN IMPLICIT_VARIANTS ON} +{$WARN UNICODE_TO_LOCALE ON} +{$WARN LOCALE_TO_UNICODE ON} +{$WARN IMAGEBASE_MULTIPLE ON} +{$WARN SUSPICIOUS_TYPECAST ON} +{$WARN PRIVATE_PROPACCESSOR ON} +{$WARN UNSAFE_TYPE OFF} +{$WARN UNSAFE_CODE OFF} +{$WARN UNSAFE_CAST OFF} { :: Implements a Uname-IT-style painter for the X2MenuBar. :: @@ -24,7 +236,7 @@ type private FOnChange: TNotifyEvent; protected - procedure Changed(); + procedure Changed; public property OnChange: TNotifyEvent read FOnChange write FOnChange; end; @@ -41,10 +253,10 @@ type FNormal: TColor; FSelected: TColor; - function IsDisabledStored(): Boolean; - function IsHotStored(): Boolean; - function IsNormalStored(): Boolean; - function IsSelectedStored(): Boolean; + 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); @@ -78,7 +290,7 @@ type protected procedure ColorChange(Sender: TObject); public - constructor Create(); + constructor Create; destructor Destroy; override; procedure Assign(Source: TPersistent); override; @@ -115,7 +327,7 @@ type procedure SetImageOffsetX(const Value: Integer); procedure SetImageOffsetY(const Value: Integer); public - constructor Create(); + constructor Create; procedure Assign(Source: TPersistent); override; published @@ -133,19 +345,26 @@ type end; + THorzAlignment = (haLeft, haCenter, haRight); + TVertAlignment = (vaTop, vaCenter, vaBottom); + + TX2MenuBarunaPainter = class(TX2CustomMenuBarPainter) private - FArrowColor: TColor; - FBlurShadow: Boolean; - FColor: TColor; - FGroupColors: TX2MenuBarunaGroupColors; - FItemColors: TX2MenuBarunaColor; - FMetrics: TX2MenuBarunaMetrics; - FShadowColor: TColor; - FShadowOffset: Integer; - FGroupGradient: Integer; - FArrowImages: TCustomImageList; - FArrowImageIndex: TImageIndex; + FArrowColor: TColor; + FBlurShadow: Boolean; + FColor: TColor; + FGroupColors: TX2MenuBarunaGroupColors; + FItemColors: TX2MenuBarunaColor; + FMetrics: TX2MenuBarunaMetrics; + FShadowColor: TColor; + FShadowOffset: Integer; + FGroupGradient: Integer; + FArrowImages: TCustomImageList; + FArrowImageIndex: TImageIndex; + FBackground: TPicture; + FBackgroundHorzAlignment: THorzAlignment; + FBackgroundVertAlignment: TVertAlignment; procedure SetBlurShadow(const Value: Boolean); procedure SetGroupColors(const Value: TX2MenuBarunaGroupColors); @@ -156,17 +375,22 @@ type procedure SetGroupGradient(const Value: Integer); procedure SetArrowImageIndex(const Value: TImageIndex); procedure SetArrowImages(const Value: TCustomImageList); + procedure SetBackground(const Value: TPicture); + procedure SetBackgroundHorzAlignment(const Value: THorzAlignment); + procedure SetBackgroundVertAlignment(const Value: TVertAlignment); protected procedure Notification(AComponent: TComponent; Operation: TOperation); override; - function HasArrowImage(): Boolean; + function HasArrowImage: Boolean; function ApplyMargins(const ABounds: TRect): TRect; override; + function UndoMargins(const ABounds: TRect): TRect; override; + function GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; override; function GetGroupHeaderHeight(AGroup: TX2MenuBarGroup): Integer; override; function GetItemHeight(AItem: TX2MenuBarItem): Integer; override; - procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect); override; + procedure DrawBackground(ACanvas: TCanvas; const ABounds: TRect; const AOffset: TPoint); 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); @@ -174,21 +398,24 @@ type procedure ColorChange(Sender: TObject); public constructor Create(AOwner: TComponent); override; - destructor Destroy(); override; + destructor Destroy; override; - procedure ResetColors(); + procedure ResetColors; published - 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; + property ArrowColor: TColor read FArrowColor write FArrowColor default clBlue; + property ArrowImageIndex: TImageIndex read FArrowImageIndex write SetArrowImageIndex default -1; + property ArrowImages: TCustomImageList read FArrowImages write SetArrowImages; + property Background: TPicture read FBackground write SetBackground; + property BackgroundHorzAlignment: THorzAlignment read FBackgroundHorzAlignment write SetBackgroundHorzAlignment default haLeft; + property BackgroundVertAlignment: TVertAlignment read FBackgroundVertAlignment write SetBackgroundVertAlignment default vaTop; + 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 GroupGradient: Integer read FGroupGradient write SetGroupGradient default 0; + 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 @@ -221,7 +448,7 @@ var begin ASource.PixelFormat := pf32bit; - refBitmap := Graphics.TBitmap.Create(); + refBitmap := Graphics.TBitmap.Create; try refBitmap.Assign(ASource); @@ -297,7 +524,7 @@ end; { TX2MenuBarunaMetrics } -constructor TX2MenuBarunaMetrics.Create(); +constructor TX2MenuBarunaMetrics.Create; begin inherited; @@ -338,7 +565,7 @@ begin if Value <> FAfterGroupHeader then begin FAfterGroupHeader := Value; - Changed(); + Changed; end; end; @@ -347,7 +574,7 @@ begin if Value <> FAfterItem then begin FAfterItem := Value; - Changed(); + Changed; end; end; @@ -356,7 +583,7 @@ begin if Value <> FAfterLastItem then begin FAfterLastItem := Value; - Changed(); + Changed; end; end; @@ -365,7 +592,7 @@ begin if Value <> FBeforeFirstItem then begin FBeforeFirstItem := Value; - Changed(); + Changed; end; end; @@ -374,7 +601,7 @@ begin if Value <> FBeforeGroupHeader then begin FBeforeGroupHeader := Value; - Changed(); + Changed; end; end; @@ -383,7 +610,7 @@ begin if Value <> FBeforeItem then begin FBeforeItem := Value; - Changed(); + Changed; end; end; @@ -392,7 +619,7 @@ begin if Value <> FGroupHeight then begin FGroupHeight := Value; - Changed(); + Changed; end; end; @@ -401,7 +628,7 @@ begin if Value <> FItemHeight then begin FItemHeight := Value; - Changed(); + Changed; end; end; @@ -410,7 +637,7 @@ begin if Value <> FMargin then begin FMargin := Value; - Changed(); + Changed; end; end; @@ -420,7 +647,7 @@ begin if Value <> FImageOffsetX then begin FImageOffsetX := Value; - Changed(); + Changed; end; end; @@ -430,7 +657,7 @@ begin if Value <> FImageOffsetY then begin FImageOffsetY := Value; - Changed(); + Changed; end; end; @@ -442,21 +669,26 @@ begin FArrowImageIndex := -1; FBlurShadow := True; - FGroupColors := TX2MenuBarunaGroupColors.Create(); - FItemColors := TX2MenuBarunaColor.Create(); - FMetrics := TX2MenuBarunaMetrics.Create(); + FGroupColors := TX2MenuBarunaGroupColors.Create; + FItemColors := TX2MenuBarunaColor.Create; + FMetrics := TX2MenuBarunaMetrics.Create; FShadowOffset := 2; + FBackground := TPicture.Create; + FBackgroundHorzAlignment := haLeft; + FBackgroundVertAlignment := vaTop; + FGroupColors.OnChange := ColorChange; FItemColors.OnChange := ColorChange; FMetrics.OnChange := ColorChange; - ResetColors(); + ResetColors; end; -destructor TX2MenuBarunaPainter.Destroy(); +destructor TX2MenuBarunaPainter.Destroy; begin SetArrowImages(nil); + FreeAndNil(FBackground); FreeAndNil(FMetrics); FreeAndNil(FItemColors); FreeAndNil(FGroupColors); @@ -465,7 +697,7 @@ begin end; -procedure TX2MenuBarunaPainter.ResetColors(); +procedure TX2MenuBarunaPainter.ResetColors; const PurpleBlue = $00BE6363; @@ -497,7 +729,7 @@ begin if Value <> FBlurShadow then begin FBlurShadow := Value; - NotifyObservers(); + NotifyObservers; end; end; @@ -508,6 +740,14 @@ begin InflateRect(Result, -Metrics.Margin, -Metrics.Margin); end; + +function TX2MenuBarunaPainter.UndoMargins(const ABounds: TRect): TRect; +begin + Result := inherited UndoMargins(ABounds); + InflateRect(Result, Metrics.Margin, Metrics.Margin); +end; + + function TX2MenuBarunaPainter.GetSpacing(AElement: TX2MenuBarSpacingElement): Integer; begin Result := inherited GetSpacing(AElement); @@ -534,12 +774,38 @@ end; procedure TX2MenuBarunaPainter.DrawBackground(ACanvas: TCanvas; - const ABounds: TRect); + const ABounds: TRect; + const AOffset: TPoint); +var + pos: TPoint; + begin ACanvas.Brush.Color := Self.Color; ACanvas.FillRect(ABounds); + + if (Background.Width > 0) and + (Background.Height > 0) then + begin + case BackgroundHorzAlignment of + haLeft: pos.X := 0; + haCenter: pos.X := (MenuBar.ClientWidth - Background.Width) div 2; + haRight: pos.X := ABounds.Right - Background.Width; + end; + + case BackgroundVertAlignment of + vaTop: pos.Y := 0; + vaCenter: pos.Y := (MenuBar.ClientHeight - Background.Height) div 2; + vaBottom: pos.Y := MenuBar.ClientHeight - Background.Height; + end; + + Dec(pos.X, AOffset.X); + Dec(pos.Y, AOffset.Y); + + ACanvas.Draw(pos.X, pos.Y, Background.Graphic); + end; end; + procedure TX2MenuBarunaPainter.DrawGroupHeader(ACanvas: TCanvas; AGroup: TX2MenuBarGroup; const ABounds: TRect; @@ -579,6 +845,7 @@ var clipRegion: HRGN; startColor: TColor; endColor: TColor; + groupOffset: TPoint; begin if not ((mdsSelected in AState) or (mdsGroupSelected in AState)) then @@ -586,14 +853,16 @@ begin { Shadow } if BlurShadow then begin - shadowBitmap := Graphics.TBitmap.Create(); + shadowBitmap := Graphics.TBitmap.Create; try shadowBitmap.PixelFormat := pf32bit; 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)); + shadowBounds := Rect(0, 0, shadowBitmap.Width, shadowBitmap.Height); + groupOffset := ABounds.TopLeft; + + DrawBackground(shadowBitmap.Canvas, shadowBounds, groupOffset); DrawShadowOutline(shadowBitmap.Canvas, Rect(0, 0, shadowBitmap.Width - (ShadowMargin * 2), shadowBitmap.Height - (ShadowMargin * 2))); @@ -690,7 +959,7 @@ var begin focusBounds := ABounds; - if HasArrowImage() then + if HasArrowImage then Dec(focusBounds.Right, ArrowImages.Width + ArrowMargin) else Dec(focusBounds.Right, ArrowWidth + ArrowMargin); @@ -727,7 +996,7 @@ var arrowPoints: array[0..2] of TPoint; begin - if HasArrowImage() then + if HasArrowImage then begin arrowX := ABounds.Right - ArrowImages.Width; arrowY := ABounds.Top + ((ABounds.Bottom - ABounds.Top - ArrowImages.Height) div 2); @@ -750,11 +1019,11 @@ end; procedure TX2MenuBarunaPainter.ColorChange(Sender: TObject); begin - NotifyObservers(); + NotifyObservers; end; -function TX2MenuBarunaPainter.HasArrowImage(): Boolean; +function TX2MenuBarunaPainter.HasArrowImage: Boolean; begin Result := Assigned(ArrowImages) and (ArrowImageIndex > -1); end; @@ -774,7 +1043,7 @@ begin if Value <> FGroupColors then begin FGroupColors.Assign(Value); - NotifyObservers(); + NotifyObservers; end; end; @@ -783,7 +1052,7 @@ begin if Value <> FItemColors then begin FItemColors.Assign(Value); - NotifyObservers(); + NotifyObservers; end; end; @@ -792,7 +1061,7 @@ begin if Value <> FMetrics then begin FMetrics.Assign(Value); - NotifyObservers(); + NotifyObservers; end; end; @@ -801,7 +1070,7 @@ begin if Value <> FShadowColor then begin FShadowColor := Value; - NotifyObservers(); + NotifyObservers; end; end; @@ -810,7 +1079,7 @@ begin if Value <> FShadowOffset then begin FShadowOffset := Value; - NotifyObservers(); + NotifyObservers; end; end; @@ -820,7 +1089,7 @@ begin if Value <> FGroupGradient then begin FGroupGradient := Value; - NotifyObservers(); + NotifyObservers; end; end; @@ -830,7 +1099,7 @@ begin if Value <> FArrowImageIndex then begin FArrowImageIndex := Value; - NotifyObservers(); + NotifyObservers; end; end; @@ -847,13 +1116,40 @@ begin if Assigned(FArrowImages) then FArrowImages.FreeNotification(Self); - NotifyObservers(); + NotifyObservers; + end; +end; + + +procedure TX2MenuBarunaPainter.SetBackground(const Value: TPicture); +begin + FBackground.Assign(Value); + NotifyObservers; +end; + + +procedure TX2MenuBarunaPainter.SetBackgroundHorzAlignment(const Value: THorzAlignment); +begin + if Value <> FBackgroundHorzAlignment then + begin + FBackgroundHorzAlignment := Value; + NotifyObservers; + end; +end; + + +procedure TX2MenuBarunaPainter.SetBackgroundVertAlignment(const Value: TVertAlignment); +begin + if Value <> FBackgroundVertAlignment then + begin + FBackgroundVertAlignment := Value; + NotifyObservers; end; end; { TX2MenuBarunaProperty } -procedure TX2MenuBarunaProperty.Changed(); +procedure TX2MenuBarunaProperty.Changed; begin if Assigned(FOnChange) then FOnChange(Self); @@ -879,22 +1175,22 @@ begin inherited; end; -function TX2MenuBarunaColor.IsDisabledStored(): Boolean; +function TX2MenuBarunaColor.IsDisabledStored: Boolean; begin Result := (FDisabled <> FDefaultDisabled); end; -function TX2MenuBarunaColor.IsHotStored(): Boolean; +function TX2MenuBarunaColor.IsHotStored: Boolean; begin Result := (FHot <> FDefaultHot); end; -function TX2MenuBarunaColor.IsNormalStored(): Boolean; +function TX2MenuBarunaColor.IsNormalStored: Boolean; begin Result := (FNormal <> FDefaultNormal); end; -function TX2MenuBarunaColor.IsSelectedStored(): Boolean; +function TX2MenuBarunaColor.IsSelectedStored: Boolean; begin Result := (FSelected <> FDefaultSelected); end; @@ -916,7 +1212,7 @@ begin if Value <> FDisabled then begin FDisabled := Value; - Changed(); + Changed; end; end; @@ -925,7 +1221,7 @@ begin if Value <> FHot then begin FHot := Value; - Changed(); + Changed; end; end; @@ -934,7 +1230,7 @@ begin if Value <> FNormal then begin FNormal := Value; - Changed(); + Changed; end; end; @@ -943,26 +1239,26 @@ begin if Value <> FSelected then begin FSelected := Value; - Changed(); + Changed; end; end; { TX2MenuBarunaGroupColors } -constructor TX2MenuBarunaGroupColors.Create(); +constructor TX2MenuBarunaGroupColors.Create; begin inherited; - FBorder := TX2MenuBarunaColor.Create(); - FFill := TX2MenuBarunaColor.Create(); - FText := TX2MenuBarunaColor.Create(); + FBorder := TX2MenuBarunaColor.Create; + FFill := TX2MenuBarunaColor.Create; + FText := TX2MenuBarunaColor.Create; FBorder.OnChange := ColorChange; FFill.OnChange := ColorChange; FText.OnChange := ColorChange; end; -destructor TX2MenuBarunaGroupColors.Destroy(); +destructor TX2MenuBarunaGroupColors.Destroy; begin FreeAndNil(FText); FreeAndNil(FFill); @@ -988,7 +1284,7 @@ end; procedure TX2MenuBarunaGroupColors.ColorChange(Sender: TObject); begin - Changed(); + Changed; end; @@ -997,7 +1293,7 @@ begin if Value <> FBorder then begin FBorder.Assign(Value); - Changed(); + Changed; end; end; @@ -1006,7 +1302,7 @@ begin if Value <> FFill then begin FFill.Assign(Value); - Changed(); + Changed; end; end; @@ -1015,7 +1311,7 @@ begin if Value <> FText then begin FText.Assign(Value); - Changed(); + Changed; end; end;