Form source (Pascal)
Form source (DFM)
Project source
Form source (Pascal)
Form source (DFM)
| Project source: CustomTest4.dpr |
program CustomTest4;
{Main program file for test application for UnitOOPS OLE Drag and Drop Components.}
uses
Forms,
fmMultiAccept in 'fmMultiAccept.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Back to top
|
| Form source: fmMultiAccept.pas |
unit fmMultiAccept;
{ UnitOOPS OLE Drag and Drop Components - Example
for accepting drags in multiple custom (user-defined) data formats.
Last modified: 09/14/98}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, uoole;
type
TForm1 = class(TForm)
Panel1: TPanel;
Label1: TLabel;
UOTextTarget1: TUOTextTarget;
Panel2: TPanel;
Label2: TLabel;
Image1: TImage;
Image2: TImage;
procedure FormCreate(Sender: TObject);
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}
uses
uoUtil;
procedure TForm1.FormCreate(Sender: TObject);
begin
with UOTextTarget1 do
begin
// Set the form itself up as an Acceptor
UOTextTarget1.AcceptorControl := self;
// Register to accept some custom formats
// A drag source that can supply more then one of these will give up the
// first one in the list that it has.
with CustomFormats do
begin
addObject('2', TObject(16));
add('Rich Text Format'); // RTF
add('UniformResourceLocator'); // URLs from Internet Explorer
add('UnitOOPS Pi'); // See CustomTest2.dpr
add('UnitOOPS e'); // See CustomTest2.dpr
add('Something Or Other'); // A custom one
add('FileName');
end; // with
end; // with
end;
procedure TForm1.UOTextTarget1Drop(Sender: TObject; Acceptor: TWinControl;
const dropText: String; X, Y: Integer);
// Figure out what formats we now have to handle.
// Since this is just an example, we list them as text.
// We also show how you can get hold of formats that were not even in the
// "accepted" list (CF_BITMAP, CF_ENHMETAFILE). In this way, you can have a
// private format that, if present, tips you off to look for some standard
// formats, without those standard formats having to be available to all
// drop targets that would otherwise accept them.
var
S: string;
j: integer;
aHBitmap: HBitmap;
aHMetaFile: HMetafile;
begin
with (Sender as TUOTextTarget), CustomFormats do
begin
if (count > 0) and (dropText = '') then
begin
// Do we have CF_BITMAP on a TYMED_GDI?
// Undocumented tip - whan using the DataObject* functions, if the global
// variable DataObjectTyped is other than 0 or 2, its value is taken as tye
// value of the TYMED for that query.
DataObjectTymed := 16; // TYMED_GDI
if DataObjectHasFormat('2') then
begin
s := DataObjectGetFormat('2');
aHBitmap := uoDecodeDWORDFromString(s);
Image1.Picture.Bitmap.Handle := aHBitmap;
end;
// Do we have CF_ENHMETAFILE on a TYMED_ENHMF?
DataObjectTymed := 64; // TYMED_ENHMF
if DataObjectHasFormat('14') then
begin
s := DataObjectGetFormat('14');
aHMetaFile := uoDecodeDWORDFromString(s);
Image2.Picture.Metafile.Handle := aHMetafile;
end;
s := 'Now we would need to write the code to accept the formats: '#13#10#13#10;
for j := 1 to Count do // Iterate
begin
DataObjectTymed := DWORD(CustomFormats.Objects[j-1]);
if DataObjectHasFormat(Strings[j-1]) then
s := s + Strings[j-1]+#13#10;
end; // for
DataObjectTymed := 0;
end
else
begin
s := 'Now we accept the standard formats accepted by this target';
end;
Label2.Caption := s;
end; // with
end;
end.
Back to top
|
| Form source: fmMultiAccept.dfm |
object Form1: TForm1
Left = 270
Top = 215
Width = 449
Height = 265
Caption = 'Custom test 4 - accepting multiple formats'
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 = 0
Width = 441
Height = 41
Align = alTop
BevelOuter = bvNone
BorderWidth = 3
TabOrder = 0
object Label1: TLabel
Left = 3
Top = 3
Width = 435
Height = 35
Align = alClient
Caption =
'Drag from another application onto the blank area below. In par' +
'ticular, drag a range of cells from Excel, and see them rendered' +
' simultaneously as a bitmap and as a metafile.'
WordWrap = True
end
end
object Panel2: TPanel
Left = 0
Top = 41
Width = 441
Height = 197
Align = alClient
BevelOuter = bvNone
BorderWidth = 5
Caption = 'Panel2'
TabOrder = 1
object Label2: TLabel
Left = 5
Top = 5
Width = 431
Height = 187
Align = alClient
AutoSize = False
end
object Image1: TImage
Left = 264
Top = 40
Width = 145
Height = 65
end
object Image2: TImage
Left = 264
Top = 112
Width = 145
Height = 65
end
end
object UOTextTarget1: TUOTextTarget
AcceptTextFormats = [dtfText, dtfCustom]
OnDrop = UOTextTarget1Drop
Left = 32
Top = 184
end
end
Back to top
|