aquihelpers.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 aqUIHelpers;

{$I aqDockingVer.inc}

interface

uses
  {$IFDEF VCL}
  Windows,
  Graphics,
  ToolWin,
  StdCtrls,
  Messages,
  Controls,
  ImgList,
  {$ELSE}
  QGraphics,
  QStdCtrls,
  QControls,
  QImgList,
  {$ENDIF}
  Classes,
  Types,
  aqDockingUtils;

type
  TaqEdgeBorder = (ebLeft, ebTop, ebRight, ebBottom);
  TaqEdgeBorders = set of TaqEdgeBorder;
  TaqEdgeStyle = (esNone, esRaised, esLowered, esFlat);
  TaqOrientation = (orLeft, orTop, orRight, orBottom);
  TaqOrientations = set of TaqOrientation;
  TGradientType = (gtSolid, gtHorizontal, gtVertical, gtHorzSplit, gtVertSplit);
  TBands = 1..256;

const
  ebRect                                                    = [ebLeft, ebTop, ebRight, ebBottom];
  orAll                                                     = [orLeft, orTop, orRight, orBottom];

  {$IFNDEF VCL}
const
  clHotLight                                                = clBlue;
  {$ENDIF}

type
  TGradient = class(TPersistent)
  private
    FType: TGradientType;
    FStart: TColor;
    FEnd: TColor;
    FSteps: TBands;
    FCStart: packed array[0..2] of Byte;
    FCDiff: packed array[0..2] of Integer;
    FUpdateCount: Integer;
    FOnChange: TNotifyEvent;
    procedure SetEnd(Value: TColor);
    procedure SetStart(Value: TColor);
    procedure SetType(Value: TGradientType);
    procedure SetSteps(Value: TBands);
    procedure SetColors(SwapColors: Boolean);
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    procedure Clear;
    procedure BeginUpdate;
    procedure EndUpdate;
    procedure Change;
    procedure Fill(ACanvas: TCanvas; const ARect, AClip: TRect; ASwapColors: Boolean = False);

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Bands: TBands read FSteps write SetSteps;
    property EndColor: TColor read FEnd write SetEnd;
    property FillType: TGradientType read FType write SetType;
    property StartColor: TColor read FStart write SetStart;
  end;

  TaqImageDrawStyle = (idsDefault, idsCenter, idsStretch);
  TaqShowAccelChar = (sacTrue, sacFalse, sacIgnore);

  {$IFDEF VCL}
  TaqThemeNotifier = class(TObject)
  private
    FHandle: THandle;
    FOnThemeChange: TNotifyEvent;
    procedure MainWndProc(var Message: TMessage);
    procedure WndProc(var Msg: TMessage);
  protected
    procedure DoThemeChange;
  public
    constructor Create;
    destructor Destroy; override;

    property OnThemeChange: TNotifyEvent read FOnThemeChange write FOnThemeChange;
  end;
  {$ENDIF}

procedure DrawEdge(ACanvas: TCanvas; ARect: TRect; AEdgeInner, AEdgeOuter: TaqEdgeStyle;
  AEdgeBorders: TaqEdgeBorders; ABaseColor: TColor = clBtnFace; ALineWidth: Cardinal = 1);
procedure DrawRoundEdge(ACanvas: TCanvas; ARect: TRect;
  AEdgeBorders: TaqEdgeBorders; AColor: TColor = clBtnFace; ALineWidth: Cardinal = 1);
function InvertEdgeStyle(AEdgeStyle: TaqEdgeStyle): TaqEdgeStyle;
function SubtractRect(out ARect: TRect; const R1, R2: TRect): Boolean;

// Image drawing helpers
procedure DrawImage(AImages: TCustomImageList; AImageIndex: Integer;
  ACanvas: TCanvas; ARect: TRect; AEnabled: Boolean = True;
  AStyle: TaqImageDrawStyle = idsStretch);
procedure DrawImageEx(AImage: Graphics.TBitmap; ACanvas: TCanvas;
  ARect: TRect; AOrientation: TaqOrientation; Region: TaqHandle);

// Text-processing helpers
procedure OutTextRect(ACanvas: TCanvas; ARect: TRect; AIndentX, AIndentY: Integer;
  const AText: string; AVertAlign: TTextLayout; AHorAlign: TAlignment; ARotate: Boolean = False;
  AWordWrap: Boolean = False; AShowAccelChar: TaqShowAccelChar = sacTrue);
function MinimizeText(const AText: string; ACanvas: TCanvas;
  AMaxWidth: Integer; AShowAccelChar: TaqShowAccelChar; out ADest: string): Boolean;
function TextMetrics(AFont: TFont; const AText: string): TPoint;

// Color-processing helpers
{$IFNDEF VCL}
function GetRValue(rgb: Cardinal): Byte;
function GetGValue(rgb: Cardinal): Byte;
function GetBValue(rgb: Cardinal): Byte;
function rgb(Red, Green, Blue: Byte): TColorRef;
{$ENDIF}
function LightColor(AColor: TColor): TColorRef;
function LightLightColor(AColor: TColor): TColorRef;
function DarkColor(AColor: TColor): TColorRef;
function DarkDarkColor(AColor: TColor): TColorRef;
function NETBackColor(AColor: TColor): TColorRef;
function DarkColorBy(Col: TColor; Percentage: Byte): TColorRef;
function LightColorBy(Col: TColor; Percentage: Byte): TColorRef;
function GetRealColor(AColor: TColorRef): TColorRef;
function GetComplexColor(AColor1, AColor2, AColor3: TColor; APercentage1,
  APercentage2, APercentage3: Integer): TColorRef; overload;
function GetComplexColor(AColor1, AColor2: TColor; APercentage: Integer): TColorRef; overload;

procedure aqProcessPaintMessages;

implementation

uses
  {$IFDEF VCL}
  Menus,
  Forms,
  {$ELSE}
  Qt,
  QMenus,
  {$ENDIF}
  Math;

{$IFDEF VCL}
{$IFNDEF DELPHI7}
const
  WM_THEMECHANGED                                           = $031A;
  {$ENDIF}
  {$ENDIF}

  // Not available in : Windows 9x/Me.
type
  TGetWorldTransform = function(DC: HDC; var p2: TXForm): BOOL; stdcall;
  TSetWorldTransform = function(DC: HDC; const p2: TXForm): BOOL; stdcall;

var
  GetWorldTransform                                         : TGetWorldTransform = nil;
  SetWorldTransform                                         : TSetWorldTransform = nil;

function MultDiv(ANumber, ANumerator, ADenominator: Integer): Integer;
begin
  {$IFDEF VCL}
  Result := Windows.MulDiv(ANumber, ANumerator, ADenominator);
  {$ELSE}
  Result := (ANumber * ANumerator) div ADenominator;
  {$ENDIF}
end;

procedure DrawEdge(ACanvas: TCanvas; ARect: TRect; AEdgeInner, AEdgeOuter: TaqEdgeStyle;
  AEdgeBorders: TaqEdgeBorders; ABaseColor: TColor; ALineWidth: Cardinal);
var
  RInner                                                    : TRect;
  LLC, LC, DC, DDC                                          : TColor;
begin
  LLC := LightLightColor(ABaseColor);                       // clWhite
  LC := LightColor(ABaseColor);                             // clBtnHighlight
  DC := DarkColor(ABaseColor);                              // clBtnShadow
  DDC := DarkDarkColor(ABaseColor);                         // clBlack

  if (ACanvas <> nil) and (ALineWidth > 0) and
    ((AEdgeInner <> esNone) or (AEdgeOuter <> esNone)) and (AEdgeBorders <> []) then
    with ACanvas do
    begin
      Dec(ARect.Bottom);
      Dec(ARect.Right);
      RInner := ARect;

      if AEdgeOuter <> esNone then
      begin
        if ebTop in AEdgeBorders then
          Inc(RInner.Top);
        if ebLeft in AEdgeBorders then
          Inc(RInner.Left);
        if ebRight in AEdgeBorders then
          Dec(RInner.Right);
        if ebBottom in AEdgeBorders then
          Dec(RInner.Bottom);
      end;
      Pen.Width := ALineWidth;
      if ebTop in AEdgeBorders then
      begin
        case AEdgeOuter of
          esRaised: Pen.Color := LLC;
          esLowered, esFlat: Pen.Color := DDC;
        end;
        if AEdgeOuter <> esNone then
        begin
          PenPos := ARect.TopLeft;
          LineTo(ARect.Right + 1, ARect.Top);
        end;

        case AEdgeInner of
          esRaised: Pen.Color := LC;
          esLowered, esFlat: Pen.Color := DC;
        end;
        if AEdgeInner <> esNone then
        begin
          PenPos := Point(RInner.Left, RInner.Top);
          LineTo(RInner.Right + 1, RInner.Top);
        end;
      end;

      if ebLeft in AEdgeBorders then
      begin
        case AEdgeOuter of
          esRaised: Pen.Color := LLC;
          esLowered, esFlat: Pen.Color := DDC;
        end;
        if AEdgeOuter <> esNone then
        begin
          PenPos := Point(ARect.Left, ARect.Top);
          LineTo(ARect.Left, ARect.Bottom + 1);
        end;

        case AEdgeInner of
          esRaised: Pen.Color := LC;
          esLowered, esFlat: Pen.Color := DC;
        end;
        if AEdgeInner <> esNone then
        begin
          PenPos := Point(RInner.Left, RInner.Top);
          LineTo(RInner.Left, RInner.Bottom + 1);
        end;
      end;

      if ebRight in AEdgeBorders then
      begin
        case AEdgeOuter of
          esRaised, esFlat: Pen.Color := DDC;
          esLowered: Pen.Color := LLC;
        end;
        if AEdgeOuter <> esNone then
        begin
          PenPos := Point(ARect.Right, ARect.Top);
          LineTo(ARect.Right, ARect.Bottom + 1);
        end;

        case AEdgeInner of
          esRaised, esFlat: Pen.Color := DC;
          esLowered: Pen.Color := LC;
        end;
        if AEdgeInner <> esNone then
        begin
          PenPos := Point(RInner.Right, RInner.Top);
          LineTo(RInner.Right, RInner.Bottom + 1);
        end;
      end;

      if ebBottom in AEdgeBorders then
      begin
        case AEdgeOuter of
          esRaised, esFlat: Pen.Color := DDC;
          esLowered: Pen.Color := LLC;
        end;
        if AEdgeOuter <> esNone then
        begin
          PenPos := Point(ARect.Left, ARect.Bottom);
          LineTo(ARect.Right + 1, ARect.Bottom);
        end;

        case AEdgeInner of
          esRaised, esFlat: Pen.Color := DC;
          esLowered: Pen.Color := LC;
        end;
        if AEdgeInner <> esNone then
        begin
          PenPos := Point(RInner.Left, RInner.Bottom);
          LineTo(RInner.Right + 1, RInner.Bottom);
        end;
      end;
    end;
end;

procedure DrawRoundEdge(ACanvas: TCanvas; ARect: TRect;
  AEdgeBorders: TaqEdgeBorders; AColor: TColor = clBtnFace; ALineWidth: Cardinal = 1);
var
  RInner                                                    : TRect;
begin
  if (ACanvas <> nil) and (ALineWidth > 0) and (AEdgeBorders <> []) then
    with ACanvas do
    begin
      Dec(ARect.Bottom);
      Dec(ARect.Right);
      RInner := ARect;

      if ebTop in AEdgeBorders then
        Inc(RInner.Top);
      if ebLeft in AEdgeBorders then
        Inc(RInner.Left);
      if ebRight in AEdgeBorders then
        Dec(RInner.Right);
      if ebBottom in AEdgeBorders then
        Dec(RInner.Bottom);

      Pen.Width := ALineWidth;
      Pen.Color := AColor;
      if ebTop in AEdgeBorders then
      begin
        if ebLeft in AEdgeBorders then
        begin
          PenPos := Point(ARect.Left, ARect.Top + 2);
          LineTo(ARect.Left + 2, ARect.Top);
        end
        else
          PenPos := ARect.TopLeft;
        if ebRight in AEdgeBorders then
          LineTo(ARect.Right - 1, ARect.Top)
        else
          LineTo(ARect.Right + 1, ARect.Top);
      end;
      if ebLeft in AEdgeBorders then
      begin
        if ebTop in AEdgeBorders then
          PenPos := Point(ARect.Left, ARect.Top + 2)
        else
          PenPos := Point(ARect.Left, ARect.Top);
        if ebBottom in AEdgeBorders then
        begin
          LineTo(ARect.Left, ARect.Bottom - 2);
          LineTo(ARect.Left + 3, ARect.Bottom + 1);
        end
        else
          LineTo(ARect.Left, ARect.Bottom + 1);
      end;
      if ebRight in AEdgeBorders then
      begin
        if ebTop in AEdgeBorders then
        begin
          PenPos := Point(ARect.Right - 2, ARect.Top);
          LineTo(ARect.Right, ARect.Top + 2);
        end
        else
          PenPos := Point(ARect.Right, ARect.Top);
        if ebBottom in AEdgeBorders then
          LineTo(ARect.Right, ARect.Bottom - 1)
        else
          LineTo(ARect.Right, ARect.Bottom + 1);
      end;
      if ebBottom in AEdgeBorders then
      begin
        if ebLeft in AEdgeBorders then
          PenPos := Point(ARect.Left + 2, ARect.Bottom)
        else
          PenPos := Point(ARect.Left, ARect.Bottom);
        if ebRight in AEdgeBorders then
        begin
          LineTo(ARect.Right - 2, ARect.Bottom);
          LineTo(ARect.Right + 1, ARect.Bottom - 3);
        end
        else
          LineTo(ARect.Right + 1, ARect.Bottom);
      end;
    end;
end;

function InvertEdgeStyle(AEdgeStyle: TaqEdgeStyle): TaqEdgeStyle;
const
  InvertedEdges                                             : array[TaqEdgeStyle] of TaqEdgeStyle =
    // esNone, esRaised, esLowered, esFlat
  (esNone, esLowered, esRaised, esFlat);
begin
  Result := InvertedEdges[AEdgeStyle];
end;

function GetRealColor(AColor: TColorRef): TColorRef;
{$IFDEF VCL}
var
  DC                                                        : HDC;
  {$ENDIF}
begin
  {$IFDEF VCL}
  DC := GetDC(0);
  Result := Windows.GetNearestColor(DC, AColor);
  if Result = CLR_INVALID then
    Result := AColor;
  ReleaseDC(0, DC);
  {$ELSE}
  Result := AColor;
  {$ENDIF}
end;

function DarkColorBy(Col: TColor; Percentage: Byte): TColorRef;
var
  R, G, B                                                   : Integer;
begin
  Col := ColorToRGB(Col);
  R := MultDiv(GetRValue(Col), Percentage, 100);
  G := MultDiv(GetGValue(Col), Percentage, 100);
  B := MultDiv(GetBValue(Col), Percentage, 100);
  Result := rgb(R, G, B);
end;

function LightColorBy(Col: TColor; Percentage: Byte): TColorRef;
var
  R, G, B                                                   : Integer;
begin
  Col := ColorToRGB(Col);
  R := MultDiv(GetRValue(Col), Percentage, 100) + MultDiv(100 - Percentage, 255, 100);
  G := MultDiv(GetGValue(Col), Percentage, 100) + MultDiv(100 - Percentage, 255, 100);
  B := MultDiv(GetBValue(Col), Percentage, 100) + MultDiv(100 - Percentage, 255, 100);
  Result := rgb(R, G, B);
end;

function LightColor(AColor: TColor): TColorRef;
begin
  Result := LightColorBy(AColor, 60);
end;

function LightLightColor(AColor: TColor): TColorRef;
begin
  Result := LightColorBy(AColor, 20);
end;

function DarkColor(AColor: TColor): TColorRef;
begin
  Result := DarkColorBy(AColor, 60);