Project source
Form source (Pascal)
Form source (DFM)
Project source: CustomTest2.dpr |
program CustomTest2; {Main program file for test application for UnitOOPS OLE Drag and Drop Components.} uses Forms, fmCustomHDROP in 'fmCustomHDROP.pas' {Form1}; {$R *.RES} begin Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end.Back to top |
Form source: fmCustomHDROP.pas |
unit fmCustomHDROP; { UnitOOPS OLE Drag and Drop Components - Example for dragging data in multiple custom (user-defined) formats. Last modified: 09/26/2000} interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FileCtrl, StdCtrls, ExtCtrls, uoole, uoUtil; type TForm1 = class(TForm) Panel1: TPanel; DriveComboBox1: TDriveComboBox; FileListBox1: TFileListBox; DirectoryListBox1: TDirectoryListBox; UOTextSource1: TUOTextSource; Panel2: TPanel; Label1: TLabel; Label2: TLabel; GroupBox1: TGroupBox; CheckBox1: TCheckBox; Edit1: TEdit; CheckBox2: TCheckBox; CheckBox3: TCheckBox; Label3: TLabel; Image1: TImage; CheckBox4: TCheckBox; CheckBox5: TCheckBox; CheckBox6: TCheckBox; CheckBox7: TCheckBox; CheckBox8: TCheckBox; CheckBox9: TCheckBox; CheckBox10: TCheckBox; Label4: TLabel; procedure CheckBox1Click(Sender: TObject); procedure UOTextSource1BeforeDrop(Sender: TObject; Donor: TComponent; var dropText: String; var cancelDrop: Boolean); procedure UOTextSource1RenderCustomFormat(Sender: TObject; const formatName: String; var formatContent: String); procedure CheckBox5Click(Sender: TObject); procedure UOTextSource1AfterDrop(Sender: TObject; Donor: TComponent; droppedOK: Boolean); procedure FormCreate(Sender: TObject); procedure FileListBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); private { Private declarations } FTempFileName: string; function GetSelectedFileList: TStringList; function HDropFromSelectedFiles: string; function ShellIDListFromSelectedFiles: string; function FileGroupDescriptorFromSelectedFiles: string; public { Public declarations } end; var Form1: TForm1; implementation uses ActiveX, ShlObj, uoPIDL; {$R *.DFM} function TForm1.FileGroupDescriptorFromSelectedFiles: string; // Build the FileGroupDescriptor format. var aSL: TStringList; begin result := ''; // Fall-through value // Get the selected items into aSL. aSL := GetSelectedFileList; try // Now, build the FGD structure using the uoUtil function uoFileGroupDescriptorFromFileList // See Win32 help for details of the structure, which we just render onto a string result := uoFileGroupDescriptorFromFileList(DirectoryListBox1.Directory, aSL); finally aSL.Free; end; end; function TForm1.HDROPFromSelectedFiles: string; // Build the HDROP format to allow dragging files. var aSL: TStringList; begin result := ''; // Fall-through value // Get the selected items into aSL. aSL := GetSelectedFileList; try // Now, build the HDROP structure using the uoUtil function uoHDROPFromFileList // See Win32 help for details of the structure, which we just render onto a string result := uoHDROPFromFileList(DirectoryListBox1.Directory, aSL); finally aSL.Free; end; end; function TForm1.ShellIDListFromSelectedFiles: string; // Build the Shell ID List to allow dragging shortcuts. Works in association // with the CF_HDROP format. var aSL: TStringList; begin result := ''; // Fall-through value // Get the selected items into aSL. aSL := GetSelectedFileList; try // Now, build the ShellIDList using the uoUtil function uoShellIDListFromFileList // See Win32 help for details of the structure, which we just render onto a string result := uoShellIDListFromFileList(DirectoryListBox1.Directory, aSL); finally aSL.Free; end; end; function TForm1.GetSelectedFileList: TStringList; // Put the list of currently selected files (names only, not full paths) in // a TStringList, and pass it back. Caller must free. var j: Integer; begin result := TStringList.create; with FileListBox1, Items do begin for j := 1 to Count do // Iterate begin if Selected[j-1] then result.Add(Strings[j-1]); end; // for end; // with end; procedure TForm1.CheckBox1Click(Sender: TObject); begin Edit1.Enabled := CheckBox1.Checked; CheckBox7.Enabled := CheckBox1.Checked; end; procedure TForm1.UOTextSource1BeforeDrop(Sender: TObject; Donor: TComponent; var dropText: String; var cancelDrop: Boolean); begin // Since we've defined custom formats, dropText is meaningless here // However, we could still cancel the drop using cancelDrop, if we // wanted, or modify the CustomFormatData list. end; procedure TForm1.UOTextSource1RenderCustomFormat(Sender: TObject; const formatName: String; var formatContent: String); begin // Render formats that weren't rendered before executing the // TUOTextSource if (AnsiCompareText(IntToStr(CF_TEXT), formatName) = 0) then formatContent := 'Here is your custom-rendered string data!'; if (AnsiCompareText('UnitOOPS e', formatName) = 0) then formatContent := uoEncodeDoubleToString(exp(1)); end; procedure TForm1.CheckBox5Click(Sender: TObject); begin CheckBox6.Enabled := CheckBox5.Checked; CheckBox8.Enabled := CheckBox5.Checked; CheckBox9.Enabled := CheckBox5.Checked; CheckBox10.Enabled := CheckBox5.Checked; end; procedure TForm1.UOTextSource1AfterDrop(Sender: TObject; Donor: TComponent; droppedOK: Boolean); begin // If we created a temporary file for scrap drops, delete it here. if ((FTempFileName <> '') and FileExists(FTempFileName)) then begin DeleteFile(FTempFileName); FTempFileName := ''; end; end; procedure TForm1.FormCreate(Sender: TObject); begin // At startup, make the drop effects checkboxes reflect the TUOTextSource // published properties set at design-time. CheckBox8.Checked := (deCopy in UOTextSource1.DropEffects); CheckBox9.Checked := (deMove in UOTextSource1.DropEffects); CheckBox10.Checked := (deLink in UOTextSource1.DropEffects); end; procedure TForm1.FileListBox1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var aString: string; aHBitmap: HBitmap; aDe: TDropEffects; begin if DragDetect(FileListBox1.Handle, POINT(X,Y)) then begin // Start with a clean slate of formats UOTextSource1.CustomFormatData.Clear; // Clear the temp file name FTempFileName := ''; // Get set to drag files if CheckBox5.Checked then begin // Get the drop effects dynamically from the checkboxes. aDe := []; if CheckBox8.Checked then Include(aDe, deCopy) else Exclude(aDe, deCopy); if CheckBox9.Checked then Include(aDe, deMove) else Exclude(aDe, deMove); if CheckBox10.Checked then Include(aDe, deLink) else Exclude(aDe, deLink); UOTextSource1.DropEffects := aDe; // Drag the "Shell IDList Array" format to get file linking capabilities // Needs CF_HDROP (=15, see below) to be present too for move/copy UOTextSource1.CustomFormatData.addFormat('Shell IDList Array', ShellIDListFromSelectedFiles); // Set "Preferred DropEffect" format to deLink, to avoid the Move/Copy/Create shortcut // menu when the drop effect chosen is "Link". In Win95 (original) you get the menu // anyway. Works in cooperation with "Shell IDList Arrray". if CheckBox6.Checked then UOTextSource1.CustomFormatData.addFormat('Preferred DropEffect', uoEncodeDWORDToString(DropEffectFromEnum(deLink))); // Drag FileGroupDescriptor UOTextSource1.CustomFormatData.addFormat('FileGroupDescriptor', FileGroupDescriptorFromSelectedFiles); // Drag the CF_HDROP (=15) format to get file copying and moving. UOTextSource1.CustomFormatData.addFormat('15', HDropFromSelectedFiles); end; // Add CF_TEXT (1) for testing. This has the same effect in a custom // format as just setting UOTextSource1.Text = Edit1.Text when not // using custom data formats. This one will be rendered on demand // (the first time only) if Edit1.Text is blank. if CheckBox1.Checked then begin UOTextSource1.Customformatdata.addFormat(IntToStr(CF_TEXT), Edit1.Text); if CheckBox7.Checked then begin // Add FileName format to get scraps properly when dragging to the desktop. // The file name specified must be valid. We create a temp file for this, // and delete it in the OnAfterDrop event. with TStringList.create do try add(Edit1.Text); FTempFileName := uoGetTempFileName('uox'); // Give it the right extension, so we can open the scrap using the // associated program when it's double-clicked RenameFile(FTempFileName, ChangeFileExt(FTempFileName, '.txt')); FTempFileName := ChangeFileExt(FTempFileName, '.txt'); SaveToFile(FTempFileName); finally free; end; // with UOTextSource1.CustomFormatData.addFormat('FileName', FTempFileName); end; end; // Test bitmap on GDI handle. This is an example of how a TUOTextSource with // custom data formats can be equivalent to a TUOGraphicSource! Of course, // for best color results, you should transfer CF_DIB rather than CF_BITMAP. if CheckBox4.Checked then begin // We just put the bitmap handle itself on the string. The component will // take care of copying it at the appropriate point. aHBitmap := Image1.Picture.Bitmap.Handle; aString := uoEncodeDWORDToString(aHBitmap); // The TYMED is passed in the objects[] array. If there's no entry // for a given custom format, the components assume TYMED_HGLOBAL // which is the usual format. UOTextSource1.CustomFormatData.AddFormatEx(IntToStr(CF_BITMAP), aString, TYMED_GDI, -1); end; // Finally, add two custom formats // This one is the geometric constant Pi if CheckBox2.Checked then UOTextSource1.CustomFormatData.addFormat('UnitOOPS Pi', uoEncodeDoubleToString(3.141592654)); // This one will be rendered on demand (the first time only), since its content // is blank. See UOTextSource1RenderCustomFormat below - it will be used to // transfer the base of the natural logarithms, e. if CheckBox3.Checked then UOTextSource1.CustomFormatData.addFormat('UnitOOPS e', ''); // Our drag source now knows how to supply several different standard data formats, // text and file lists) as well as our custom formats ('Unitoops Pi','UnitOOPS e') // that deliver "Pi" and "e" as doubles (test this using CustomTest1.DPR, with the // target format set to 'UnitOOPS Pi' and 'UnitOOPS e', respectively. UOTextSource1.Execute; end; end; end.Back to top |
Form source: fmCustomHDROP.dfm |
object Form1: TForm1 Left = 216 Top = 139 BorderStyle = bsDialog Caption = 'Test of custom OLE drag/drop formats - HDROP' ClientHeight = 317 ClientWidth = 583 Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object Panel1: TPanel Left = 0 Top = 48 Width = 577 Height = 265 BevelOuter = bvNone TabOrder = 0 object Label2: TLabel Left = 9 Top = 9 Width = 216 Height = 13 Caption = 'Drag from the list of files for all drag operations' end object DriveComboBox1: TDriveComboBox Left = 8 Top = 29 Width = 130 Height = 19 DirList = DirectoryListBox1 TabOrder = 0 end object FileListBox1: TFileListBox Left = 143 Top = 29 Width = 162 Height = 234 DragMode = dmAutomatic ItemHeight = 16 MultiSelect = True TabOrder = 1 OnStartDrag = FileListBox1StartDrag end object DirectoryListBox1: TDirectoryListBox Left = 8 Top = 53 Width = 130 Height = 210 FileList = FileListBox1 ItemHeight = 16 TabOrder = 2 end object GroupBox1: TGroupBox Left = 311 Top = 3 Width = 266 Height = 260 Caption = 'What to drag...' TabOrder = 3 object Label3: TLabel Left = 141 Top = 123 Width = 113 Height = 13 Alignment = taRightJustify Caption = '(delayed render if blank)' end object Image1: TImage Left = 30 Top = 197 Width = 122 Height = 57 AutoSize = True Picture.Data = { 07544269746D6170D21F0000424DD21F00000000000036040000280000007A00 ...truncated for brevity... D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D2D20000} end object Label4: TLabel Left = 29 Top = 59 Width = 110 Height = 13 Caption = 'Drop effects to include:' end object CheckBox1: TCheckBox Left = 9 Top = 100 Width = 65 Height = 17 Caption = 'this text:' State = cbChecked TabOrder = 0 OnClick = CheckBox1Click end object Edit1: TEdit Left = 80 Top = 98 Width = 177 Height = 21 TabOrder = 1 Text = 'Test text to drag' end object CheckBox2: TCheckBox Left = 9 Top = 140 Width = 201 Height = 17 Caption = '"UnitOOPS Pi" format' State = cbChecked TabOrder = 2 end object CheckBox3: TCheckBox Left = 9 Top = 160 Width = 207 Height = 17 Caption = '"UnitOOPS e" format (delayed render)' State = cbChecked TabOrder = 3 end object CheckBox4: TCheckBox Left = 9 Top = 179 Width = 200 Height = 17 Caption = 'This image in CF_BITMAP format' State = cbChecked TabOrder = 4 end object CheckBox5: TCheckBox Left = 9 Top = 22 Width = 232 Height = 17 Caption = 'The selected files in the list' State = cbChecked TabOrder = 5 OnClick = CheckBox5Click end object CheckBox6: TCheckBox Left = 29 Top = 40 Width = 220 Height = 17 Caption = 'Drag shortcuts by default' TabOrder = 6 end object CheckBox7: TCheckBox Left = 28 Top = 119 Width = 97 Height = 17 Caption = 'Allow scraps' TabOrder = 7 end object CheckBox8: TCheckBox Left = 29 Top = 74 Width = 51 Height = 16 Caption = 'Copy' TabOrder = 8 end object CheckBox9: TCheckBox Left = 85 Top = 74 Width = 51 Height = 16 Caption = 'Move' TabOrder = 9 end object CheckBox10: TCheckBox Left = 145 Top = 74 Width = 104 Height = 16 Caption = 'Link (shortcut)' TabOrder = 10 end end end object Panel2: TPanel Left = 0 Top = 0 Width = 583 Height = 49 Align = alTop BevelOuter = bvNone BorderWidth = 5 TabOrder = 1 object Label1: TLabel Left = 5 Top = 5 Width = 573 Height = 39 Align = alClient Caption = 'Demonstrates how to drag multiple custom data formats including ' + 'custom-implemented versions of CF_HDROP and "Shell IDList Array"' + ' for dragging lists of files and shortcuts.' WordWrap = True end end object UOTextSource1: TUOTextSource OnBeforeDrop = UOTextSource1BeforeDrop OnAfterDrop = UOTextSource1AfterDrop OnRenderCustomFormat = UOTextSource1RenderCustomFormat Text = 'Default text' DropEffects = [deCopy, deMove, deLink] Left = 56 Top = 232 end endBack to top |