Sample Application: richedittest.dpr

Project source
Form source (Pascal)
Form source (DFM)

Design-time form image
Project source: RichEditTest.dpr 

program RichEditTest;

uses
  Forms,
  fmRichEdit in 'fmRichEdit.pas' {Form1};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
Back to top
Form source: fmRichEdit.pas 

unit fmRichEdit;
{ UnitOOPS OLE Drag and Drop Components - Example
 Form for RTF drop into TRichEdit demonstration.

 Last modified:  08/28/98}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  uoole, uoUtil, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    UOTextTarget1: TUOTextTarget;
    RichEdit1: TRichEdit;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    procedure UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
      const dropText: String; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure UOTextTarget1DragOver(Sender: TObject; effect: TDropEffect;
      X, Y: Integer);
  private
    { Private declarations }
    function CharPosInRichEdit(aRichEdit: TRichEdit; X, Y: integer): integer;
    function PixelPosInRichEdit(aRichEdit: TRichEdit; aCharPos: integer): TPoint;

  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
  const dropText: String; X, Y: Integer);
var
  doInsert: boolean;
begin
  // We've got the dropped text.
  // If it's RTF, use the utility function.
  // If it's plain text, use standard stuff.

  doInsert := CheckBox3.Checked; // Are we inserting or appending?

  // addContentToRichEdit is in the uoUtil unit.  It allows you to add text
  // to a TRichEdit, accepting as input either plain text or RTF.  The third
  // parameter is true for RTF, false otherwise.  The fourth parameter is
  // true to insert the content at the cursor position, false to append it.
  // If you want to replace the contents of the RichEdit, first clear them.
  case (Sender as TUOTextTarget).droppedTextFormat of    //
    dtfRichText: // It's RTF - insert it
      addContentToRichEdit(dropText, RichEdit1, true, doInsert); // Insert RTF
    dtfText: // It's plain text - insert it
      addContentToRichEdit(dropText, RichEdit1, false, doInsert); // Insert text
  end;    // case

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Initial control settings
  CheckBox1.Checked := UOTextTarget1.AcceptText;
  CheckBox2.Checked := UOTextTarget1.AcceptRichText;

  // No compiler warnings, please 
  PixelPosInRichEdit(RichEdit1, 0);

end;

procedure TForm1.CheckBox1Click(Sender: TObject);
// Common handler for both checkboxes
var
  aCB: TCheckBox;
begin
  aCB := TCheckBox(Sender);

  if (aCB = CheckBox1) then
    UOTextTarget1.AcceptText := aCB.Checked;
  if (aCB = CheckBox2) then
    UOTextTarget1.AcceptRichText := aCB.Checked;
end;

function TForm1.CharPosInRichEdit(aRichEdit: TRichEdit; X, Y: integer): integer;
// Get the current character position (0-based) in the TRichEdit aRichEdit
// corresponding to the client coordinates X, Y.  Returns -1 if there
// is no corresponding character.
// ****THERE IS A BUG IN THE MICROSOFT WIN32 HELP**** regarding this - the
// parameters are passed differently from the EM_CHARFROMPOS of an edit (TMemo,
// TEdit) control.  Same goes for EM_POSFROMCHAR.  See MS Knowledgebase
// article PSS ID Number: Q137805  See PixelPosInRichEdit below for the inverse
// function.
var
  aPt: TPoint;
begin
  aPt.X := X;  aPt.Y := Y;
  result := aRichEdit.Perform(EM_CHARFROMPOS, 0, LPARAM(@aPt));
end;

function TForm1.PixelPosInRichEdit(aRichEdit: TRichEdit; aCharPos: integer): TPoint;
// The inverse of CharPosInRichEdit.  Not used in this application, but supplied
// for completeness.  Note that the inverse is not necessarily going to give back
// the same point, since a character spans multiple points.  I _think_ we get back
// the coordinate of the top left pixel of the character.
var
  aPt: TPoint;
begin
  aRichEdit.Perform(EM_POSFROMCHAR, WPARAM(@aPt), aCharPos);

  result := aPt;
end;

procedure TForm1.UOTextTarget1DragOver(Sender: TObject;
  effect: TDropEffect; X, Y: Integer);
// Give caret feedback.  We've given up having this automatically by doing
// the drag and drop handling for the TRichEdit ourselves.
var
  aCharPos: integer;
begin
  (Sender as TUOTextTarget).AcceptFiles := (Y > (RichEdit1.Height div 2));
  aCharPos := CharPosInRichEdit(RichEdit1, X, Y);

  // If it makes sense, then put the caret there.
  if ((aCharPos <> -1) and CheckBox3.Checked) then
  begin
    with RichEdit1 do
    begin
      selStart := aCharPos; // Set the selection start
      selLength := 0; // No actual selection
      SetFocus;  // Focus it, to see the caret
    end;    // with

  end;
end;

end.
Back to top
Form source: fmRichEdit.dfm 

object Form1: TForm1
  Left = 311
  Top = 283
  Width = 437
  Height = 270
  Caption = 'Rich Edit control example'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 68
    Width = 429
    Height = 175
    Align = alClient
    BevelOuter = bvNone
    BorderWidth = 3
    Caption = 'Panel1'
    TabOrder = 0
    object RichEdit1: TRichEdit
      Left = 3
      Top = 3
      Width = 423
      Height = 169
      Align = alClient
      ScrollBars = ssBoth
      TabOrder = 0
      WordWrap = False
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 0
    Width = 429
    Height = 68
    Align = alTop
    BevelOuter = bvNone
    BorderWidth = 3
    TabOrder = 1
    object Label1: TLabel
      Left = 3
      Top = 3
      Width = 423
      Height = 30
      AutoSize = False
      Caption = 
        'Drop plain text or rich text onto this TRichEdit control.  We'#39've' +
        ' overridden the default TRichEdit drag/drop handling to get more' +
        ' control.'
      WordWrap = True
    end
    object CheckBox1: TCheckBox
      Left = 17
      Top = 33
      Width = 129
      Height = 17
      Caption = 'Accept plain text'
      TabOrder = 0
      OnClick = CheckBox1Click
    end
    object CheckBox2: TCheckBox
      Left = 17
      Top = 50
      Width = 151
      Height = 17
      Caption = 'Accept rich text (RTF)'
      TabOrder = 1
      OnClick = CheckBox1Click
    end
    object CheckBox3: TCheckBox
      Left = 192
      Top = 33
      Width = 97
      Height = 17
      Caption = 'Insert at caret'
      State = cbChecked
      TabOrder = 2
    end
  end
  object UOTextTarget1: TUOTextTarget
    AcceptorControl = RichEdit1
    AcceptTextFormats = [dtfFiles]
    OnDragOver = UOTextTarget1DragOver
    OnDrop = UOTextTarget1Drop
    Left = 40
    Top = 105
  end
end
Back to top

Back to the examples page