main.pas 6.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200
  1. unit main;
  2. interface
  3. uses
  4. DragDrop,
  5. DropTarget,
  6. DragDropGraphics,
  7. DropComboTarget,
  8. Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  9. ComCtrls, StdCtrls, ExtCtrls;
  10. type
  11. TFormMain = class(TForm)
  12. DropComboTarget1: TDropComboTarget;
  13. PageControl1: TPageControl;
  14. TabSheetText: TTabSheet;
  15. TabSheetFiles: TTabSheet;
  16. TabSheetBitmap: TTabSheet;
  17. TabSheetURL: TTabSheet;
  18. ListBoxFiles: TListBox;
  19. ListBoxMaps: TListBox;
  20. Splitter1: TSplitter;
  21. Label1: TLabel;
  22. Label2: TLabel;
  23. EditURLURL: TEdit;
  24. EditURLTitle: TEdit;
  25. MemoText: TMemo;
  26. TabSheetData: TTabSheet;
  27. TabSheetMetaFile: TTabSheet;
  28. ScrollBox1: TScrollBox;
  29. ImageMetaFile: TImage;
  30. ScrollBox2: TScrollBox;
  31. ImageBitmap: TImage;
  32. Panel2: TPanel;
  33. PanelDropZone: TPanel;
  34. Panel1: TPanel;
  35. GroupBox1: TGroupBox;
  36. CheckBoxText: TCheckBox;
  37. CheckBoxFiles: TCheckBox;
  38. CheckBoxURLs: TCheckBox;
  39. CheckBoxBitmaps: TCheckBox;
  40. CheckBoxMetaFiles: TCheckBox;
  41. CheckBoxData: TCheckBox;
  42. ListViewData: TListView;
  43. Label3: TLabel;
  44. procedure DropComboTarget1Drop(Sender: TObject;
  45. ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
  46. procedure CheckBoxTextClick(Sender: TObject);
  47. procedure CheckBoxFilesClick(Sender: TObject);
  48. procedure CheckBoxURLsClick(Sender: TObject);
  49. procedure CheckBoxBitmapsClick(Sender: TObject);
  50. procedure CheckBoxMetaFilesClick(Sender: TObject);
  51. procedure CheckBoxDataClick(Sender: TObject);
  52. procedure ListViewDataDblClick(Sender: TObject);
  53. private
  54. { Private declarations }
  55. public
  56. { Public declarations }
  57. end;
  58. var
  59. FormMain: TFormMain;
  60. implementation
  61. uses
  62. ShellApi;
  63. {$R *.DFM}
  64. procedure TFormMain.DropComboTarget1Drop(Sender: TObject;
  65. ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
  66. var
  67. Stream: TStream;
  68. i: integer;
  69. Name: string;
  70. begin
  71. // Clear all formats.
  72. EditURLURL.Text := '';
  73. EditURLTitle.Text := '';
  74. MemoText.Lines.Clear;
  75. ImageBitmap.Picture.Assign(nil);
  76. ImageMetaFile.Picture.Assign(nil);
  77. ListBoxFiles.Items.Clear;
  78. ListBoxMaps.Items.Clear;
  79. ListViewData.Items.Clear;
  80. // Extract and display dropped data.
  81. for i := 0 to DropComboTarget1.Data.Count-1 do
  82. begin
  83. Name := DropComboTarget1.Data.Names[i];
  84. if (Name = '') then
  85. Name := intToStr(i)+'.dat';
  86. Stream := TFileStream.Create(ExtractFilePath(Application.ExeName)+Name, fmCreate);
  87. try
  88. with ListViewData.Items.Add do
  89. begin
  90. Caption := Name;
  91. SubItems.Add(IntToStr(DropComboTarget1.Data[i].Size));
  92. end;
  93. // Copy dropped data to stream (in this case a file stream).
  94. Stream.CopyFrom(DropComboTarget1.Data[i], DropComboTarget1.Data[i].Size);
  95. finally
  96. Stream.Free;
  97. end;
  98. end;
  99. // Copy the rest of the dropped formats.
  100. ListBoxFiles.Items.Assign(DropComboTarget1.Files);
  101. ListBoxMaps.Items.Assign(DropComboTarget1.FileMaps);
  102. EditURLURL.Text := DropComboTarget1.URL;
  103. EditURLTitle.Text := DropComboTarget1.Title;
  104. ImageBitmap.Picture.Assign(DropComboTarget1.Bitmap);
  105. ImageMetaFile.Picture.Assign(DropComboTarget1.MetaFile);
  106. MemoText.Lines.Text := DropComboTarget1.Text;
  107. // Determine which formats were dropped.
  108. TabSheetFiles.TabVisible := (ListBoxFiles.Items.Count > 0);
  109. TabSheetURL.TabVisible := (EditURLURL.Text <> '') or (EditURLTitle.Text <> '');
  110. TabSheetBitmap.TabVisible := (ImageBitmap.Picture.Graphic <> nil) and
  111. (not ImageBitmap.Picture.Graphic.Empty);
  112. TabSheetMetaFile.TabVisible := (ImageMetaFile.Picture.Graphic <> nil) and
  113. (TMetaFile(ImageMetaFile.Picture.Graphic).Handle <> 0);
  114. TabSheetText.TabVisible := (MemoText.Lines.Count > 0);
  115. TabSheetData.TabVisible := (ListViewData.Items.Count > 0);
  116. end;
  117. procedure TFormMain.CheckBoxTextClick(Sender: TObject);
  118. begin
  119. // Enable or disable format according to users selection.
  120. if (TCheckBox(Sender).Checked) then
  121. DropComboTarget1.Formats := DropComboTarget1.Formats + [mfText]
  122. else
  123. DropComboTarget1.Formats := DropComboTarget1.Formats - [mfText];
  124. end;
  125. procedure TFormMain.CheckBoxFilesClick(Sender: TObject);
  126. begin
  127. // Enable or disable format according to users selection.
  128. if (TCheckBox(Sender).Checked) then
  129. DropComboTarget1.Formats := DropComboTarget1.Formats + [mfFile]
  130. else
  131. DropComboTarget1.Formats := DropComboTarget1.Formats - [mfFile];
  132. end;
  133. procedure TFormMain.CheckBoxURLsClick(Sender: TObject);
  134. begin
  135. // Enable or disable format according to users selection.
  136. if (TCheckBox(Sender).Checked) then
  137. DropComboTarget1.Formats := DropComboTarget1.Formats + [mfURL]
  138. else
  139. DropComboTarget1.Formats := DropComboTarget1.Formats - [mfURL];
  140. end;
  141. procedure TFormMain.CheckBoxBitmapsClick(Sender: TObject);
  142. begin
  143. // Enable or disable format according to users selection.
  144. if (TCheckBox(Sender).Checked) then
  145. DropComboTarget1.Formats := DropComboTarget1.Formats + [mfBitmap]
  146. else
  147. DropComboTarget1.Formats := DropComboTarget1.Formats - [mfBitmap];
  148. end;
  149. procedure TFormMain.CheckBoxMetaFilesClick(Sender: TObject);
  150. begin
  151. // Enable or disable format according to users selection.
  152. if (TCheckBox(Sender).Checked) then
  153. DropComboTarget1.Formats := DropComboTarget1.Formats + [mfMetaFile]
  154. else
  155. DropComboTarget1.Formats := DropComboTarget1.Formats - [mfMetaFile];
  156. end;
  157. procedure TFormMain.CheckBoxDataClick(Sender: TObject);
  158. begin
  159. // Enable or disable format according to users selection.
  160. if (TCheckBox(Sender).Checked) then
  161. DropComboTarget1.Formats := DropComboTarget1.Formats + [mfData]
  162. else
  163. DropComboTarget1.Formats := DropComboTarget1.Formats - [mfData];
  164. end;
  165. procedure TFormMain.ListViewDataDblClick(Sender: TObject);
  166. begin
  167. // Launch an extracted data file if user double clicks on it.
  168. Screen.Cursor := crAppStart;
  169. try
  170. Application.ProcessMessages; {otherwise cursor change will be missed}
  171. ShellExecute(0, nil,
  172. PChar(ExtractFilePath(Application.ExeName)+TListView(Sender).Selected.Caption),
  173. nil, nil, SW_NORMAL);
  174. finally
  175. Screen.Cursor := crDefault;
  176. end;
  177. end;
  178. end.