Sample Application: RichEditTest2.dpr

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

Design-time form image
Project source: RichEditTest2.dpr 

program RichEditTest2;

{Example application for UnitOOPS OLE Drag and Drop Components.}

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

{$R *.RES}

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

unit fmRichEditTest2;

{ UnitOOPS OLE Drag and Drop Components - Example
 for self-avoiding text drags.

 Last modified:  11/17/98}

interface

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

type
  TForm1 = class(TForm)
    UOTextSource1: TUOTextSource;
    UOTextTarget1: TUOTextTarget;
    Panel1: TPanel;
    Label1: TLabel;
    Panel2: TPanel;
    RichEdit1: TRichEdit;

    procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure UOTextTarget1DragOver(Sender: TObject; effect: TDropEffect;
      X, Y: Integer);
    procedure UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
      const dropText: String; X, Y: Integer);
  private
    { Private declarations }
    FItsMyself: boolean;

    function CharPosInRichEdit(aRichEdit: TRichEdit; X, Y: integer): integer;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

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;

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
  // Turn on or off acceptance of text depending on whether the drag originated
  // from the same control, in which case FItsMyself is true
  UOTextTarget1.AcceptText := not FItsMyself;

  // Find the current character position.
  aCharPos := CharPosInRichEdit(RichEdit1, X, Y);

  // If it makes sense, then put the caret there.
  if (aCharPos <> -1) 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;

procedure TForm1.RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
// TRichEdit can do drag and drop natively, but we override here for more control.
begin
  // Mouse down.  Do we do a drag?
  if DragDetect(RichEdit1.Handle, POINT(X, Y)) then
  begin
    // Set the flag so we know it's ourself
    FItsMyself := true;

    // Tell the drag source component what's selected
    UOTextSource1.Text := Richedit1.SelText;

    // Execute the drag
    UOTextSource1.Execute;

    // Drag is over.  Reset the flag.
    FItsMyself := false;
  end;

end;

procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
  const dropText: String; X, Y: Integer);
// Handle text drops onto the TRichEdit.
begin
  // The selection is just a caret position (see UOTextTarget1DragOver above)
  // so "replacing" the selection inserts the dropped text at the caret.
  RichEdit1.Perform(EM_REPLACESEL, integer(true), integer(PChar(dropText)));
end;

end.
Back to top
Form source: fmRichEditTest2.dfm 

object Form1: TForm1
  Left = 206
  Top = 238
  Width = 556
  Height = 350
  Caption = 'Self-avoiding text drags from a memo'
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 548
    Height = 41
    Align = alTop
    BevelOuter = bvNone
    BorderWidth = 3
    Caption = 'Panel1'
    TabOrder = 0
    object Label1: TLabel
      Left = 3
      Top = 3
      Width = 542
      Height = 35
      Align = alClient
      Caption = 
        'The window below is a TRichEdit with PlainText := true, to simul' +
        'ate a TMemo.  Although TRichEdit can do drag and drop natively, ' +
        'we override it so we can e.g., prohibit dragging within the TRic' +
        'hEdit, as we'#39've done here.'
      WordWrap = True
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 41
    Width = 548
    Height = 282
    Align = alClient
    BevelOuter = bvNone
    BorderWidth = 5
    Caption = 'Panel2'
    TabOrder = 1
    object RichEdit1: TRichEdit
      Left = 5
      Top = 5
      Width = 538
      Height = 272
      Align = alClient
      TabOrder = 0
      OnMouseDown = RichEdit1MouseDown
    end
  end
  object UOTextSource1: TUOTextSource
    DropEffects = [deCopy, deMove]
    Left = 104
    Top = 136
  end
  object UOTextTarget1: TUOTextTarget
    AcceptorControl = RichEdit1
    AcceptTextFormats = [dtfText]
    OnDragOver = UOTextTarget1DragOver
    OnDrop = UOTextTarget1Drop
    Left = 224
    Top = 128
  end
end
Back to top

Back to the examples page