cxeditutils.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 862 行 · 第 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 cxEditUtils;

{$I cxVer.inc}

interface

{.$DEFINE NOFLICKER}

uses
  Windows,
  dxThemeManager,
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  Classes, Controls, Forms, Graphics, ImgList, StdCtrls, SysUtils,
  cxContainer, cxControls, cxEdit, cxEditPaintUtils,
  cxGraphics, cxLookAndFeels, cxLookAndFeelPainters, cxScrollBar;

const
  cxEditButtonMaxBorderWidth = 2;
  cxEditMaxBorderWidth = cxContainerMaxBorderWidth;
  cxEditMaxCheckBoxBorderWidth = 2;
  cxEditShadowWidth = cxContainerShadowWidth;

type
  TcxEditCanvasHandle = HDC;

function CalculateEditDefaultButtonWidth(ACanvas: TcxCanvas; AViewInfo: TcxEditButtonViewInfo): Integer;
function cxEditGetBorderWidthBySkinPainter(ABorderStyle: TcxEditBorderStyle;
  ASkinPainter: TcxCustomLookAndFeelPainterClass): Integer;
procedure cxEditFillRect(ACanvas: TCanvas; const R: TRect; AColor: TColor); overload;
procedure cxEditFillRect(ACanvas: TcxCanvas; const R: TRect; AColor: TColor); overload;
procedure cxEditFillRect(ACanvasHandle: TcxEditCanvasHandle; const R: TRect;
  ABrush: TBrushHandle); overload;
function cxOffsetRect(var ARect: TRect; AOffset: TPoint): Boolean;
function cxTextOutFlagsToDrawTextFlags(AFlags: DWORD): Integer;
procedure DrawArrow(ACanvas: TcxCanvas; AArrowSize: Integer; AContentRect: TRect;
  AArrowDirection: TcxArrowDirection; AIsDoubleArrow: Boolean;
  AOffsetContent: Boolean; AColor: TColor);
procedure DrawButtonBorder(ACanvas: TcxCanvas; var ARect: TRect;
  ABorders: TcxBorders; AColor: TColor);
procedure DrawCustomEdit(ACanvas: TcxCanvas; AViewInfo: TcxCustomEditViewInfo;
  ADrawBackground: Boolean; ABackgroundStyle: TcxEditBackgroundPaintingStyle);
function DrawTextFlagsTocxTextOutFlags(AFlags: DWORD): Integer;
procedure DrawGlyph(ACanvas: TCanvas; X, Y: Integer; AGlyph: TBitmap;
  AEnabled: Boolean; ABrushColor: TColor = clNone; ABackgroundBitmap: TBitmap = nil); overload;
procedure DrawGlyph(ACanvas: TcxCanvas; X, Y: Integer; AGlyph: TBitmap;
  AEnabled: Boolean; ABrushColor: TColor = clNone; ABackgroundBitmap: TBitmap = nil); overload;
procedure DrawGlyph(ACanvas: TcxCanvas; AImageList: TCustomImageList;
  AImageIndex: TImageIndex;
  const AGlyphRect: TRect; ABrushColor: TColor; AEnabled: Boolean;
  ABackgroundBitmap: TBitmap = nil); overload;
function GetArrowSize(const AContentSize: TSize; AArrowDirection: TcxArrowDirection): TSize;
function GetEditButtonsContentVerticalOffset(ACanvas: TcxCanvas;
  AButtonsStyle: TcxEditButtonStyle; ANativeStyle: Boolean): Integer;
function GetHotTrackColor: TColor;
function GetNativeInnerTextEditContentHeightCorrection(
  AProperties: TcxCustomEditProperties; AIsInplace: Boolean): Integer;
function GetEditButtonRegion(ACanvas: TcxCanvas; AViewInfo: TcxEditButtonViewInfo): TcxRegion;
function GetEditBorderHighlightColor(AIsOffice11Style: Boolean): TColor;
function GetEditButtonHighlightColor(APressed: Boolean;
  AIsOffice11Style: Boolean): TColor;
function GetPainterClass(ANativeStyle: Boolean;
  ALookAndFeel: TcxLookAndFeelKind): TcxCustomLookAndFeelPainterClass;
procedure InternalFillRect(ACanvas: TcxCanvas; const AOuterRect, AInternalRect: TRect;
  ABrush: TBrushHandle);
procedure InternalPolyLine(ACanvas: TcxCanvas; const Points: array of TPoint;
  AColor: TColor; AOrtoDrawing: Boolean = False);
function IsShadowDrawingNeeded(AViewData: TcxCustomEditViewData): Boolean;
procedure RestoreCanvasFont(ACanvas: TcxCanvas; const ASavedLogFont: TLogFont);
procedure SaveCanvasFont(ACanvas: TcxCanvas; out ALogFont: TLogFont);
function VerifyBitmap(ABitmap: TBitmap): Boolean;
function VerifyImages(AImages: TCustomImageList): Boolean;

implementation

uses
  Messages, cxClasses, cxDrawTextUtils, dxOffice11, dxThemeConsts, dxUxTheme, cxGeometry, cxDWMApi;

const
  cxEditButtonContentVerticalOffset: array [TcxEditButtonStyle] of Integer =
    (0, 4, 2, 2, 2, 2, 2);

var
  FIsWin98Or2000: Boolean = False;

procedure RetrieveWindowsVersion;
var
  AInfo: TOSVersionInfo;
begin
  AInfo.dwOSVersionInfoSize := SizeOf(AInfo);
  GetVersionEx(AInfo);
  with AInfo do
    FIsWin98Or2000 :=
      (dwPlatformId = VER_PLATFORM_WIN32_WINDOWS) and (dwMinorVersion <> 0) or
      (dwPlatformId = VER_PLATFORM_WIN32_NT) and (dwMajorVersion = 5);
end;

procedure DrawArrow(ACanvas: TcxCanvas; AArrowSize: Integer; AContentRect: TRect;
  AArrowDirection: TcxArrowDirection; AIsDoubleArrow: Boolean;
  AOffsetContent: Boolean; AColor: TColor);
var
  AArrowBrush: TBrushHandle;
  AArrowRect: TRect;

  procedure InternalDrawArrow;
  var
    I: Integer;
    R: TRect;
  begin
    case AArrowDirection of
      adLeft:
        begin
          with AArrowRect do
            R := Rect(Left, Top + AArrowSize - 1, Left + 1, Top + AArrowSize);
          with R do
            for I := 1 to AArrowSize do
            begin
              cxEditFillRect(ACanvas.Handle, R, AArrowBrush);
              Inc(Left);
              Dec(Top);
              Inc(Right);
              Inc(Bottom);
            end;
          Inc(AArrowRect.Left, AArrowSize);
        end;
      adRight:
        begin
          with AArrowRect do
            R := Rect(Left, Top, Left + 1, Bottom);
          with R do
            for I := 1 to AArrowSize do
            begin
              cxEditFillRect(ACanvas.Handle, R, AArrowBrush);
              Inc(Left);
              Inc(Top);
              Inc(Right);
              Dec(Bottom);
            end;
          Inc(AArrowRect.Left, AArrowSize);
        end;
      adUp:
        begin
          with AArrowRect do
            R := Rect(Left + AArrowSize - 1, Top, Left + AArrowSize, Top + 1);
          with R do
            for I := 1 to AArrowSize do
            begin
              cxEditFillRect(ACanvas.Handle, R, AArrowBrush);
              Dec(Left);
              Inc(Top);
              Inc(Right);
              Inc(Bottom);
            end;
          Inc(AArrowRect.Top, AArrowSize);
        end;
      adDown:
        begin
          with AArrowRect do
            R := Rect(Left, Top, Right, Top + 1);
          with R do
            for I := 1 to AArrowSize do
            begin
              cxEditFillRect(ACanvas.Handle, R, AArrowBrush);
              Inc(Left);
              Inc(Top);
              Dec(Right);
              Inc(Bottom);
            end;
          Inc(AArrowRect.Top, AArrowSize);
        end;
    end;
  end;

var
  AArrowRectSize: TSize;
  I: Integer;
begin
  if AArrowDirection in [adLeft, adRight] then
  begin
    AArrowRectSize.cx := AArrowSize * (1 + Integer(AIsDoubleArrow));
    AArrowRectSize.cy := AArrowSize * 2 - 1;
  end
  else
  begin
    AArrowRectSize.cx := AArrowSize * 2 - 1;
    AArrowRectSize.cy := AArrowSize * (1 + Integer(AIsDoubleArrow));
  end;

  with AContentRect do
  begin
    AArrowRect.Left := Left + (Right - Left - AArrowRectSize.cx) div 2;
    AArrowRect.Top := Top + (Bottom - Top - AArrowRectSize.cy) div 2;
    if AOffsetContent then
    begin
      Inc(AArrowRect.Left);
      Inc(AArrowRect.Top);
    end;
    AArrowRect.Right := AArrowRect.Left + AArrowRectSize.cx;
    AArrowRect.Bottom := AArrowRect.Top + AArrowRectSize.cy;
  end;

  AArrowBrush := GetSolidBrush(ACanvas, AColor);
  for I := 0 to Integer(AIsDoubleArrow) do
    InternalDrawArrow;
end;

procedure DrawButtonBorder(ACanvas: TcxCanvas; var ARect: TRect;
  ABorders: TcxBorders; AColor: TColor);
var
  AWorkRect: TRect;
begin
  AWorkRect := ARect;
  Dec(AWorkRect.Bottom, 1);
  Dec(AWorkRect.Right, 1);
  ACanvas.Pen.Color := AColor;

  if bLeft in ABorders then
  begin
    InternalPolyLine(ACanvas, [AWorkRect.TopLeft, Point(AWorkRect.Left, AWorkRect.Bottom)], AColor);
    Inc(ARect.Left);
  end;
  if bRight in ABorders then
  begin
    InternalPolyLine(ACanvas, [Point(AWorkRect.Right, AWorkRect.Top), AWorkRect.BottomRight], AColor);
    Dec(ARect.Right);
  end;
  if bTop in ABorders then
  begin
    InternalPolyLine(ACanvas, [AWorkRect.TopLeft, Point(AWorkRect.Right, AWorkRect.Top)], AColor);
    Inc(ARect.Top);
  end;
  if bBottom in ABorders then
  begin
    InternalPolyLine(ACanvas, [Point(AWorkRect.Left, AWorkRect.Bottom), AWorkRect.BottomRight], AColor);
    Dec(ARect.Bottom);
  end;
end;

procedure DrawGlyph(ACanvas: TCanvas; X, Y: Integer; AGlyph: TBitmap;
  AEnabled: Boolean; ABrushColor: TColor = clNone; ABackgroundBitmap: TBitmap = nil);

  procedure InternalDrawGlyph1;
  var
    AGlyphDrawingBrush: TBrush;
    APrevBrushStyle: TBrushStyle;
    R: TRect;
  begin
    if ABackgroundBitmap = nil then
      AGlyphDrawingBrush := ACanvas.Brush
    else
      AGlyphDrawingBrush := ABackgroundBitmap.Canvas.Brush;
    APrevBrushStyle := AGlyphDrawingBrush.Style;

    with ACanvas do
    begin
      if (ABackgroundBitmap <> nil) or (ABrushColor = clNone) then
        AGlyphDrawingBrush.Style := bsClear
      else
        AGlyphDrawingBrush.Color := ABrushColor;
      if ABackgroundBitmap = nil then
        ACanvas.BrushCopy(Bounds(X, Y, AGlyph.Width, AGlyph.Height), AGlyph,
          Rect(0, 0, AGlyph.Width, AGlyph.Height), AGlyph.TransparentColor)
      else
      begin
        R := Rect(0, 0, AGlyph.Width, AGlyph.Height);
        ABackgroundBitmap.Canvas.BrushCopy(R, AGlyph, R, AGlyph.TransparentColor);
        ACanvas.Draw(X, Y, ABackgroundBitmap);
      end;
    end;

    AGlyphDrawingBrush.Style := APrevBrushStyle;
  end;

  procedure InternalDrawGlyph2;
  var
    ABitmap: TBitmap;
    AImageList: TImageList;
  begin
    ABitmap := nil;
    AImageList := nil;
    try
      AImageList := TImageList.Create(nil);
      AImageList.Width := AGlyph.Width;
      AImageList.Height := AGlyph.Height;
      if (ABackgroundBitmap = nil) and (ABrushColor <> clNone) then
      begin
        ABitmap := TBitmap.Create;
        ABitmap.Width := AImageList.Width;
        ABitmap.Height := AImageList.Height;
        with ABitmap.Canvas do
          cxEditFillRect(Handle, Rect(0, 0, ABitmap.Width, ABitmap.Height),
            GetSolidBrush(ABitmap.Canvas, ABrushColor));
      end;
      AImageList.AddMasked(AGlyph, AGlyph.TransparentColor);
      if ABitmap <> nil then
      begin
        AImageList.Draw(ABitmap.Canvas, 0, 0, 0, AEnabled);
        ACanvas.Draw(X, Y, ABitmap);
      end
      else
        if ABackgroundBitmap = nil then
          AImageList.Draw(ACanvas, X, Y, 0, AEnabled)
        else
        begin
          AImageList.Draw(ABackgroundBitmap.Canvas, 0, 0, 0, AEnabled);
          ACanvas.Draw(X, Y, ABackgroundBitmap);
        end;
    finally
      if ABitmap <> nil then
        ABitmap.Free;
      if AImageList <> nil then
        AImageList.Free;
    end;
  end;

begin
  if AEnabled then
    InternalDrawGlyph1
  else
    InternalDrawGlyph2;
end;

procedure DrawGlyph(ACanvas: TcxCanvas; X, Y: Integer; AGlyph: TBitmap;
  AEnabled: Boolean; ABrushColor: TColor = clNone; ABackgroundBitmap: TBitmap = nil);
begin
  DrawGlyph(ACanvas.Canvas, X, Y, AGlyph, AEnabled, ABrushColor, ABackgroundBitmap);
end;

procedure DrawGlyph(ACanvas: TcxCanvas; AImageList: TCustomImageList;
  AImageIndex: TImageIndex;
  const AGlyphRect: TRect; ABrushColor: TColor; AEnabled: Boolean;
  ABackgroundBitmap: TBitmap = nil);
var
  ABitmap: TBitmap;
begin
  ABitmap := nil;
  try
    if ABackgroundBitmap = nil then
    begin
      ABitmap := TBitmap.Create;
      ABitmap.Width := AImageList.Width;
      ABitmap.Height := AImageList.Height;
      with ABitmap.Canvas do
        cxEditFillRect(Handle, Rect(0, 0, ABitmap.Width, ABitmap.Height),
          GetSolidBrush(ABitmap.Canvas, ABrushColor));
    end;
    if ABackgroundBitmap <> nil then
    begin
      AImageList.Draw(ABackgroundBitmap.Canvas, 0, 0, AImageIndex, AEnabled); // ??? itMask TODO
      ACanvas.Draw(AGlyphRect.Left, AGlyphRect.Top, ABackgroundBitmap);
    end else
    begin
      AImageList.Draw(ABitmap.Canvas, 0, 0, AImageIndex, AEnabled); // ??? itMask TODO
      ACanvas.Draw(AGlyphRect.Left, AGlyphRect.Top, ABitmap);
    end;
  finally
    if ABitmap <> nil then
      ABitmap.Free;
  end;
end;

function GetPainterClass(ANativeStyle: Boolean;
  ALookAndFeel: TcxLookAndFeelKind): TcxCustomLookAndFeelPainterClass;
const
  APainterMap: array[TcxLookAndFeelKind] of TcxCustomLookAndFeelPainterClass = (
    TcxFlatLookAndFeelPainter, TcxStandardLookAndFeelPainter,
    TcxUltraFlatLookAndFeelPainter, TcxOffice11LookAndFeelPainter
  );
begin
  if ANativeStyle and AreVisualStylesAvailable then
    Result := TcxWinXPLookAndFeelPainter
  else
    Result := APainterMap[ALookAndFeel];
end;

procedure InternalPolyLine(ACanvas: TcxCanvas; const Points: array of TPoint;
  AColor: TColor; AOrtoDrawing: Boolean = False);
var
  I: Integer;
  P1, P2: TPoint;
  ABrush: TBrushHandle;
begin
  with ACanvas do
    if AOrtoDrawing then
    begin
      ABrush := GetSolidBrush(AColor);
      for I := 0 to Length(Points) - 2 do
      begin
        P1 := Points[I];
        P2 := Points[I + 1];
        if P1.X = P2.X then
        begin
          Inc(P2.X);
          if P1.Y > P2.Y then
          begin