Subversion Repositories delphiutils

Compare Revisions

Regard whitespace Rev 45 → Rev 46

/trunk/Delphi Code/QuerySystemMenu/QuerySystemMenu.pas
81,7 → 81,7
function TWndProcIntercept.MsgProc(Handle: HWnd; Msg: UInt;
WParam: Windows.WParam; LParam: Windows.LParam): LResult;
begin
result := Windows.CallWindowProc(WNDPROC(FPrevWndProc), Handle, Msg, WParam, LParam)
result := Windows.CallWindowProc(WindowsCompat.WNDPROC(FPrevWndProc), Handle, Msg, WParam, LParam)
end;
 
function TWndProcIntercept.MsgProcVirtualCall(Handle: HWnd; Msg: UInt;
102,7 → 102,7
 
f.Code := @TWndProcIntercept.MsgProcVirtualCall;
f.Data := Self;
MsgProcPointer := MakeProcInstance(f);
MsgProcPointer := MethodPtr.MakeProcInstance(f);
 
// Problem: Kann es zu Komplikationen mit mehreren msg handlern kommen?
// (Beim vermischten register+unregister !)
/trunk/Delphi Code/DragNDropDlgs/Main.pas
9,6 → 9,7
type
TForm1 = class(TForm)
Button1: TButton;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
32,9 → 33,10
begin
x := TDragDropOpenDlg.Create(self);
try
x.Options := x.Options + [ofAllowMultiSelect];
if x.Execute then
begin
ShowMessage('Datei erhalten: ' + x.FileName);
ShowMessage('Datei erhalten: ' + x.Files.Text);
end;
finally
x.Free;
/trunk/Delphi Code/DragNDropDlgs/DlgExtended.exe
Cannot display: file marked as a binary type.
svn:mime-type = application/octet-stream
/trunk/Delphi Code/DragNDropDlgs/Main.dfm
22,4 → 22,8
TabOrder = 0
OnClick = Button1Click
end
object OpenDialog1: TOpenDialog
Left = 352
Top = 144
end
end
/trunk/Delphi Code/DragNDropDlgs/DragDropOpenDlg.pas
4,13 → 4,17
// - New design
// - Overwrite (Save) / MustExists (Open) as default
// - DragDrop feature!
// + DialogHandle
 
// TODO (incl. QuerySystemMenu): Besser mit WndProc(var Message) und Dispatch wie in Dialogs.pas arbeiten?
 
// TODO
// - Fertigstellen. Alles ausschließen wie z.B. Ordner, Nonexisting files etc. (je nach Options)
 
interface
 
uses
Windows, Dialogs, Classes, messages, shellapi, sysutils, WindowsCompat;
Windows, WindowsCompat, Dialogs, Classes, Messages, ShellAPI, SysUtils;
 
type
TDragDropOpenDlg = class(TOpenDialog)
22,6 → 26,7
function msgr(Handle: HWnd; Msg: UInt;
WParam: Windows.WParam; LParam: Windows.LParam): LResult; stdcall;
public
function DialogHandle: THandle;
constructor Create(AOwner: TComponent); override;
end;
 
33,69 → 38,92
{ TDragDropOpenDlg }
 
const
IDA = 101;
ID_DROP_FIELD = 101;
 
function TDragDropOpenDlg.DialogHandle: THandle;
begin
result := GetParent(Self.Handle);
end;
 
function TDragDropOpenDlg.msgr(Handle: HWnd; Msg: UInt;
WParam: Windows.WParam; LParam: Windows.LParam): LResult;
const
MAXFILENAME = 255; // TODO MAX_PATH?
MAXFILENAME = 255; // MAX_PATH???
ID_FILENAME_EDIT = $47C; // Tested on Win XP
var
cnt, fileCount : integer;
fileName : array [0..MAXFILENAME] of char;
hDialog, hFilename: THandle;
Filenames: string;
resourcestring
LNG_NO_MULTISELECT = 'Es kann nur eine Datei ausgewählt werden.';
LNG_NO_FOLDER = 'Ordner können nicht aufgenommen werden. Bitte die Ordner aus der Selektion nehmen.';
LNG_FILE_NOT_EXISTS = 'Datei "%s" existiert nicht. Bitte korrigieren Sie die Selektion.';
begin
result := Windows.CallWindowProc(WindowsCompat.WNDPROC(FPrevWndProc), Handle, Msg, WParam, LParam);
 
if Msg = WM_DROPFILES then
begin
// how many files dropped?
fileCount := DragQueryFile(wParam, $FFFFFFFF, fileName, MAXFILENAME) ;
 
// query for file names
if (fileCount > 1) and not (ofAllowMultiSelect in Options) then
begin
ShowMessage(LNG_NO_MULTISELECT);
Exit;
end;
 
Filenames := '';
for cnt := 0 to fileCount-1 do
begin
DragQueryFile(wParam, cnt, fileName, MAXFILENAME) ;
 
//do something with the file(s)
showmessage('Drag accepted: ' + filename);
if DirectoryExists(fileName) then
begin
ShowMessage(LNG_NO_FOLDER);
Exit;
end;
 
//release memory
if (ofFileMustExist in Options) and not FileExists(fileName) then
begin
// Should never happen
ShowMessageFmt(LNG_FILE_NOT_EXISTS, [fileName]);
Exit;
end;
 
Filenames := Filenames + '"' + fileName + '"' + ' ';
end;
Filenames := copy(Filenames, 1, length(Filenames)-1);
 
DragFinish(wParam);
 
// TOpenDialog.Handle ist irgendwie das falsche :?
Filename := filename;
SendMessage(GetParent(Self.Handle), WM_CLOSE, 0, 0);
hDialog := DialogHandle;
hFilename := GetDlgItem(hDialog, ID_FILENAME_EDIT);
SendMessage(hFilename, WM_SETTEXT, 0, DWord(PChar(Filenames)));
 
// TODO: Before WM_CLOSE, we have to send something to make the call successfull
SendMessage(hDialog, WM_COMMAND, IDOK, 0);
end;
 
result := Windows.CallWindowProc({!!!}WindowsCompat.WNDPROC(FPrevWndProc), Handle, Msg, WParam, LParam)
end;
 
procedure TDragDropOpenDlg.OpenDialog1Show(Sender: TObject);
var
hParent: THandle;
hDialog: THandle;
rect: TRect;
hEdit: THandle;
f: TMethod;
begin
// TOpenDialog.Handle ist irgendwie das falsche :?
hParent := GetParent(Handle);
// Position und Größe ermitteln
GetWindowRect(hParent, rect);
// Dialog vergrößern für Edit
SetWindowPos(hParent, 0, 0, 0, rect.Right - rect.Left, rect.Bottom - rect.Top
hDialog := DialogHandle;
GetWindowRect(hDialog, rect);
SetWindowPos(hDialog, 0, 0, 0, rect.Right - rect.Left, rect.Bottom - rect.Top
+ 25*2, SWP_NOMOVE);
// Edit erzeugen, ID = 101
hEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', '', WS_VISIBLE or WS_CHILD,
195, rect.Bottom - rect.Top - 27, 150, 20, hParent, IDA, 0, nil);
if hEdit = 0 then
RaiseLastOSError;
195, rect.Bottom - rect.Top - 27, 150, 20, hDialog, ID_DROP_FIELD, 0, nil);
if hEdit = 0 then RaiseLastOSError;
 
FPrevWndProc := GetWindowLongPtr(hEdit, GWLP_WNDPROC);
 
f.Code := @TDragDropOpenDlg.msgr;
f.Data := Self;
MsgProcPointer := {!!!}MethodPtr.MakeProcInstance(f);
MsgProcPointer := MethodPtr.MakeProcInstance(f);
 
// Problem: Kann es zu Komplikationen mit mehreren msg handlern kommen?
// (Beim vermischten register+unregister !)
106,30 → 134,15
 
procedure TDragDropOpenDlg.OpenDialog1Close(Sender: TObject);
var
hParent: THandle;
hDialog: THandle;
hEdit: THandle;
Buffer: PChar;
len: Integer;
begin
hParent := GetParent(Handle);
// Handle des Edits ermitteln, ID = 101 siehe oben
hEdit := GetDlgItem(hParent, IDA);
hDialog := DialogHandle;
hEdit := GetDlgItem(hDialog, ID_DROP_FIELD);
 
DragAcceptFiles(hEdit, false);
SetWindowLongPtr(hEdit, GWLP_WNDPROC, FPrevWndProc);
 
// Speicher allozieren
len := SendMessage(hEdit, WM_GETTEXTLENGTH, 0, 0);
GetMem(Buffer, len + 1);
try
ZeroMemory(Buffer, len + 1);
// Text aus Edit holen
SendMessage(hEdit, WM_GETTEXT, len, lParam(Buffer));
ShowMessage('Text im Editfeld:' + Buffer);
finally
FreeMem(Buffer, len + 1);
end;
end;
 
constructor TDragDropOpenDlg.Create(AOwner: TComponent);
begin
138,9 → 151,6
// TODO: Als Wrapper, damit auch weiter verwendbar!
OnClose := OpenDialog1Close;
OnShow := OpenDialog1Show;
 
end;
 
// {!!!} = Bitte auch in QuerySystemMenu verwenden!
 
end.