Autor Beitrag
derDoc
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starhalf ontopic star
Beiträge: 623

Win Vista Prof
D2007 Prof
BeitragVerfasst: So 19.01.03 12:30 
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:
ausblenden volle Höhe 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.

_________________
MfG derDoc
There are only 10 types of people: those who understand binary and those who don't.