cxexteditutils.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 704 行 · 第 1/2 页

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressEditors                                               }
{                                                                    }
{       Copyright (c) 1998-2008 Developer Express Inc.               }
{       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 DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSEDITORS AND ALL                }
{   ACCOMPANYING VCL 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 EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}

unit cxExtEditUtils;

{$I cxVer.inc}

interface

{.$DEFINE NOFLICKER}

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  Windows, Classes, Controls, Forms, Graphics, ImgList, Messages, StdCtrls,
  SysUtils, cxCheckBox, cxClasses, cxContainer, cxControls, cxEdit,
  cxEditPaintUtils, cxEditUtils, cxGraphics, cxLookAndFeelPainters,
  cxLookAndFeels, cxTextEdit, cxVariants, dxThemeManager;

const
  MRUDelimiterWidth = 3;

type
  { TcxControlHook }

  TcxControlHook = class(TObject)
  private
    FControl: TWinControl;
    FNewWndProc: Pointer;
    FPrevWndProcAddress: Pointer;
    FDestroying: Boolean;
  protected
    procedure SetWinControl(Value: TWinControl); virtual;
    procedure HookWndProc(var AMsg: TMessage); virtual;
  public
    constructor Create;
    destructor Destroy; override;
    procedure HookControl; virtual;
    procedure UnhookControl; virtual;
    property WinControl: TWinControl read FControl write SetWinControl;
    property IsDestroying: Boolean read FDestroying;
  end;

function DrawBounds(ACanvas: TcxCanvas; Bounds: TRect; const AUpperLeftColor,
  ALowerRightColor: TColor): TRect;
procedure DrawCanvasLine(ACanvas: TCanvas; const AColor: TColor;
  const AFromPoint, AToPoint: TPoint);
procedure DrawMRUDelimiter(ACanvas: TCanvas; const AItemRect: TRect;
  AIsItemSelected: Boolean);
procedure InflateRectEx(var R: TRect; const AlOffset, AtOffset, ArOffset, AbOffset: Integer);
function RectWidth(const ARect: TRect): Integer;
function NonCanvasTextHeight(const AFont: TFont): Integer;
function NonCanvasTextWidth(const AFont: TFont; const AText: string): Integer;
function CalcMaxWidth(ACanvas: TCanvas; const AText: string): Integer;
function RectHeight(const ARect: TRect): Integer;
function PrepareTextFlag(const AStartFlag: Longint;
  const AHorzAlignments: TAlignment; const AVertAlignments: TcxAlignmentVert;
  const AShowEndEllipsis: Boolean; const AWordWrap: Boolean;
  const ATabWidth: Integer = 0; const AIsDTFlags: Boolean = True;
  const AShowAccelChar: Boolean = False): Longint;
function IncColor(const AColor: TColor; const AR, AG, AB: Integer): TColor;
function CalcCenterPosHeight(const ARect: TRect; const ADrawHeight: Integer): Integer;
function CalcDrawWidth(const ARect: TRect; const ADrawHeight: Integer): Integer;
function IsVarEmpty(const AValue: Variant): Boolean;
function IsValidStringForInt(S: string): Boolean;
function IsValidStringForDouble(const AValue: string): Boolean;
function cxStrToInt(const AValue: string;
  AToFirstNonNum: Boolean = False): Integer;
function cxStrToFloat(const AValue: string;
  AToFirstNonNum: Boolean = False): Extended;
function cxStrToColor(const S: string; out AColor: TColor): Boolean;
function cxRGBStringColorToColor(const AString: string): TColor;
function cxHexRGBStringColorToColor(const AString: string): TColor;
function CheckStateToString(const Value: TcxCheckBoxState): string;
function StringToCheckState(const Value: string; const AllowGrayed: Boolean): TcxCheckBoxState;
function CurrentShiftState: TShiftState;
function GetWord(const APosition: Integer; const S: string;
  const Delimiter: Char): string;
procedure PaintBackground(const AControl: TWinControl; DC: HDC; DoParent: Boolean);
{$IFNDEF DELPHI5}
function SameText(const S1, S2: string): Boolean; assembler;
{$ENDIF}
function AdjustCanvasFont(ACanvas: TCanvas; AFont: TFont; AAngle: Integer): Boolean;

implementation

uses
  Math, cxDrawTextUtils, dxThemeConsts, dxUxTheme;

type
  TWinControlAccess = class(TWinControl);

{ TcxControlHook }

constructor TcxControlHook.Create;
begin
  inherited Create;
  FNewWndProc :=
    {$IFDEF DELPHI6}Classes.{$ENDIF}MakeObjectInstance(HookWndProc);
end;

destructor TcxControlHook.Destroy;
begin
  FDestroying := True;
  WinControl := nil;
  {$IFDEF DELPHI6}Classes.{$ENDIF}FreeObjectInstance(FNewWndProc);
  FNewWndProc := nil;
  inherited Destroy;
end;

procedure TcxControlHook.HookControl;
begin
  if Assigned(FControl) and not((csDesigning in FControl.ComponentState) or
    (csDestroying in FControl.ComponentState) or FDestroying) then
  begin
    FControl.HandleNeeded;
    FPrevWndProcAddress := Pointer(GetWindowLong(FControl.Handle, GWL_WNDPROC));
    SetWindowLong(FControl.Handle, GWL_WNDPROC,
      LongInt(FNewWndProc));
  end;
end;

procedure TcxControlHook.UnhookControl;
begin
  if Assigned(FControl) then
  begin
    if Assigned(FPrevWndProcAddress) and FControl.HandleAllocated and
      (Pointer(GetWindowLong(FControl.Handle, GWL_WNDPROC)) =
        FNewWndProc) then
          SetWindowLong(FControl.Handle, GWL_WNDPROC, LongInt(FPrevWndProcAddress));
  end;
  FPrevWndProcAddress := nil;
end;

procedure TcxControlHook.HookWndProc(var AMsg: TMessage);
begin
  if Assigned(FControl) and not IsDestroying then
  begin
    if Assigned(FPrevWndProcAddress) then
      AMsg.Result := CallWindowProc(FPrevWndProcAddress, FControl.Handle, AMsg.Msg,
        AMsg.WParam, AMsg.LParam)
    else
      AMsg.Result := CallWindowProc(TWinControlAccess(FControl).DefWndProc,
        FControl.Handle, AMsg.Msg, AMsg.WParam, AMsg.LParam);
    if AMsg.Msg = WM_DESTROY then
      UnhookControl;
  end;
end;

procedure TcxControlHook.SetWinControl(Value: TWinControl);
begin
  if Value <> FControl then
  begin
    if FControl <> nil then
      UnhookControl;
    FControl := Value;
    if FControl <> nil then
      HookControl;
  end;
end;
{ TcxControlHook }

function DrawBounds(ACanvas: TcxCanvas; Bounds: TRect;
  const AUpperLeftColor, ALowerRightColor: TColor): TRect;
begin
  ACanvas.Pen.Color:=AUpperLeftColor;
  ACanvas.MoveTo(Bounds.Left, Bounds.Top);
  ACanvas.LineTo(Bounds.Left, Bounds.Bottom + 1);
  ACanvas.MoveTo(Bounds.Left, Bounds.Top);
  ACanvas.LineTo(Bounds.Right + 1, Bounds.Top);
  ACanvas.Pen.Color:=ALowerRightColor;
  ACanvas.MoveTo(Bounds.Right, Bounds.Top + 1);
  ACanvas.LineTo(Bounds.Right, Bounds.Bottom);
  ACanvas.MoveTo(Bounds.Left + 1, Bounds.Bottom);
  ACanvas.LineTo(Bounds.Right + 1, Bounds.Bottom);
  Result.Left := Bounds.Left + 1;
  Result.Top := Bounds.Top + 1;
  Result.Right := Bounds.Right - 1;
  Result.Bottom := Bounds.Bottom - 1;
end;

procedure DrawCanvasLine(ACanvas: TCanvas;const AColor: TColor;
  const AFromPoint, AToPoint: TPoint);
begin
  ACanvas.Pen.Color := AColor;
  ACanvas.MoveTo(AFromPoint.x, AFromPoint.y);
  ACanvas.LineTo(AToPoint.x, AToPoint.y);
end;

procedure DrawMRUDelimiter(ACanvas: TCanvas; const AItemRect: TRect;
  AIsItemSelected: Boolean);
begin
  if AIsItemSelected then
    ACanvas.Pen.Color := clWindow
  else
    ACanvas.Pen.Color := clWindowText;
  ACanvas.MoveTo(AItemRect.Left, AItemRect.Bottom - MRUDelimiterWidth);
  ACanvas.LineTo(AItemRect.Right, AItemRect.Bottom - MRUDelimiterWidth);
  ACanvas.MoveTo(AItemRect.Left, AItemRect.Bottom - 1);
  ACanvas.LineTo(AItemRect.Right, AItemRect.Bottom - 1);
end;

procedure InflateRectEx(var R: TRect; const AlOffset, AtOffset, ArOffset, AbOffset: Integer);
begin
  with R do
  begin
    Left := Left + AlOffset;
    Top := Top + AtOffset;
    Right := Right + ArOffset;
    Bottom := Bottom + AbOffset;
  end;
end;

function RectWidth(const ARect: TRect): Integer;
begin
  Result := ARect.Right - ARect.Left;
  if Result < 0 then
    Result := 0;
end;

function RectHeight(const ARect: TRect): Integer;
begin
  Result := ARect.Bottom - ARect.Top;
  if Result < 0 then
    Result := 0;
end;

function PrepareTextFlag(const AStartFlag: Longint;
  const AHorzAlignments: TAlignment; const AVertAlignments: TcxAlignmentVert;
  const AShowEndEllipsis: Boolean; const AWordWrap: Boolean;
  const ATabWidth: Integer = 0; const AIsDTFlags: Boolean = True;
  const AShowAccelChar: Boolean = False): Longint;
const
  ShowAccelCharArray: array[Boolean] of Integer = (DT_NOPREFIX, 0);
  cxShowAccelCharArray: array[Boolean] of Integer = (0, cxShowPrefix);

  ShowEndEllipsisArray: array[Boolean] of Integer = (0, DT_END_ELLIPSIS);
  cxShowEndEllipsisArray: array[Boolean] of Integer = (0, cxShowEndEllipsis);

  WordWrapArray: array[Boolean] of Integer = (0, DT_WORDBREAK);
  cxWordWrapArray: array[Boolean] of Integer = (0, cxWordBreak);

begin
  Result := AStartFlag;
  if AIsDTFlags then
  begin
    Result := Result or SystemAlignmentsHorz[AHorzAlignments] or
      SystemAlignmentsVert[AVertAlignments] or
      ShowEndEllipsisArray[AShowEndEllipsis] or
      WordWrapArray[AWordWrap] or ShowAccelCharArray[AShowAccelChar];
    if ATabWidth > 0 then
      Result := Result or DT_EXPANDTABS or DT_TABSTOP;
  end
  else
  begin
    Result := Result or cxAlignmentsHorz[AHorzAlignments] or
      cxAlignmentsVert[AVertAlignments] or
      cxShowEndEllipsisArray[AShowEndEllipsis] or
      cxWordWrapArray[AWordWrap] or cxShowAccelCharArray[AShowAccelChar];
    if ATabWidth > 0 then
      Result := Result or cxExpandTabs;
  end;
end;

function NonCanvasTextHeight(const AFont: TFont): Integer;
var
  FBitmap: TBitmap;
begin
  FBitmap := TBitmap.Create;
  try
    FBitmap.Canvas.Font.Assign(AFont);
    Result := FBitmap.Canvas.TextHeight('Wg');
  finally
    FBitmap.Free;
  end;
end;

function NonCanvasTextWidth(const AFont: TFont; const AText: string): Integer;
var
  FBitmap: TBitmap;
begin
  FBitmap := TBitmap.Create;
  try
    FBitmap.Canvas.Font.Assign(AFont);
    Result := FBitmap.Canvas.TextWidth(AText);
  finally
    FBitmap.Free;
  end;
end;

function CalcMaxWidth(ACanvas: TCanvas; const AText: string): Integer;
var
  FStringList: TStringList;
  I, FWidth: Integer;
begin
  Result := ACanvas.TextWidth(AText);
  FStringList := TStringList.Create;
  try
    FStringList.Text := AText;
    for I := 0 to FStringList.Count - 1 do
    begin
      FWidth := ACanvas.TextWidth(FStringList[I]);
      if FWidth > Result then Result := FWidth;
    end;
  finally
    FStringList.Free;
  end;
  Inc(Result, 1);
end;

function IncColor(const AColor: TColor; const AR, AG, AB: Integer): TColor;
var
  FR, FG, FB: Integer;
begin
  FR := GetRValue(ColorToRGB(AColor));
  FG := GetGValue(ColorToRGB(AColor));
  FB := GetBValue(ColorToRGB(AColor));
  if (FR + AR) > High(Byte) then
    FR := High(Byte)