richedit2.pas

类似QQ的源码程序

    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure WMDestroy(var Msg: TMessage); message WM_DESTROY;
    function PrivatePerform(Msg: Cardinal; WParam, LParam: Longint): Longint;

    procedure FindNonSpace(var CR: TCharRange);
    procedure DetectURLs(CR: TCharRange);
  protected
    { Protected declarations }
    procedure CreateWnd; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DefineProperties(Filer: TFiler); override;
    procedure WMNCDestroy(var Message: TWMNCDestroy); message WM_NCDESTROY;
    procedure WMSetText(var Message: TWMSetText); message WM_SETTEXT;
    procedure WMGetText(var Message: TWMGetText); message WM_GETTEXT;
    procedure WMGetTextLength(var Message: TWMGetTextLength); message WM_GETTEXTLENGTH;
    procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure EMReplaceSel(var Message: TMessage); message EM_REPLACESEL;
    procedure EMGetSelText(var Message: TMessage); message EM_GETSELTEXT;
    procedure EMGetTextRange(var Message: TMessage); message EM_GETTEXTRANGE;
    procedure EMGetLine(var Message: TMessage); message EM_GETLINE;
    procedure EMStreamIn(var Message: TMessage); message EM_STREAMIN;
    procedure EMStreamOut(var Message: TMessage); message EM_STREAMOUT;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure DoSetMaxLength(Value: Integer); override;
    function GetLine: Integer;
    procedure SetLine(Value: Integer);
    function GetColumn: Integer;
    procedure SetColumn(Value: Integer);
    procedure SetAutoURLDetect(Value: TAutoURLDetect);
    function GetFirstVisibleLine: Integer;
    property Lines: TStrings read FRichEditStrings write SetRichEditStrings;
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
    function GetWideText: WideString;
    procedure SetWideText(Value: WideString);
    procedure SetLanguage(Value: TLanguage);
    function GetWideSelText: WideString;
    procedure SetWideSelText(Value: WideString);
    property OnURLClick: TURLClickEvent read FOnURLClick write FOnURLClick;
    property OnURLMove: TURLMoveEvent read FOnURLMove write FOnURLMove;
    property OnSaveProgress: TRichEditProgressEvent read FOnSaveProgress write FOnSaveProgress;
    property OnLoadProgress: TRichEditProgressEvent read FOnLoadProgress write FOnLoadProgress;
    procedure CreateWindowHandle(const Params: TCreateParams); override;
    procedure SetLangOptions(Value: TLangOptions);
    procedure SetCustomURLs(Value: TURLCollection);
    procedure CloseOLEObjects;
    procedure CreateOLEObjectInterface;
    function GetPopupMenu: TPopupMenu; override;
    procedure SetRTFSelText(Value: String);
    function GetRTFSelText: String;
    function GetSelType: TSelectionType;
    procedure SetUndoLimit(Value: Integer);
  public
    { Public declarations }
    RichEditOle: IRichEditOle;
    RichEditOleCallback: IRichEditOleCallback;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function ObjectSelected:Boolean;
    procedure Clear; override;
    procedure CreateLinkToFile(const FileName: string; Iconic: Boolean);
    procedure CreateObject(const OleClassName: string; Iconic: Boolean);
    procedure CreateObjectFromFile(const FileName: string; Iconic: Boolean);
    procedure CreateObjectFromInfo(const CreateInfo: TCreateInfo);
    procedure InsertObjectDialog;
    function PasteSpecialDialog: Boolean;
    function ChangeIconDialog: Boolean;
    property AutoVerbMenu: boolean read FAutoVerbMenu write FAutoVerbMenu default true;
    property InputFormat: TInputFormat read FPlainTextIn write FPlainTextIn;
    property OutputFormat: TOutputFormat read FPlainTextOut write FPlainTextOut;
    property SelectedInOut: Boolean read FSelectedInOut write FSelectedInOut;
    property PlainRTF: Boolean read FPlainRTF write FPlainRTF;

    // pgm 8/29/04 - Move these to public API
    procedure BeginUpdate;
    procedure EndUpdate;

    procedure InsertFromFile(const FileName: String);
    property Line: Integer read GetLine write SetLine;
    property Col: Integer read GetColumn write SetColumn;
    procedure SetCaret(Line, Column: Integer);
    property DefAttributes: TTextAttributes98 read FDefAttributes write SetDefAttributes;
    property SelAttributes: TTextAttributes98 read FSelAttributes write SetSelAttributes;
    property Paragraph: TParaAttributes98 read FParagraph;
    property ShowSelectionBar: Boolean read FShowSelBar write SetShowSelBar;
    property WordFormatting: Boolean read FWordFormatting write FWordFormatting default True;
    function FindText(const SearchStr: string;
      StartPos, Length: Integer; Options: TSearchTypes98): Integer;
    function FindWideText(const SearchStr: WideString;
      StartPos, Length: Integer; Options: TSearchTypes98): Integer;
    function CanUndo: Boolean;
    procedure Undo;
    function UndoName: TUndoName;
    function CanRedo: Boolean;
    procedure Redo;
    function RedoName: TUndoName;
    procedure StopGroupTyping;
    property AutoURLDetect: TAutoURLDetect read FAutoURLDetect write SetAutoURLDetect;
    property FirstVisibleLine: Integer read GetFirstVisibleLine;
    function GetWordAtPos(Pos: Integer; var Start, Len: Integer): String;
    property RTFSelText: String read GetRTFSelText write SetRTFSelText;
    property WideText: WideString read GetWideText write SetWideText;
    property Language: TLanguage read FLanguage write SetLanguage;
    property LangOptions: TLangOptions read FLangOptions write SetLangOptions;
    property WideLines: TWideStrings read FWideStrings stored False;
    property WideSelText: WideString read GetWideSelText write SetWideSelText;
    property CustomURLs: TURLCollection read FURLs write SetCustomURLs;
    function CharAtPos(Pos: TPoint): Integer;
    property IncludeOLE: Boolean read FIncludeOLE write SetIncludeOLE default False;
    property CanPaste: Boolean read GetCanPaste;
    property URLColor : TColor read FURLColor write FURLColor;
    property URLCursor : TCursor read FURLCursor write FURLCursor;
    property SelType: TSelectionType read GetSelType;
    property UndoLimit: Integer read FUndoLimit write SetUndoLimit;
  end;

  TRichEdit98 = class(TCustomRichEdit98)
  published
    { Published declarations }
    property Align;
    property Alignment;
    property AutoURLDetect;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property CustomURLs;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property HideScrollBars;
    property ImeMode;
    property ImeName;
    property LangOptions;
    property Language;
    property Lines stored False;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
//    property PlainText;
    property PopupMenu;
    property ReadOnly;
    property ScrollBars;
    property ShowHint;
    property ShowSelectionBar;
    property TabOrder;
    property TabStop default True;
    property URLColor;
    property URLCursor;
    property Visible;
    property WantTabs;
    property WantReturns;
    property WordFormatting;
    property WordWrap;
    property OnChange;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnLoadProgress;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResizeRequest;
    property OnSelectionChange;
    property OnSaveProgress;
    property OnStartDrag;
    property OnProtectChange;
    property OnSaveClipboard;
    property OnURLClick;
    property OnURLMove;
    property AutoVerbMenu;
    property InputFormat;
    property OutputFormat;
    property SelectedInOut;
    property PlainRTF;
    property UndoLimit;

    property IncludeOLE;
    property AllowInPlace;

{$IFDEF VER120}
    property Anchors;
    property BiDiMode;
    property BorderWidth;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
{$ENDIF}
  end;

{$ifdef BDE_SUPPORT}
  TDBRichEdit98 = class(TCustomRichEdit98)
  private
    FDataLink: TFieldDataLink;
    FAutoDisplay: Boolean;
    FFocused: Boolean;
    FMemoLoaded: Boolean;
    FDataSave: string;
    procedure BeginEditing;
    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    function GetReadOnly: Boolean;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetReadOnly(Value: Boolean);
    procedure SetAutoDisplay(Value: Boolean);
    procedure SetFocused(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
  protected
    procedure DefineProperties(Filer: TFiler); override;
    procedure Change; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadMemo;
    property Field: TField read GetField;
  published
    property Align;
    property Alignment;
    property AutoDisplay: Boolean read FAutoDisplay write SetAutoDisplay default True;
    property AutoURLDetect;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property CustomURLs;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property HideScrollBars;
    property ImeMode;
    property ImeName;
    property Language;
    property LangOptions;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
//    property PlainText;
    property PopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ScrollBars;
    property ShowHint;
    property ShowSelectionBar;
    property TabOrder;
    property TabStop;
    property Visible;
    property WantReturns;
    property WantTabs;
    property WordFormatting;
    property WordWrap;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnLoadProgress;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResizeRequest;
    property OnSaveProgress;
    property OnSelectionChange;
    property OnProtectChange;
    property OnSaveClipboard;
    property OnStartDrag;
    property OnURLClick;
    property AutoVerbMenu;
    property InputFormat;
    property OutputFormat;
    property SelectedInOut;
    property PlainRTF;
    property UndoLimit;

    property IncludeOLE;
    property AllowInPlace;

{$IFDEF VER120}
    property Anchors;
    property BiDiMode;
    property BorderWidth;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
{$ENDIF}
  end;

{$endif}

const
  RTFConversionFormat: TConversionFormat = (
    ConversionClass: TConversion;
    Extension: 'rtf';
    Next: nil);
  TextConversionFormat: TConversionFormat = (
    ConversionClass: TConversion;
    Extension: 'txt';
    Next: @RTFConversionFormat);

var
  ConversionFormatList: PConversionFormat = @TextConversionFormat;

procedure Register;

implementation

uses
  TypInfo;

var
  PixPerInch: TPoint;
  CFEmbeddedObject: Integer;
  CFLinkSource: Integer;

function PixelsToHimetric(const P: TPoint): TPoint;
begin
  Result.X := MulDiv(P.X, 2540, PixPerInch.X);
  Result.Y := MulDiv(P.Y, 2540, PixPerInch.Y);
end;

procedure CenterWindow(Wnd: HWnd);
var
  Rect: TRect;
begin
  GetWindowRect(Wnd, Rect);
  SetWindowPos(Wnd, 0,
    (GetSystemMetrics(SM_CXSCREEN) - Rect.Right + Rect.Left) div 2,
    (GetSystemMetrics(SM_CYSCREEN) - Rect.Bottom + Rect.Top) div 3,
    0, 0, SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOZORDER);
end;

function OleDialogHook(Wnd: HWnd; Msg, WParam, LParam: Longint): Longint; stdcall;
begin
  Result := 0;
  if Msg = WM_INITDIALOG then
  begin
    if GetWindowLong(Wnd, GWL_STYLE) and WS_CHILD <> 0 then
      Wnd := GetWindowLong(Wnd, GWL_HWNDPARENT);
    CenterWindow(Wnd);
    Result := 1;
  end;
end;

function GetVCLFrameForm(Form: TCustomForm): IVCLFrameForm;
begin
  if Form.OleFormObject = nil then TOleForm.Create(Form);
  Result := Form.OleFormObject as IVCLFrameForm;
end;



procedure Register;
begin
  RegisterComponents('Win32', [TRichEdit98]);
{$ifdef BDE_SUPPORT}
  RegisterComponents('Data Controls', [TDBRichEdit98]);
{$endif}
end;

var
  IsWinNT: Boolean;


{ TTextAttributes98}

constructor TTextAttributes98.Create(AOwner: TCustomRichEdit98;
  AttributeType: TAttributeType);
begin
  inherited Create;
  RichEdit := AOwner;
  FType := AttributeType;
  if RichEdit.FVer10 then
    case FType of
    atSelected:
      FOldAttr:= TRichEdit(Richedit).SelAttributes;
    atDefaultText:
      FOldAttr:= TRichEdit(Richedit).DefAttributes;
    end;
end;

procedure TTextAttributes98.InitFormat(var Format: TCharFormat2W);
begin
  FillChar(Format, SizeOf(TCharFormat2W), 0);
  Format.cbSize := SizeOf(TCharFormat2W);
end;

function TTextAttributes98.GetConsistentAttributes: TConsistentAttributes98;
var
  Format: TCharFormat2W;
begin
  Result := [];
  if RichEdit.HandleAllocated and (FType = atSelected) then
  begin
    InitFormat(Format);
    RichEdit.Perform(EM_GETCHARFORMAT,
      WPARAM(FType = atSelected), LPARAM(@Format));
    with Format do
    begin
      if (dwMask and CFM_BOLD) <> 0 then Include(Result, caBold);
      if (dwMask and CFM_COLOR) <> 0 then Include(Result, caColor);
      if (dwMask and CFM_FACE) <> 0 then Include(Result, caFace);
      if (dwMask and CFM_ITALIC) <> 0 then Include(Result, caItalic);
      if (dwMask and CFM_SIZE) <> 0 then Include(Result, caSize);
      if (dwMask and CFM_STRIKEOUT) <> 0 then Include(Result, caStrikeOut);
      if (dwMask and CFM_UNDERLINE) <> 0 then Include(Result, caUnderline);
      if (dwMask and CFM_PROTECTED) <> 0 then Include(Result, caProtected);
      if (dwMask and CFM_WEIGHT) <> 0 then Include(Result, caWeight);
      if (dwMask and CFM_BACKCOLOR) <> 0 then Include(Result, caBackColor);
      if (dwMask and CFM_LCID) <> 0 then Include(Result, caLanguage);
      if (dwMask and CFM_SUPERSCRIPT) <> 0 then Include(Result, caIndexKind);
      if (dwMask and CFM_OFFSET) <> 0 then Include(Result, caOffset);