Entwickler-Ecke

Windows API - Drag & Drop mit TMemo


derDoc - So 19.01.03 12:30
Titel: Drag & Drop mit TMemo
Hallo Leute
ich sitze hier an einem Memo, auf das ich per Drag & Drop Dateien ziehen will und öffnen möchte. Aber sobald ich die Datei loslasse wird sie geöffnet und das Sytem macht einen Abgang. Vielleicht kann mir jemand sagen, wo mein Fehler ist.

Hier ist erstmal der Code:

Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
unit UEditorMemo;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, Printers, StdCtrls, ComCtrls, DesignIntf, shellAPI, RTLConsts;

type
  TFHaupt = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure FormDestroy(Sender: TObject);
  private
    procedure AddFile(dateiname: String);
    procedure WindowProc(var Nachricht: TMessage); Message WM_DROPFILES;
    procedure WMDROPFILES(var Msg: TMessage);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  FHaupt: TFHaupt;
  Dateien: TStrings;
  OldWindowProc: TWndMethod;

implementation

{$R *.DFM}

procedure TFHaupt.FormCreate(Sender: TObject);
begin
  OldWindowProc := Memo1.WindowProc;
  Memo1.WindowProc := WindowProc;
  DragAcceptFiles(Memo1.Handle, true);
end;

procedure TFHaupt.FormDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := true;
end;

procedure TFHaupt.FormDestroy(Sender: TObject);
begin
  Memo1.WindowProc := OldWindowProc;
end;

procedure TFHaupt.AddFile(dateiname: String);
begin
  Dateien.Add(dateiname);
end;

procedure TFHaupt.WindowProc(var Nachricht: TMessage);
begin
  if Nachricht.Msg = WM_DROPFILES then
    begin
      WMDROPFILES(Nachricht);
    end;
  OldWindowProc(Nachricht);
end;

procedure TFHaupt.WMDROPFILES(var Msg: TMessage);
var
  dateiname: PChar;
  i, groesse, anzahl: Integer;
begin
  dateiname := '';
  Dateien := TStringList.Create;
  anzahl := DragQueryFile(Msg.WParam, $FFFFFFFF, dateiname, 255);
  for i := 0 to anzahl - 1 do
    begin
      groesse := DragQueryFile(Msg.WParam, i, nil, 0) + 1;
      dateiname := StrAlloc(groesse);
      DragQueryFile(Msg.WParam, i, dateiname, groesse);
      if FileExists(dateiname) then
        begin
          AddFile(dateiname);
        end;
      StrDispose(dateiname);
    end;
  Memo1.Lines.LoadFromFile(Dateien.Strings[0]);
  DragFinish(Msg.WParam);
  Dateien.Free;
end;

end.