{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at http://www.mozilla.org/MPL/MPL-1.1.html Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License. The Original Code is: JvXPBar.PAS, released on 2004-01-01. The Initial Developer of the Original Code is Marc Hoffman. Portions created by Marc Hoffman are Copyright (C) 2002 APRIORI business solutions AG. Portions created by APRIORI business solutions AG are Copyright (C) 2002 APRIORI business solutions AG All Rights Reserved. Contributor(s): dejoy //dejoy 2004-4-20 --add GroupIndex,AutoCheck,Checked property in TJvXPBarItem. --add GetItemClass in TJvXPBarItems. --add GetBarItemsClass in TJvXPCustomWinXPBar. Contributor(s): dierk schmid //dierk 2004-4-23 --add property RoundedItemFrame in TJvXPCustomWinXPBar (Integer>0 is the edge radius) --add property ItemFrameColor in TJvXPBarColors //dejoy 2004-4-25 -- splitt ItemFrameColor to CheckedFrameColor , FocusedFrameColor in TJvXPBarColors. Contributors(s): matej golob //matej 2004-5-3 --add property BorderColor in TJvXPBarColors. --add property HeaderRounded --add property TopSpace You may retrieve the latest version of this file at the Project JEDI's JVCL home page, located at http://jvcl.sourceforge.net Known Issues: -----------------------------------------------------------------------------} // $Id: JvXPBar.pas 11400 2007-06-28 21:24:06Z ahuser $ // Ported to Lazarus (no too hard after all) by Sergio Samayoa - september 2007. // Still dont tested on linux. {$mode objfpc}{$H+} unit JvXPBar; interface uses ActnList, Classes, Controls, Graphics, ExtCtrls, Forms, ImgList, LCLIntf, LCLProc, LCLType, LMessages, LResources, SysUtils, JvXPCore, JvXPCoreUtils; type TJvXPBarRollDirection = (rdExpand, rdCollapse); TJvXPBarRollMode = (rmFixed, rmShrink); // rmFixed is default TJvXPBarHitTest = ( htNone, // mouse is inside non-supported rect htHeader, // mouse is inside header htRollButton // mouse is inside rollbutton ); TJvXPBarRollDelay = 1..200; TJvXPBarRollStep = 1..50; const WM_XPBARAFTERCOLLAPSE = WM_USER + 303; // Ord('J') + Ord('V') + Ord('C') + Ord('L') WM_XPBARAFTEREXPAND = WM_XPBARAFTERCOLLAPSE + 1; { color constants. } // dxColor_CheckedColorXP := TColor($00c9b4e2); // dxColor_CheckedColorXP := TColor($00d9c1bb); // dxColor_CheckedColorXP := TColor($00e8ccae); dxColor_FocusedColorXP = TColor($00D8ACB0); dxColor_CheckedColorXP = TColor($00D9C1BB); dxColor_BodyColorXP = TColor($00F7DFD6); clHotLight = TColor(COLOR_HOTLIGHT or $80000000); dxColor_FocusedFrameColorXP = clHotLight; dxColor_CheckedFrameColorXP = clHighlight; type TJvXPBarItem = class; TJvXPBarItems = class; TJvXPCustomWinXPBar = class; TJvXPBarOnCanChangeEvent = procedure(Sender: TObject; Item: TJvXPBarItem; var AllowChange: Boolean) of object; TJvXPBarOnCollapsedChangeEvent = procedure(Sender: TObject; Collapsing: Boolean) of object; TJvXPBarOnDrawItemEvent = procedure(Sender: TObject; ACanvas: TCanvas; Rect: TRect; State: TJvXPDrawState; Item: TJvXPBarItem) of object; TJvXPBarOwnerDrawEvent = procedure(Sender: TObject; ACanvas: TCanvas; var ARect: TRect) of object; TJvXPBarOnItemClickEvent = procedure(Sender: TObject; Item: TJvXPBarItem) of object; TJvXPBarItemActionLink = class(TActionLink) private FClient: TJvXPBarItem; protected procedure AssignClient(AClient: TObject); override; function IsCaptionLinked: Boolean; override; function IsCheckedLinked: Boolean; override; function IsEnabledLinked: Boolean; override; function IsHintLinked: Boolean; override; function IsImageIndexLinked: Boolean; override; function IsVisibleLinked: Boolean; override; function IsOnExecuteLinked: Boolean; override; procedure SetCaption(const Value: string); override; procedure SetHint(const Value: string); override; function DoShowHint(var HintStr: string): Boolean; virtual; function IsAutoCheckLinked: Boolean; virtual; procedure SetAutoCheck(Value: Boolean); override; procedure SetChecked(Value: Boolean); override; procedure SetEnabled(Value: Boolean); override; procedure SetImageIndex(Value: Integer); override; procedure SetVisible(Value: Boolean); override; procedure SetOnExecute(Value: TNotifyEvent); override; property Client: TJvXPBarItem read FClient write FClient; end; TJvXPBarItemActionLinkClass = class of TJvXPBarItemActionLink; TJvXPBarItemClass = class of TJvXPBarItem; { TJvXPBarItem } TJvXPBarItem = class(TCollectionItem) private FActionLink: TJvXPBarItemActionLink; FCollection: TJvXPBarItems; FCaption: TCaption; FData: Pointer; FDataObject: TObject; FEnabled: Boolean; FHint: string; FImageIndex: TImageIndex; FImageList: TCustomImageList; FName: string; FWinXPBar: TJvXPCustomWinXPBar; FTag: Integer; FVisible: Boolean; FOnClick: TNotifyEvent; FOnDblClick: TNotifyEvent; FGroupIndex: Integer; FChecked: Boolean; FAutoCheck: Boolean; function IsAutoCheckStored: Boolean; function IsCaptionStored: Boolean; function IsEnabledStored: Boolean; function IsHintStored: Boolean; function IsImageIndexStored: Boolean; function IsVisibleStored: Boolean; function IsOnClickStored: Boolean; function IsCheckedStored: Boolean; function GetImages: TCustomImageList; procedure DoActionChange(Sender: TObject); procedure SetAction(Value: TBasicAction); procedure SetCaption(Value: TCaption); procedure SetEnabled(Value: Boolean); procedure SetImageIndex(Value: TImageIndex); procedure SetImageList(Value: TCustomImageList); procedure SetName(const Value: string); procedure SetVisible(Value: Boolean); procedure SetGroupIndex(const Value: Integer); procedure SetChecked(const Value: Boolean); procedure TurnSiblingsOff; protected function GetActionLinkClass: TJvXPBarItemActionLinkClass; dynamic; function GetAction: TBasicAction; virtual; function GetDisplayName: string; override; procedure Notification(AComponent: TComponent); virtual; procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic; procedure DrawItem(AWinXPBar: TJvXPCustomWinXPBar; ACanvas: TCanvas; Rect: TRect; State: TJvXPDrawState; ShowItemFrame: Boolean); virtual; property ActionLink: TJvXPBarItemActionLink read FActionLink write FActionLink; public constructor Create(ACollection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; function GetNamePath: string; override; property Data: Pointer read FData write FData; property DataObject: TObject read FDataObject write FDataObject; property Images: TCustomImageList read GetImages; property WinXPBar: TJvXPCustomWinXPBar read FWinXPBar; published property Action: TBasicAction read GetAction write SetAction; property AutoCheck: Boolean read FAutoCheck write FAutoCheck stored IsAutoCheckStored default False; property Caption: TCaption read FCaption write SetCaption stored IsCaptionStored; property Checked: Boolean read FChecked write SetChecked stored IsCheckedStored default False; property Enabled: Boolean read FEnabled write SetEnabled stored IsEnabledStored default True; property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0; property Hint: string read FHint write FHint stored IsHintStored; property ImageIndex: TImageIndex read FImageIndex write SetImageIndex stored IsImageIndexStored default -1; property ImageList: TCustomImageList read FImageList write SetImageList; property Name: string read FName write SetName; property Tag: Integer read FTag write FTag default 0; property Visible: Boolean read FVisible write SetVisible stored IsVisibleStored default True; property OnClick: TNotifyEvent read FOnClick write FOnClick stored IsOnClickStored; property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick; end; TJvXPBarItemsClass = class of TJvXPBarItems; TJvXPBarItems = class(TCollection) private FWinXPBar: TJvXPCustomWinXPBar; function GetItem(Index: Integer): TJvXPBarItem; procedure SetItem(Index: Integer; Value: TJvXPBarItem); protected procedure Update(Item: TCollectionItem); override; function GetOwner: TPersistent; override; class function GetItemClass: TJvXPBarItemClass; virtual; public constructor Create(WinXPBar: TJvXPCustomWinXPBar); function Add: TJvXPBarItem; overload; function Add(Action: TBasicAction): TJvXPBarItem; overload; function Add(DataObject: TObject): TJvXPBarItem; overload; function Insert(Index: Integer): TJvXPBarItem; overload; function Insert(Index: Integer; Action: TBasicAction): TJvXPBarItem; overload; function Insert(Index: Integer; DataObject: TObject): TJvXPBarItem; overload; function Find(const AName: string): TJvXPBarItem; overload; function Find(const Action: TBasicAction): TJvXPBarItem; overload; function Find(const DataObject: TObject): TJvXPBarItem; overload; property Items[Index: Integer]: TJvXPBarItem read GetItem write SetItem; default; end; TJvXPBarVisibleItems = class(TPersistent) private FItems: TList; FWinXPBar: TJvXPCustomWinXPBar; function Exists(Item: TJvXPBarItem): Boolean; function GetItem(Index: Integer): TJvXPBarItem; procedure Add(Item: TJvXPBarItem); procedure Delete(Item: TJvXPBarItem); public constructor Create(WinXPBar: TJvXPCustomWinXPBar); destructor Destroy; override; function Count: Integer; property Items[Index: Integer]: TJvXPBarItem read GetItem; default; end; TJvXPFadeThread = class(TThread) private FWinXPBar: TJvXPCustomWinXPBar; FRollDirection: TJvXPBarRollDirection; FWinXPBarNewOffSet: Integer; protected procedure DoWinXPBarSetRollOffset; procedure DoWinXPBarInternalRedraw; public constructor Create(WinXPBar: TJvXPCustomWinXPBar; RollDirection: TJvXPBarRollDirection); procedure Execute; override; end; TJvXPBarColors = class(TPersistent) private FCheckedFrameColor: TColor; FFocusedFrameColor: TColor; FCheckedColor: TColor; FFocusedColor: TColor; FBodyColor: TColor; FBodyBorderColor: TColor; FGradientTo: TColor; FGradientFrom: TColor; FSeparatorColor: TColor; FBorderColor: TColor; FOnChange: TNotifyEvent; procedure SetBorderColor(const Value: TColor); procedure SetBodyColor(const Value: TColor); procedure SetGradientFrom(const Value: TColor); procedure SetGradientTo(const Value: TColor); procedure SetSeparatorColor(const Value: TColor); procedure SetCheckedColor(const Value: TColor); procedure SetFocusedColor(const Value: TColor); procedure SetCheckedFrameColor(const Value: TColor); procedure SetFocusedFrameColor(const Value: TColor); procedure SetBodyBorderColor(const Value: TColor); public constructor Create; procedure Assign(Source: TPersistent); override; procedure Change; published property BorderColor: TColor read FBorderColor write SetBorderColor default clWhite; property CheckedColor: TColor read FCheckedColor write SetCheckedColor default dxColor_CheckedColorXP; property FocusedColor: TColor read FFocusedColor write SetFocusedColor default dxColor_FocusedColorXP; property CheckedFrameColor: TColor read FCheckedFrameColor write SetCheckedFrameColor default dxColor_CheckedFrameColorXP; property FocusedFrameColor: TColor read FFocusedFrameColor write SetFocusedFrameColor default dxColor_FocusedFrameColorXP; property BodyColor: TColor read FBodyColor write SetBodyColor default dxColor_BodyColorXP; property BodyBorderColor: TColor read FBodyBorderColor write SetBodyBorderColor default dxColor_BodyColorXP; property GradientFrom: TColor read FGradientFrom write SetGradientFrom default clWhite; property GradientTo: TColor read FGradientTo write SetGradientTo default TColor($00F7D7C6); property SeparatorColor: TColor read FSeparatorColor write SetSeparatorColor default TColor($00F7D7C6); property OnChange: TNotifyEvent read FOnChange write FOnChange; end; TJvXPBarOptions = class(TPersistent) end; TJvXPCustomWinXPBar = class(TJvXPCustomControl) private FCollapsed: Boolean; FFadeThread: TJvXPFadeThread; FFont: TFont; FFontChanging: Boolean; FGradientWidth: Integer; FHeaderFont: TFont; FHeaderRounded: Boolean; FHitTest: TJvXPBarHitTest; FHotTrack: Boolean; FHoverIndex: Integer; FIcon: TIcon; FImageList: TCustomImageList; FItemHeight: Integer; FItems: TJvXPBarItems; FRollDelay: TJvXPBarRollDelay; FRolling: Boolean; FRollMode: TJvXPBarRollMode; FRollOffset: Integer; FRollStep: TJvXPBarRollStep; FShowLinkCursor: Boolean; FShowRollButton: Boolean; FHotTrackColor: TColor; FVisibleItems: TJvXPBarVisibleItems; FAfterCollapsedChange: TJvXPBarOnCollapsedChangeEvent; FBeforeCollapsedChange: TJvXPBarOnCollapsedChangeEvent; FOnCollapsedChange: TJvXPBarOnCollapsedChangeEvent; FOnCanChange: TJvXPBarOnCanChangeEvent; FOnDrawItem: TJvXPBarOnDrawItemEvent; FOnItemClick: TJvXPBarOnItemClickEvent; FColors: TJvXPBarColors; FRollImages: TCustomImageList; FImageChangeLink: TChangeLink; FRollChangeLink: TChangeLink; FGrouped: Boolean; FHeaderHeight: Integer; FStoredHint: string; FShowItemFrame: Boolean; FRoundedItemFrame: Integer; // DS FTopSpace: Integer; FOwnerDraw: Boolean; FOnDrawBackground: TJvXPBarOwnerDrawEvent; FOnDrawHeader: TJvXPBarOwnerDrawEvent; procedure FontChange(Sender: TObject); procedure SetCollapsed(Value: Boolean); procedure SetFont(Value: TFont); procedure SetHeaderFont(Value: TFont); procedure SetHotTrack(Value: Boolean); procedure SetHotTrackColor(Value: TColor); procedure SetIcon(Value: TIcon); procedure SetImageList(Value: TCustomImageList); procedure SetItemHeight(Value: Integer); procedure SetItems(Value: TJvXPBarItems); procedure SetRollOffset(const Value: Integer); procedure SetShowRollButton(Value: Boolean); procedure ResizeToMaxHeight; procedure SetColors(const Value: TJvXPBarColors); procedure SetRollImages(const Value: TCustomImageList); procedure SetGrouped(const Value: Boolean); procedure GroupMessage; procedure SetHeaderHeight(const Value: Integer); function GetRollHeight: Integer; function GetRollWidth: Integer; procedure SetHeaderRounded(const Value: Boolean); procedure SetTopSpace(const Value: Integer); procedure SetOwnerDraw(const Value: Boolean); protected procedure CMDialogChar(var Msg: TCMDialogChar); message CM_DIALOGCHAR; class function GetBarItemsClass: TJvXPBarItemsClass; virtual; function GetHitTestRect(const AHitTest: TJvXPBarHitTest): TRect; function GetItemRect(Index: Integer): TRect; virtual; procedure ItemVisibilityChanged(Item: TJvXPBarItem); dynamic; procedure Notification(AComponent: TComponent; Operation: TOperation); override; procedure HookMouseDown; override; procedure HookMouseEnter; override; procedure HookMouseLeave; override; procedure HookMouseMove(X: Integer = 0; Y: Integer = 0); override; procedure HookParentFontChanged; override; procedure HookResized; override; procedure SortVisibleItems(const Redraw: Boolean); procedure DoColorsChange(Sender: TObject); procedure DoDrawItem(const Index: Integer; State: TJvXPDrawState); virtual; procedure Paint; override; procedure EndUpdate; override; procedure WMAfterXPBarCollapse(var Msg: TLMessage); message WM_XPBARAFTERCOLLAPSE; procedure WMAfterXPBarExpand(var Msg: TLMessage); message WM_XPBARAFTEREXPAND; property Collapsed: Boolean read FCollapsed write SetCollapsed default False; property Colors: TJvXPBarColors read FColors write SetColors; property RollImages: TCustomImageList read FRollImages write SetRollImages; property Font: TFont read FFont write SetFont; property Grouped: Boolean read FGrouped write SetGrouped default False; property HeaderFont: TFont read FHeaderFont write SetHeaderFont stored; property HeaderHeight: Integer read FHeaderHeight write SetHeaderHeight default 28; property HeaderRounded: Boolean read FHeaderRounded write SetHeaderRounded default True; property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw; property HotTrack: Boolean read FHotTrack write SetHotTrack default True; property HotTrackColor: TColor read FHotTrackColor write SetHotTrackColor default $00FF7C35; property Icon: TIcon read FIcon write SetIcon; property ImageList: TCustomImageList read FImageList write SetImageList; property ItemHeight: Integer read FItemHeight write SetItemHeight default 20; property Items: TJvXPBarItems read FItems write SetItems; property RollDelay: TJvXPBarRollDelay read FRollDelay write FRollDelay default 25; property Rolling: Boolean read FRolling default False; property RollMode: TJvXPBarRollMode read FRollMode write FRollMode default rmShrink; property RollOffset: Integer read FRollOffset write SetRollOffset; property RollStep: TJvXPBarRollStep read FRollStep write FRollStep default 3; property ShowLinkCursor: Boolean read FShowLinkCursor write FShowLinkCursor default True; property ShowRollButton: Boolean read FShowRollButton write SetShowRollButton default True; property ShowItemFrame: Boolean read FShowItemFrame write FShowItemFrame; property RoundedItemFrame: Integer read FRoundedItemFrame write FRoundedItemFrame default 1; //DS property TopSpace: Integer read FTopSpace write SetTopSpace default 5; property AfterCollapsedChange: TJvXPBarOnCollapsedChangeEvent read FAfterCollapsedChange write FAfterCollapsedChange; property BeforeCollapsedChange: TJvXPBarOnCollapsedChangeEvent read FBeforeCollapsedChange write FBeforeCollapsedChange; property OnCollapsedChange: TJvXPBarOnCollapsedChangeEvent read FOnCollapsedChange write FOnCollapsedChange; property OnCanChange: TJvXPBarOnCanChangeEvent read FOnCanChange write FOnCanChange; property OnDrawItem: TJvXPBarOnDrawItemEvent read FOnDrawItem write FOnDrawItem; property OnDrawBackground: TJvXPBarOwnerDrawEvent read FOnDrawBackground write FOnDrawBackground; property OnDrawHeader: TJvXPBarOwnerDrawEvent read FOnDrawHeader write FOnDrawHeader; property OnItemClick: TJvXPBarOnItemClickEvent read FOnItemClick write FOnItemClick; procedure AdjustClientRect(var Rect: TRect); override; // show hints for individual items in the list function HintShow(var HintInfo: THintInfo): Boolean; {$IFDEF USEJVCL} override; {$ELSE} dynamic; {$ENDIF} {$IFNDEF USEJVCL} procedure CMHintShow(var Msg: TCMHintShow); message CM_HINTSHOW; {$ENDIF !USEJVCL} procedure DblClick; override; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetHitTestAt(X, Y: Integer): TJvXPBarHitTest; function GetItemAt(X, Y: Integer): Integer; procedure Click; override; property Height default 46; property VisibleItems: TJvXPBarVisibleItems read FVisibleItems; property Width default 153; procedure InitiateAction; override; end; TJvXPBar = class(TJvXPCustomWinXPBar) published property Caption; property Collapsed; property Colors; property Items; property RollImages; property Font; property Grouped; property HeaderFont; property HeaderHeight; property HeaderRounded; property HotTrack; property HotTrackColor; property OwnerDraw; property Icon; property ImageList; property ItemHeight; property RollDelay; property RollMode; property RollStep; property ShowLinkCursor; property ShowRollButton; property ShowItemFrame; property RoundedItemFrame; property TopSpace; property AfterCollapsedChange; property BeforeCollapsedChange; property OnCollapsedChange; property OnCanChange; property OnDrawItem; property OnDrawBackground; property OnDrawHeader; property OnItemClick; //property BevelInner; //property BevelOuter; //property BevelWidth; //property BiDiMode; //property Ctl3D; //property DockSite; //property ParentBiDiMode; //property ParentCtl3D; //property TabOrder; //property TabStop; //property UseDockManager default True; property Align; property Anchors; //property AutoSize; property BorderSpacing; property Constraints; property DragCursor; property DragKind; //21.09.07 - SESS //property OnCanResize; property DragMode; //property Enabled; property ParentFont; property ParentShowHint; property PopupMenu; property ShowHint; property Visible; //property OnDockDrop; //property OnDockOver; //property OnEndDock; //property OnGetSiteInfo; //property OnStartDock; //property OnUnDock; property OnClick; property OnDblClick; property OnConstrainedResize; property OnContextPopup; property OnDragDrop; property OnDragOver; property OnEndDrag; property OnEnter; property OnExit; property OnKeyDown; property OnKeyPress; property OnKeyUp; property OnMouseDown; property OnMouseEnter; property OnMouseLeave; property OnMouseMove; property OnMouseUp; property OnStartDrag; end; procedure RoundedFrame(Canvas: TCanvas; ARect: TRect; AColor: TColor; R: Integer); implementation uses Menus; resourcestring RsUntitled = 'untitled'; RsUntitledFmt = '(%s %d)'; RsHintShortcutFmt = '%s (%s)'; const FC_HEADER_MARGIN = 6; FC_ITEM_MARGIN = 8; function SortByIndex(Item1, Item2: Pointer): Integer; var Idx1, Idx2: Integer; begin Idx1 := TCollectionItem(Item1).Index; Idx2 := TCollectionItem(Item2).Index; if Idx1 < Idx2 then Result := -1 else if Idx1 = Idx2 then Result := 0 else Result := 1; end; //=== { TJvXPBarItemActionLink } ============================================= procedure TJvXPBarItemActionLink.AssignClient(AClient: TObject); begin Client := AClient as TJvXPBarItem; end; function TJvXPBarItemActionLink.IsAutoCheckLinked: Boolean; begin Result := (Client.AutoCheck = (Action as TCustomAction).AutoCheck); end; function TJvXPBarItemActionLink.IsCaptionLinked: Boolean; begin Result := inherited IsCaptionLinked and (Client.Caption = (Action as TCustomAction).Caption); end; function TJvXPBarItemActionLink.IsCheckedLinked: Boolean; begin Result := inherited IsCheckedLinked and (Client.Checked = (Action as TCustomAction).Checked); end; function TJvXPBarItemActionLink.IsEnabledLinked: Boolean; begin Result := inherited IsEnabledLinked and (Client.Enabled = (Action as TCustomAction).Enabled); end; function TJvXPBarItemActionLink.IsHintLinked: Boolean; begin Result := inherited IsHintLinked and (Client.Hint = (Action as TCustomAction).Hint); end; function TJvXPBarItemActionLink.IsImageIndexLinked: Boolean; begin Result := inherited IsImageIndexLinked and (Client.ImageIndex = (Action as TCustomAction).ImageIndex); end; function TJvXPBarItemActionLink.IsVisibleLinked: Boolean; begin Result := inherited IsVisibleLinked and (Client.Visible = (Action as TCustomAction).Visible); end; function TJvXPBarItemActionLink.IsOnExecuteLinked: Boolean; begin Result := inherited IsOnExecuteLinked and JvXPMethodsEqual(TMethod(Client.OnClick), TMethod(Action.OnExecute)); end; procedure TJvXPBarItemActionLink.SetAutoCheck(Value: Boolean); begin if IsAutoCheckLinked then Client.AutoCheck := Value; end; procedure TJvXPBarItemActionLink.SetCaption(const Value: string); begin if IsCaptionLinked then Client.Caption := Value; end; procedure TJvXPBarItemActionLink.SetEnabled(Value: Boolean); begin if IsEnabledLinked then Client.Enabled := Value; end; procedure TJvXPBarItemActionLink.SetChecked(Value: Boolean); begin if IsCheckedLinked then Client.Checked := Value; end; procedure TJvXPBarItemActionLink.SetHint(const Value: string); begin if IsHintLinked then Client.Hint := Value; end; procedure TJvXPBarItemActionLink.SetImageIndex(Value: Integer); begin if IsImageIndexLinked then Client.ImageIndex := Value; end; procedure TJvXPBarItemActionLink.SetVisible(Value: Boolean); begin if IsVisibleLinked then Client.Visible := Value; end; procedure TJvXPBarItemActionLink.SetOnExecute(Value: TNotifyEvent); begin if IsOnExecuteLinked then Client.OnClick := Value; end; //===TJvXPBarItem ============================================================ constructor TJvXPBarItem.Create(ACollection: TCollection); begin inherited Create(ACollection); FCollection := TJvXPBarItems(ACollection); FCaption := ''; FData := nil; FDataObject := nil; FEnabled := True; FImageIndex := -1; FImageList := nil; FHint := ''; FName := ''; FWinXPBar := FCollection.FWinXPBar; FTag := 0; FVisible := True; FAutoCheck := False; FChecked := False; FGroupIndex := 0; FWinXPBar.ItemVisibilityChanged(Self); FWinXPBar.ResizeToMaxHeight; end; destructor TJvXPBarItem.Destroy; begin FVisible := False; // required to remove from visible list! FWinXPBar.ItemVisibilityChanged(Self); FActionLink.Free; FActionLink := nil; inherited Destroy; FWinXPBar.ResizeToMaxHeight; end; procedure TJvXPBarItem.Notification(AComponent: TComponent); begin if AComponent = Action then Action := nil; if AComponent = FImageList then FImageList := nil; end; function TJvXPBarItem.GetDisplayName: string; begin Result := FCaption; if Result = '' then Result := RsUntitled; if FName <> '' then Result := Result + ' [' + FName + ']'; if not FVisible then Result := Result + '*'; end; function TJvXPBarItem.GetImages: TCustomImageList; begin Result := FImageList; if (Result = nil) and Assigned(Action) then Result := TAction(Action).ActionList.Images; if Result = nil then Result := FWinXPBar.FImageList; end; procedure TJvXPBarItem.ActionChange(Sender: TObject; CheckDefaults: Boolean); begin if Sender is TCustomAction then with TCustomAction(Sender) do begin if not (csLoading in ComponentState) then Update; if not CheckDefaults or not Self.AutoCheck then Self.AutoCheck := AutoCheck; if not CheckDefaults or (Self.Caption = '') or (Self.Caption = Self.Name) then Self.Caption := Caption; if not CheckDefaults or not Self.Checked then Self.Checked := Checked; if not CheckDefaults or Self.Enabled then Self.Enabled := Enabled; if not CheckDefaults or (Self.Hint = '') then Self.Hint := Hint; if not CheckDefaults or (Self.ImageIndex = -1) then Self.ImageIndex := ImageIndex; if not CheckDefaults or Self.Visible then Self.Visible := Visible; if not CheckDefaults or not Assigned(Self.OnClick) then Self.OnClick := OnExecute; end; end; procedure TJvXPBarItem.DrawItem(AWinXPBar: TJvXPCustomWinXPBar; ACanvas: TCanvas; Rect: TRect; State: TJvXPDrawState; ShowItemFrame: Boolean); var ItemCaption: TCaption; WorkImages: TCustomImageList; LBar: TJvXPCustomWinXPBar; begin LBar := (AWinXPBar as TJvXPCustomWinXPBar); with ACanvas do begin Font.Assign(LBar.Font); Brush.Color := LBar.Colors.BodyColor; if not ShowItemFrame then FillRect(Rect); if not Self.Enabled then Font.Color := clGray else begin if dsFocused in State then begin if LBar.HotTrack then begin if LBar.FHotTrackColor <> clNone then Font.Color := LBar.FHotTrackColor; Font.Style := Font.Style + [fsUnderline]; end; if ShowItemFrame then begin Brush.Color := LBar.Colors.FocusedColor; if LBar.RoundedItemFrame > 0 then RoundedFrame(ACanvas, Rect, LBar.Colors.FocusedFrameColor, LBar.RoundedItemFrame) else begin FillRect(Rect); JvXPFrame3D(ACanvas, Rect, LBar.Colors.FocusedFrameColor, LBar.Colors.FocusedFrameColor); end; end; end else if dsClicked in State then begin if ShowItemFrame then begin Brush.Color := LBar.Colors.CheckedColor; if LBar.RoundedItemFrame > 0 then RoundedFrame(ACanvas, Rect, LBar.Colors.CheckedFrameColor, LBar.RoundedItemFrame) else begin FillRect(Rect); JvXPFrame3D(ACanvas, Rect, LBar.Colors.CheckedFrameColor, LBar.Colors.CheckedFrameColor); end; end; end else FillRect(Rect); end; WorkImages := Self.Images; if WorkImages <> nil then begin if (Self.ImageIndex <> -1) then WorkImages.Draw(ACanvas, Rect.Left + 1, Rect.Top + (LBar.FItemHeight - WorkImages.Height) div 2, Self.ImageIndex); Inc(Rect.Left, Self.Images.Width + 4); end else Inc(Rect.Left, 4); ItemCaption := Self.Caption; if (ItemCaption = '') and ((csDesigning in LBar.ComponentState) or (LBar.ControlCount = 0)) then ItemCaption := Format(RsUntitledFmt, [RsUntitled, Index]); SetBkMode(ACanvas.Handle, TRANSPARENT); //{$IFDEF USEJVCL} //DrawText(ACanvas, ItemCaption, -1, Rect, // DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS); //{$ELSE} DrawText(ACanvas.Handle, PAnsiChar(ItemCaption), Length(ItemCaption), Rect, DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS); end; end; function TJvXPBarItem.GetActionLinkClass: TJvXPBarItemActionLinkClass; begin Result := TJvXPBarItemActionLink; end; procedure TJvXPBarItem.Assign(Source: TPersistent); begin if Source is TJvXPBarItem then with TJvXPBarItem(Source) do begin Self.Action := Action; Self.Caption := Caption; Self.Data := Data; Self.DataObject := DataObject; Self.Enabled := Enabled; Self.Hint := Hint; Self.ImageList := ImageList; Self.ImageIndex := ImageIndex; Self.Name := Name; Self.Tag := Tag; Self.Visible := Visible; Self.OnClick := OnClick; Self.AutoCheck := AutoCheck; Self.Checked := Checked; Self.GroupIndex := GroupIndex; Self.OnDblClick := OnDblClick; end else inherited Assign(Source); end; function TJvXPBarItem.GetNamePath: string; begin if FName <> '' then Result := FWinXPBar.GetNamePath + '.' + FName else Result := inherited GetNamePath; end; function TJvXPBarItem.IsAutoCheckStored: Boolean; begin Result := (ActionLink = nil) or not FActionLink.IsAutoCheckLinked; end; function TJvXPBarItem.IsCaptionStored: Boolean; begin Result := (ActionLink = nil) or not FActionLink.IsCaptionLinked; end; function TJvXPBarItem.IsEnabledStored: Boolean; begin Result := (ActionLink = nil) or not FActionLink.IsEnabledLinked; end; function TJvXPBarItem.IsHintStored: Boolean; begin Result := (ActionLink = nil) or not FActionLink.IsHintLinked; end; function TJvXPBarItem.IsImageIndexStored: Boolean; begin Result := (ActionLink = nil) or not FActionLink.IsImageIndexLinked; end; function TJvXPBarItem.IsVisibleStored: Boolean; begin Result := (ActionLink = nil) or not FActionLink.IsVisibleLinked; end; function TJvXPBarItem.IsOnClickStored: Boolean; begin Result := (ActionLink = nil) or not FActionLink.IsOnExecuteLinked; end; function TJvXPBarItem.IsCheckedStored: Boolean; begin Result := (ActionLink = nil) or not FActionLink.IsCheckedLinked; end; procedure TJvXPBarItem.DoActionChange(Sender: TObject); begin if Sender = Action then ActionChange(Sender, False); end; function TJvXPBarItem.GetAction: TBasicAction; begin if FActionLink <> nil then Result := FActionLink.Action else Result := nil; end; procedure TJvXPBarItem.SetAction(Value: TBasicAction); begin if Value = nil then begin FActionLink.Free; FActionLink := nil; FWinXPBar.InternalRedraw; // redraw image end else begin if FActionLink = nil then FActionLink := GetActionLinkClass.Create(Self); FActionLink.Action := Value; FActionLink.OnChange := @DoActionChange; ActionChange(Value, csLoading in Value.ComponentState); Value.FreeNotification(FWinXPBar); // deligates notification to WinXPBar! end; end; procedure TJvXPBarItem.SetCaption(Value: TCaption); begin if Value <> FCaption then begin FCaption := Value; FWinXPBar.InternalRedraw; end; end; procedure TJvXPBarItem.SetEnabled(Value: Boolean); begin if Value <> FEnabled then begin FEnabled := Value; FWinXPBar.InternalRedraw; end; end; procedure TJvXPBarItem.SetImageIndex(Value: TImageIndex); begin if Value <> FImageIndex then begin FImageIndex := Value; FWinXPBar.InternalRedraw; end; end; procedure TJvXPBarItem.SetImageList(Value: TCustomImageList); begin if Value <> FImageList then begin FImageList := Value; FWinXPBar.InternalRedraw; end; end; procedure TJvXPBarItem.SetName(const Value: string); begin if (Value <> FName) and (FCollection.Find(Value) = nil) then FName := Value; end; procedure TJvXPBarItem.SetVisible(Value: Boolean); begin if Value <> FVisible then begin FVisible := Value; FWinXPBar.ItemVisibilityChanged(Self); FWinXPBar.ResizeToMaxHeight; end; end; procedure TJvXPBarItem.SetGroupIndex(const Value: Integer); begin if FGroupIndex <> Value then begin FGroupIndex := Value; if Checked then TurnSiblingsOff; end; end; procedure TJvXPBarItem.SetChecked(const Value: Boolean); begin if FChecked <> Value then begin FChecked := Value; // Change(False); if Value then TurnSiblingsOff; end; end; procedure TJvXPBarItem.TurnSiblingsOff; var I: Integer; Item: TJvXPBarItem; begin if (GroupIndex <> 0) and Assigned(FWinXPBar) then begin for I := 0 to FWinXPBar.Items.Count - 1 do begin Item := FWinXPBar.Items[I]; if (Item <> Self) and (Item.GroupIndex = GroupIndex) then Item.Checked := False; end; end; end; //=== { TJvXPBarItems } ====================================================== constructor TJvXPBarItems.Create(WinXPBar: TJvXPCustomWinXPBar); begin inherited Create(GetItemClass); FWinXPBar := WinXPBar; end; function TJvXPBarItems.Add: TJvXPBarItem; begin Result := TJvXPBarItem(inherited Add); end; function TJvXPBarItems.Add(Action: TBasicAction): TJvXPBarItem; begin Result := Add; Result.Action := Action; end; function TJvXPBarItems.Add(DataObject: TObject): TJvXPBarItem; begin Result := Add; Result.DataObject := DataObject; end; function TJvXPBarItems.Insert(Index: Integer): TJvXPBarItem; begin Result := TJvXPBarItem(inherited Insert(Index)); end; function TJvXPBarItems.Insert(Index: Integer; Action: TBasicAction): TJvXPBarItem; begin Result := Insert(Index); Result.Action := Action; end; function TJvXPBarItems.Insert(Index: Integer; DataObject: TObject): TJvXPBarItem; begin Result := Insert(Index); Result.DataObject := DataObject; end; function TJvXPBarItems.GetOwner: TPersistent; begin Result := FWinXPBar; end; class function TJvXPBarItems.GetItemClass: TJvXPBarItemClass; begin Result := TJvXPBarItem; end; function TJvXPBarItems.GetItem(Index: Integer): TJvXPBarItem; begin Result := TJvXPBarItem(inherited GetItem(Index)); end; procedure TJvXPBarItems.SetItem(Index: Integer; Value: TJvXPBarItem); begin inherited SetItem(Index, Value); end; procedure TJvXPBarItems.Update(Item: TCollectionItem); begin FWinXPBar.SortVisibleItems(True); end; function TJvXPBarItems.Find(const AName: string): TJvXPBarItem; var I: Integer; begin Result := nil; for I := 0 to Count - 1 do if Items[I].Name = AName then begin Result := Items[I]; Break; end; end; function TJvXPBarItems.Find(const Action: TBasicAction): TJvXPBarItem; var I: Integer; begin Result := nil; for I := 0 to Count - 1 do if Items[I].Action = Action then begin Result := Items[I]; Break; end; end; function TJvXPBarItems.Find(const DataObject: TObject): TJvXPBarItem; var I: Integer; begin Result := nil; for I := 0 to Count - 1 do if Items[I].DataObject = DataObject then begin Result := Items[I]; Break; end; end; //=== { TJvXPBarVisibleItems } =============================================== constructor TJvXPBarVisibleItems.Create(WinXPBar: TJvXPCustomWinXPBar); begin inherited Create; FItems := TList.Create; FWinXPBar := WinXPBar; end; destructor TJvXPBarVisibleItems.Destroy; begin FItems.Free; inherited Destroy; end; function TJvXPBarVisibleItems.GetItem(Index: Integer): TJvXPBarItem; begin Result := nil; if Index < FItems.Count then Result := TJvXPBarItem(FItems[Index]); end; function TJvXPBarVisibleItems.Count: Integer; begin Result := FItems.Count; end; function TJvXPBarVisibleItems.Exists(Item: TJvXPBarItem): Boolean; var I: Integer; begin Result := False; for I := 0 to Count - 1 do if Items[I] = Item then begin Result := True; Break; end; end; procedure TJvXPBarVisibleItems.Add(Item: TJvXPBarItem); begin if not Exists(Item) then begin FItems.Add(Item); FWinXPBar.SortVisibleItems(False); end; end; procedure TJvXPBarVisibleItems.Delete(Item: TJvXPBarItem); begin if Exists(Item) then FItems.Delete(FItems.IndexOf(Item)); end; //=== { TJvXPFadeThread } ==================================================== constructor TJvXPFadeThread.Create(WinXPBar: TJvXPCustomWinXPBar; RollDirection: TJvXPBarRollDirection); begin inherited Create(True); FWinXPBar := WinXPBar; FRollDirection := RollDirection; FreeOnTerminate := True; Suspended := False; end; procedure TJvXPFadeThread.DoWinXPBarInternalRedraw; begin FWinXPBar.InternalRedraw; end; procedure TJvXPFadeThread.DoWinXPBarSetRollOffset; begin FWinXPBar.RollOffset := FWinXPBarNewOffSet; end; procedure TJvXPFadeThread.Execute; var NewOffset: Integer; begin while not Terminated do try FWinXPBar.FRolling := True; { calculate new roll offset } if FRollDirection = rdCollapse then NewOffset := FWinXPBar.RollOffset - FWinXPBar.FRollStep else NewOffset := FWinXPBar.RollOffset + FWinXPBar.FRollStep; { validate offset ranges } if NewOffset < 0 then NewOffset := 0; if NewOffset > FWinXPBar.FItemHeight then NewOffset := FWinXPBar.FItemHeight; FWinXPBarNewOffSet := NewOffset; Synchronize(@DoWinXPBarSetRollOffset); { terminate on 'out-of-range' } if ((FRollDirection = rdCollapse) and (NewOffset = 0)) or ((FRollDirection = rdExpand) and (NewOffset = FWinXPBar.FItemHeight)) then Terminate; { idle process } Sleep(FWinXPBar.FRollDelay); finally FWinXPBar.FRolling := False; end; { redraw button state } FWinXPBar.FCollapsed := FRollDirection = rdCollapse; if FWinXPBar.FShowRollButton then Synchronize(@DoWinXPBarInternalRedraw); { update inspector } if csDesigning in FWinXPBar.ComponentState then TCustomForm(FWinXPBar.Owner).Designer.Modified else PostMessage(FWinXPBar.Handle, WM_XPBARAFTERCOLLAPSE, Ord(FRollDirection = rdCollapse), 0); end; //=== { TJvXPBarColors } ===================================================== constructor TJvXPBarColors.Create; begin inherited Create; // (rom) needs local color constants FBodyColor := dxColor_BodyColorXP; FBodyBorderColor := dxColor_BodyColorXP; FBorderColor := clWhite; FGradientFrom := clWhite; FGradientTo := TColor($00F7D7C6); FSeparatorColor := TColor($00F7D7C6); FCheckedColor := dxColor_CheckedColorXP; FFocusedColor := dxColor_FocusedColorXP; FCheckedFrameColor := dxColor_CheckedFrameColorXP; FFocusedFrameColor := dxColor_FocusedFrameColorXP; end; procedure TJvXPBarColors.Assign(Source: TPersistent); begin if Source is TJvXPBarColors then with TJvXPBarColors(Source) do begin Self.CheckedColor := CheckedColor; Self.FocusedColor := FocusedColor; Self.CheckedFrameColor := CheckedFrameColor; Self.FocusedFrameColor := FocusedFrameColor; Self.BodyColor := BodyColor; Self.GradientTo := GradientTo; Self.GradientFrom := GradientFrom; Self.SeparatorColor := SeparatorColor; end else inherited Assign(Source); end; procedure TJvXPBarColors.Change; begin if Assigned(FOnChange) then FOnChange(Self); end; procedure TJvXPBarColors.SetBodyColor(const Value: TColor); begin if FBodyColor <> Value then begin FBodyColor := Value; Change; end; end; procedure TJvXPBarColors.SetGradientFrom(const Value: TColor); begin if FGradientFrom <> Value then begin FGradientFrom := Value; Change; end; end; procedure TJvXPBarColors.SetGradientTo(const Value: TColor); begin if FGradientTo <> Value then begin FGradientTo := Value; Change; end; end; procedure TJvXPBarColors.SetSeparatorColor(const Value: TColor); begin if FSeparatorColor <> Value then begin FSeparatorColor := Value; Change; end; end; procedure TJvXPBarColors.SetCheckedColor(const Value: TColor); begin if FCheckedColor <> Value then begin FCheckedColor := Value; Change; end; end; procedure TJvXPBarColors.SetBorderColor(const Value: TColor); begin if FBorderColor <> Value then begin FBorderColor := Value; Change; end; end; procedure TJvXPBarColors.SetFocusedColor(const Value: TColor); begin if FFocusedColor <> Value then begin FFocusedColor := Value; Change; end; end; procedure TJvXPBarColors.SetCheckedFrameColor(const Value: TColor); begin if FCheckedFrameColor <> Value then begin FCheckedFrameColor := Value; Change; end; end; procedure TJvXPBarColors.SetFocusedFrameColor(const Value: TColor); begin if FFocusedFrameColor <> Value then begin FFocusedFrameColor := Value; Change; end; end; procedure TJvXPBarColors.SetBodyBorderColor(const Value: TColor); begin if FBodyBorderColor <> Value then begin FBodyBorderColor := Value; Change; end; end; //=== { TJvXPCustomWinXPBar } ================================================ constructor TJvXPCustomWinXPBar.Create(AOwner: TComponent); const MouseEvents: TJvXPControlStyle = [csRedrawMouseEnter, csRedrawMouseLeave]; begin inherited Create(AOwner); FStoredHint := '|'; // no one in their right mind uses a pipe as the only character in a hint... ControlStyle := ControlStyle {- [csDoubleClicks]} + [csAcceptsControls, csActionClient]; ExControlStyle := [csRedrawCaptionChanged]; ExControlStyle := ExControlStyle + MouseEvents; Height := 46; HotTrack := True; // initialize mouse events Width := 153; FColors := TJvXPBarColors.Create; FColors.OnChange := @DoColorsChange; FCollapsed := False; FFadeThread := nil; FImageChangeLink := TChangeLink.Create; FImageChangeLink.OnChange := @DoColorsChange; FRollChangeLink := TChangeLink.Create; FRollChangeLink.OnChange := @DoColorsChange; FTopSpace := 5; FFont := TFont.Create; FFont.Color := $00840000; FFont.Size := 8; FFont.OnChange := @FontChange; FHeaderHeight := 28; FHeaderRounded := True; FGradientWidth := 0; FHeaderFont := TFont.Create; FHeaderFont.Color := $00840000; FHeaderFont.Size := 8; FHeaderFont.Style := [fsBold]; FHeaderFont.OnChange := @FontChange; FHitTest := htNone; FHotTrackColor := $00FF7C35; FHoverIndex := -1; FIcon := TIcon.Create; FItemHeight := 20; FItems := GetBarItemsClass.Create(Self); FRollDelay := 25; FRolling := False; FRollMode := rmShrink; FRollOffset := FItemHeight; FRollStep := 3; FShowLinkCursor := True; FShowRollButton := True; FVisibleItems := TJvXPBarVisibleItems.Create(Self); end; destructor TJvXPCustomWinXPBar.Destroy; begin FFont.Free; FHeaderFont.Free; FIcon.Free; FItems.Free; FVisibleItems.Free; FColors.Free; FImageChangeLink.Free; FRollChangeLink.Free; inherited Destroy; end; procedure TJvXPCustomWinXPBar.Notification(AComponent: TComponent; Operation: TOperation); var I: Integer; begin if not (csDestroying in ComponentState) and (Operation = opRemove) then begin if AComponent = FImageList then ImageList := nil; if AComponent = FRollImages then RollImages := nil; for I := 0 to FItems.Count - 1 do FItems[I].Notification(AComponent); end; inherited Notification(AComponent, Operation); end; procedure TJvXPCustomWinXPBar.FontChange(Sender: TObject); begin if (not FFontChanging) and not (csLoading in ComponentState) then ParentFont := False; InternalRedraw; end; procedure TJvXPCustomWinXPBar.ResizeToMaxHeight; var NewHeight: Integer; begin { TODO: Check this!!! } if IsLocked then Exit; NewHeight := FC_HEADER_MARGIN + HeaderHeight + FVisibleItems.Count * FRollOffset + FC_ITEM_MARGIN + 1; { full collapsing } if ((FRolling and not FCollapsed) or (not FRolling and FCollapsed) or (FVisibleItems.Count = 0)) then Dec(NewHeight, FC_ITEM_MARGIN); // if Height <> NewHeight then Height := NewHeight - 5 + FTopSpace; end; function TJvXPCustomWinXPBar.GetHitTestAt(X, Y: Integer): TJvXPBarHitTest; begin Result := htNone; if PtInRect(GetHitTestRect(htHeader), Point(X, Y)) then Result := htHeader; if PtInRect(GetHitTestRect(htRollButton), Point(X, Y)) then Result := htRollButton; end; function TJvXPCustomWinXPBar.GetItemRect(Index: Integer): TRect; begin Result.Left := 3; Result.Right := Width - 3; if FRollMode = rmShrink then Result.Top := FC_HEADER_MARGIN + HeaderHeight + FC_ITEM_MARGIN div 2 + Index * FRollOffset - 4 + FTopSpace else Result.Top := FC_HEADER_MARGIN + HeaderHeight + FC_ITEM_MARGIN div 2 + Index * FItemHeight - 4 + FTopSpace; Result.Bottom := Result.Top + FItemHeight; end; function TJvXPCustomWinXPBar.GetRollHeight: Integer; begin if Assigned(FRollImages) then Result := FRollImages.Height else Result := 18; end; function TJvXPCustomWinXPBar.GetRollWidth: Integer; begin if Assigned(FRollImages) then Result := FRollImages.Width else Result := 18; end; function TJvXPCustomWinXPBar.GetHitTestRect(const AHitTest: TJvXPBarHitTest): TRect; begin case AHitTest of htHeader: Result := Bounds(0, FTopSpace, Width, FHeaderHeight); htRollButton: Result := Bounds(Width - 24, FTopSpace + (FHeaderHeight - GetRollHeight) div 2, GetRollWidth, GetRollHeight); end; end; procedure TJvXPCustomWinXPBar.SortVisibleItems(const Redraw: Boolean); begin if (csLoading in ComponentState) or (csDestroying in ComponentState) then Exit; FVisibleItems.FItems.Sort(@SortByIndex); if Redraw then InternalRedraw; end; procedure TJvXPCustomWinXPBar.ItemVisibilityChanged(Item: TJvXPBarItem); begin // update visible-item list if Item.Visible then FVisibleItems.Add(Item) else FVisibleItems.Delete(Item); end; procedure TJvXPCustomWinXPBar.HookMouseDown; var Rect: TRect; begin inherited HookMouseDown; // update drawstate if FHitTest = htRollButton then begin Rect := GetHitTestRect(htRollButton); InvalidateRect(Handle, @Rect, False); end; end; procedure TJvXPCustomWinXPBar.HookMouseEnter; begin inherited HookMouseEnter; if FHoverIndex <> -1 then DoDrawItem(FHoverIndex, [dsFocused]); end; procedure TJvXPCustomWinXPBar.HookMouseLeave; begin inherited HookMouseLeave; if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) and (not FVisibleItems[FHoverIndex].Checked) then DoDrawItem(FHoverIndex, []); end; function TJvXPCustomWinXPBar.GetItemAt(X, Y: Integer): Integer; var Header: Integer; begin Header := FC_HEADER_MARGIN div 2 + HeaderHeight + FC_ITEM_MARGIN div 2 + FTopSpace; if (Y < Header) or (Y > Height - FC_ITEM_MARGIN div 2) then Result := -1 else Result := (Y - Header) div ItemHeight; end; procedure TJvXPCustomWinXPBar.HookMouseMove(X, Y: Integer); const cPipe = '|'; var Rect: TRect; OldHitTest: TJvXPBarHitTest; NewIndex: Integer; begin OldHitTest := FHitTest; FHitTest := GetHitTestAt(X, Y); if FHitTest <> OldHitTest then begin Rect := Bounds(0, FTopSpace, Width, FHeaderHeight); // header InvalidateRect(Handle, @Rect, False); if FShowLinkCursor then if FHitTest <> htNone then Cursor := crHandPoint else Cursor := crDefault; end; NewIndex := GetItemAt(X, Y); if (NewIndex >= 0) and (NewIndex < VisibleItems.Count) then begin if FStoredHint = cPipe then FStoredHint := Hint; if Action is TCustomAction then inherited Hint := TCustomAction(Action).Hint else inherited Hint := VisibleItems[NewIndex].Hint; end else begin NewIndex := -1; if FStoredHint <> cPipe then inherited Hint := FStoredHint; FStoredHint := cPipe; end; if NewIndex <> FHoverIndex then begin if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) then if FVisibleItems[FHoverIndex].Checked then DoDrawItem(FHoverIndex, [dsClicked]) else DoDrawItem(FHoverIndex, []); FHoverIndex := NewIndex; if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) and (FVisibleItems[FHoverIndex].Enabled) then begin DoDrawItem(FHoverIndex, [dsFocused]); if FShowLinkCursor then Cursor := crHandPoint; end else if FShowLinkCursor then Cursor := crDefault; end; inherited HookMouseMove(X, Y); end; procedure TJvXPCustomWinXPBar.HookParentFontChanged; begin if ParentFont then begin FFontChanging := True; try FFont.Color := $00E75100; FFont.Name := inherited Font.Name; FFont.Size := 8; FFont.Style := inherited Font.Style; FHeaderFont.Color := $00E75100; FHeaderFont.Name := Font.Name; FHeaderFont.Size := 8; FHeaderFont.Style := [fsBold]; finally FFontChanging := False; end; inherited HookParentFontChanged; end; end; procedure TJvXPCustomWinXPBar.HookResized; begin // perform actions only on 'width'-change if FGradientWidth <> Width then FGradientWidth := Width; // resize to maximum height ResizeToMaxHeight; inherited HookResized; end; procedure TJvXPCustomWinXPBar.SetCollapsed(Value: Boolean); begin if Value <> FCollapsed then begin // Using fading while loading is useless. // Using the fading thread at design time is NOT safe. See Mantis 3547. if ComponentState * [csLoading, csDesigning] = [] then begin if Assigned(FBeforeCollapsedChange) then FBeforeCollapsedChange(Self, Value); if Value then FFadeThread := TJvXPFadeThread.Create(Self, rdCollapse) else FFadeThread := TJvXPFadeThread.Create(Self, rdExpand); if Assigned(FOnCollapsedChange) then FOnCollapsedChange(Self, Value); end else begin FCollapsed := Value; FRolling := True; if Value then RollOffset := 0 else RollOffset := FItemHeight; FRolling := False; if Grouped and not Value then GroupMessage; end; end; end; procedure TJvXPCustomWinXPBar.SetFont(Value: TFont); begin FFont.Assign(Value); InternalRedraw; end; procedure TJvXPCustomWinXPBar.SetHeaderFont(Value: TFont); begin FHeaderFont.Assign(Value); InternalRedraw; end; procedure TJvXPCustomWinXPBar.SetHotTrack(Value: Boolean); const MouseEvents: TJvXPControlStyle = [csRedrawMouseEnter, csRedrawMouseLeave]; begin if Value <> FHotTrack then begin FHotTrack := Value; // if FHotTrack then // ExControlStyle := ExControlStyle + MouseEvents // else // ExControlStyle := ExControlStyle - MouseEvents; if not (csLoading in ComponentState) then InternalRedraw; end; end; procedure TJvXPCustomWinXPBar.SetHotTrackColor(Value: TColor); begin if Value <> FHotTrackColor then begin FHotTrackColor := Value; InternalRedraw; end; end; procedure TJvXPCustomWinXPBar.SetIcon(Value: TIcon); begin if Value <> FIcon then begin FIcon.Assign(Value); InternalRedraw; end; end; procedure TJvXPCustomWinXPBar.SetImageList(Value: TCustomImageList); begin if Value <> FImageList then begin if FImageList <> nil then FImageList.UnRegisterChanges(FImageChangeLink); FImageList := Value; if FImageList <> nil then begin FImageList.FreeNotification(Self); FImageList.RegisterChanges(FImageChangeLink); end; InternalRedraw; end; end; procedure TJvXPCustomWinXPBar.SetItemHeight(Value: Integer); begin if Value <> FItemHeight then begin FItemHeight := Value; if not FCollapsed then RollOffset := FItemHeight; end; end; procedure TJvXPCustomWinXPBar.SetItems(Value: TJvXPBarItems); begin FItems.Assign(Value); end; procedure TJvXPCustomWinXPBar.SetRollOffset(const Value: Integer); begin if Value <> FRollOffset then begin FRollOffset := Value; ResizeToMaxHeight; end; end; procedure TJvXPCustomWinXPBar.SetShowRollButton(Value: Boolean); begin if Value <> FShowRollButton then begin FShowRollButton := Value; InternalRedraw; end; end; procedure TJvXPCustomWinXPBar.EndUpdate; begin inherited EndUpdate; ResizeToMaxHeight; end; procedure TJvXPCustomWinXPBar.Click; var AllowChange, CallInherited: Boolean; LItem: TJvXPBarItem; begin CallInherited := True; if FShowRollButton and (FHitTest <> htNone) then Collapsed := not Collapsed; if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) and FVisibleItems[FHoverIndex].Enabled then begin AllowChange := True; if Assigned(FOnCanChange) then FOnCanChange(Self, FVisibleItems[FHoverIndex], AllowChange); if not AllowChange then Exit; //dejoy add LItem := FVisibleItems[FHoverIndex]; with LItem do begin if (not Assigned(ActionLink) and AutoCheck) or (Assigned(ActionLink) and not ActionLink.IsAutoCheckLinked and AutoCheck) then LItem.Checked := not LItem.Checked; end; if FVisibleItems[FHoverIndex].Checked then DrawState := DrawState + [dsClicked] else DrawState := DrawState - [dsClicked]; if Assigned(FOnItemClick) then begin FOnItemClick(Self, FVisibleItems[FHoverIndex]); CallInherited := False; end; if Assigned(FVisibleItems[FHoverIndex].FOnClick) then begin { set linked 'action' as Sender } if Assigned(FVisibleItems[FHoverIndex].Action) and (@FVisibleItems[FHoverIndex].FOnClick <> @FVisibleItems[FHoverIndex].Action.OnExecute) then FVisibleItems[FHoverIndex].FOnClick(FVisibleItems[FHoverIndex]) else if not (csDesigning in ComponentState) and Assigned(FVisibleItems[FHoverIndex].ActionLink) then FVisibleItems[FHoverIndex].ActionLink.Execute(Self) else if Assigned(FVisibleItems[FHoverIndex].FOnClick) then FVisibleItems[FHoverIndex].FOnClick(FVisibleItems[FHoverIndex]); CallInherited := False; end; Collapsed := False; InternalRedraw; //dejoy end; if CallInherited then inherited Click; end; procedure TJvXPCustomWinXPBar.DoDrawItem(const Index: Integer; State: TJvXPDrawState); var ItemRect: TRect; begin with Canvas do begin ItemRect := GetItemRect(Index); if OwnerDraw then begin if Assigned(FOnDrawItem) then FOnDrawItem(Self, Canvas, ItemRect, State, FVisibleItems[Index]); end else FVisibleItems[Index].DrawItem(Self, Canvas, ItemRect, State, ShowItemFrame); end; end; procedure TJvXPCustomWinXPBar.Paint; var ARect: TRect; Bitmap: TBitmap; Index, I: Integer; OwnColor: TColor; // (rom) Do as prefix for a local function is not ideal procedure DoDrawBackground(ACanvas: TCanvas; var R: TRect); begin ACanvas.Brush.Color := FColors.BodyColor; // $00F7DFD6; Inc(R.Top, FTopSpace + FHeaderHeight); if OwnerDraw then begin if Assigned(FOnDrawBackground) then FOnDrawBackground(Self, ACanvas, R); end else begin if not FCollapsed and (FColors.FBodyColor <> FColors.FBodyBorderColor) then begin ACanvas.Pen.Color := FColors.FBodyBorderColor; ACanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom - 1); end else ACanvas.FillRect(R); end; end; procedure DoDrawHeader(ACanvas: TCanvas; var R: TRect); begin Dec(R.Top, FHeaderHeight); R.Bottom := R.Top + FHeaderHeight; if OwnerDraw then begin ACanvas.Brush.Color := FColors.FBorderColor; if Assigned(FOnDrawHeader) then FOnDrawHeader(Self, ACanvas, R); end else begin ACanvas.GradientFill(Rect(0, R.Top, Width, R.Top + FHeaderHeight), FColors.GradientFrom, FColors.GradientTo, gdHorizontal); { draw frame... } ACanvas.Brush.Color := FColors.FBorderColor; ACanvas.FrameRect(R); if FHeaderRounded then begin OwnColor := TJvXPWinControl(Parent).Brush.Color; ACanvas.Pixels[0, R.Top] := OwnColor; ACanvas.Pixels[0, R.Top + 1] := OwnColor; ACanvas.Pixels[1, R.Top] := OwnColor; ACanvas.Pixels[1, R.Top + 1] := FColors.FBorderColor; ACanvas.Pixels[Width - 1, R.Top] := OwnColor; ACanvas.Pixels[Width - 2, R.Top] := OwnColor; ACanvas.Pixels[Width - 1, R.Top + 1] := OwnColor; ACanvas.Pixels[Width - 2, R.Top + 1] := FColors.FBorderColor; end; // Paint rollover button: (expanded/collapsed state button images) if FShowRollButton and (Width >= 115) then begin Bitmap := TBitmap.Create; try if Assigned(FRollImages) then begin // format: // 0 - normal collapsed // 1 - normal expanded // 2 - hot collapsed // 3 - hot expanded // 4 - down collapsed // 5 - down expanded Index := 0; // normal if FHitTest = htRollButton then begin if dsHighlight in DrawState then Index := 2; // hot if (dsClicked in DrawState) and (dsHighlight in DrawState) then Index := 4; // down end; if not FCollapsed then Inc(Index); if Index >= FRollImages.Count then Index := Ord(not FCollapsed); FRollImages.GetBitmap(Index, Bitmap); end else begin Index := 0; if FHitTest = htRollButton then begin if dsHighlight in DrawState then Index := 1; // hot if (dsClicked in DrawState) and (dsHighlight in DrawState) then Index := 2; // down end; Bitmap.Assign(nil); // fixes GDI resource leak if FCollapsed then //Bitmap.LoadFromResourceName(HInstance, 'JvXPCustomWinXPBarEXPAND' + IntToStr(Index)) Bitmap.LoadFromLazarusResource('JvXPCustomWinXPBarEXPAND' + IntToStr(Index)) else //Bitmap.LoadFromResourceName(HInstance, 'JvXPCustomWinXPBarCOLLAPSE' + IntToStr(Index)); Bitmap.LoadFromLazarusResource('JvXPCustomWinXPBarCOLLAPSE' + IntToStr(Index)); end; // Transparency fix not needed Here! -WPostma Bitmap.Transparent := True; ACanvas.Draw(R.Right - 24, R.Top + (HeaderHeight - GetRollHeight) div 2, Bitmap); finally Bitmap.Free; end; Dec(R.Right, 25); end; Inc(R.Left, 22); ACanvas.Pen.Color := FColors.SeparatorColor; JvXPDrawLine(ACanvas, 1, ARect.Top + FHeaderHeight, Width - 1, ARect.Top + FHeaderHeight); if not FIcon.Empty then begin ACanvas.Draw(2, 0, FIcon); Inc(R.Left, 16); end; Dec(ARect.Right, 25); end; { draw seperator line } ACanvas.Pen.Color := FColors.SeparatorColor; JvXPDrawLine(ACanvas, 1, ARect.Top + FHeaderHeight, Width - 1, ARect.Top + FHeaderHeight); { draw icon } // Inc(ARect.Left, 22); if not FIcon.Empty then begin ACanvas.Draw(2, 1, FIcon); Inc(ARect.Left, 6); end else Dec(ARect.Left, 16); SetBkMode(ACanvas.Handle, TRANSPARENT); ACanvas.Font.Assign(FHeaderFont); if FHotTrack and (dsHighlight in DrawState) and (FHitTest <> htNone) and (FHotTrackColor <> clNone) then ACanvas.Font.Color := FHotTrackColor; ARect.Bottom := ARect.Top + FHeaderHeight; Dec(ARect.Right, 3); //{$IFDEF USEJVCL} //DrawText(ACanvas, Caption, -1, ARect, // DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX); //{$ELSE} DrawText(ACanvas.Handle, PChar(Caption), Length(Caption), ARect, DT_SINGLELINE or DT_LEFT or DT_VCENTER or DT_END_ELLIPSIS or DT_NOPREFIX); end; begin { get client rect } ARect := GetClientRect; DoDrawBackground(Canvas, ARect); { draw header } DoDrawHeader(Canvas, ARect); { draw visible items } Canvas.Brush.Color := FColors.BodyColor; if not FCollapsed or FRolling then for I := 0 to FVisibleItems.Count - 1 do if FVisibleItems[I].Checked then DoDrawItem(I, [dsClicked]) else DoDrawItem(I, []); end; procedure TJvXPCustomWinXPBar.WMAfterXPBarCollapse(var Msg: TLMessage); begin if Assigned(FAfterCollapsedChange) then FAfterCollapsedChange(Self, Msg.WParam <> 0); if Grouped and not FCollapsed then GroupMessage; end; procedure TJvXPCustomWinXPBar.DoColorsChange(Sender: TObject); begin Invalidate; end; procedure TJvXPCustomWinXPBar.SetColors(const Value: TJvXPBarColors); begin FColors.Assign(Value); end; procedure TJvXPCustomWinXPBar.SetRollImages(const Value: TCustomImageList); begin if FRollImages <> Value then begin if FRollImages <> nil then FRollImages.UnRegisterChanges(FRollChangeLink); FRollImages := Value; if FRollImages <> nil then begin FRollImages.FreeNotification(Self); FRollImages.RegisterChanges(FRollChangeLink); end; InternalRedraw; end; end; procedure TJvXPCustomWinXPBar.GroupMessage; var Msg: TLMessage; begin if Parent <> nil then begin Msg.Msg := WM_XPBARAFTEREXPAND; Msg.WParam := WPARAM(Self); Msg.Result := 0; Parent.Broadcast(Msg); end; end; procedure TJvXPCustomWinXPBar.WMAfterXPBarExpand(var Msg: TLMessage); begin if Grouped and (TObject(Msg.WParam) <> Self) then Collapsed := True; end; procedure TJvXPCustomWinXPBar.SetGrouped(const Value: Boolean); begin if FGrouped <> Value then begin FGrouped := Value; if FGrouped and not Collapsed then Collapsed := True; end; end; procedure TJvXPCustomWinXPBar.AdjustClientRect(var Rect: TRect); begin inherited AdjustClientRect(Rect); if ControlCount > 0 then begin Inc(Rect.Top, FHeaderHeight + 4); InflateRect(Rect, -4, -4); end; end; procedure TJvXPCustomWinXPBar.SetHeaderHeight(const Value: Integer); begin if FHeaderHeight <> Value then begin FHeaderHeight := Value; ResizeToMaxHeight; // InternalRedraw; end; end; function TJvXPCustomWinXPBar.HintShow(var HintInfo: THintInfo): Boolean; begin // draw the item hint (if available) if (FHoverIndex > -1) and (FVisibleItems[FHoverIndex] <> nil) then begin HintInfo.CursorRect := GetItemRect(FHoverIndex); with VisibleItems[FHoverIndex] do begin if Action is TCustomAction then HintInfo.HintStr := TCustomAction(Action).Hint else HintInfo.HintStr := VisibleItems[FHoverIndex].Hint; end; end else if (VisibleItems.Count > 0) and not Collapsed then HintInfo.CursorRect := GetHitTestRect(htHeader); if HintInfo.HintStr = '' then HintInfo.HintStr := Hint; Result := False; // use default hint window end; procedure TJvXPCustomWinXPBar.CMHintShow(var Msg: TCMHintShow); begin Msg.Result := Ord(HintShow(Msg.HintInfo^)); end; function TJvXPBarItemActionLink.DoShowHint(var HintStr: string): Boolean; begin Result := True; if Action is TCustomAction then begin Result := TCustomAction(Action).DoHint(HintStr); if Result and Application.HintShortCuts and (TCustomAction(Action).ShortCut <> scNone) then if HintStr <> '' then HintStr := Format(RsHintShortcutFmt, [HintStr, ShortCutToText(TCustomAction(Action).ShortCut)]); end; end; procedure TJvXPCustomWinXPBar.InitiateAction; var I: Integer; begin inherited InitiateAction; // go through each item and update // Note: Do not call ActionChange as it would trigger Mantis 3244 and it is // basically wrong as the point of InitiateAction is to call Update (see in // the inherited code). for I := 0 to Items.Count - 1 do if Assigned(Items[I].ActionLink) then Items[I].ActionLink.Update; end; procedure TJvXPCustomWinXPBar.CMDialogChar(var Msg: TCMDialogChar); var I: Integer; begin if CanFocus then begin if IsAccel(Msg.CharCode, Caption) then begin Collapsed := not Collapsed; Msg.Result := 1; end else if not Collapsed then for I := 0 to VisibleItems.Count - 1 do if IsAccel(Msg.CharCode, VisibleItems[I].Caption) and VisibleItems[I].Enabled then begin Msg.Result := 1; FHitTest := htNone; FHoverIndex := I; Click; Exit; end; end; // 21.07.2007 - SESS: Parece no estar en la clase base // inherited; end; class function TJvXPCustomWinXPBar.GetBarItemsClass: TJvXPBarItemsClass; begin Result := TJvXPBarItems; end; procedure TJvXPCustomWinXPBar.DblClick; var LItem: TJvXPBarItem; begin if (FHoverIndex <> -1) and (FVisibleItems[FHoverIndex] <> nil) and FVisibleItems[FHoverIndex].Enabled then begin LItem := FVisibleItems[FHoverIndex]; if Assigned(LItem.FOnDblClick) then LItem.FOnDblClick(LItem); end; inherited DblClick; end; procedure RoundedFrame(Canvas: TCanvas; ARect: TRect; AColor: TColor; R: Integer); begin // Draw Frame with round edges with Canvas, ARect do begin Pen.Color := AColor; Dec(Right); Dec(Bottom); Polygon( [Point(Left + R, Top), Point(Right - R, Top), Point(Right, Top + R), Point(Right, Bottom - R), Point(Right - R, Bottom), Point(Left + R, Bottom), Point(Left, Bottom - R), Point(Left, Top + R), Point(Left + R, Top)]); Inc(Right); Inc(Bottom); end; end; procedure TJvXPCustomWinXPBar.SetHeaderRounded(const Value: Boolean); begin if FHeaderRounded <> Value then begin FHeaderRounded := Value; InternalRedraw; end; end; procedure TJvXPCustomWinXPBar.SetTopSpace(const Value: Integer); begin if Value <> FTopSpace then begin FTopSpace := Value; if FTopSpace < 0 then FTopSpace := 0; ResizeToMaxHeight; InternalRedraw; end; end; procedure TJvXPCustomWinXPBar.SetOwnerDraw(const Value: Boolean); begin if FOwnerDraw <> Value then begin FOwnerDraw := Value; Invalidate; end; end; initialization {$I JvXPBar.lrs} end.