Form source (Pascal)
Form source (DFM)
Project source
Form source (Pascal)
Form source (DFM)
| Project source: DelayRenderDIBTest.dpr |
program DelayRenderDIBTest;
{Example application for UnitOOPS OLE Drag and Drop Components}
uses
Forms,
fmDelayRenderDIBTest in 'fmDelayRenderDIBTest.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
Back to top
|
| Form source: fmDelayRenderDIBTest.pas |
unit fmDelayRenderDIBTest;
{ Example for UnitOOPS OLE Drag and Drop Components. Demonstrates how to
drag a bitmap in DIB format, and only have the data rendered at drop-time (when
it's actually needed) to avoid large memory allocations until needed.
Last modified: 11/10/99
}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, uoole;
type
TForm1 = class(TForm)
Label1: TLabel;
Panel1: TPanel;
Image1: TImage;
UOTextSource1: TUOTextSource;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure UOTextSource1RenderCustomFormat(Sender: TObject;
const formatName: String; var formatContent: String);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
// OnMouseDown - detect the drag.
begin
if DragDetect(Panel1.Handle, POINT(X,Y)) then
begin
// We have a drag.
with UOTextSource1, CustomFormatData do
begin
// Clear out the custom format list,
Clear;
// Advertise that we can supply DIB's, but send no data.
// At drop time we'll be asked for this in OnRenderCustomFormat
AddFormat(IntToStr(CF_DIB), '');
// Do the drag
Execute;
end; // with
end;
end;
procedure TForm1.UOTextSource1RenderCustomFormat(Sender: TObject;
const formatName: String; var formatContent: String);
// We've been asked to render the custom format formatName.
// We may get called multiple times here.
var
aMS: TStringStream;
begin
// Have we been asked for DIB?
if (formatName = IntToStr(CF_DIB)) then
begin
// Use a TStringStream to get the data on a string easily
aMS := TStringStream.create('');
try
// Put the bitmap from our TImage on the stream
Image1.Picture.Bitmap.SaveToStream(aMS);
// Grab the contents as a string
formatContent := aMS.DataString;
// Remove the file header to get a standalone DIB
Delete(formatContent, 1, sizeOf(TBitmapFileHeader));
finally // wrap up
aMS.free;
end; // try/finally
end;
end;
end.
Back to top
|
| Form source: fmDelayRenderDIBTest.dfm |
object Form1: TForm1
Left = 192
Top = 194
Width = 538
Height = 173
Caption = 'Test of delay-rendering DIB'#39's'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 8
Width = 311
Height = 13
Caption =
'Drag the image . It will be delay-rendered as CF_DIB in the tar' +
'get.'
end
object Panel1: TPanel
Left = 8
Top = 30
Width = 511
Height = 107
AutoSize = True
Caption = 'Panel1'
TabOrder = 0
object Image1: TImage
Left = 1
Top = 1
Width = 509
Height = 105
AutoSize = True
Picture.Data = {
07544269746D6170EE720200424DEE720200000000003600000028000000FD01
0000690000000100180000000000B87202000000000000000000000000000000
0000F7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFF
F7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FF
FFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7
FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFF
...omitted for brevity...
F7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FF
FFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7
FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFF
F7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FF
FFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFF00}
OnMouseDown = Image1MouseDown
end
end
object UOTextSource1: TUOTextSource
OnRenderCustomFormat = UOTextSource1RenderCustomFormat
DropEffects = [deCopy]
MouseButton = mbLeft
Left = 456
Top = 8
end
end
Back to top
|