Form source (Pascal)
Form source (DFM)
Project source
Form source (Pascal)
Form source (DFM)
| Project source: memotest.dpr |
program memotest;
{Main program file for test application for UnitOOPS OLE Drag and Drop Components.}
uses
Forms,
fmcaretmemo in 'fmcaretmemo.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Back to top
|
| Form source: fmCaretMemo.pas |
unit fmcaretmemo;
{ UnitOOPS OLE Drag and Drop Components - Example
Form for TMemo demonstration, showing caret feedback and status bar
processing.
Last modified: 08/12/98}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
uoole, StdCtrls, ExtCtrls, ComCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Memo1: TMemo;
StatusBar1: TStatusBar;
UOTextTarget1: TUOTextTarget;
procedure UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
const dropText: String; X, Y: Integer);
procedure UOTextTarget1DragOver(Sender: TObject; effect: TDropEffect;
X, Y: Integer);
procedure UOTextTarget1DragLeave(Sender: TObject);
private
{ Private declarations }
function CharPosInMemo(aMemo: TMemo; X, Y: integer): integer;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function TForm1.CharPosInMemo(aMemo: TMemo; X, Y: integer): integer;
// Get the current character position (0-based) in the TMemo aMemo
// corresponding to the client coordinates X, Y. Returns -1 if there
// is no corresponding character.
begin
result := LoWord(SendMessage(aMemo.Handle, EM_CHARFROMPOS, 0, MAKELPARAM(X, Y)));
end;
procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
const dropText: String; X, Y: Integer);
// Handle a drop of text
var
aCharPos: integer;
// Following needed for case a) only
// aString: string;
begin
// Get the current position
aCharPos := CharPosInMemo(Memo1, X, Y);
// If it makes sense, do an insert
if (aCharPos <> -1) then
begin
// Here are 3 different ways of doing it
// a) Total text replacement
// Advantage - simple
// Disadvantage - no undo, possible flicker.
//
// Get the current text
//aString := Memo1.Text;
// Insert the dropped text at the right position
// Note the +1 as strings are 1-based
//Insert(dropText, aString, aCharPos+1);
// Give the new string back to the memo
//Memo1.Text := aString;
// b) Using a VCL wrapper method, replace the selection
// (i.e., insert at the zero-length caret position)
// Advantage - fairly simple
// Disadvantage - no undo
//
//Memo1.SetSelTextBuf(PChar(dropText));
// c) Using a WinAPI message, replace the selection
// Advantage - undo is available
// Disadvantage - not quite as simple
// The "true" is the "can undo" flag
Memo1.Perform(EM_REPLACESEL, integer(true), integer(PChar(dropText)));
// Alternative to preceding line:
// SendMessage(Memo1.Handle, EM_REPLACESEL, integer(true), integer(PChar(dropText)));
// Following is common to all 3 methods.
// Finally, move the caret to immediately following
// the dropped text
Memo1.SelStart := aCharPos+length(dropText);
Memo1.SelLength := 0;
end
else
// Otherwise, just give the entire text to the memo
Memo1.Text := dropText;
// Clean up the status bar
StatusBar1.SimpleText := '';
end;
procedure TForm1.UOTextTarget1DragOver(Sender: TObject;
effect: TDropEffect; X, Y: Integer);
// Handle dragging over our drop target.
// We could, e.g., set up a custom caret here if we wanted
// to do something like Word's grayed caret to indicate position.
var
aCharPos: integer;
aString: string;
begin
// Make the status bar look like Word's on OLE drop
if (deCopy = effect) then
aString := 'Copy'
else
if (deMove = effect) then
aString := 'Move'
else
begin
// Not a move or copy - bale out altogether
StatusBar1.SimpleText := '';
exit;
end;
StatusBar1.SimpleText := Format('%s to where?', [aString]);
// Focus the memo so we can see the caret.
Memo1.SetFocus;
// Get the current position
aCharPos := CharPosInMemo(Memo1, X, Y);
// If it makes sense, then put the caret there.
if (aCharPos <> -1) then
begin
Memo1.selStart := aCharPos;
Memo1.selLength := 0;
end;
end;
procedure TForm1.UOTextTarget1DragLeave(Sender: TObject);
begin
StatusBar1.SimpleText := '';
Memo1.SetFocus;
end;
end.
Back to top
|
| Form source: fmCaretMemo.dfm |
object Form1: TForm1
Left = 217
Top = 206
Width = 446
Height = 253
Caption = 'Test of TUOTextTarget cursor feedback'
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 = 438
Height = 207
Align = alClient
BevelOuter = bvNone
BorderWidth = 3
Caption = 'Panel1'
TabOrder = 0
object Memo1: TMemo
Left = 3
Top = 3
Width = 432
Height = 201
Align = alClient
Lines.Strings = (
'Drag text from some text drag source onto this TMemo, and watch ' +
'the caret track the '
'insertion point as you move the drag cursor around. Typical dra' +
'g sources you'#39'll already '
'have on your computer include: Windows Help, WordPad, Excel, Wo' +
'rd, etc.'
''
'When you drop the text, it is inserted at the current caret posi' +
'tion.'
''
'If you make the window smaller than the text vertically, you can' +
' have the TMemo scroll '
'while you'#39're dragging over it (to do the drop in a part of the t' +
'ext currently not visible) by '
'dragging close to the edge of the text. This happens automatica' +
'lly - you don'#39't have to '
'do anything in your own code.'
''
'Finally, the status bar mimics the behavior of MS-Word.'
''
'See the OnDragEnter, OnDragOver, OnDragLeave and OnDrop handlers' +
' for the '
'TUOTextTarget component included in this project for more detail' +
's. The whole '
'process '
'is accomplished in just a few lines of code.'
'')
ScrollBars = ssVertical
TabOrder = 0
end
end
object StatusBar1: TStatusBar
Left = 0
Top = 207
Width = 438
Height = 19
Panels = <>
SimplePanel = True
end
object UOTextTarget1: TUOTextTarget
AcceptorControl = Memo1
AcceptTextFormats = [dtfText]
OnDragOver = UOTextTarget1DragOver
OnDragLeave = UOTextTarget1DragLeave
OnDrop = UOTextTarget1Drop
Left = 80
Top = 32
end
end
Back to top
|