a basic DND demo.

4 files changed, 393 insertions, 0 deletions

diff --git a/examples/gui/drag_n_drop/dndexample.lpi b/examples/gui/drag_n_drop/dndexample.lpi
new file mode 100644
index 00000000..c962aa5e
--- /dev/null
+++ b/examples/gui/drag_n_drop/dndexample.lpi
@@ -0,0 +1,82 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="7"/>
+    <General>
+      <Flags>
+        <SaveOnlyProjectUnits Value="True"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+      <UseAppBundle Value="False"/>
+    </General>
+    <VersionInfo>
+      <Language Value=""/>
+      <CharSet Value=""/>
+      <StringTable ProductVersion="" CompanyName="" FileDescription="" FileVersion="" InternalName="" OriginalFilename="" ProductName=""/>
+    </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="fpgui_toolkit"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="dndexample.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="dndexample"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <Target>
+      <Filename Value="dndexample"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)/"/>
+      <UnitOutputDirectory Value="units/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <IncludeAssertionCode Value="True"/>
+        <AllowLabel Value="False"/>
+        <CPPInline Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <CompilerMessages>
+        <UseMsgFile Value="True"/>
+      </CompilerMessages>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
diff --git a/examples/gui/drag_n_drop/dndexample.lpr b/examples/gui/drag_n_drop/dndexample.lpr
new file mode 100644
index 00000000..706cfd42
--- /dev/null
+++ b/examples/gui/drag_n_drop/dndexample.lpr
@@ -0,0 +1,306 @@
+program dndexample;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, SysUtils,
+  fpg_base, fpg_main, fpg_form, fpg_button, fpg_grid, fpg_panel,
+  fpg_label, fpg_edit, fpg_stdimages;
+
+type
+  TMainForm = class(TfpgForm)
+  private
+    {@VFD_HEAD_BEGIN: MainForm}
+    Bevel1: TfpgPanel;
+    Grid1: TfpgStringGrid;
+    Button1: TfpgButton;
+    btnClear: TfpgButton;
+    MyDragSourceLabel: TfpgLabel;
+    Edit1: TfpgEdit;
+    Label1: TfpgLabel;
+    Label2: TfpgLabel;
+    Label3: TfpgLabel;
+    {@VFD_HEAD_END: MainForm}
+    procedure Edit1DragDrop(Sender, Source: TObject; X, Y: integer; AData: variant);
+    procedure Edit1DragEnter(Sender, Source: TObject; AMimeList: TStringList; var AMimeChoice: TfpgString; var ADropAction: TfpgDropAction; var Accept: Boolean);
+    procedure Bevel1DragEnter(Sender, Source: TObject; AMimeList: TStringList; var AMimeChoice: TfpgString; var ADropAction: TfpgDropAction; var Accept: Boolean);
+    procedure Bevel1DragLeave(Sender: TObject);
+    procedure PanelDragDrop(Sender, Source: TObject; X, Y: integer; AData: variant);
+    procedure Button1Clicked(Sender: TObject);
+    procedure LabelDragStartDetected(Sender: TObject);
+    procedure ShowMimeList(AMimeList: TStringList);
+  public
+    procedure AfterCreate; override;
+  end;
+
+{@VFD_NEWFORM_DECL}
+
+
+
+{@VFD_NEWFORM_IMPL}
+
+procedure TMainForm.Edit1DragDrop(Sender, Source: TObject; X, Y: integer;
+  AData: variant);
+begin
+  Edit1.Text := AData;
+end;
+
+procedure TMainForm.Edit1DragEnter(Sender, Source: TObject;
+  AMimeList: TStringList; var AMimeChoice: TfpgString;
+  var ADropAction: TfpgDropAction; var Accept: Boolean);
+var
+  s: string;
+begin
+  s := 'text/plain';
+  Accept := AMimeList.IndexOf(s) > -1;
+  if Accept then
+  begin
+    if AMimeChoice <> s then
+      AMimeChoice := s;
+    ShowMimeList(AMimeList);
+  end;
+end;
+
+procedure TMainForm.Bevel1DragEnter(Sender, Source: TObject;
+  AMimeList: TStringList; var AMimeChoice: TfpgString;
+  var ADropAction: TfpgDropAction; var Accept: Boolean);
+var
+  i: integer;
+  s: string;
+begin
+  { the mime type we want to accept }
+  s := 'text/html';
+  { if we wil accept the drop, set Accept to True }
+  Accept := AMimeList.IndexOf(s) > -1;
+  if Accept then
+  begin
+    { If the offered mime type is different, request our preference }
+    if AMimeChoice <> s then
+      AMimeChoice := s;
+
+    ShowMimeList(AMimeList);
+    Bevel1.BackgroundColor := clRed;
+  end;
+end;
+
+procedure TMainForm.Bevel1DragLeave(Sender: TObject);
+begin
+  Bevel1.BackgroundColor := clWindowBackground;
+end;
+
+procedure TMainForm.PanelDragDrop(Sender, Source: TObject; X, Y: integer;
+  AData: Variant);
+var
+  s: string;
+  v: variant;
+begin
+  s := AData;
+  Bevel1.Text := Format('Drop event at (%d,%d) with value(s):'+LineEnding+'%s', [X, Y, s]);
+  Bevel1DragLeave(nil);
+end;
+
+procedure TMainForm.Button1Clicked(Sender: TObject);
+begin
+  Close;
+end;
+
+procedure TMainForm.LabelDragStartDetected(Sender: TObject);
+var
+  m: TfpgMimeData;
+  d: TfpgDrag;
+  v: variant;
+begin
+  m := TfpgMimeData.Create;
+  { via convenience properties }
+  m.Text := 'My name is Earl';
+  m.HTML := 'My name is <b>Earl</b>';
+  { via generic SetData function }
+  m.SetData('text/special', 'type number three');
+  v := 'type number four';
+  m.SetData('text/four', v);
+  m.SetData('text/five', 'type number five');
+
+  { tell TfpgDrag who is the Source of the drag }
+//  d := TfpgDrag.Create(MyDragSourceLabel);
+  d := TfpgDrag.Create(Sender as TfpgWindow);
+
+  { TfpgDrag now takes ownership of TfpgMimeData }
+  d.MimeData := m;
+  { TfpgDrag instance will be freed later when DND action is completed }
+  d.Execute([daCopy]);
+end;
+
+procedure TMainForm.ShowMimeList(AMimeList: TStringList);
+var
+  i: integer;
+begin
+  { for debug purposes, output the various mime types supported by the source }
+  Grid1.RowCount := AMimeList.Count;
+  for i := 0 to AMimeList.Count-1 do
+  begin
+    Grid1.Cells[0, i] := IntToStr(i+1);
+    Grid1.Cells[1, i] := AMimeList[i];
+  end;
+end;
+
+procedure TMainForm.AfterCreate;
+begin
+  {%region 'Auto-generated GUI code' -fold}
+  {@VFD_BODY_BEGIN: MainForm}
+  Name := 'MainForm';
+  SetPosition(316, 186, 512, 429);
+  WindowTitle := 'Drop Site Demo';
+  Hint := '';
+  EnableDrops := True;
+
+  Bevel1 := TfpgPanel.Create(self);
+  with Bevel1 do
+  begin
+    Name := 'Bevel1';
+    SetPosition(260, 40, 244, 140);
+    Anchors := [anLeft,anRight,anTop];
+    Alignment := taLeftJustify;
+    FontDesc := '#Label1';
+    Hint := '';
+    Layout := tlTop;
+    Style := bsLowered;
+    Text := '';
+    WrapText := True;
+    BorderStyle := bsDouble;
+    AcceptDrops := True;
+    OnDragEnter := @Bevel1DragEnter;
+    OnDragLeave := @Bevel1DragLeave;
+    OnDragDrop  := @PanelDragDrop;
+  end;
+
+  Grid1 := TfpgStringGrid.Create(self);
+  with Grid1 do
+  begin
+    Name := 'Grid1';
+    SetPosition(8, 224, 496, 167);
+    Anchors := [anLeft,anRight,anTop,anBottom];
+    AddColumn('#', 20, taLeftJustify);
+    AddColumn('MIME Type', 190, taLeftJustify);
+    AddColumn('Data', 250, taLeftJustify);
+    FontDesc := '#Grid';
+    HeaderFontDesc := '#GridHeader';
+    Hint := '';
+    RowCount := 0;
+    RowSelect := False;
+    TabOrder := 2;
+  end;
+
+  Button1 := TfpgButton.Create(self);
+  with Button1 do
+  begin
+    Name := 'Button1';
+    SetPosition(424, 400, 80, 24);
+    Anchors := [anRight,anBottom];
+    Text := 'Quit';
+    FontDesc := '#Label1';
+    Hint := '';
+    ImageName := '';
+    TabOrder := 3;
+    Down := False;
+    OnClick :=@Button1Clicked;
+  end;
+
+  btnClear := TfpgButton.Create(self);
+  with btnClear do
+  begin
+    Name := 'btnClear';
+    SetPosition(340, 400, 80, 24);
+    Anchors := [anRight,anBottom];
+    Text := 'Clear';
+    FontDesc := '#Label1';
+    Hint := '';
+    ImageName := '';
+    TabOrder := 4;
+    Down := False;
+  end;
+
+  MyDragSourceLabel := TfpgLabel.Create(self);
+  with MyDragSourceLabel do
+  begin
+    Name := 'MyDragSourceLabel';
+    SetPosition(28, 20, 84, 40);
+    Alignment := taCenter;
+    FontDesc := '#Label1';
+    Hint := '';
+    Layout := tlCenter;
+    Text := 'Drag Me!';
+    BackgroundColor := clSteelBlue;
+    OnDragStartDetected := @LabelDragStartDetected;
+  end;
+
+  Edit1 := TfpgEdit.Create(self);
+  with Edit1 do
+  begin
+    Name := 'Edit1';
+    SetPosition(8, 156, 240, 24);
+    ExtraHint := '';
+    Hint := '';
+    TabOrder := 7;
+    Text := '';
+    FontDesc := '#Edit1';
+    AcceptDrops := True;
+    OnDragEnter := @Edit1DragEnter;
+    OnDragDrop  := @Edit1DragDrop;
+  end;
+
+  Label1 := TfpgLabel.Create(self);
+  with Label1 do
+  begin
+    Name := 'Label1';
+    SetPosition(260, 20, 244, 16);
+    FontDesc := '#Label2';
+    Hint := '';
+    Text := 'Accepts ''text/html''';
+  end;
+
+  Label2 := TfpgLabel.Create(self);
+  with Label2 do
+  begin
+    Name := 'Label2';
+    SetPosition(8, 136, 240, 16);
+    FontDesc := '#Label2';
+    Hint := '';
+    Text := 'Accepts ''text/plain''';
+  end;
+
+  Label3 := TfpgLabel.Create(self);
+  with Label3 do
+  begin
+    Name := 'Label3';
+    SetPosition(8, 204, 284, 16);
+    FontDesc := '#Label2';
+    Hint := '';
+    Text := 'Available drop formats';
+  end;
+
+  {@VFD_BODY_END: MainForm}
+  {%endregion}
+end;
+
+
+procedure MainProc;
+var
+  frm: TMainForm;
+begin
+  fpgApplication.Initialize;
+  frm := TMainForm.Create(nil);
+  try
+    frm.Show;
+    fpgApplication.Run;
+  finally
+    frm.Free;
+  end;
+end;
+
+begin
+  MainProc;
+end.
+
diff --git a/examples/gui/drag_n_drop/extrafpc.cfg b/examples/gui/drag_n_drop/extrafpc.cfg
new file mode 100644
index 00000000..775d592f
--- /dev/null
+++ b/examples/gui/drag_n_drop/extrafpc.cfg
@@ -0,0 +1,5 @@
+-FUunits
+-Fu../../../lib/$fpctarget
+-Xs
+-XX
+-CX
diff --git a/examples/gui/drag_n_drop/units/placeholder.txt b/examples/gui/drag_n_drop/units/placeholder.txt
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/examples/gui/drag_n_drop/units/placeholder.txt