aqdockinguithemed.pas

AutomatedDocking Library 控件源代码修改 适合Delphi 2009 和C++ Builder 20009 使用。 修正汉字不能正确显示问题

{*******************************************************************}
{                                                                   }
{       AutomatedDocking Library (Cross-Platform Edition)           }
{                                                                   }
{       Copyright (c) 1999-2008 AutomatedQA Corp.                   }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{   The entire contents of this file is protected by U.S. and       }
{   International Copyright Laws. Unauthorized reproduction,        }
{   reverse-engineering, and distribution of all or any portion of  }
{   the code contained in this file is strictly prohibited and may  }
{   result in severe civil and criminal penalties and will be       }
{   prosecuted to the maximum extent possible under the law.        }
{                                                                   }
{   RESTRICTIONS                                                    }
{                                                                   }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES           }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE    }
{   SECRETS OF AUTOMATEDQA CORP. THE REGISTERED DEVELOPER IS        }
{   LICENSED TO DISTRIBUTE THE AUTOMATEDDOCKING LIBRARY AND ALL     }
{   ACCOMPANYING VCL AND CLX CONTROLS AS PART OF AN EXECUTABLE      }
{   PROGRAM ONLY.                                                   }
{                                                                   }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED      }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE        }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE       }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT WRITTEN CONSENT          }
{   AND PERMISSION FROM AUTOMATEDQA CORP.                           }
{                                                                   }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}

unit aqDockingUIThemed;

{$I aqDockingVer.inc}

interface

uses
  Classes, Graphics, Types, aqDockingUIDefault, aqDockingUI, ImgList, Controls,
  aqUIHelpers, Messages, Windows;

type
  TaqCaptionButtonWidget = (bwNone, bwDropDown, bwSysButton, bwMDISysButton,
    bwMinButton, bwMDIMinButton, bwMaxButton, bwCloseButton,
    bwSmallCloseButton, tbwMDICloseButton, bwRestoreButton, bwMDIRestoreButton,
    bwHelpButton, bwMDIHelpButton, bwPushButton, bwSpinUp,
    bwSpinDown, bwSpinRight, bwSpinLeft, bwPin, bwRotatedPin);

  TaqThemedUIStyle = class;
  TaqCaptionButtonWidgets = class;

  TaqThemeOrientation = (toTop, toBottom);

  TaqCaptionButton = class(TPersistent)
  private
    FOwner: TaqCaptionButtonWidgets;
    FPartIndex: TaqCaptionButtonWidget;
    FImageIndex: TImageIndex;
    FKind: TaqDockButtonKind;

    procedure SetImageIndex(const Value: TImageIndex);
    procedure SetPartIndex(const Value: TaqCaptionButtonWidget);
  protected
    FDefaultPartIndex: TaqCaptionButtonWidget;

    procedure AssignTo(Dest: TPersistent); override;
    function GetOwner: TPersistent; override;

    property Owner: TaqCaptionButtonWidgets read FOwner;
  public
    procedure Reset;

    constructor CreateEx(AOwner: TaqCaptionButtonWidgets; Kind: TaqDockButtonKind);
  published
    property PartIndex: TaqCaptionButtonWidget read FPartIndex write SetPartIndex;
    property ImageIndex: TImageIndex read FImageIndex write SetImageIndex default -1;
  end;

  TaqCaptionButtonWidgets = class(TComponent)
  private
    FOwner: TaqThemedUIStyle;
    FButtonWidgets: array [TaqDockButtonKind] of TaqCaptionButton;
    FImages: TImageList;
    FImageChangeLink: TChangeLink;
    FUpdateCount: Integer;
    FDrawStyle: TaqImageDrawStyle;
    procedure SetButtonWidget(ButtonKind: TaqDockButtonKind; Value: TaqCaptionButton);
    function GetButtonWidget(ButtonKind: TaqDockButtonKind): TaqCaptionButton;
    procedure SetImages(const Value: TImageList);
    procedure SetDrawStyle(const Value: TaqImageDrawStyle);
  protected
    procedure Change;
    procedure AssignTo(Dest: TPersistent); override;

    property Owner: TaqThemedUIStyle read FOwner;
  public
    procedure Reset;

    function GetButtonKindCode(ButtonKind: TaqDockButtonKind): Integer;
    class function GetWidgetCode(ButtonWidget: TaqCaptionButtonWidget): Integer;

    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    procedure BeginUpdate;
    procedure EndUpdate;

    property ButtonWidgets[ButtonKind: TaqDockButtonKind]: TaqCaptionButton read GetButtonWidget write SetButtonWidget; default;
    property UpdateCount: Integer read FUpdateCount;
  published
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property HideButton: TaqCaptionButton index dbkHide read GetButtonWidget write SetButtonWidget;
    property UndockButton: TaqCaptionButton index dbkUndock read GetButtonWidget write SetButtonWidget;
    property AutoHideButton: TaqCaptionButton index dbkAutoHide read GetButtonWidget write SetButtonWidget;
    property UndoAutoHideButton: TaqCaptionButton index dbkUndoAutoHide read GetButtonWidget write SetButtonWidget;
    property MaximizeButton: TaqCaptionButton index dbkMaximize read GetButtonWidget write SetButtonWidget;
    property RestoreButton: TaqCaptionButton index dbkRestore read GetButtonWidget write SetButtonWidget;
    property HelpButton: TaqCaptionButton index dbkHelp read GetButtonWidget write SetButtonWidget;
    property MenuButton: TaqCaptionButton index dbkMenu read GetButtonWidget write SetButtonWidget;
    property CustomButton: TaqCaptionButton index dbkCustom read GetButtonWidget write SetButtonWidget;
    property Images: TImageList read FImages write SetImages;
    property DrawStyle: TaqImageDrawStyle read FDrawStyle write SetDrawStyle default idsStretch;
  end;

  TaqThemedUIStyle = class(TaqCustomDefaultUIStyle)
  private
    FThemeAvailable: Boolean;
    FCaptionButtonWidgets: TaqCaptionButtonWidgets;
    FThemeNotifier: TObject;
    procedure SetCaptionButtons(const Value: TaqCaptionButtonWidgets);
    procedure DoFindComponentClass(Reader: TReader; const ClassName: string;
      var ComponentClass: TComponentClass);
    procedure DoCreateComponent(Reader: TReader;
      ComponentClass: TComponentClass; var Component: TComponent);
    procedure CheckTheme;
    class procedure DrawThemeEx(Theme: THandle; ACanvas: TCanvas; ARect: TRect;
      PartId, StateId: Integer; AOrientation: TaqOrientation);
  protected
    class procedure DrawCaptionWidget(ACanvas: TCanvas; ARect: TRect;
      AState: TaqDockButtonState; ACaptionState: TaqDockCaptionState;
      AWidget: TaqCaptionButtonWidget);
    procedure AssignTo(Dest: TPersistent); override;
    procedure ThemeChange(Sender: TObject);
    function GetMetric(AMetric: TaqDockingUIMetric): Integer; override;
    procedure CheckAeroStyle;

    procedure ReadState(Reader: TReader); override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;

    { TaqDockingUIStyle }
    procedure DoDrawCaptionButtonWidget(ACanvas: TCanvas; ARect: TRect;
      AState: TaqDockButtonState; ACaptionState: TaqDockCaptionState;
      AKind: TaqDockButtonKind); override;

    procedure DoDrawTabButton(ACanvas: TCanvas; ARect: TRect;
      AState: TaqTabButtonState; AKind: TaqTabButtonKind); override;
    procedure DoDrawTabPane(ACanvas: TCanvas; ARect: TRect;
      AOrientation: TaqTabOrientation); override;
    procedure DoDrawTabItem(ACanvas: TCanvas; ARect: TRect;
      const ACaption: string; AState: TaqTabItemState;
      APosition: TaqTabItemPosition; AOrientation: TaqOrientation;
      AButtonAreaWidthBefore: Integer; AButtonAreaWidthAfter: Integer;
      ADrawImage: Boolean; AImages: TCustomImageList; AImageIndex: Integer); override;
    procedure DoDrawTabTarget(ACanvas: TCanvas; ARect: TRect); override;
    procedure DoDrawCaptionButton(ACanvas: TCanvas; ARect: TRect;
      AState: TaqDockButtonState; ACaptionState: TaqDockCaptionState; AKind: TaqDockButtonKind); override;
    procedure DoDrawCaption(ACanvas: TCanvas; ARect: TRect; const ACaption: string;
      AState: TaqDockCaptionState; AMaxCaptionWidth: Integer; var AFitCaption: Boolean;
      ADrawImage: Boolean; AImages: TCustomImageList; AImageIndex: Integer); override;
    procedure DoDrawSplitter(ACanvas: TCanvas; ARect: TRect;
      AOrientation: TaqSplitterOrientation); override;
    procedure DoDrawControl(ACanvas: TCanvas; ARect: TRect;
      AKind: TaqDockControlDrawKind); override;

    procedure DoDrawHideZone(ACanvas: TCanvas; ASiteRect, ARect: TRect;
      AOrientation: TaqHideZoneOrientation); override;
    procedure DoDrawHiddenTabItem(ACanvas: TCanvas; ARect: TRect;
      const AText: string; AState: TaqTabItemState;
      AOrientation: TaqHideZoneOrientation; APosition: TaqTabItemPosition;
      ADrawImage, ADrawText: Boolean; AImages: TCustomImageList; AImageIndex: Integer); override;

    { TaqCustomDefaultUIStyle }
    function GetCaptionButtonImagesClass: TaqCaptionButtonImagesClass; override;

    property ThemeAvailable: Boolean read FThemeAvailable;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    property ActiveCaptionFont;
    property ActiveHiddenTabFont;
    property CaptionButtons: TaqCaptionButtonWidgets read FCaptionButtonWidgets write SetCaptionButtons;
    property CaptionButtonSize;
    property CaptionFont;
    property HiddenTabFont;
    property SplitterHeight;
    property SplitterWidth;
    property TabFont;
    property ActiveTabFont;
    property TabIndent;

    property OnGetTabWidth;
    property OnDrawTabButton;
    property OnDrawTabPane;
    property OnDrawTabItem;
    property OnDrawTabTarget;
    property OnDrawCaptionButton;
    property OnDrawCaption;
    property OnDrawControl;
    property OnDrawSplitter;
    property OnChange;
  end;

implementation

uses
  StdCtrls, SysUtils, Forms,

  UxTheme,

  ActiveX, Math;

const
  DefHideWidget = bwCloseButton;
  DefUndockWidget = bwSpinUp;
  DefAutoHideWidget = bwPin;
  DefUndoAutoHideWidget = bwRotatedPin;
  DefMaximizeWidget = bwMaxButton;
  DefRestoreWidget = bwRestoreButton;
  DefHelpWidget = bwHelpButton;
  DefMenuWidget = bwDropDown; 
  DefCustomWidget = bwPushButton;

  cVistaAeroStyleButtonRatio = 1.75;

  DefWidgets: array [TaqDockButtonKind] of TaqCaptionButtonWidget = (
    DefHideWidget,
    DefUndockWidget,
    DefAutoHideWidget,
    DefUndoAutoHideWidget,
    DefMaximizeWidget,
    DefRestoreWidget,
    DefMenuWidget,
    DefCustomWidget,
    DefHelpWidget,
    DefCustomWidget);

type
  TaqDefaultUIStyleFriend = class(TaqDefaultUIStyle);
  TaqDockingUIStyleFriend = class(TaqDockingUIStyle);

  TaqFakeCaptionButtonImages = class(TaqCaptionButtonImages)
  protected
    { TaqCaptionButtonImages }
    procedure Change; override;
  end;

{ TaqFakeCaptionButtonImages }

procedure TaqFakeCaptionButtonImages.Change;
begin
  { do nothing }
end;

{ TaqThemedUIStyle }

procedure TaqThemedUIStyle.AssignTo(Dest: TPersistent);
begin
  if Dest is TaqThemedUIStyle then
    with TaqThemedUIStyle(Dest) do
    begin
      BeginUpdate;
      try
        inherited;
        CaptionButtons.Assign(Self.CaptionButtons);
      finally
        EndUpdate;
      end;
    end
  else
    inherited;
end;

constructor TaqThemedUIStyle.Create;
begin
  inherited;
  CheckTheme;
  FCaptionButtonWidgets := TaqCaptionButtonWidgets.Create(Self);
  FThemeNotifier := TaqThemeNotifier.Create;
  TaqThemeNotifier(FThemeNotifier).OnThemeChange := ThemeChange;
  TabIndent := 1;
  FMetrics[dumTabTopOffset] := 2;

  {Vista style}
  if Win32MajorVersion > 5 then
    CheckAeroStyle;
end;

destructor TaqThemedUIStyle.Destroy;
begin
  FreeAndNil(FThemeNotifier);
  if FThemeAvailable then
    FreeThemeLibrary;
  FreeAndNil(FCaptionButtonWidgets);
  inherited;
end;

procedure TaqThemedUIStyle.DoDrawCaptionButton(ACanvas: TCanvas; ARect: TRect;
  AState: TaqDockButtonState; ACaptionState: TaqDockCaptionState; AKind: TaqDockButtonKind);
begin
  if FThemeAvailable then
    DoDrawCaptionButtonWidget(ACanvas, ARect, AState, ACaptionState, AKind)
  else
    inherited DoDrawCaptionButton(ACanvas, ARect, AState, ACaptionState, AKind);
end;

procedure TaqThemedUIStyle.DoDrawCaption(ACanvas: TCanvas; ARect: TRect;
  const ACaption: string; AState: TaqDockCaptionState; AMaxCaptionWidth: Integer;
  var AFitCaption: Boolean; ADrawImage: Boolean; AImages: TCustomImageList; AImageIndex: Integer);
const
  States: array [0..2] of Integer =
    (CS_ACTIVE, CS_INACTIVE, CS_DISABLED);
var
  Theme: HTHEME;
  Handle: THandle;
begin
  Handle := TWinControl(TControlCanvas(ACanvas).Control).Handle;
  if FThemeAvailable then
    Theme := OpenThemeData(Handle, 'Tab')
  else
    Theme := 0;
  if Theme <> 0 then
  begin
    DrawThemeBackground(Theme, ACanvas.Handle, TABP_BODY, States[0], ARect, nil);
    CloseThemeData(Theme);
    Theme := OpenThemeData(Handle, 'Button');
    DrawThemeBackground(Theme, ACanvas.Handle, BP_GROUPBOX, States[0], ARect, @ARect);
    CloseThemeData(Theme);
    DoDrawCaptionContent(ACanvas, ARect, ACaption, AState, AMaxCaptionWidth, AFitCaption, ADrawImage, AImages, AImageIndex);
  end
  else
    inherited DoDrawCaption(ACanvas, ARect, ACaption, AState, AMaxCaptionWidth, AFitCaption,
      ADrawImage, AImages, AImageIndex);
end;

procedure TaqThemedUIStyle.DoDrawSplitter(ACanvas: TCanvas; ARect: TRect;
  AOrientation: TaqSplitterOrientation);
var
  Theme: HTHEME;
  Handle: THandle;
begin
  Handle := TWinControl(TControlCanvas(ACanvas).Control).Handle;
  if FThemeAvailable then
    Theme := OpenThemeData(Handle, 'Tab')
  else
    Theme := 0;
  if Theme <> 0 then
  begin
    //DrawThemeBackground(Theme, ACanvas.Handle, TABP_BODY, 0, ARect, nil);
    ACanvas.Brush.Style := bsSolid;