From 546684ab7b1f4f8de63aab16b59a906229ad1cf9 Mon Sep 17 00:00:00 2001 From: paul Date: Tue, 15 Jan 2008 10:18:20 +0000 Subject: [PATCH] DragImageList example git-svn-id: trunk@13757 - --- .gitattributes | 6 ++ examples/dragimagelist/project1.lpi | 139 ++++++++++++++++++++++++++++ examples/dragimagelist/project1.lpr | 18 ++++ examples/dragimagelist/readme.txt | 6 ++ examples/dragimagelist/unit1.lfm | 40 ++++++++ examples/dragimagelist/unit1.lrs | 16 ++++ examples/dragimagelist/unit1.pas | 110 ++++++++++++++++++++++ 7 files changed, 335 insertions(+) create mode 100644 examples/dragimagelist/project1.lpi create mode 100644 examples/dragimagelist/project1.lpr create mode 100644 examples/dragimagelist/readme.txt create mode 100644 examples/dragimagelist/unit1.lfm create mode 100644 examples/dragimagelist/unit1.lrs create mode 100644 examples/dragimagelist/unit1.pas diff --git a/.gitattributes b/.gitattributes index eb2c0eeccd..92c657b805 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1565,6 +1565,12 @@ examples/designerbaseclass/example/unit1.lfm svneol=native#text/plain examples/designerbaseclass/example/unit1.lrs svneol=native#text/plain examples/designerbaseclass/example/unit1.pas svneol=native#text/plain examples/dlgform.pp svneol=native#text/pascal +examples/dragimagelist/project1.lpi svneol=native#text/plain +examples/dragimagelist/project1.lpr svneol=native#text/pascal +examples/dragimagelist/readme.txt svneol=native#text/plain +examples/dragimagelist/unit1.lfm svneol=native#text/plain +examples/dragimagelist/unit1.lrs svneol=native#text/pascal +examples/dragimagelist/unit1.pas svneol=native#text/pascal examples/dropfiles/dropfiles.lpi svneol=native#text/plain examples/dropfiles/dropfiles.lpr svneol=native#text/pascal examples/dropfiles/unit1.lfm svneol=native#text/plain diff --git a/examples/dragimagelist/project1.lpi b/examples/dragimagelist/project1.lpi new file mode 100644 index 0000000000..1689ca4a57 --- /dev/null +++ b/examples/dragimagelist/project1.lpi @@ -0,0 +1,139 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/dragimagelist/project1.lpr b/examples/dragimagelist/project1.lpr new file mode 100644 index 0000000000..5f76875bbf --- /dev/null +++ b/examples/dragimagelist/project1.lpr @@ -0,0 +1,18 @@ +program project1; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX}{$IFDEF UseCThreads} + cthreads, + {$ENDIF}{$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms + { you can add units after this }, Unit1; + +begin + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/examples/dragimagelist/readme.txt b/examples/dragimagelist/readme.txt new file mode 100644 index 0000000000..6b5d6fd085 --- /dev/null +++ b/examples/dragimagelist/readme.txt @@ -0,0 +1,6 @@ +This example demonstrates the usage of DragImageList. + +You will see Button image nearly cursor while drag. +This Button image is from the DragImageList. You can +place any other image there to show it while drag +operation. \ No newline at end of file diff --git a/examples/dragimagelist/unit1.lfm b/examples/dragimagelist/unit1.lfm new file mode 100644 index 0000000000..e19b286cc2 --- /dev/null +++ b/examples/dragimagelist/unit1.lfm @@ -0,0 +1,40 @@ +object Form1: TForm1 + Left = 290 + Height = 300 + Top = 175 + Width = 400 + HorzScrollBar.Page = 399 + VertScrollBar.Page = 299 + Caption = 'Form1' + ClientHeight = 300 + ClientWidth = 400 + object Label1: TLabel + Left = 8 + Height = 40 + Top = 240 + Width = 159 + Caption = 'If DragImageList is working then '#13#10'you should see Button image '#13#10'dragged nearly mouse cursor.' + ParentColor = False + end + object Button1: TButton + Left = 16 + Height = 25 + Top = 16 + Width = 75 + Caption = 'Move me' + DragMode = dmAutomatic + OnStartDrag = Button1StartDrag + TabOrder = 0 + end + object Panel1: TPanel + Left = 216 + Height = 50 + Top = 232 + Width = 170 + BevelInner = bvLowered + Caption = 'Move here' + TabOrder = 1 + OnDragDrop = Panel1DragDrop + OnDragOver = Panel1DragOver + end +end diff --git a/examples/dragimagelist/unit1.lrs b/examples/dragimagelist/unit1.lrs new file mode 100644 index 0000000000..45b22979e5 --- /dev/null +++ b/examples/dragimagelist/unit1.lrs @@ -0,0 +1,16 @@ +{ Это - файл ресурсов, автоматически созданный lazarus } + +LazarusResources.Add('TForm1','FORMDATA',[ + 'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'"'#1#6'Height'#3','#1#3'Top'#3#175#0#5'Wi' + +'dth'#3#144#1#18'HorzScrollBar.Page'#3#143#1#18'VertScrollBar.Page'#3'+'#1#7 + +'Caption'#6#5'Form1'#12'ClientHeight'#3','#1#11'ClientWidth'#3#144#1#0#6'TLa' + +'bel'#6'Label1'#4'Left'#2#8#6'Height'#2'('#3'Top'#3#240#0#5'Width'#3#159#0#7 + +'Caption'#6']If DragImageList is working then '#13#10'you should see Button ' + +'image '#13#10'dragged nearly mouse cursor.'#11'ParentColor'#8#0#0#7'TButton' + +#7'Button1'#4'Left'#2#16#6'Height'#2#25#3'Top'#2#16#5'Width'#2'K'#7'Caption' + +#6#7'Move me'#8'DragMode'#7#11'dmAutomatic'#11'OnStartDrag'#7#16'Button1Star' + +'tDrag'#8'TabOrder'#2#0#0#0#6'TPanel'#6'Panel1'#4'Left'#3#216#0#6'Height'#2 + +'2'#3'Top'#3#232#0#5'Width'#3#170#0#10'BevelInner'#7#9'bvLowered'#7'Caption' + +#6#9'Move here'#8'TabOrder'#2#1#10'OnDragDrop'#7#14'Panel1DragDrop'#10'OnDra' + +'gOver'#7#14'Panel1DragOver'#0#0#0 +]); diff --git a/examples/dragimagelist/unit1.pas b/examples/dragimagelist/unit1.pas new file mode 100644 index 0000000000..18aaa3513d --- /dev/null +++ b/examples/dragimagelist/unit1.pas @@ -0,0 +1,110 @@ +unit Unit1; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, + ExtCtrls; + +type + + { TForm1 } + + TForm1 = class(TForm) + Button1: TButton; + Label1: TLabel; + Panel1: TPanel; + procedure Button1StartDrag(Sender: TObject; var DragObject: TDragObject); + procedure Panel1DragDrop(Sender, Source: TObject; X, Y: Integer); + procedure Panel1DragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); + private + { private declarations } + public + { public declarations } + end; + + { TMyDragObject } + + TMyDragObject = class(TDragControlObject) + private + FDragImages: TDragImageList; + protected + function GetDragImages: TDragImageList; override; + public + constructor Create(AControl: TControl); override; + destructor Destroy; override; + end; + +var + Form1: TForm1; + +implementation + +{ TForm1 } + +procedure TForm1.Button1StartDrag(Sender: TObject; var DragObject: TDragObject); +begin + DragObject := TMyDragObject.Create(Sender as TControl); +end; + +procedure TForm1.Panel1DragDrop(Sender, Source: TObject; X, Y: Integer); +begin + ShowMessage('Congratulations. You droped button on me :)') +end; + +procedure TForm1.Panel1DragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); +var + Control: TControl; +begin + if Source is TControl then + Control := Source as TControl + else + if Source is TDragControlObject then + Control := (Source as TDragControlObject).Control + else + Control := nil; + Accept := Control is TButton; +end; + +{ TMyDragObject } + +function TMyDragObject.GetDragImages: TDragImageList; +begin + Result := FDragImages; +end; + +constructor TMyDragObject.Create(AControl: TControl); +var + Bitmap: TBitmap; +begin + inherited Create(AControl); + FDragImages := TDragImageList.Create(AControl); + AlwaysShowDragImages := True; + + Bitmap := TBitmap.Create; + Bitmap.Width := AControl.Width; + Bitmap.Height := AControl.Height; + if AControl is TWinControl then + (AControl as TWinControl).PaintTo(Bitmap.Canvas, 0, 0); + FDragImages.Width := Bitmap.Width; + FDragImages.Height := Bitmap.Height; + FDragImages.Add(Bitmap, nil); + FDragImages.DragHotspot := Point(Bitmap.Width, Bitmap.Height); + Bitmap.Free; +end; + +destructor TMyDragObject.Destroy; +begin + FDragImages.Free; + inherited Destroy; +end; + +initialization + {$I unit1.lrs} + +end. +