cxlabel.pas

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

{********************************************************************}
{                                                                    }
{       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 cxLabel;

{$I cxVer.inc}

interface

uses
{$IFDEF DELPHI6}
  Types, Variants,
{$ENDIF}
  Windows, Classes, Controls, Forms, Graphics, Messages, SysUtils, cxClasses,
  cxContainer, cxControls, cxCustomData, cxDataUtils, cxEdit, cxExtEditConsts,
  cxGraphics, cxTextEdit, cxVariants;

type
  TcxLabelEffect = (cxleNormal, cxleFun, cxleExtrude, cxleCool);
  TcxLabelStyle = (cxlsNormal, cxlsRaised, cxlsLowered, cxlsOutLine);
  TcxLabelOrientation = (cxoLeft, cxoRight, cxoTop, cxoBottom, cxoLeftTop,
    cxoLeftBottom, cxoRightTop, cxoRightBottom);

  { TcxLabelEditStyle }

  TcxLabelEditStyle = class(TcxEditStyle)
  protected
    function DefaultBorderStyle: TcxContainerBorderStyle; override;
    function DefaultHotTrack: Boolean; override;
  end;

  { TcxCustomLabelViewInfo }

  TcxCustomLabelViewInfo = class(TcxCustomTextEditViewInfo)
  private
    FAlignment: TcxEditAlignment;
    FAngle: Integer;
    FDepth: Word;
    FDepthDeltaSize: TSize;
    FDrawBitmap: TBitmap;
    FGlyph: TBitmap;
    FIsDrawBitmapDirty: Boolean;
    FInplaceOffset: TPoint;
    FLabelEffect: TcxLabelEffect;
    FLabelStyle: TcxLabelStyle;
    FLabelTextRect: TRect;
    FOrientation: TcxLabelOrientation;
    FPenWidth: Integer;
    FShadowedColor: TColor;
    FWordWrap: Boolean;
  protected
    procedure SetBackgroundColor(Value: TColor); override;
    property Alignment: TcxEditAlignment read FAlignment write FAlignment;
    property LabelEffect: TcxLabelEffect read FLabelEffect write FLabelEffect;
    property LabelStyle: TcxLabelStyle read FLabelStyle write FLabelStyle;
    property Orientation: TcxLabelOrientation read FOrientation write FOrientation;
    property Depth: Word read FDepth write FDepth;
    property DepthDeltaSize: TSize read FDepthDeltaSize write FDepthDeltaSize;
    property ShadowedColor: TColor read FShadowedColor write FShadowedColor;
    property Angle: Integer read FAngle write FAngle;
    property PenWidth: Integer read FPenWidth write FPenWidth;
    property WordWrap: Boolean read FWordWrap write FWordWrap;
    property Glyph: TBitmap read FGlyph write FGlyph;
    property LabelTextRect: TRect read FLabelTextRect write FLabelTextRect;
  public
    DrawTextOffsets: TRect;
    FocusRect: TRect;
    HasGlyph: Boolean;
    LeftTop: TPoint;
    ShowAccelChar: Boolean;
    constructor Create; override;
    destructor Destroy; override;
    procedure Offset(DX, DY: Integer); override;
    procedure Paint(ACanvas: TcxCanvas); override;
    procedure DrawLabel(ACanvas: TcxCanvas); virtual;
  end;

  { TcxCustomLabelViewData }

  TcxCustomLabelProperties = class;

  TcxCustomLabelViewData = class(TcxCustomEditViewData)
  private
    function GetProperties: TcxCustomLabelProperties;
    procedure CalculateLabelViewInfoProps(AViewInfo: TcxCustomEditViewInfo);
  protected
    function GetDrawTextFlags: Integer; virtual;
    function GetIsEditClass: Boolean;
    function InternalEditValueToDisplayText(AEditValue: TcxEditValue): string; override;
  public
    procedure Calculate(ACanvas: TcxCanvas; const ABounds: TRect; const P: TPoint;
      Button: TcxMouseButton; Shift: TShiftState; AViewInfo: TcxCustomEditViewInfo;
      AIsMouseEvent: Boolean); override;
    procedure EditValueToDrawValue(ACanvas: TcxCanvas; const AEditValue: TcxEditValue;
      AViewInfo: TcxCustomEditViewInfo); override;
    function GetEditContentSize(ACanvas: TcxCanvas; const AEditValue: TcxEditValue;
      const AEditSizeProperties: TcxEditSizeProperties): TSize; override;
    property Properties: TcxCustomLabelProperties read GetProperties;
  end;

  { TcxCustomLabelProperties }

  TcxCustomLabelProperties = class(TcxCustomEditProperties)
  private
    FLabelEffect: TcxLabelEffect;
    FLabelStyle: TcxLabelStyle;
    FOrientation: TcxLabelOrientation;
    FDepth: Word;
    FShadowedColor: TColor;
    FShowAccelChar: Boolean;
    FShowEndEllipsis: Boolean; // deprecated
    FAngle: Integer;
    FPenWidth: Integer;
    FGlyph: TBitmap;
    FWordWrap: Boolean;
    procedure SetLabelEffect(Value : TcxLabelEffect);
    procedure SetLabelStyle(Value : TcxLabelStyle);
    procedure SetOrientation(Value : TcxLabelOrientation);
    procedure SetDepth(Value : Word);
    procedure SetShadowedColor(Value : TColor);
    procedure SetAngle(Value: Integer);
    procedure SetPenWidth(Value: Integer);
    function GetGlyph: TBitmap;
    procedure GlyphChanged(Sender: TObject);
    procedure SetGlyph(Value: TBitmap);
    procedure SetShowAccelChar(Value: Boolean);
    procedure SetWordWrap(Value: Boolean);
  protected
    class function GetViewDataClass: TcxCustomEditViewDataClass; override;
    function HasDisplayValue: Boolean; override;
    function CalculateDepthDelta: TSize; virtual;
    function GetDisplayFormatOptions: TcxEditDisplayFormatOptions; override;
    property ShowEndEllipsis: Boolean read FShowEndEllipsis
      write FShowEndEllipsis stored False; // deprecated
  public
    constructor Create(AOwner: TPersistent); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function CanCompareEditValue: Boolean; override;
    class function GetContainerClass: TcxContainerClass; override;
    class function GetStyleClass: TcxCustomEditStyleClass; override;
    function GetDisplayText(const AEditValue: TcxEditValue;
      AFullText: Boolean = False; AIsInplace: Boolean = True): WideString; override;
    function GetSupportedOperations: TcxEditSupportedOperations; override;
    class function GetViewInfoClass: TcxContainerViewInfoClass; override;
    function IsEditValueValid(var EditValue: TcxEditValue; AEditFocused: Boolean): Boolean; override;
    procedure PrepareDisplayValue(const AEditValue: TcxEditValue;
      var DisplayValue: TcxEditValue; AEditFocused: Boolean); override;
    function GetEditValueSource(AEditFocused: Boolean): TcxDataEditValueSource; override;
    // !!!
    property Angle: Integer read FAngle write SetAngle default 0;
    property Depth: Word read FDepth write SetDepth default 0;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property LabelEffect: TcxLabelEffect read FLabelEffect
      write SetLabelEffect default cxleNormal;
    property LabelStyle: TcxLabelStyle read FLabelStyle
      write SetLabelStyle default cxlsNormal;
    property Orientation: TcxLabelOrientation read FOrientation
      write SetOrientation default cxoRightBottom;
    property PenWidth: Integer read FPenWidth write SetPenWidth default 1;
    property ShadowedColor: TColor read FShadowedColor
      write SetShadowedColor default clGrayText;
    property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar
      default True;
    property Transparent; // deprecated
    property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
  end;

  { TcxLabelProperties }

  TcxLabelProperties = class(TcxCustomLabelProperties)
  published
    property Alignment;
    property Angle;
    property Depth;
    property Glyph;
    property LabelEffect;
    property LabelStyle;
    property Orientation;
    property PenWidth;
    property ShadowedColor;
    property ShowAccelChar;
    property ShowEndEllipsis; // deprecated
    property Transparent; // deprecated
    property WordWrap;
  end;

  { TcxCustomLabel }

  TcxCustomLabel = class(TcxCustomEdit)
  private
    FFocusControl: TWinControl;
    FLockCaption: Boolean;
    function GetProperties: TcxCustomLabelProperties;
    function GetActiveProperties: TcxCustomLabelProperties;
    function GetStyle: TcxLabelEditStyle;
    function GetViewInfo: TcxCustomLabelViewInfo;
    procedure SetProperties(Value: TcxCustomLabelProperties);
    procedure SetStyle(Value: TcxLabelEditStyle);
    procedure SetFocusControl(Value: TWinControl);
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  protected
    procedure Initialize; override;
    procedure InternalSetEditValue(const Value: TcxEditValue; AValidateEditValue: Boolean); override;
    function IsRightBoundFixed: Boolean; override;
    procedure Loaded; override;
    procedure SetInternalDisplayValue(Value: TcxEditValue); override;
    procedure TextChanged; override;
    function CanAutoWidth: Boolean; override;
    function CanFocusOnClick: Boolean; override;
    function DefaultParentColor: Boolean; override;
    procedure Notification(ACOmponent: TComponent; Operation: TOperation); override;
    property FocusControl: TWinControl read FFocusControl write SetFocusControl;
    property ViewInfo: TcxCustomLabelViewInfo read GetViewInfo;
  public
    destructor Destroy; override;
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    function CanFocus: Boolean; override;
  {$IFDEF DELPHI10}
    function GetTextBaseLine: Integer; override;
    function HasTextBaseLine: Boolean; override;
  {$ENDIF}
    property ActiveProperties: TcxCustomLabelProperties
      read GetActiveProperties;
    property Caption;
    property Properties: TcxCustomLabelProperties read GetProperties
      write SetProperties;
    property Style: TcxLabelEditStyle read GetStyle write SetStyle;
    property TabOrder stored False;
    property Transparent;
  end;

  { TcxCustomLabel }

  TcxLabel = class(TcxCustomLabel)
  private
    function GetActiveProperties: TcxLabelProperties;
    function GetProperties: TcxLabelProperties;
    procedure SetProperties(Value: TcxLabelProperties);
  public
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    property ActiveProperties: TcxLabelProperties read GetActiveProperties;
  published
    property Align;
    property Anchors;
    property AutoSize;
    property Caption;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FocusControl;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property Properties: TcxLabelProperties read GetProperties
      write SetProperties;
    property ShowHint;
    property Style;
    property StyleDisabled;
    property StyleFocused;
    property StyleHot;
    property TabOrder;
    property Transparent;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;
  end;

implementation

uses
  Math, cxEditConsts, cxEditPaintUtils, cxEditUtils, cxExtEditUtils,
  cxFilterControlUtils, dxThemeConsts, dxThemeManager, dxUxTheme;

const
  TextFromBorderOffset = 1;

procedure CalculateCustomLabelViewInfo(ACanvas: TcxCanvas; AViewData: TcxCustomLabelViewData;
  AViewInfo: TcxCustomLabelViewInfo);

  procedure CheckFocusRectBounds;
  begin
    with AViewInfo do
    begin
      if FocusRect.Left < TextRect.Left - 1 then
        FocusRect.Left := TextRect.Left - 1;
      if FocusRect.Top < TextRect.Top - 1 then
        FocusRect.Top := TextRect.Top - 1;
      if FocusRect.Right > TextRect.Right + 1 then
        FocusRect.Right := TextRect.Right + 1;
      if FocusRect.Bottom > TextRect.Bottom + 1 then
        FocusRect.Bottom := TextRect.Bottom + 1;
    end;
  end;

begin
  with AViewInfo do
  begin
    if not IsInplace and Focused then
      if Length(Text) = 0 then
        FocusRect := cxEmptyRect
      else
      begin
        FocusRect := TextRect;
        InflateRect(FocusRect, 1, 1);
        CheckFocusRectBounds;
      end;
  end;
end;

{ TcxLabelEditStyle }

function TcxLabelEditStyle.DefaultBorderStyle: TcxContainerBorderStyle;
begin
  if IsBaseStyle then
    Result := cbsNone
  else
    Result := inherited DefaultBorderStyle;
end;

function TcxLabelEditStyle.DefaultHotTrack: Boolean;
begin
  Result := False;
end;

{ TcxCustomLabelViewInfo }

constructor TcxCustomLabelViewInfo.Create;
begin
  inherited Create;
  FAlignment := TcxEditAlignment.Create(nil);
  FDrawBitmap := TBitmap.Create;
  FInplaceOffset := Point(MaxInt, MaxInt);
end;

destructor TcxCustomLabelViewInfo.Destroy;
begin
  FreeAndNil(FDrawBitmap);
  if Assigned(FAlignment) then FreeAndNil(FAlignment);
  inherited;
end;

procedure TcxCustomLabelViewInfo.Offset(DX, DY: Integer);
begin
  inherited Offset(DX, DY);
  OffsetRect(FLabelTextRect, DX, DY);
  OffsetRect(FocusRect, DX, DY);
  if Transparent then
    FIsDrawBitmapDirty := True;
end;

procedure TcxCustomLabelViewInfo.Paint(ACanvas: TcxCanvas);
begin
  DrawCustomEdit(ACanvas, Self, False, bpsSolid);
  DrawLabel(ACanvas);
end;

procedure TcxCustomLabelViewInfo.DrawLabel(ACanvas: TcxCanvas);

  function GetColor(BColor, EColor: TColor; N,H: Integer) : TColor;
  begin
    EColor := ColorToRGB(EColor);
    BColor := ColorToRGB(BColor);

    Result := RGB(Trunc(GetRValue(BColor) + (GetRValue(EColor) - GetRValue(BColor)) * N / H),
                  Trunc(GetGValue(BColor) + (GetGValue(EColor) - GetGValue(BColor)) * N / H),
                  Trunc(GetBValue(BColor) + (GetBValue(EColor) - GetBValue(BColor)) * N / H));
  end;

  procedure DrawBackground(ADrawCanvas: TcxCanvas; const ADrawingRect: TRect;
    AParentBackgroundOffset: TPoint);
  begin
    if Self.DrawBackground(ADrawCanvas, AParentBackgroundOffset) then
      Exit;
    if not Transparent or IsInplace and Focused then
      cxEditFillRect(ADrawCanvas, ADrawingRect, BackgroundColor)
    else
      if IsInplace then
        BitBlt(ADrawCanvas.Handle, ADrawingRect.Left, ADrawingRect.Top,
          RectWidth(ADrawingRect), RectHeight(ADrawingRect), ACanvas.Handle,
          AParentBackgroundOffset.X, AParentBackgroundOffset.Y, SRCCOPY)
      else
      begin
        if not (csPaintCopy in Edit.ControlState) then
        begin
          with AParentBackgroundOffset do
            cxDrawTransparentControlBackground(Edit, ADrawCanvas,
              Rect(X, Y, X + RectWidth(ADrawingRect), Y + RectHeight(ADrawingRect)));
        end;
      end;
  end;

  function GetLabelStyleOffset: Integer;
  begin
    Result := 0;
    if LabelStyle in [cxlsRaised, cxlsLowered] then
    begin
      if Font.Size >= 12 then
        Result := 2
      else
        Result := 1;
    end;
  end;