LCL: added TForm.AllowDropFiles to enable OnDropFiles event, updated DropFiles example

git-svn-id: trunk@11686 -

examples/dropfiles/dropfiles.lpi

@@ -7,7 +7,7 @@
       <MainUnit Value="0"/>
       <IconPath Value="./"/>
       <TargetFileExt Value=".exe"/>
-      <ActiveEditorIndexAtStart Value="1"/>
+      <ActiveEditorIndexAtStart Value="0"/>
     </General>
     <VersionInfo>
       <ProjectVersion Value=""/>
@@ -31,14 +31,14 @@
         <PackageName Value="LCL"/>
       </Item1>
     </RequiredPackages>
-    <Units Count="4">
+    <Units Count="20">
       <Unit0>
         <Filename Value="dropfiles.lpr"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="dropfiles"/>
-        <CursorPos X="13" Y="17"/>
+        <CursorPos X="28" Y="6"/>
         <TopLine Value="1"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="22"/>
       </Unit0>
       <Unit1>
         <Filename Value="unit1.pas"/>
@@ -46,10 +46,10 @@
         <IsPartOfProject Value="True"/>
         <ResourceFilename Value="unit1.lrs"/>
         <UnitName Value="Unit1"/>
-        <CursorPos X="41" Y="19"/>
-        <TopLine Value="13"/>
+        <CursorPos X="21" Y="13"/>
+        <TopLine Value="1"/>
         <EditorIndex Value="0"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="22"/>
         <Loaded Value="True"/>
       </Unit1>
       <Unit2>
@@ -65,23 +65,121 @@
         <IsPartOfProject Value="True"/>
         <ResourceFilename Value="unit2.lrs"/>
         <UnitName Value="Unit2"/>
-        <CursorPos X="80" Y="16"/>
-        <TopLine Value="4"/>
+        <CursorPos X="43" Y="43"/>
+        <TopLine Value="25"/>
         <EditorIndex Value="1"/>
-        <UsageCount Value="20"/>
+        <UsageCount Value="22"/>
         <Loaded Value="True"/>
       </Unit3>
+      <Unit4>
+        <Filename Value="..\..\lcl\interfaces\gtk\gtkproc.pp"/>
+        <UnitName Value="GTKProc"/>
+        <CursorPos X="50" Y="266"/>
+        <TopLine Value="299"/>
+        <UsageCount Value="11"/>
+      </Unit4>
+      <Unit5>
+        <Filename Value="..\..\lcl\interfaces\gtk\gtkcallback.inc"/>
+        <CursorPos X="29" Y="3223"/>
+        <TopLine Value="3223"/>
+        <UsageCount Value="11"/>
+      </Unit5>
+      <Unit6>
+        <Filename Value="..\..\lcl\interfaces\gtk\gtkobject.inc"/>
+        <CursorPos X="61" Y="5188"/>
+        <TopLine Value="5177"/>
+        <UsageCount Value="11"/>
+      </Unit6>
+      <Unit7>
+        <Filename Value="..\..\lcl\interfaces\gtk\gtkint.pp"/>
+        <UnitName Value="GtkInt"/>
+        <CursorPos X="23" Y="317"/>
+        <TopLine Value="303"/>
+        <UsageCount Value="10"/>
+      </Unit7>
+      <Unit8>
+        <Filename Value="..\..\lcl\interfaces\gtk\gtkwscontrols.pp"/>
+        <UnitName Value="GtkWSControls"/>
+        <CursorPos X="40" Y="336"/>
+        <TopLine Value="316"/>
+        <UsageCount Value="10"/>
+      </Unit8>
+      <Unit9>
+        <Filename Value="..\..\..\fpc\fpcsrc\packages\extra\gtk2\gtk+\gtk\gtkincludes.inc"/>
+        <CursorPos X="11" Y="166"/>
+        <TopLine Value="152"/>
+        <UsageCount Value="10"/>
+      </Unit9>
+      <Unit10>
+        <Filename Value="..\..\lcl\lmessages.pp"/>
+        <UnitName Value="LMessages"/>
+        <CursorPos X="3" Y="241"/>
+        <TopLine Value="227"/>
+        <UsageCount Value="10"/>
+      </Unit10>
+      <Unit11>
+        <Filename Value="..\..\lcl\interfaces\gtk\gtkwsstdctrls.pp"/>
+        <UnitName Value="GtkWSStdCtrls"/>
+        <CursorPos X="1" Y="1"/>
+        <TopLine Value="296"/>
+        <UsageCount Value="10"/>
+      </Unit11>
+      <Unit12>
+        <Filename Value="..\..\lcl\interfaces\qt\qtwidgets.pas"/>
+        <UnitName Value="qtwidgets"/>
+        <CursorPos X="3" Y="853"/>
+        <TopLine Value="824"/>
+        <UsageCount Value="10"/>
+      </Unit12>
+      <Unit13>
+        <Filename Value="..\..\lcl\interfaces\gtk\gtkdragcallback.inc"/>
+        <CursorPos X="3" Y="29"/>
+        <TopLine Value="16"/>
+        <UsageCount Value="10"/>
+      </Unit13>
+      <Unit14>
+        <Filename Value="..\..\lcl\interfaces\gtk2\gtk2wsstdctrls.pp"/>
+        <UnitName Value="Gtk2WSStdCtrls"/>
+        <CursorPos X="71" Y="903"/>
+        <TopLine Value="887"/>
+        <UsageCount Value="10"/>
+      </Unit14>
+      <Unit15>
+        <Filename Value="..\..\lcl\interfaces\gtk\gtkwsforms.pp"/>
+        <UnitName Value="GtkWSForms"/>
+        <CursorPos X="28" Y="213"/>
+        <TopLine Value="201"/>
+        <UsageCount Value="10"/>
+      </Unit15>
+      <Unit16>
+        <Filename Value="..\..\lcl\interfaces\gtk\gtkdef.pp"/>
+        <UnitName Value="GTKDef"/>
+        <CursorPos X="45" Y="42"/>
+        <TopLine Value="36"/>
+        <UsageCount Value="10"/>
+      </Unit16>
+      <Unit17>
+        <Filename Value="..\..\lcl\interfaces\gtk2\gtk2wscustommemo.inc"/>
+        <CursorPos X="31" Y="131"/>
+        <TopLine Value="118"/>
+        <UsageCount Value="10"/>
+      </Unit17>
+      <Unit18>
+        <Filename Value="..\..\lcl\interfaces\gtk2\gtk2wsspin.pp"/>
+        <UnitName Value="Gtk2WSSpin"/>
+        <CursorPos X="19" Y="50"/>
+        <TopLine Value="41"/>
+        <UsageCount Value="10"/>
+      </Unit18>
+      <Unit19>
+        <Filename Value="..\..\lcl\interfaces\gtk\gtkwsspin.pp"/>
+        <UnitName Value="GtkWSSpin"/>
+        <CursorPos X="26" Y="163"/>
+        <TopLine Value="152"/>
+        <UsageCount Value="10"/>
+      </Unit19>
     </Units>
-    <JumpHistory Count="2" HistoryIndex="1">
-      <Position1>
-        <Filename Value="unit1.pas"/>
-        <Caret Line="20" Column="5" TopLine="18"/>
-      </Position1>
-      <Position2>
-        <Filename Value="unit2.pas"/>
-        <Caret Line="17" Column="5" TopLine="16"/>
-      </Position2>
-    </JumpHistory>
+    <JumpHistory Count="0" HistoryIndex="-1"/>
   </ProjectOptions>
   <CompilerOptions>
     <Version Value="5"/>
@@ -89,13 +187,6 @@
     <CodeGeneration>
       <Generate Value="Faster"/>
     </CodeGeneration>
-    <Linking>
-      <Options>
-        <Win32>
-          <GraphicApplication Value="True"/>
-        </Win32>
-      </Options>
-    </Linking>
     <Other>
       <CompilerPath Value="$(CompPath)"/>
     </Other>

examples/dropfiles/unit1.lfm

@@ -6,6 +6,7 @@ object Form1: TForm1
   HorzScrollBar.Page = 700
   VertScrollBar.Page = 352
   ActiveControl = Memo1
+  AllowDropFiles = True
   Caption = 'On Files Drop event example'
   ClientHeight = 353
   ClientWidth = 701

examples/dropfiles/unit1.lrs

@@ -3,14 +3,15 @@
 LazarusResources.Add('TForm1','FORMDATA',[
   'TPF0'#6'TForm1'#5'Form1'#4'Left'#3'+'#1#6'Height'#3'a'#1#3'Top'#3#155#0#5'Wi'
   +'dth'#3#189#2#18'HorzScrollBar.Page'#3#188#2#18'VertScrollBar.Page'#3'`'#1#13
-  +'ActiveControl'#7#5'Memo1'#7'Caption'#6#27'On Files Drop event example'#12'C'
-  +'lientHeight'#3'a'#1#11'ClientWidth'#3#189#2#11'OnDropFiles'#7#13'FormDropFi'
-  +'les'#0#6'TLabel'#6'Label1'#4'Left'#2#13#6'Height'#2#14#3'Top'#2#18#5'Width'
-  +#3'('#1#7'Caption'#6'>Drag and drop files on this form and see the results i'
-  +'n memo. '#11'ParentColor'#8#0#0#5'TMemo'#5'Memo1'#4'Left'#2#12#6'Height'#3
-  +#31#1#3'Top'#2'0'#5'Width'#3#154#2#10'ScrollBars'#7#10'ssVertical'#8'TabOrde'
-  +'r'#2#0#0#0#22'TApplicationProperties'#22'ApplicationProperties1'#17'Capture'
-  +'Exceptions'#9#9'HintColor'#7#8'clInfoBk'#13'HintHidePause'#3#196#9#9'HintPa'
-  +'use'#3#244#1#13'HintShortCuts'#9#8'ShowHint'#9#11'OnDropFiles'#7#31'Applica'
-  +'tionProperties1DropFiles'#4'left'#2'~'#3'top'#3','#1#0#0#0
+  +'ActiveControl'#7#5'Memo1'#14'AllowDropFiles'#9#7'Caption'#6#27'On Files Dro'
+  +'p event example'#12'ClientHeight'#3'a'#1#11'ClientWidth'#3#189#2#11'OnDropF'
+  +'iles'#7#13'FormDropFiles'#0#6'TLabel'#6'Label1'#4'Left'#2#13#6'Height'#2#14
+  +#3'Top'#2#18#5'Width'#3'('#1#7'Caption'#6'>Drag and drop files on this form '
+  +'and see the results in memo. '#11'ParentColor'#8#0#0#5'TMemo'#5'Memo1'#4'Le'
+  +'ft'#2#12#6'Height'#3#31#1#3'Top'#2'0'#5'Width'#3#154#2#10'ScrollBars'#7#10
+  +'ssVertical'#8'TabOrder'#2#0#0#0#22'TApplicationProperties'#22'ApplicationPr'
+  +'operties1'#17'CaptureExceptions'#9#9'HintColor'#7#8'clInfoBk'#13'HintHidePa'
+  +'use'#3#196#9#9'HintPause'#3#244#1#13'HintShortCuts'#9#8'ShowHint'#9#11'OnDr'
+  +'opFiles'#7#31'ApplicationProperties1DropFiles'#4'left'#2'~'#3'top'#3','#1#0
+  +#0#0
 ]);

examples/dropfiles/unit1.pas

@@ -5,7 +5,8 @@ unit Unit1;
 interface
 
 uses
-  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls;
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
+  Spin;
 
 type
 

examples/dropfiles/unit2.lfm

@@ -5,16 +5,28 @@ object Form2: TForm2
   Width = 473
   HorzScrollBar.Page = 472
   VertScrollBar.Page = 55
+  ActiveControl = CheckBox1
   Caption = 'Form2'
   ClientHeight = 56
   ClientWidth = 473
   OnDropFiles = FormDropFiles
   object Label1: TLabel
-    Left = 13
+    Left = 15
     Height = 14
-    Top = 18
+    Top = 12
     Width = 296
     Caption = 'Drag and drop files on this form and see the results in memo. '
     ParentColor = False
   end
+  object CheckBox1: TCheckBox
+    Left = 15
+    Height = 13
+    Top = 39
+    Width = 147
+    Caption = 'Allow drop files on this form'
+    Checked = True
+    OnChange = CheckBox1Change
+    State = cbChecked
+    TabOrder = 0
+  end
 end

examples/dropfiles/unit2.lrs

@@ -2,9 +2,13 @@
 
 LazarusResources.Add('TForm2','FORMDATA',[
   'TPF0'#6'TForm2'#5'Form2'#4'Left'#3#166#1#6'Height'#2'8'#3'Top'#3'P'#2#5'Widt'
-  +'h'#3#217#1#18'HorzScrollBar.Page'#3#216#1#18'VertScrollBar.Page'#2'7'#7'Cap'
-  +'tion'#6#5'Form2'#12'ClientHeight'#2'8'#11'ClientWidth'#3#217#1#11'OnDropFil'
-  +'es'#7#13'FormDropFiles'#0#6'TLabel'#6'Label1'#4'Left'#2#13#6'Height'#2#14#3
-  +'Top'#2#18#5'Width'#3'('#1#7'Caption'#6'>Drag and drop files on this form an'
-  +'d see the results in memo. '#11'ParentColor'#8#0#0#0
+  +'h'#3#217#1#18'HorzScrollBar.Page'#3#216#1#18'VertScrollBar.Page'#2'7'#13'Ac'
+  +'tiveControl'#7#9'CheckBox1'#7'Caption'#6#5'Form2'#12'ClientHeight'#2'8'#11
+  +'ClientWidth'#3#217#1#11'OnDropFiles'#7#13'FormDropFiles'#0#6'TLabel'#6'Labe'
+  +'l1'#4'Left'#2#15#6'Height'#2#14#3'Top'#2#12#5'Width'#3'('#1#7'Caption'#6'>D'
+  +'rag and drop files on this form and see the results in memo. '#11'ParentCol'
+  +'or'#8#0#0#9'TCheckBox'#9'CheckBox1'#4'Left'#2#15#6'Height'#2#13#3'Top'#2''''
+  +#5'Width'#3#147#0#7'Caption'#6#29'Allow drop files on this form'#7'Checked'#9
+  +#8'OnChange'#7#15'CheckBox1Change'#5'State'#7#9'cbChecked'#8'TabOrder'#2#0#0
+  +#0#0
 ]);

examples/dropfiles/unit2.pas

@@ -12,8 +12,10 @@ type
   { TForm2 }
 
   TForm2 = class(TForm)
+    CheckBox1: TCheckBox;
     Label1: TLabel;
     procedure FormDropFiles(Sender: TObject; const FileNames: array of String);
+    procedure CheckBox1Change(Sender: TObject);
   private
     { private declarations }
   public
@@ -39,6 +41,11 @@ begin
     Form1.Memo1.Lines.Add(FileNames[I]);
 end;
 
+procedure TForm2.CheckBox1Change(Sender: TObject);
+begin
+  AllowDropFiles := CheckBox1.Checked;
+end;
+
 initialization
   {$I unit2.lrs}
 

lcl/forms.pp

@@ -353,6 +353,7 @@ type
     FActive: Boolean;
     FActiveControl: TWinControl;
     FActiveDefaultControl: TControl;
+    FAllowDropFiles: Boolean;
     FBorderIcons: TBorderIcons;
     FDefaultControl: TControl;
     FCancelControl: TControl;
@@ -400,6 +401,7 @@ type
     procedure SetActive(AValue: Boolean);
     procedure SetActiveControl(AWinControl: TWinControl);
     procedure SetActiveDefaultControl(AControl: TControl);
+    procedure SetAllowDropFiles(const AValue: Boolean);
     procedure SetBorderIcons(NewIcons: TBorderIcons);
     procedure SetFormBorderStyle(NewStyle: TFormBorderStyle);
     procedure SetCancelControl(NewControl: TControl);
@@ -511,6 +513,7 @@ type
     property Active: Boolean read FActive;
     property ActiveControl: TWinControl read FActiveControl write SetActiveControl;
     property ActiveDefaultControl: TControl read FActiveDefaultControl write SetActiveDefaultControl;
+    property AllowDropFiles: Boolean read FAllowDropFiles write SetAllowDropFiles default False;
     property BorderIcons: TBorderIcons read FBorderIcons write SetBorderIcons
       default [biSystemMenu, biMinimize, biMaximize];
     property BorderStyle: TFormBorderStyle
@@ -577,6 +580,7 @@ type
     property Action;
     property ActiveControl;
     property Align;
+    property AllowDropFiles;
     property AutoSize;
     property BiDiMode;
     property BorderIcons;

lcl/include/customform.inc

@@ -1260,6 +1260,15 @@ begin
     FDefaultControl.ActiveDefaultControlChanged(AControl);
 end;
 
+procedure TCustomForm.SetAllowDropFiles(const AValue: Boolean);
+begin
+  if AValue = FAllowDropFiles then Exit;
+  FAllowDropFiles := AValue;
+  
+  if HandleAllocated and not (csDesigning in ComponentState) then
+    TWSCustomFormClass(WidgetSetClass).SetAllowDropFiles(Self, AValue);
+end;
+
 {------------------------------------------------------------------------------
        TCustomForm SetFormStyle
 ------------------------------------------------------------------------------}
@@ -1306,6 +1315,7 @@ constructor TCustomForm.Create(AOwner : TComponent);
 begin
   //DebugLn('[TCustomForm.Create] A Class=',Classname);
   FShowInTaskbar := stDefault;
+  FAllowDropFiles := False;
 
   GlobalNameSpace.BeginWrite;
   try
@@ -1374,6 +1384,7 @@ begin
   FloatingDockSiteClass := TWinControlClass(ClassType);
   Screen.AddForm(Self);
   EndFormUpdate;
+  FAllowDropFiles := False;
 End;
 
 {------------------------------------------------------------------------------
@@ -1771,6 +1782,9 @@ begin
       LCLIntf.SetFocus(FActiveControl.Handle);
     end;
   end;
+  
+  // set allow drop files
+  TWSCustomFormClass(WidgetSetClass).SetAllowDropFiles(Self, FAllowDropFiles);
   //DebugLn('TCustomForm.CreateWnd END ',ClassName);
 end;
 

lcl/interfaces/gtk/gtkwsforms.pp

@@ -81,6 +81,7 @@ type
   public
     class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
     
+    class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
     class procedure SetFormBorderStyle(const AForm: TCustomForm;
                              const AFormBorderStyle: TFormBorderStyle); override;
     class procedure SetIcon(const AForm: TCustomForm; const AIcon: HICON); override;
@@ -297,10 +298,6 @@ begin
   if not (csDesigning in AWinControl.ComponentState) then
     AWidgetInfo^.UserData := Pointer(1);
     
-  // enable widget as file drag destination
-  gtk_drag_dest_set(AWidgetInfo^.CoreWidget, GTK_DEST_DEFAULT_ALL,
-    @FileDragTarget, 1, GDK_ACTION_COPY or GDK_ACTION_MOVE);
-    
   SetCallbacks(AWinControl, AWidgetInfo);
 
   {$IFDEF DebugLCLComponents}
@@ -309,6 +306,16 @@ begin
   Result := TLCLIntfHandle(P);
 end;
 
+class procedure TGtkWSCustomForm.SetAllowDropFiles(const AForm: TCustomForm;
+  AValue: Boolean);
+begin
+  if AValue then
+    gtk_drag_dest_set(PGtkWidget(AForm.Handle), GTK_DEST_DEFAULT_ALL,
+      @FileDragTarget, 1, GDK_ACTION_COPY or GDK_ACTION_MOVE)
+  else
+    gtk_drag_dest_unset(PGtkWidget(AForm.Handle));
+end;
+
 class procedure TGtkWSCustomForm.SetFormBorderStyle(const AForm: TCustomForm;
   const AFormBorderStyle: TFormBorderStyle);
 begin

lcl/interfaces/win32/win32wsforms.pp

@@ -83,6 +83,7 @@ type
   protected
   public
     class procedure CloseModal(const ACustomForm: TCustomForm); override;
+    class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override;
     class procedure SetBorderIcons(const AForm: TCustomForm;
           const ABorderIcons: TBorderIcons); override;
     class function  CreateHandle(const AWinControl: TWinControl;
@@ -251,8 +252,7 @@ begin
   FinishCreateWindow(AWinControl, Params, false);
   // TODO: proper icon, for now set default icon
   SetIcon(TCustomForm(AWinControl), 0);
-  // enable accepting drop files
-  DragAcceptFiles(Params.Window, True);
+
   Result := Params.Window;
 end;
 
@@ -261,6 +261,12 @@ begin
   EnableApplicationWindows(ACustomForm.Handle);
 end;
 
+class procedure TWin32WSCustomForm.SetAllowDropFiles(const AForm: TCustomForm;
+  AValue: Boolean);
+begin
+  DragAcceptFiles(AForm.Handle, AValue);
+end;
+
 class procedure TWin32WSCustomForm.SetBorderIcons(const AForm: TCustomForm;
           const ABorderIcons: TBorderIcons);
 begin

lcl/widgetset/wsforms.pp

@@ -76,6 +76,7 @@ type
 
   TWSCustomForm = class(TWSScrollingWinControl)
     class procedure CloseModal(const ACustomForm: TCustomForm); virtual;
+    class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); virtual;
     class procedure SetBorderIcons(const AForm: TCustomForm;
         const ABorderIcons: TBorderIcons); virtual;
     class procedure SetFormBorderStyle(const AForm: TCustomForm;
@@ -123,6 +124,11 @@ class procedure TWSCustomForm.CloseModal(const ACustomForm: TCustomForm);
 begin
 end;
 
+class procedure TWSCustomForm.SetAllowDropFiles(const AForm: TCustomForm;
+  AValue: Boolean);
+begin
+end;
+
 class procedure TWSCustomForm.SetBorderIcons(const AForm: TCustomForm;
         const ABorderIcons: TBorderIcons);
 begin
@@ -167,4 +173,4 @@ initialization
 //  RegisterWSComponent(TScreen, TWSScreen);
 //  RegisterWSComponent(TApplicationProperties, TWSApplicationProperties);
 ////////////////////////////////////////////////////
-end.
+end.