jvctrls.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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: JvCtrls.PAS, released May 13, 2000.

The Initial Developer of the Original Code is Petr Vones (petr dott v att mujmail dott cz)
Portions created by Petr Vones are Copyright (C) 2000 Petr Vones.
Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
All Rights Reserved.

Contributor(s): ______________________________________.

Current Version: 0.50

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: JvCtrls.pas,v 1.49 2005/02/17 10:20:19 marquardt Exp $

unit JvCtrls;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, Graphics, Controls, StdCtrls, ImgList,
  JvButton;

{$IFDEF VisualCLX}

const
  ODS_DISABLED = 1;
  ODS_SELECTED = 2;
  ODS_FOCUS    = 4;

type
  TDrawItemStruct = record
    itemState: Integer;
  end;

{$ENDIF VisualCLX}

type
  TJvImgBtnLayout = (blImageLeft, blImageRight);

  TJvImgBtnKind = (bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo, bkClose,
    bkAbort, bkRetry, bkIgnore, bkAll);

  TJvCustomImageButton = class;

  TJvImgBtnActionLink = class(TButtonActionLink)
  protected
    FClient: TJvCustomImageButton;
    procedure AssignClient(AClient: TObject); override;
    function IsImageIndexLinked: Boolean; override;
    procedure SetImageIndex(Value: Integer); override;
  end;

  TJvImgBtnDrawEvent = procedure(Sender: TObject; const DrawItemStruct: TDrawItemStruct) of object;
  TJvImgBtnAnimIndexEvent = procedure(Sender: TObject; CurrentAnimateFrame: Byte;
    var ImageIndex: Integer) of object;

  TJvCustomImageButton = class(TJvCustomButton)
  private
    FAlignment: TAlignment;
    FAnimate: Boolean;
    FAnimateFrames: Integer;
    FAnimateInterval: Cardinal;
    FAnimating: Boolean;
    FCanvas: TCanvas;
    FCurrentAnimateFrame: Byte;
    FImageIndex: Integer;
    FImages: TCustomImageList;
    FImageChangeLink: TChangeLink;
    FIsFocused: Boolean;
    FKind: TJvImgBtnKind;
    FLayout: TJvImgBtnLayout;
    FOwnerDraw: Boolean;
    FSpacing: Integer;
    FMargin: Integer;
    FMouseInControl: Boolean;
    FOnButtonDraw: TJvImgBtnDrawEvent;
    FOnGetAnimateIndex: TJvImgBtnAnimIndexEvent;
    FImageVisible: Boolean;
    FFlat: Boolean;
    procedure ImageListChange(Sender: TObject);
    procedure SetAlignment(const Value: TAlignment);
    procedure SetAnimate(const Value: Boolean);
    procedure SetAnimateFrames(const Value: Integer);
    procedure SetAnimateInterval(const Value: Cardinal);
    procedure SetImageIndex(const Value: Integer);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetImageVisible(const Value: Boolean);
    procedure SetKind(const Value: TJvImgBtnKind);
    procedure SetLayout(const Value: TJvImgBtnLayout);
    procedure SetOwnerDraw(const Value: Boolean);
    procedure SetMargin(const Value: Integer);
    procedure SetSpacing(const Value: Integer);
    procedure SetFlat(const Value: Boolean);
    {$IFDEF VCL}
    procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
    procedure CNMeasureItem(var Msg: TWMMeasureItem); message CN_MEASUREITEM;
    procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
    procedure WMLButtonDblClk(var Msg: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    {$ENDIF VCL}
    procedure WMTimer(var Msg: TWMTimer); message WM_TIMER;
  protected
    {$IFDEF VisualCLX}
    procedure DestroyWidget; override;
    procedure Paint; override;
    {$ENDIF VisualCLX}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    procedure CalcButtonParts(ButtonRect: TRect; var RectText, RectImage: TRect);
    {$IFDEF VCL}
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    {$ENDIF VCL}
    procedure DrawItem(const DrawItemStruct: TDrawItemStruct); dynamic;
    function GetActionLinkClass: TControlActionLinkClass; override;
    function GetCustomCaption: string; dynamic;
    function GetImageIndex: Integer;
    function GetImageList: TCustomImageList;
    function GetKindImageIndex: Integer;
    function GetRealCaption: string;override;
    procedure InvalidateImage;
    function IsImageVisible: Boolean;
    procedure Loaded; override;
    procedure SetButtonStyle(ADefault: Boolean); {$IFDEF VCL} override; {$ENDIF}
    procedure ShowNextFrame;
    procedure StartAnimate;
    procedure StopAnimate;
    procedure RestartAnimate;
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
    procedure EnabledChanged; override;
    procedure FontChanged; override;
    class procedure InitializeDefaultImageList;
    property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
    property Animate: Boolean read FAnimate write SetAnimate default False;
    property AnimateFrames: Integer read FAnimateFrames write SetAnimateFrames default 0;
    property AnimateInterval: Cardinal read FAnimateInterval write SetAnimateInterval default 200;
    property Color default clBtnFace;
    property Images: TCustomImageList read FImages write SetImages;
    property ImageIndex: Integer read FImageIndex write SetImageIndex default -1;
    property ImageVisible: Boolean read FImageVisible write SetImageVisible default True;
    property Kind: TJvImgBtnKind read FKind write SetKind default bkCustom;
    property Flat: Boolean read FFlat write SetFlat default False;
    property Layout: TJvImgBtnLayout read FLayout write SetLayout default blImageLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property OwnerDraw: Boolean read FOwnerDraw write SetOwnerDraw default False;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property OnButtonDraw: TJvImgBtnDrawEvent read FOnButtonDraw write FOnButtonDraw;
    property OnGetAnimateIndex: TJvImgBtnAnimIndexEvent read FOnGetAnimateIndex write FOnGetAnimateIndex;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
    procedure DrawButtonImage(ImageBounds: TRect);
    procedure DrawButtonFocusRect(const RectContent: TRect);
    procedure DrawButtonFrame(const DrawItemStruct: TDrawItemStruct; var RectContent: TRect);
    procedure DrawButtonText(TextBounds: TRect; TextEnabled: Boolean);
    property Canvas: TCanvas read FCanvas;
    property CurrentAnimateFrame: Byte read FCurrentAnimateFrame;
    property MouseInControl: Boolean read FMouseInControl;
  end;

  TJvImgBtn = class(TJvCustomImageButton)
  published
    property Alignment;
    property Animate;
    property AnimateFrames;
    property AnimateInterval;
    property Color;
    property DropDownMenu;
    property DropArrow;
    property Flat;
    property HotTrack;
    property HotTrackFont;
    property HotTrackFontOptions;

    property HintColor;
    property Images;
    property ImageIndex;
    property ImageVisible;
    property Kind;
    property Layout;
    property Margin;
    property Spacing;
    property WordWrap;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;
    property OwnerDraw;
    {$IFDEF VCL}
    property OnButtonDraw;
    {$ENDIF VCL}
    property OnDropDownMenu;
    property OnGetAnimateIndex;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvCtrls.pas,v $';
    Revision: '$Revision: 1.49 $';
    Date: '$Date: 2005/02/17 10:20:19 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  Consts, SysUtils, Forms, ActnList, ExtCtrls,
  JvJCLUtils, JvJVCLUtils, JvThemes;

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

const
  JvImgBtnModalResults: array [TJvImgBtnKind] of TModalResult =
    (mrNone, mrOk, mrCancel, mrNone, mrYes, mrNo, mrNone,
     mrAbort, mrRetry, mrIgnore, mrAll);

  Alignments: array [TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);

var
  DefaultImgBtnImagesList: TImageList = nil;

//=== { TJvImgBtnActionLink } ================================================

procedure TJvImgBtnActionLink.AssignClient(AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TJvCustomImageButton;
end;

function TJvImgBtnActionLink.IsImageIndexLinked: Boolean;
begin
  Result := inherited IsImageIndexLinked and
    (FClient.ImageIndex = (Action as TCustomAction).ImageIndex);
end;

procedure TJvImgBtnActionLink.SetImageIndex(Value: Integer);
begin
  if IsImageIndexLinked then
    FClient.ImageIndex := Value;
end;

//=== { TJvCustomImageButton } ===============================================

constructor TJvCustomImageButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFlat := False;
  FCanvas := TCanvas.Create;
  FAlignment := taCenter;
  FAnimateInterval := 200;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := ImageListChange;
  FImageIndex := -1;
  FImageVisible := True;
  FKind := bkCustom;
  FLayout := blImageLeft;
  FMargin := -1;
  FSpacing := 4;
  Color := clBtnFace;
  InitializeDefaultImageList;
end;

destructor TJvCustomImageButton.Destroy;
begin
  FreeAndNil(FImageChangeLink);
  inherited Destroy;
  // (rom) destroy Canvas AFTER inherited Destroy
  FreeAndNil(FCanvas);
end;

procedure TJvCustomImageButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = Images) then
    Images := nil;
end;

{$IFDEF VCL}

procedure TJvCustomImageButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    Style := Style or BS_OWNERDRAW;
end;

procedure TJvCustomImageButton.CreateWnd;
begin
  inherited CreateWnd;
  if FAnimate then
    StartAnimate;
end;

{$ENDIF VCL}

procedure TJvCustomImageButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
    begin
      if ActionList <> nil then
        Self.SetImages(ActionList.Images);
      Self.SetImageIndex(ImageIndex);
      Invalidate;
    end;
end;

procedure TJvCustomImageButton.CalcButtonParts(ButtonRect: TRect; var RectText, RectImage: TRect);
var
  BlockWidth, ButtonWidth, ButtonHeight, BlockMargin, InternalSpacing: Integer;
begin
  SetRect(RectText, 0, 0, 0, 0);
  //  RectText.Right := ButtonRect.Right - ButtonRect.Left;
  DrawText(Canvas, PChar(GetRealCaption), -1, RectText, DT_CALCRECT or Alignments[FAlignment]);
  if IsImageVisible then
  begin
    with GetImageList do
      SetRect(RectImage, 0, 0, Width - 1, Height - 1);
    InternalSpacing := Spacing;
  end
  else
  begin
    SetRect(RectImage, 0, 0, 0, 0);
    InternalSpacing := 0;
  end;
  if FAlignment <> taCenter then
  begin
    if RectText.Right < Width - RectImage.Right - 18 then
      RectText.Right := Width - RectImage.Right - 18;
  end;
  BlockWidth := RectImage.Right + InternalSpacing + RectText.Right;
  ButtonWidth := ButtonRect.Right - ButtonRect.Left;
  if Margin = -1 then
    BlockMargin := (ButtonWidth - BlockWidth) div 2
  else
    BlockMargin := Margin;
  case Layout of
    blImageLeft:
      begin
        OffsetRect(RectImage, BlockMargin, 0);
        OffsetRect(RectText, RectImage.Right + InternalSpacing, 0);
      end;
    blImageRight:
      begin
        OffsetRect(RectImage, ButtonWidth - BlockMargin - RectImage.Right, 0);
        OffsetRect(RectText, ButtonWidth - BlockWidth - BlockMargin, 0);
      end;
  end;
  ButtonHeight := ButtonRect.Bottom - ButtonRect.Top;
  OffsetRect(RectImage, ButtonRect.Left, (ButtonHeight - RectImage.Bottom) div 2 + ButtonRect.Top);
  OffsetRect(RectText, ButtonRect.Left, (ButtonHeight - RectText.Bottom) div 2 + ButtonRect.Top);
end;

procedure TJvCustomImageButton.Click;
var
  Form: TCustomForm;
  Control: TWinControl;
begin
  case FKind of
    bkClose:
      begin
        Form := GetParentForm(Self);
        if Form <> nil then
          Form.Close
        else
          inherited Click;
      end;
    bkHelp:
      begin
        Control := Self;
        while (Control <> nil) and (Control.HelpContext = 0) do
          Control := Control.Parent;
        if Control <> nil then
          {$IFDEF VCL}
          Application.HelpContext(Control.HelpContext)
          {$ENDIF VCL}
          {$IFDEF VisualCLX}
          Application.HelpSystem.ShowContextHelp(Control.HelpContext, Application.HelpFile)
          {$ENDIF VisualCLX}
        else
          inherited Click;
      end;
  else
    inherited Click;
  end;
end;

procedure TJvCustomImageButton.EnabledChanged;
begin
  inherited EnabledChanged;
  Invalidate;
end;

procedure TJvCustomImageButton.FontChanged;
begin
  inherited FontChanged;
  Invalidate;
end;

procedure TJvCustomImageButton.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if not FMouseInControl and Enabled and (GetCapture = NullHandle) then
  begin
    FMouseInControl := True;
    inherited MouseEnter(Control);
    {$IFDEF JVCLThemesEnabled}
    if ThemeServices.ThemesEnabled then
      Repaint
    else
    {$ENDIF JVCLThemesEnabled}
    if Flat then
      Invalidate;
  end;
end;

procedure TJvCustomImageButton.MouseLeave(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if FMouseInControl and Enabled and not Dragging then
  begin
    FMouseInControl := False;
    inherited MouseLeave(Control);
    {$IFDEF JVCLThemesEnabled}
    if ThemeServices.ThemesEnabled then
      Repaint
    else
    {$ENDIF JVCLThemesEnabled}
    if Flat then
      Invalidate;
  end;
end;

{$IFDEF VCL}

procedure TJvCustomImageButton.CNDrawItem(var Msg: TWMDrawItem);
begin
  if csDestroying in ComponentState then
    Exit;
  FCanvas.Handle := Msg.DrawItemStruct^.hDC;
  try
    FCanvas.Font := Font;
    if FOwnerDraw and Assigned(FOnButtonDraw) then
      FOnButtonDraw(Self, Msg.DrawItemStruct^)
    else
      DrawItem(Msg.DrawItemStruct^);
  finally
    FCanvas.Handle := 0;
  end;
end;

procedure TJvCustomImageButton.CNMeasureItem(var Msg: TWMMeasureItem);
begin
  with Msg.MeasureItemStruct^ do
  begin
    itemWidth := Width;
    itemHeight := Height;
  end;
end;

{$ENDIF VCL}

{$IFDEF VisualCLX}
procedure TJvCustomImageButton.Paint;
var
  DrawItemStruct: TDrawItemStruct;
begin
  if csDestroying in ComponentState then
    Exit;

  with DrawItemStruct do
  begin
    itemState := 0;
    if Focused or Default then
      itemState := ODS_FOCUS;
    if not Enabled then
      itemState := ODS_DISABLED;
    if Down then
      itemState := ODS_SELECTED;
  end;

  FCanvas.Handle := inherited Canvas.Handle;
  FCanvas.Start(False);
  try
    FCanvas.Font := Font;
    if FOwnerDraw and Assigned(FOnButtonDraw) then
      FOnButtonDraw(Self, DrawItemStruct)
    else
      DrawItem(DrawItemStruct);
  finally
    FCanvas.Stop;
    FCanvas.Handle := NullHandle;
  end;
end;
{$ENDIF VisualCLX}

procedure TJvCustomImageButton.DrawButtonFocusRect(const RectContent: TRect);
begin
  if FIsFocused and not (csDestroying in ComponentState) then
  begin
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Brush.Color := clBtnFace;
    DrawFocusRect(FCanvas.Handle, RectContent);
  end;
end;

procedure TJvCustomImageButton.DrawButtonFrame(const DrawItemStruct: TDrawItemStruct; var RectContent: TRect);
var
  IsDown, IsEnabled, IsDefault: Boolean;
  R: TRect;