DragImageList example

git-svn-id: trunk@13757 -
2025-10-23 06:41:30 +02:00 · 2008-01-15 10:18:20 +00:00 · 2008-01-15 10:18:20 +00:00 · 546684ab7b
commit 546684ab7b
parent 3092ac63d9
7 changed files with 335 additions and 0 deletions
--- 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
--- a/examples/dragimagelist/project1.lpi
+++ b/examples/dragimagelist/project1.lpi
@ -0,0 +1,139 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <PathDelim Value="\"/>
+    <Version Value="6"/>
+    <General>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=".exe"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+    </General>
+    <VersionInfo>
+      <ProjectVersion Value=""/>
+      <Language Value=""/>
+      <CharSet Value=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="project1.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="project1"/>
+        <UsageCount Value="20"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="unit1.pas"/>
+        <ComponentName Value="Form1"/>
+        <IsPartOfProject Value="True"/>
+        <ResourceFilename Value="unit1.lrs"/>
+        <UnitName Value="Unit1"/>
+        <CursorPos X="13" Y="24"/>
+        <TopLine Value="16"/>
+        <EditorIndex Value="0"/>
+        <UsageCount Value="20"/>
+        <Loaded Value="True"/>
+      </Unit1>
+    </Units>
+    <JumpHistory Count="14" HistoryIndex="13">
+      <Position1>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="9" Column="19" TopLine="1"/>
+      </Position1>
+      <Position2>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="20" Column="70" TopLine="8"/>
+      </Position2>
+      <Position3>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="19" Column="5" TopLine="14"/>
+      </Position3>
+      <Position4>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="30" Column="3" TopLine="26"/>
+      </Position4>
+      <Position5>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="82" Column="1" TopLine="58"/>
+      </Position5>
+      <Position6>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="9" Column="11" TopLine="1"/>
+      </Position6>
+      <Position7>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="78" Column="20" TopLine="60"/>
+      </Position7>
+      <Position8>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="1" Column="1" TopLine="1"/>
+      </Position8>
+      <Position9>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="72" Column="18" TopLine="60"/>
+      </Position9>
+      <Position10>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="9" Column="19" TopLine="9"/>
+      </Position10>
+      <Position11>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="71" Column="20" TopLine="49"/>
+      </Position11>
+      <Position12>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="9" Column="11" TopLine="1"/>
+      </Position12>
+      <Position13>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="19" Column="1" TopLine="1"/>
+      </Position13>
+      <Position14>
+        <Filename Value="unit1.pas"/>
+        <Caret Line="40" Column="24" TopLine="30"/>
+      </Position14>
+    </JumpHistory>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="5"/>
+    <PathDelim Value="\"/>
+    <CodeGeneration>
+      <Generate Value="Faster"/>
+    </CodeGeneration>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="2">
+      <Item1>
+        <Name Value="ECodetoolError"/>
+      </Item1>
+      <Item2>
+        <Name Value="EFOpenError"/>
+      </Item2>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
--- a/examples/dragimagelist/project1.lpr
+++ 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.
+
--- a/examples/dragimagelist/readme.txt
+++ 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.
--- a/examples/dragimagelist/unit1.lfm
+++ 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
--- a/examples/dragimagelist/unit1.lrs
+++ 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
+]);
--- a/examples/dragimagelist/unit1.pas
+++ 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.
+