cxmemo.pas

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

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

{$I cxVer.inc}

interface

uses
  Windows, Messages,
{$IFDEF DELPHI6}
  Types,
{$ENDIF}
  Classes, Controls, Forms, Graphics, Menus, StdCtrls, SysUtils, cxClasses,
  cxContainer, cxControls, cxDataStorage, cxDataUtils, cxEdit, cxDrawTextUtils,
  cxGraphics, cxLookAndFeels, cxTextEdit, cxFilterControlUtils;

type
  { IcxInnerMemo }

  IcxInnerMemo = interface(IcxInnerTextEdit)
  ['{9D0DFE35-58DC-4C0C-9C98-65C5AAD757C9}']
    function GetCaretPos: TPoint;
    function GetLines: TStrings;
    function GetScrollBars: TScrollStyle;
    function GetWantReturns: Boolean;
    function GetWantTabs: Boolean;
    function GetWordWrap: Boolean;
    procedure SetCaretPos(const Value: TPoint);
    procedure SetScrollBars(Value: TScrollStyle);
    procedure SetWantReturns(Value: Boolean);
    procedure SetWantTabs(Value: Boolean);
    procedure SetWordWrap(Value: Boolean);
    property CaretPos: TPoint read GetCaretPos write SetCaretPos;
    property Lines: TStrings read GetLines;
    property ScrollBars: TScrollStyle read GetScrollBars write SetScrollBars;
    property WantReturns: Boolean read GetWantReturns write SetWantReturns;
    property WantTabs: Boolean read GetWantTabs write SetWantTabs;
    property WordWrap: Boolean read GetWordWrap write SetWordWrap; 
  end;

  { TcxCustomTextEditViewInfo }

  TcxCustomMemoViewInfo = class(TcxCustomTextEditViewInfo)
  public
    procedure DrawText(ACanvas: TcxCanvas); override;
  end;

  { TcxCustomMemoViewData }

  TcxCustomMemoProperties = class;

  TcxCustomMemoViewData = class(TcxCustomTextEditViewData)
  private
    function GetProperties: TcxCustomMemoProperties;
  protected
    function GetMaxLineCount: Integer; override;
    function InternalGetEditConstantPartSize(ACanvas: TcxCanvas; AIsInplace: Boolean;
      AEditSizeProperties: TcxEditSizeProperties; var MinContentSize: TSize;
      AViewInfo: TcxCustomEditViewInfo): TSize; override;
    function InternalGetEditContentSize(ACanvas: TcxCanvas; const AEditValue: TcxEditValue;
      const AEditSizeProperties: TcxEditSizeProperties): TSize; override;
  public
    function GetDrawTextFlags: DWORD; override;
    function GetDrawTextOffset: TRect; override;
    function GetEditContentSizeCorrection: TSize; override;
    property Properties: TcxCustomMemoProperties read GetProperties;
  end;

  { TcxCustomMemoProperties }

  TcxCustomInnerMemo = class;

  TcxCustomMemoProperties = class(TcxCustomTextEditProperties)
  private
    FScrollBars: TScrollStyle;
    FVisibleLineCount: Integer;
    FWantReturns: Boolean;
    FWantTabs: Boolean;
    FWordWrap: Boolean;
    function GetAlignment: TAlignment;
    function IsAlignmentStored: Boolean;
    procedure SetAlignment(Value: TAlignment);
    procedure SetScrollBars(Value: TScrollStyle);
    procedure SetVisibleLineCount(Value: Integer);
    procedure SetWantReturns(Value: Boolean);
    procedure SetWantTabs(Value: Boolean);
    procedure SetWordWrap(Value: Boolean);
  protected
    class function GetViewDataClass: TcxCustomEditViewDataClass; override;
    function InnerEditNeedsTabs: Boolean; override;
    function IsMultiLine: Boolean; override;
  public
    constructor Create(AOwner: TPersistent); override;
    procedure Assign(Source: TPersistent); override;
    class function GetContainerClass: TcxContainerClass; override;
    function GetDisplayText(const AEditValue: TcxEditValue;
      AFullText: Boolean = False; AIsInplace: Boolean = True): WideString; override;
    function GetEditValueSource(AEditFocused: Boolean): TcxDataEditValueSource; override;
    class function GetViewInfoClass: TcxContainerViewInfoClass; override;
    // !!!
    property Alignment: TAlignment read GetAlignment write SetAlignment stored IsAlignmentStored;
    property AutoSelect default False;
    property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssNone;
    property VisibleLineCount: Integer read FVisibleLineCount write SetVisibleLineCount default 0;
    property WantReturns: Boolean read FWantReturns write SetWantReturns default True;
    property WantTabs: Boolean read FWantTabs write SetWantTabs default False;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
  end;

  { TcxMemoProperties }

  TcxMemoProperties = class(TcxCustomMemoProperties)
  published
    property Alignment;
    property AssignedValues;
    property AutoSelect;
    property CharCase;
    property ClearKey;
    property HideSelection;
    property ImeMode;
    property ImeName;
    property MaxLength;
    property OEMConvert;
    property ReadOnly;
    property ScrollBars;
    property VisibleLineCount;
    property WantReturns;
    property WantTabs;
    property WordWrap;
    property OnChange;
    property OnEditValueChanged;
    property OnValidate;
  end;

  { TcxCustomMemo }

  TcxCustomMemo = class(TcxCustomTextEdit)
  private
    FCanCreateScrollBars: Boolean;
    FInternalAction: Boolean;
    FScrollBarsCalculating: Boolean;
    function GetActiveProperties: TcxCustomMemoProperties;
    function GetCaretPos: TPoint;
    function GetLines: TStrings;
    function GetInnerMemo: IcxInnerMemo;
    function GetProperties: TcxCustomMemoProperties;
    procedure SetCaretPos(const Value: TPoint);
    procedure SetLines(Value: TStrings);
    procedure SetProperties(Value: TcxCustomMemoProperties);
    procedure WMCommand(var Message: TWMCommand); message WM_COMMAND;
  protected
    procedure AdjustInnerEdit; override;
    procedure AdjustInnerEditPosition; override;
    function CanAutoSize: Boolean; override;
    function CanKeyDownModifyEdit(Key: Word; Shift: TShiftState): Boolean; override;
    function CanScrollLineWithoutScrollBars(ADirection: TcxDirection): Boolean; override;
    procedure ChangeHandler(Sender: TObject); override;
    procedure DoEditKeyDown(var Key: Word; Shift: TShiftState); override;
    procedure EnabledChanged; override;
    procedure FontChanged; override;
    function GetInnerEditClass: TControlClass; override;
    procedure Initialize; override;
    procedure InitializeViewData(AViewData: TcxCustomEditViewData); override;
    function IsCheckAsYouTypeSupports: Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    function NeedsScrollBars: Boolean; override;
    procedure PropertiesChanged(Sender: TObject); override;
    procedure ReadState(Reader: TReader); override;
    procedure Scroll(AScrollBarKind: TScrollBarKind; AScrollCode: TScrollCode;
      var AScrollPos: Integer); override;
    function SendActivationKey(Key: Char): Boolean; override;
    procedure SetSelText(const Value: TCaption); override;
    function TabsNeeded: Boolean; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WndProc(var Message: TMessage); override;
    function CanMemoKeyModifyEdit(Key: Word; Shift: TShiftState;
      AIsKeyPress: Boolean): Boolean; virtual;
    procedure InternalSynchronizeEditValue;
    property InnerMemo: IcxInnerMemo read GetInnerMemo;
    property ScrollBarsCalculating: Boolean read FScrollBarsCalculating;
  public
    procedure ClearSelection; override;
    procedure CutToClipboard; override;
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    function IsEditClass: Boolean; override;
    property ActiveProperties: TcxCustomMemoProperties read GetActiveProperties;
    property CaretPos: TPoint read GetCaretPos write SetCaretPos;
    property Lines: TStrings read GetLines write SetLines;
    property Properties: TcxCustomMemoProperties read GetProperties
      write SetProperties;
  end;

  { TcxMemo }

  TcxMemo = class(TcxCustomMemo)
  private
    function GetActiveProperties: TcxMemoProperties;
    function GetProperties: TcxMemoProperties;
    procedure SetProperties(Value: TcxMemoProperties);
  public
    class function GetPropertiesClass: TcxCustomEditPropertiesClass; override;
    property ActiveProperties: TcxMemoProperties read GetActiveProperties;
  published
    property Align;
    property Anchors;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ImeMode;
    property ImeName;
    property Lines;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property Properties: TcxMemoProperties read GetProperties
      write SetProperties;
    property ShowHint;
    property Style;
    property StyleDisabled;
    property StyleFocused;
    property StyleHot;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
{$IFDEF DELPHI5}
    property OnContextPopup;
{$ENDIF}
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEditing;
    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;

  { TcxFilterMemoHelper }

  TcxFilterMemoHelper = class(TcxFilterTextEditHelper)
  public
    class function GetSupportedFilterOperators(
      AProperties: TcxCustomEditProperties;
      AValueTypeClass: TcxValueTypeClass;
      AExtendedSet: Boolean = False): TcxFilterControlOperators; override;
  end;

  { TcxCustomInnerMemoHelper }

  TcxCustomInnerMemoHelper = class(TcxInterfacedPersistent,
    IcxContainerInnerControl, IcxCustomInnerEdit, IcxInnerTextEdit,
    IcxInnerMemo)
  private
    FEdit: TcxCustomInnerMemo;
  protected
    property Edit: TcxCustomInnerMemo read FEdit;
  public
    constructor Create(AEdit: TcxCustomInnerMemo); reintroduce; virtual;

    // IcxContainerInnerControl
    function GetControlContainer: TcxContainer;
    function GetControl: TWinControl;

    // IcxCustomInnerEdit
    function CallDefWndProc(AMsg: UINT; WParam: WPARAM;
      LParam: LPARAM): LRESULT;
    function GetEditValue: TcxEditValue;
    function GetOnChange: TNotifyEvent;
    procedure LockBounds(ALock: Boolean);
    procedure SafelySetFocus;
    procedure SetEditValue(const Value: TcxEditValue);
    procedure SetParent(Value: TWinControl);
    procedure SetOnChange(Value: TNotifyEvent);

    // IcxInnerTextEdit
    procedure ClearSelection;
    procedure CopyToClipboard;
    function GetAlignment: TAlignment;
    function GetAutoSelect: Boolean;
    function GetCharCase: TEditCharCase;
    function GetEchoMode: TcxEditEchoMode;
    function GetFirstVisibleCharIndex: Integer;
    function GetHideSelection: Boolean;
    function GetImeLastChar: Char;
    function GetImeMode: TImeMode;
    function GetImeName: TImeName;
    function GetInternalUpdating: Boolean;
    function GetMaxLength: Integer;
    function GetMultiLine: Boolean;
    function GetOEMConvert: Boolean;
    function GetOnSelChange: TNotifyEvent;
    function GetPasswordChar: TCaptionChar;
    function GetReadOnly: Boolean;
    function GetSelLength: Integer;
    function GetSelStart: Integer;
    function GetSelText: string;
    procedure SelectAll;
    procedure SetAlignment(Value: TAlignment);
    procedure SetAutoSelect(Value: Boolean);
    procedure SetCharCase(Value: TEditCharCase);
    procedure SetEchoMode(Value: TcxEditEchoMode);
    procedure SetHideSelection(Value: Boolean);
    procedure SetImeMode(Value: TImeMode);
    procedure SetImeName(const Value: TImeName);
    procedure SetInternalUpdating(Value: Boolean);
    procedure SetMaxLength(Value: Integer);
    procedure SetOEMConvert(Value: Boolean);
    procedure SetOnSelChange(Value: TNotifyEvent);
    procedure SetPasswordChar(Value: TCaptionChar);
    procedure SetReadOnly(Value: Boolean);
    procedure SetSelLength(Value: Integer);
    procedure SetSelStart(Value: Integer);
    procedure SetSelText(Value: string);

    // IcxInnerMemo
    function GetCaretPos: TPoint;
    function GetLines: TStrings;
    function GetScrollBars: TScrollStyle;
    function GetWantReturns: Boolean;
    function GetWantTabs: Boolean;
    function GetWordWrap: Boolean;
    procedure SetCaretPos(const Value: TPoint);
    procedure SetScrollBars(Value: TScrollStyle);
    procedure SetWantReturns(Value: Boolean);
    procedure SetWantTabs(Value: Boolean);
    procedure SetWordWrap(Value: Boolean);
  end;

  { TcxCustomInnerMemo }

  TcxMultiLineEditCharPosition = packed record
    Line, Col: Integer;
  end;

  TcxInnerMemoSelectionState = packed record
    CursorPosition: TcxMultiLineEditCharPosition;
    SelectionStart: TcxMultiLineEditCharPosition;
    SelectionEnd: TcxMultiLineEditCharPosition;
  end;

  TcxCustomInnerMemo = class(TMemo, IUnknown,
    IcxContainerInnerControl, IcxInnerEditHelper)
  private
    FAutoSelect: Boolean;
    FEchoMode: TcxEditEchoMode;
    FEscapePressed: Boolean;
    FHelper: TcxCustomInnerMemoHelper;
    FInternalTextSettingCount: Integer;
    FInternalUpdating: Boolean;
    FIsCreating: Boolean;
    FLockBoundsCount: Integer;
    FOnSelChange: TNotifyEvent;

    procedure BeginInternalTextSetting;
    procedure EndInternalTextSetting;
    function IsInternalTextSetting: Boolean;

    function GetContainer: TcxCustomMemo;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN;
    procedure EMReplaceSel(var Message: TMessage); message EM_REPLACESEL;
    procedure EMSetSel(var Message: TMessage); message EM_SETSEL;
    procedure WMClear(var Message: TMessage); message WM_CLEAR;
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMIMEComposition(var Message: TMessage); message WM_IME_COMPOSITION;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
    procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    procedure WMWindowPosChanging(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
  protected
    procedure Click; override;
    procedure DblClick; override;
    procedure DoEnter; override;
    procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseLeave(AControl: TControl); dynamic;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure CreateHandle; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure WndProc(var Message: TMessage); override;

    // IcxContainerInnerControl
    function GetControl: TWinControl;
    function GetControlContainer: TcxContainer;

    // IcxInnerEditHelper
    function GetHelper: IcxCustomInnerEdit;

    property AutoSelect: Boolean read FAutoSelect write FAutoSelect default False;
    property Container: TcxCustomMemo read GetContainer;
    property Helper: TcxCustomInnerMemoHelper read FHelper;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DragDrop(Source: TObject; X, Y: Integer); override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
{$IFDEF DELPHI5}
    function CanFocus: Boolean; override;
{$ENDIF}
    procedure DefaultHandler(var Message); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    property CharCase;
    property OnSelChange: TNotifyEvent read FOnSelChange write FOnSelChange;
  end;

procedure ExtractFirstLine(var AText: WideString; AMaxLength: Integer = 0);
procedure SetMemoCaretPos(AMemo: TCustomMemo; const Value: TPoint);

implementation

uses
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  Clipbrd, cxEditConsts, cxEditUtils, cxScrollBar;

type
  TWinControlAccess = class(TWinControl);

const
  cxMemoMaxDisplayTextLength = 250;

procedure CorrectLineBreaks(var S: string);
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while I < L do
    if (S[I] = #10) and (S[I + 1] = #13) then
    begin
      S[I] := #13;
      Inc(I);
      S[I] := #10;
      Inc(I);
      Insert(#13#10, S, I);
      Inc(I, 2);
    end
    else
    begin