Sample Application: rtftest.dpr

A simple demonstration of accepting RTF in a TMemo. It contains a single TUOTextTarget. This is just about the simplest demo you could write, having a single event handler with only one crucial line of code!

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

Design-time form image
Project source: rtftest.dpr 

program rtftest;

{Main program file for test application for UnitOOPS OLE Drag and Drop Components.}
uses
  Forms,
  fmRTFMemo in 'fmRTFMemo.pas' {Form1};

{$R *.RES}

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

unit fmRTFMemo;
{ UnitOOPS OLE Drag and Drop Components - Example
 Form for rich text drop demonstration.

 Last modified:  08/12/98}
interface

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

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Memo1: TMemo;
    UOTextTarget1: TUOTextTarget;
    Label1: TLabel;
    Label2: TLabel;
    procedure UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
      const dropText: String; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
  const dropText: String; X, Y: Integer);
begin
  with (Sender as TUOTextTarget) do
  begin
    // Feedback - tell the user what we got
    if (droppedTextFormat = dtfRichText) then
      Label1.Caption := 'Dropped rich text'
    else
      Label1.Caption := 'Dropped plain text';

    // Give the dropped text lines to the memo.
    memo1.lines := droppedLines;
  end;    // with
end;

end.
Back to top
Form source: fmRTFMemo.dfm 

object Form1: TForm1
  Left = 190
  Top = 140
  BorderIcons = [biSystemMenu]
  BorderStyle = bsDialog
  Caption = 'Test of RTF drag and drop using UnitOOPS OLE components'
  ClientHeight = 291
  ClientWidth = 518
  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 = 518
    Height = 25
    Align = alTop
    BevelOuter = bvNone
    TabOrder = 0
    object Label1: TLabel
      Left = 8
      Top = 8
      Width = 161
      Height = 13
      AutoSize = False
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clRed
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      ParentFont = False
    end
    object Label2: TLabel
      Left = 176
      Top = 8
      Width = 227
      Height = 13
      Caption = 'This memo accepts plain text and rich text drops'
    end
  end
  object Panel2: TPanel
    Left = 0
    Top = 25
    Width = 518
    Height = 266
    Align = alClient
    BevelOuter = bvNone
    BorderWidth = 3
    Caption = 'Panel2'
    TabOrder = 1
    object Memo1: TMemo
      Left = 3
      Top = 3
      Width = 512
      Height = 260
      Align = alClient
      ScrollBars = ssVertical
      TabOrder = 0
    end
  end
  object UOTextTarget1: TUOTextTarget
    AcceptorControl = Memo1
    AcceptTextFormats = [dtfRichText, dtfText]
    OnDrop = UOTextTarget1Drop
    Left = 40
    Top = 225
  end
end
Back to top

Back to the examples page