jvcaptionbutton.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: JvCaptionButton.PAS, released on 2002-05-26.

The Initial Developer of the Original Code is Peter Th鰎nqvist [peter3 at sourceforge dot net]
Portions created by Peter Th鰎nqvist are Copyright (C) 2002 Peter Th鰎nqvist.

This unit is a merging of the original TJvCaptionButton, TJvaCaptionButton.
Merging done 2003-06-12 by Remko Bonte [remkobonte at myrealbox dot com]

All Rights Reserved.

Contributor(s):
  Andrei Prygounkov <a dot prygounkov at gmx dot de>, author of TJvaCaptionButton.
  Remko Bonte [remkobonte at myrealbox dot com], theme support, actions
  Olivier Sannier [obones att altern dott org], caption hints.

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Modified 2003-06-13 (p3):
- Fixed MouseUp X,Y inconsistentcy (did not report the same values as MouseDown)
- Added MouseMove handler
- Added ShowHint, ParentShowHint
- Fixed drawing of disabled MinimizeToTray icon as well as incorrect Font.Color in text drawing
- Added Assign
- Tested on W2k
- Demo (examples\CaptionBtn) updated and extended

Known Issues:

  * Msimg32.dll code should be moved to seperate import unit. Code is partly
    copied from JwaWinGDI.pas.
  * Button can disappear at design-time when switching themes.
  * With more buttons, button can appear hot while mouse is over another caption
    button.
  * Still some flicker while resizing due to wrong FButtonRect, see comment
    at HandleNCPaintBefore.
  * Buttons on small caption (BorderStyle in [bsSizeToolWin, bsToolWin]) looks
    ugly.

-----------------------------------------------------------------------------}
// $Id: JvCaptionButton.pas,v 1.48 2005/03/09 07:24:56 marquardt Exp $

unit JvCaptionButton;

{$I jvcl.inc}
{$I windowsonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, Classes, Graphics, Controls, Forms,
  {$IFDEF HAS_UNIT_TYPES}
  Types,
  {$ENDIF HAS_UNIT_TYPES}
  ActnList, ImgList,
  JvComponent;

{$IFNDEF COMPILER6_UP}
const
  {$EXTERNALSYM AC_SRC_ALPHA}
  AC_SRC_ALPHA = $01;
{$ENDIF !COMPILER6_UP}

type
  {$IFDEF COMPILER5}
  TWMNCPaint = packed record
    Msg: Cardinal;
    RGN: HRGN;
    Unused: Longint;
    Result: Longint;
  end;
  {$ENDIF COMPILER5}

  TJvStandardButton = (tsbNone, tsbClose, tsbHelp, tsbMax, tsbMin, tsbRestore,
    tsbMinimizeToTray); // a la e-Mule
  TJvCaptionButtonLayout = (cbImageLeft, cbImageRight);
  TJvRedrawKind = (rkDirect, rkIndirect, rkTotalCaptionBar);

  TJvCaptionButton = class;

  TJvCaptionButtonActionLink = class(TActionLink)
  protected
    FClient: TJvCaptionButton;
    procedure AssignClient(AClient: TObject); override;
    function IsCaptionLinked: 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 SetEnabled(Value: Boolean); override;
    procedure SetHint(const Value: string); override;
    procedure SetImageIndex(Value: Integer); override;
    procedure SetVisible(Value: Boolean); override;
    procedure SetOnExecute(Value: TNotifyEvent); override;
  end;

  TJvCaptionButtonActionLinkClass = class of TJvCaptionButtonActionLink;

  TJvCaptionButton = class(TJvComponent)
  private
    { Properties }
    FAlignment: TAlignment;
    FHeight: Integer;
    FLeft: Integer;
    FTop: Integer;
    FWidth: Integer;
    FCaption: string;
    FDown: Boolean;
    FEnabled: Boolean;
    FFont: TFont;
    FHint: string;
    FImageIndex: TImageIndex;
    FImages: TCustomImageList;
    FLayout: TJvCaptionButtonLayout;
    FMargin: Integer;
    FPosition: Integer;
    FSpacing: Integer;
    FStandard: TJvStandardButton;
    FToggle: Boolean;
    FVisible: Boolean;
    FOnClick: TNotifyEvent;
    FOnMouseUp: TMouseEvent;
    FOnMouseDown: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;

    FDefaultButtonLeft: Integer;
    FDefaultButtonTop: Integer;
    FDefaultButtonWidth: Integer;
    FDefaultButtonHeight: Integer;

    FActionLink: TJvCaptionButtonActionLink;
    FBuffer: TBitmap;
    FButtonRect: TRect;
    FCaptionHeight: Integer;
    FClickRect: TRect; // Clickable area is a bit bigger than the button
    FHasCaption: Boolean; // True, if the form has a caption
    FHasSmallCaption: Boolean; // True, if the form has BorderStyle bsToolWindow, bsSizeToolWin
    FImageChangeLink: TChangeLink;
    FMouseButtonDown: Boolean;
    FMouseInControl: Boolean;
    FNeedRecalculate: Boolean;
    FRgnChanged: Boolean;
    FSaveRgn: HRGN;
    FShowHint: Boolean;
    FParentShowHint: Boolean;

    {tool tip specific}
    FToolTipHandle: THandle;
    {tool tip specific end}

    {$IFDEF JVCLThemesEnabled}
    FCaptionActive: Boolean;
    FForceDrawSimple: Boolean;
    function GetIsThemed: Boolean;
    procedure SetForceDrawSimple(const Value: Boolean);
    {$ENDIF JVCLThemesEnabled}
    function GetAction: TBasicAction;
    function GetIsImageVisible: Boolean;
    function GetParentForm: TCustomForm;
    function GetParentFormHandle: THandle;
    function IsCaptionStored: Boolean;
    function IsEnabledStored: Boolean;
    function IsHintStored: Boolean;
    function IsImageIndexStored: Boolean;
    procedure SetAction(const Value: TBasicAction);
    procedure SetAlignment(Value: TAlignment);
    procedure SetCaption(Value: string);
    procedure SetDown(const Value: Boolean);
    procedure SetEnabled(const Value: Boolean);
    procedure SetFont(Value: TFont);
    procedure SetHeight(Value: Integer);
    procedure SetImageIndex(const Value: TImageIndex);
    procedure SetImages(const Value: TCustomImageList);
    procedure SetLayout(const Value: TJvCaptionButtonLayout);
    procedure SetLeft(Value: Integer);
    procedure SetMargin(const Value: Integer);
    procedure SetMouseInControl(const Value: Boolean);
    procedure SetPosition(const Value: Integer);
    procedure SetSpacing(const Value: Integer);
    procedure SetStandard(Value: TJvStandardButton);
    procedure SetToggle(const Value: Boolean);
    procedure SetTop(Value: Integer);
    procedure SetVisible(const Value: Boolean);
    procedure SetWidth(Value: Integer);

    {tool tip handling}
    procedure CreateToolTip(Wnd: THandle);
    procedure DestroyToolTip;
    procedure HideToolTip;
    procedure ForwardToToolTip(Msg: TMessage);

    procedure Hook;
    procedure UnHook;
    function WndProcAfter(var Msg: TMessage): Boolean;
    function WndProcBefore(var Msg: TMessage): Boolean;

    procedure DrawButton(DC: HDC);
    {$IFDEF JVCLThemesEnabled}
    procedure DrawButtonBackground(ACanvas: TCanvas);
    {$ENDIF JVCLThemesEnabled}
    procedure DrawStandardButton(ACanvas: TCanvas);
    procedure DrawNonStandardButton(ACanvas: TCanvas);
    procedure DrawButtonImage(ACanvas: TCanvas; ImageBounds: TRect);
    procedure DrawButtonText(ACanvas: TCanvas; TextBounds: TRect);

    procedure Redraw(const AKind: TJvRedrawKind);
    procedure CalcDefaultButtonRect(Wnd: THandle);

    {Paint related messages}
    procedure HandleNCActivate(var Msg: TWMNCActivate);
    procedure HandleNCPaintAfter(Wnd: THandle; var Msg: TWMNCPaint);
    procedure HandleNCPaintBefore(Wnd: THandle; var Msg: TWMNCPaint);
    {Mouse down-related messages}
    function HandleButtonDown(var Msg: TWMNCHitMessage): Boolean;
    function HandleButtonUp(var Msg: TWMNCHitMessage): Boolean;
    function HandleHitTest(var Msg: TWMNCHitTest): Boolean;
    function HandleMouseMove(var Msg: TWMNCHitMessage): Boolean;
    procedure HandleNCMouseMove(var Msg: TWMNCHitMessage);
    {Other}
    function HandleNotify(var Msg: TWMNotify): Boolean;

    procedure ImageListChange(Sender: TObject);
    procedure DoActionChange(Sender: TObject);

    function MouseOnButton(X, Y: Integer; const TranslateToScreenCoord: Boolean): Boolean;
    procedure SetParentShowHint(const Value: Boolean);
    procedure SetShowHint(const Value: Boolean);
  protected
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); dynamic;
    procedure CalcButtonParts(ACanvas: TCanvas; ButtonRect: TRect; var RectText, RectImage: TRect);
    function GetActionLinkClass: TJvCaptionButtonActionLinkClass; dynamic;
    procedure Loaded; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure UpdateButtonRect(Wnd: THandle);

    property ActionLink: TJvCaptionButtonActionLink read FActionLink write FActionLink;
    property IsImageVisible: Boolean read GetIsImageVisible;
    {$IFDEF JVCLThemesEnabled}
    // The value of IsThemed stays the same until a WM_THEMECHANGED is received.
    property IsThemed: Boolean read GetIsThemed;
    {$ENDIF JVCLThemesEnabled}
    property MouseInControl: Boolean read FMouseInControl;
    property ParentFormHandle: THandle read GetParentFormHandle;
    property ParentForm: TCustomForm read GetParentForm;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure InitiateAction; virtual;
    procedure ResetButton;
    procedure Click; dynamic;
  published
    property Action: TBasicAction read GetAction write SetAction;
    property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
    property ButtonHeight: Integer read FHeight write SetHeight default 0;
    property ButtonLeft: Integer read FLeft write SetLeft default 0;
    property ButtonTop: Integer read FTop write SetTop default 0;
    property ButtonWidth: Integer read FWidth write SetWidth default 0;
    property Caption: string read FCaption write SetCaption stored IsCaptionStored;
    property Down: Boolean read FDown write SetDown default False;
    {$IFDEF JVCLThemesEnabled}
    property ForceDrawSimple: Boolean read FForceDrawSimple write SetForceDrawSimple default False;
    {$ENDIF JVCLThemesEnabled}
    property ShowHint: Boolean read FShowHint write SetShowHint default False;
    property ParentShowHint: Boolean read FParentShowHint write SetParentShowHint default True;
    property Enabled: Boolean read FEnabled write SetEnabled stored IsEnabledStored default True;
    property Font: TFont read FFont write SetFont;
    property Hint: string read FHint write FHint stored IsHintStored;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex stored IsImageIndexStored default -1;
    property Images: TCustomImageList read FImages write SetImages;
    property Layout: TJvCaptionButtonLayout read FLayout write SetLayout default cbImageLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property Position: Integer read FPosition write SetPosition default 0;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property Standard: TJvStandardButton read FStandard write SetStandard default tsbNone;
    property Toggle: Boolean read FToggle write SetToggle default False;
    property Visible: Boolean read FVisible write SetVisible default True;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
  end;

function TransparentBlt(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest, hHeightDest: Integer;
  hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer;
  crTransparent: UINT): BOOL; stdcall;
function AlphaBlend(hdcDest: HDC; nXOriginDest, nYOriginDest, nWidthDest,
  nHeightDest: Integer; hdcSrc: HDC; nXOriginSrc, nYOriginSrc, nWidthSrc,
  nHeightSrc: Integer; BlendFunction: BLENDFUNCTION): BOOL; stdcall;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvCaptionButton.pas,v $';
    Revision: '$Revision: 1.48 $';
    Date: '$Date: 2005/03/09 07:24:56 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  CommCtrl, Buttons, SysUtils,
  JvThemes,
  {$IFDEF JVCLThemesEnabled}
  UxTheme,
  {$IFNDEF COMPILER7_UP}
  TmSchema,
  {$ENDIF !COMPILER7_UP}
  JvJVCLUtils,
  {$ENDIF JVCLThemesEnabled}
  JvDsgnIntf, JvConsts, JvTypes, JvJCLUtils, JvResources, JvWndProcHook;

const
  { Msimg32.dll is included in Windows 98 and later }
  Msimg32DLLName = 'Msimg32.dll';

  TransparentBltName = 'TransparentBlt';
  AlphaBlendName = 'AlphaBlend';

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

var
  GMsimg32Handle: THandle = 0;
  GTriedLoadMsimg32Dll: Boolean = False;

  _AlphaBlend: Pointer;
  _TransparentBlt: Pointer;

{$IFDEF JVCLThemesEnabled}

type
  { (rb) I couldn't get the alpha channel to work with the normal TBitmap so
         introduced TAlphaBitmap. TBitmapAdapter hides the implementation details
         of the TBitmap/TAlphaBitmap }

  TAlphaBitmap = class(TObject)
  private
    FHandle: HDC;
    FBitmapInfo: TBitmapInfo;
    FDIBHandle: HBitmap;
    FOldBitmap: HBitmap;
    FBitsMem: Pointer;
    FBitCount: Byte;
    FHasAlphaChannel: Boolean;
    function GetWidth: Integer;
    function GetHeight: Integer;
  protected
    procedure CreateHandle(AWidth, AHeight: Integer);
    function CreateDIB(ADC: HDC; AWidth, AHeight: Integer): HBitmap;
    procedure Duplicate(Src: HBitmap);
    procedure FreeHandle;
    procedure InitAlpha;
  public
    destructor Destroy; override;

    procedure LoadFromResourceID(Instance: THandle; ResID: Integer);
    procedure LoadFromResourceName(Instance: THandle; const ResName: string);

    property Handle: HDC read FHandle;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
    property Data: Pointer read FBitsMem;
    property BitCount: Byte read FBitCount;
    property HasAlphaChannel: Boolean read FHasAlphaChannel;
  end;

  TBitmapAdapter = class(TObject)
  private
    FBitmap: TObject;
    FMargins: TMargins;
    FTransparentColor: TColorRef;
    function GetHeight: Integer;
    function GetWidth: Integer;
    function GetIsValid: Boolean;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Clear;

    procedure LoadFromResourceName(Instance: THandle; const ResName: string);
    procedure LoadFromResourceID(Instance: THandle; ResID: Integer);

    function Draw(ACanvas: TCanvas; const Rect: TRect; AMargins: PMargins): Boolean;
    function DrawFixed(ACanvas: TCanvas; const X, Y: Integer): Boolean;
    function DrawFixedPart(ACanvas: TCanvas; const DestRect: TRect; const SrcX, SrcY: Integer): Boolean;
    function DrawPart(ACanvas: TCanvas; const SrcRect, DestRect: TRect; AMargins: PMargins): Boolean;

    property Margins: TMargins read FMargins write FMargins;
    property Width: Integer read GetWidth;
    property Height: Integer read GetHeight;
    property IsValid: Boolean read GetIsValid;
    property TransparentColor: TColorRef read FTransparentColor write FTransparentColor;
  end;

  TGlobalXPData = class(TObject)
  private
    FCaptionButtonHeight: Integer;
    FCaptionButtonCount: Integer;
    FCaptionButtons: TBitmapAdapter;

    FIsThemed: Boolean;
    FBitmapValid: Boolean;
    FClientCount: Integer;
  public