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:

unit Demo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    FWindowProcDragDrop : TWndMethod;
    procedure LVWindowProc(var Msg: TMessage);
    procedure DropFiles(ATargetControl: TWinControl; var Msg: TWMDropFiles);

    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation
uses ShellApi;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
    FWindowProcDragDrop := Listbox1.WindowProc;
    ListBox1.WindowProc := LVWindowProc;
    DragAcceptFiles(Listbox1.Handle, true);
end;

procedure TForm1.LVWindowProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_DROPFILES then
    DropFiles(Listbox1, TWMDropFiles(Msg));
  FWindowProcDragDrop(Msg);
end;

procedure TForm1.DropFiles(ATargetControl : TWinControl; var Msg: TWMDropFiles);
var
  DropH: HDROP;               // drop handle
  DroppedFileCount: Integer;  // number of files dropped
  FileNameLength: Integer;    // length of a dropped file name
  FileName: string;           // a dropped file name
  nFileCount: Integer;                 // loops thru all dropped files
  DropPoint: TPoint;          // point where files dropped
  isnotunc:Boolean;
begin
  inherited;
  isnotunc := false;

  DropH := Msg.Drop;
  try
    DroppedFileCount := DragQueryFile(DropH, $FFFFFFFF, nil, 0);

    if ATargetControl = Listbox1 then
      for nFileCount := 0 to Pred(DroppedFileCount) do begin
        FileNameLength := DragQueryFile(DropH, nFileCount, nil, 0);
        SetLength(FileName, FileNameLength);
        DragQueryFile(DropH, nFileCount, PChar(FileName), FileNameLength + 1);
        Listbox1.Items.Add(FileName);
      end;
    DragQueryPoint(DropH, DropPoint);
  finally
    DragFinish(DropH);
  end;
  Msg.Result := 0;
end;



end.					

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:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:

unit DragDropUnit;

interface

uses
  Dialogs, buttons, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, ComCtrls, OleCtnrs, Menus;

type
  TForm1 = class(TForm)

    Ziel: TGroupBox;
    PopUp: TPopupMenu;
    mi_loeschen: TMenuItem;
    mi_umbenennen: TMenuItem;
    mi_deleteable: TMenuItem;
    mi_saveable: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure SpeichernClick(Sender: TObject);
    procedure ladenClick(Sender: TObject);
    procedure MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

    function LabelNr(i: integer): TLabel;
    function ButtonNr(i: integer): TSpeedButton;
    procedure mi_umbenennenClick(Sender: TObject);
    procedure mi_loeschenClick(Sender: TObject);
    procedure ClickBtn(Sender: TObject);
    procedure mi_deleteableClick(Sender: TObject);
    procedure mi_saveableClick(Sender: TObject);
  private
    fAktuellerButton: integer;
    fletzterButton: integer;
    fZielAdresse: TStringList;
    fdeleteable: TStringList;
    fsaveable: TStringList;
    xSp, ySp: integer;
    function GetLetzterButton: integer;
    procedure SetLetzterButton(const Value: integer);
    function GetAktuellerButton: integer;
    procedure SetAktuellerButton(const Value: integer);
    function GetZielAdresse(Index: integer): string;
    procedure SetZielAdresse(Index: Integer; const Value: string);
    function GetDeleteable(Index: integer): boolean;
    procedure SetDeleteable(Index: integer; const Value: boolean);
    function Getsaveable(Index: integer): boolean;
    procedure Setsaveable(Index: integer; const Value: boolean);
    { Private-Deklarationen }
  public
    FWindowProcDragDrop: TWndMethod;
    property LetzterButton: integer read GetLetzterButton write SetLetzterButton;
    property AktuellerButton: integer read GetAktuellerButton write SetAktuellerButton;
    property ZielAdresse[Index: integer]: string read GetZielAdresse write SetZielAdresse;
    property deleteable[Index: integer]: boolean read GetDeleteable write SetDeleteable;
    property saveable[Index: integer]: boolean read Getsaveable write Setsaveable;

    procedure LVWindowProc(var Msg: TMessage);
    procedure DropFiles(ATargetControl: TWinControl; var Msg: TWMDropFiles);

  end;

var
  Form1: TForm1;
  AktID: integer;
implementation
uses ShellApi;
{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  fZielAdresse := TStringList.Create;
  fdeleteable := TStringList.Create;
  fsaveable := TStringList.Create;
  FWindowProcDragDrop := Ziel.WindowProc;
  Ziel.WindowProc := LVWindowProc;
  DragAcceptFiles(Ziel.Handle, true);
  AktID := 0;
  AktuellerButton := 0;
  ladenClick(Sender);
end;

procedure TForm1.LVWindowProc(var Msg: TMessage);
begin
  if Msg.Msg = WM_DROPFILES then
    DropFiles(Ziel, TWMDropFiles(Msg));
  FWindowProcDragDrop(Msg);
end;

procedure TForm1.DropFiles(ATargetControl: TWinControl; var Msg: TWMDropFiles);
var
  DropH: HDROP; // drop handle
  DroppedFileCount: Integer; // number of files dropped
  FileNameLength: Integer; // length of a dropped file name
  FileName: string; // a dropped file name
  nFileCount: Integer; // loops thru all dropped files
  DropPoint: TPoint; // point where files dropped
  isnotunc: Boolean;
  Eintrag: TSpeedButton;
  EintragLabel: TLabel;
begin
  inherited;
  isnotunc := false;

  DropH := Msg.Drop;
  try
    DroppedFileCount := DragQueryFile(DropH, $FFFFFFFF, nil, 0);

    if ATargetControl = Ziel then
      for nFileCount := 0 to Pred(DroppedFileCount) do
      begin
        FileNameLength := DragQueryFile(DropH, nFileCount, nil, 0);
        SetLength(FileName, FileNameLength);
        DragQueryFile(DropH, nFileCount, PChar(FileName), FileNameLength + 1);
        Eintrag := TSpeedButton.Create(Self);
        EintragLabel := TLabel.Create(Self);
        with EintragLabel do
        begin
          Caption := InputBox('Untertext', 'Text unter Icon:', 'Anwendung');
          Font.Size := 8;
          Parent := Ziel;
        end;
        with Eintrag do
        begin
          if FileExists(Filename) then
          begin
            Glyph.LoadFromFile(ExtractFilePath(Paramstr(0)) + 'File.bmp');
          end
          else
          begin
            Glyph.LoadFromFile(ExtractFilePath(Paramstr(0)) + 'Dir.bmp');
          end;
          Tag := letzterButton;
          ZielAdresse[letzterButton] := FileName;
          width := 70;
          height := 70;
          Parent := Ziel;
          PopupMenu := PopUp;
          Left := Mouse.CursorPos.X - Self.Left;
          Top := Mouse.CursorPos.Y - Self.Top;
          EintragLabel.Tag := letzterButton;
          EintragLabel.Left := Left;
          EintragLabel.Top := Top + Height + 4;
          OnClick := ClickBtn;
          OnMouseUp := MouseUp;
          OnMouseDown := MouseDown;
          deleteable[LetzterButton] := TRUE;
          saveable[LetzterButton] := TRUE;
          LetzterButton := LetzterButton + 1;
        end;

      end;
    DragQueryPoint(DropH, DropPoint);
  finally
    DragFinish(DropH);
    speichernClick(nil);
  end;
  Msg.Result := 0;
end;

procedure TForm1.SpeichernClick(Sender: TObject);
var
  i, j: integer;
  c: TControl;
  bb: TSpeedButton;
  f: TextFile;
  path, fName: string;
  Wert: integer;
  EintragLabel: TLabel;
begin
  Path := ExtractFilePath(Paramstr(0));
  fName := Path + 'Daten.Txt';
  AssignFile(f, FName);
  ReWrite(f);
  for i := 0 to Ziel.ControlCount - 1 do
  begin
    c := Ziel.Controls[i];
    if (c is TSpeedButton) and (c.Parent = Ziel) then
    begin
      bb := TSpeedButton(c);
      if Saveable[bb.tag] then
      begin
        WriteLn(f, ZielAdresse[bb.Tag]);
        if FileExists(ZielAdresse[bb.Tag]) then
          WriteLn(f, Path + 'FILE.BMP')
        else
          WriteLn(f, Path + 'DIR.BMP');
        EintragLabel := LabelNr(bb.Tag);
        if EintragLabel <> nil then
        begin
          WriteLn(f, EintragLabel.Caption);
        end
        else
          WriteLn(f, '??');

        Writeln(f, bb.Top);
        Writeln(f, bb.Left);
        if DeleteAble[bb.Tag] then
          WriteLn(f, '1')
        else
          WriteLn(f, '0');
        if SaveAble[bb.Tag] then
          WriteLn(f, '1')
        else
          WriteLn(f, '0');
      end;
    end;
  end;
  CloseFile(f);
end;

procedure TForm1.ladenClick(Sender: TObject);
var
  i: integer;
  c: TControl;
  bb: TSpeedButton;
  EintragLabel: TLabel;
  f: TextFile;
  path, fName, Bild, s: string;
  Wert: integer;
  del, save: string;
begin
  Path := ExtractFilePath(Paramstr(0));
  for i := Ziel.ControlCount - 1 downto 0 do
  begin
    c := Ziel.Controls[i];
    try
      if (c is TSpeedButton) or (c is TLabel) then
      begin
        if c is TSpeedButton then
        begin
          bb := TSpeedButton(c);
          if Deleteable[bb.Tag] then
          begin
            if bb.Parent = Ziel then
              bb.free;
          end;
        end
        else
        begin
          EintragLabel := TLabel(c);
          if deleteable[bb.Tag] then
          begin
            if EintragLabel.Parent = Ziel then
              EintragLabel.Free;
          end;
        end;
      end;
    finally
      if deleteable[bb.Tag] then
      begin
      end;
    end;
  end;
  fName := Path + 'Daten.Txt';
  AssignFile(f, FName);
  ReSet(f);
  i := 0;
  while not eof(f) do
  begin
    bb := TSpeedButton.Create(Self);
    bb.Parent := Ziel;
    bb.PopupMenu := PopUp;
    EintragLabel := TLabel.Create(Self);
    EintragLabel.Parent := Ziel;
    ReadLn(f, s);
    ZielAdresse[i] := s;
    ReadLn(f, Bild);
    bb.Glyph.LoadFromFile(Bild);
    bb.OnClick := ClickBtn;
    bb.OnMouseDown := MouseDown;
    bb.OnMouseUp := MouseUp;
    ReadLn(f, s);
    EintragLabel.Caption := s;
    Readln(f, Wert);
    bb.Top := abs(Wert) mod Ziel.Height;
    Readln(f, Wert);
    bb.Left := abs(Wert) mod Ziel.Width;
    ReadLn(f, del);
    ReadLn(f, save);
    Deleteable[i] := del = '1';
    saveable[i] := save = '1';
    bb.width := 70;
    bb.height := 70;
    EintragLabel.Left := bb.Left;
    EintragLabel.Top := bb.Top + bb.Height + 4;
    EintragLabel.Tag := i;
    bb.tag := i;
    inc(i);
  end;
  LetzterButton := i;
  CloseFile(f);
end;

procedure TForm1.MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  bb: TSpeedButton;
  EintragLabel: TLabel;
  i: integer;
begin
  if Button = mbLeft then
  begin
    with bb do
    begin
      visible := FALSE;
      Top := Top + (Mouse.CursorPos.y - ySp);
      Left := Left + (Mouse.CursorPos.x - xSp);
      visible := TRUE;
      EintragLabel := LabelNr(bb.Tag);
      if EintragLabel <> nil then
      begin
        EintragLabel.Left := Left;
        EintragLabel.Top := Top + Height + 4;
      end;
      SpeichernClick(Sender);
    end;
  end;
end;

procedure TForm1.MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  AktuellerButton := TSpeedButton(Sender).Tag;
  mi_deleteable.checked := deleteable[AktuellerButton];
  mi_saveable.checked := saveable[AktuellerButton];
  if Button = mbLeft then
  begin
    ySp := Mouse.CursorPos.y;
    xSp := Mouse.CursorPos.x;
  end;
end;

function TForm1.LabelNr(i: integer): TLabel;
var
  j: integer;
begin
  result := nil;
  for j := 0 to Ziel.ControlCount - 1 do
  begin
    if Ziel.Controls[j] is TLabel then
    begin
      if TLabel(Ziel.Controls[j]).tag = i then
        result := TLabel(Ziel.Controls[j]);
    end;
  end;
end;

function TForm1.ButtonNr(i: integer): TSpeedButton;
var
  j: integer;
begin
  result := nil;
  for j := 0 to Ziel.ControlCount - 1 do
  begin
    if Ziel.Controls[j] is TSpeedButton then
    begin
      if TSpeedButton(Ziel.Controls[j]).tag = i then
        result := TSpeedButton(Ziel.Controls[j]);
    end;
  end;
end;

procedure TForm1.mi_umbenennenClick(Sender: TObject);
var
  EintragLabel: TLabel;
begin
  EintragLabel := LabelNr(AktuellerButton);
  if EintragLabel <> nil then
  begin
    EintragLabel.Caption := InputBox('Neue Bezeichnung', 'Bezeichnung:', EintragLabel.Caption);
    speichernClick(Sender);
  end;
end;

procedure TForm1.mi_loeschenClick(Sender: TObject);
var
  EintragLabel: TLabel;
  bb: TSpeedButton;
  txt: string;
begin
  EintragLabel := LabelNr(AktuellerButton);
  bb := ButtonNr(AktuellerButton);
  if EintragLabel <> nil then
    Txt := EintragLabel.Caption + ' löschen?'
  else
    Txt := 'Löschen?';
  if MessageDlg(txt, mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  begin
    if EintragLabel <> nil then
      EintragLabel.Free;
    bb.Free;
    SpeichernClick(Sender);
  end;
end;

procedure TForm1.ClickBtn(Sender: TObject);
begin
  AktuellerButton := TSpeedButton(Sender).Tag;
  ShellExecute(Application.Handle, 'open', PChar(ZielAdresse[AktuellerButton]), PChar(''), PChar(''), SW_SHOW);
end;

function TForm1.GetLetzterButton: integer;
begin
  Result := fLetzterButton;
end;

procedure TForm1.SetLetzterButton(const Value: integer);
begin
  fLetzterButton := Value;
end;

function TForm1.GetAktuellerButton: integer;
begin
  Result := fAktuellerButton;
end;

procedure TForm1.SetAktuellerButton(const Value: integer);
begin
  fAktuellerButton := Value;
  mi_saveable.Checked := saveable[AktuellerButton];
  mi_deleteable.Checked := deleteable[AktuellerButton];
end;

function TForm1.GetZielAdresse(Index: integer): string;
begin
  if Index < fZielAdresse.Count then
    Result := fZielAdresse.Strings[Index]
  else
    Result := '';
end;

procedure TForm1.SetZielAdresse(Index: Integer; const Value: string);
begin
  if Index < fZielAdresse.Count then
    fZielAdresse.Strings[Index] := Value
  else
    fZielAdresse.Add(Value);
end;

function TForm1.GetDeleteable(Index: integer): boolean;
begin
  if (fSaveable.Count = 0) or (Index >= fdeleteable.Count) then
    Result := FALSE
  else
    Result := fdeleteable.Strings[Index] = '1';

end;

procedure TForm1.SetDeleteable(Index: integer; const Value: boolean);
begin
  if Value then
    if Index >= fDeleteable.Count then
      fDeleteable.Add('1')
    else
      fDeleteable.Strings[Index] := '1'
  else if Index >= fDeleteable.Count then
    fDeleteable.Add('0')
  else
    fDeleteable.Strings[Index] := '0';
end;

function TForm1.Getsaveable(Index: integer): boolean;
begin
  if (fSaveAble.Count = 0) or (Index >= fsaveable.Count) then
    Result := FALSE
  else
    Result := fsaveable.Strings[Index] = '1';
end;

procedure TForm1.Setsaveable(Index: integer; const Value: boolean);
begin
  if Value then
    if Index >= fsaveable.Count then
      fsaveable.Add('1')
    else
      fsaveable.Strings[Index] := '1'
  else if Index >= fsaveable.Count then
    fsaveable.Add('0')
  else
    fsaveable.Strings[Index] := '0';
end;

procedure TForm1.mi_deleteableClick(Sender: TObject);
begin
  mi_Deleteable.checked := not (mi_deleteable.checked);
  deleteAble[AktuellerButton] := mi_deleteAble.checked;
  if not mi_deleteable.checked then
    mi_saveable.checked := TRUE;
  speichernClick(Sender);
end;

procedure TForm1.mi_saveableClick(Sender: TObject);
begin
  mi_saveable.checked := not (mi_saveable.checked);
  saveAble[AktuellerButton] := mi_saveAble.checked;
  speichernClick(Sender);
end;

end.