jvxpbar.pas

East make Tray Icon in delphi

    procedure Paint; override;
    procedure EndUpdate; override;
    procedure WMAfterXPBarCollapse(var Msg: TMessage); message WM_XPBARAFTERCOLLAPSE;
    procedure WMAfterXPBarExpand(var Msg: TMessage); 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 stored IsFontStored;
    property Grouped: Boolean read FGrouped write SetGrouped default False;
    property HeaderFont: TFont read FHeaderFont write SetHeaderFont stored IsFontStored;
    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;
    // (rom) this name is not acceptable. Prefix with "On"
    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;
    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 Constraints;
    {$IFDEF VCL}
    property DragCursor;
    property DragKind;
    property OnCanResize;
    {$ENDIF VCL}
    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;
    {$IFDEF COMPILER6_UP}
    property OnContextPopup;
    {$ENDIF COMPILER6_UP}
    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);

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvXPBar.pas,v $';
    Revision: '$Revision: 1.88 $';
    Date: '$Date: 2005/03/07 16:45:17 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  {$IFDEF JVCLThemesEnabled}
  UxTheme,
  {$IFNDEF COMPILER7_UP}
  TmSchema,
  {$ENDIF !COMPILER7_UP}
  JvThemes,
  {$ENDIF JVCLThemesEnabled}
  {$IFDEF USEJVCL}
  JvJCLUtils, JvResources,
  {$ENDIF USEJVCL}
  Menus;

{$IFDEF MSWINDOWS}
{$R ..\Resources\JvXPBar.res}
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
{$R ../Resources/JvXPBar.res}
{$ENDIF UNIX}

{$IFNDEF USEJVCL}
resourcestring
  RsUntitled = 'untitled';
  RsUntitledFmt = '(%s %d)';
  RsHintShortcutFmt = '%s (%s)';
{$ENDIF !USEJVCL}

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;

{$ifdef XP_TRANSPARENCY_FIX}
{ BitmapBgPaint:

  This fixes a bug in the Delphi 7 VCL on systems
  running Windows XP SP2 or Windows Server 2003,
  where transparency in the VCL TImageList.Draw
  function is broken.

  -WPostma. }

procedure BitmapBgPaint( Bitmap:TBitmap;bgColor:TColor);
var
 r:TRect;
begin
  r.Left := 0;
  r.Top := 0;
  r.Right := Bitmap.Width;
  r.Bottom := Bitmap.Height;
  Bitmap.Canvas.Brush.Color := bgColor;
  Bitmap.Canvas.FillRect( r );
end;

{$endif}



//=== { TJvXPBarItemActionLink } =============================================

procedure TJvXPBarItemActionLink.AssignClient(AClient: TObject);
begin
  Client := AClient as TJvXPBarItem;
end;

{$IFDEF VCL}
{$IFDEF COMPILER6_UP}
function TJvXPBarItemActionLink.IsAutoCheckLinked: Boolean;
begin
  Result := (Client.AutoCheck = (Action as TCustomAction).AutoCheck);
end;
{$ENDIF COMPILER6_UP}
{$ENDIF VCL}

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;

{$IFDEF VCL}
{$IFDEF COMPILER6_UP}
procedure TJvXPBarItemActionLink.SetAutoCheck(Value: Boolean);
begin
  if IsAutoCheckLinked then
    Client.AutoCheck := Value;
end;
{$ENDIF COMPILER6_UP}
{$ENDIF VCL}

{$IFDEF VCL}
procedure TJvXPBarItemActionLink.SetCaption(const Value: string);
{$ENDIF VCL}
{$IFDEF VisualCLX}
procedure TJvXPBarItemActionLink.SetCaption(const Value: TCaption);
{$ENDIF VisualCLX}
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;

{$IFDEF VCL}
procedure TJvXPBarItemActionLink.SetHint(const Value: string);
{$ENDIF VCL}
{$IFDEF VisualCLX}
procedure TJvXPBarItemActionLink.SetHint(const Value: WideString);
{$ENDIF VisualCLX}
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(Collection: TCollection);
begin
  inherited Create(Collection);
  FCollection := TJvXPBarItems(Collection);
  FCaption := '';
  FData := nil;
  FDataObject := nil;
  FEnabled := True;
  FImageIndex := -1;
  FImageList := nil;
  FHint := '';
  FName := '';
  FWinXPBar := FCollection.FWinXPBar;
  FTag := 0;
  FVisible := True;
  {$IFDEF VCL}
  FAutoCheck := False;
  {$ENDIF VCL}
  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;
var
  DisplayName, ItemName: string;
begin
  DisplayName := FCaption;
  if DisplayName = '' then
    DisplayName := RsUntitled;
  ItemName := FName;
  if ItemName <> '' then
    DisplayName := DisplayName + ' [' + ItemName + ']';
  if not FVisible then
    DisplayName := DisplayName + '*';
  Result := DisplayName;
end;

function TJvXPBarItem.GetImages: TCustomImageList;
begin
  Result := nil;
  if Assigned(FImageList) then
    Result := FImageList
  else
  if Assigned(Action) and Assigned(TAction(Action).ActionList.Images) then
    Result := TAction(Action).ActionList.Images
  else
  if Assigned(FWinXPBar.FImageList) 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