// Im Folgenden wird gezeigt, wie man eine (von der Anwendung unterstützte)
// Bilddatei aus dem Explorer auf die eigene Anwendung ziehen und in einem
//
TImage anzeigen kann. Vergleiche auch Dateinamen bei DragDrop ermitteln.
// Da ein
TImage kein Handle besitzt, wird ein TPanel als Anzeigefläche genutzt.
// Setzen Sie also ein
TPanel auf die Form und ziehen Sie es auf die maximal
// vorgesehene Größe. Den Rest können Sie dem Code entnehmen.
// Wenn Sie ein Bild auf die Form ziehen, welches größer als das Panel ist,
// werden entsprechende Laufleisten angezeigt. Wenn gleichzeitig mehrere
// Dateien gezogen werden, sucht die Anwendung das erste unterstützte Bild.


// Getestet mit D4 unter XP

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, 
  Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    Panel1: TPanel; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure FormShow(Sender: TObject); 
  private 
    Bild: TImage; 
    svert, shorz: TScrollbar; 
    maxbreit, maxhoch: integer; 
  public 
    OldProc: TWndMethod; 
    procedure NewProc(var M: TMessage); 
    procedure Ablegen(var M: TWMDropFiles); 
    procedure einstellen; 
    procedure Horzscroll(Sender: TObject); 
    procedure Vertscroll(Sender: TObject); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
uses ShellApi, JPeg; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  OldProc := Panel1.WindowProc; 
  Panel1.WindowProc := NewProc; 
  DragAcceptFiles(Panel1.Handle, true); 
  Bild := TImage.create(self); 
  Bild.parent := Panel1; 
  Bild.autosize := true; 
  svert := TScrollbar.create(self); 
  with svert do begin 
    Kind := sbVertical; 
    parent := self; 
    onChange := Vertscroll; 
    visible := false; 
  end; 
  shorz := TScrollbar.create(self); 
  with shorz do begin 
    parent := self; 
    onChange := Horzscroll; 
    visible := false; 
  end; 
  with Panel1 do begin 
    caption := ''; 
    bevelouter := bvNone; 
    bevelinner := bvNone; 
    maxhoch := height; 
    maxbreit := width; 
  end; 
end; 
 
procedure TForm1.NewProc(var M: TMessage); 
begin 
  if M.Msg = WM_DROPFILES then 
    Ablegen(TWMDropFiles(M)) else 
    OldProc(M); 
end; 
 
procedure TForm1.Horzscroll(Sender: TObject); 
begin 
  Bild.left := -shorz.Position; 
  Panel1.setfocus; 
end; 
 
procedure TForm1.Vertscroll(Sender: TObject); 
begin 
  Bild.top := -svert.Position; 
  Panel1.setfocus; 
end; 
 
procedure TForm1.einstellen; 
var s, l: integer; 
begin 
  Bild.left := 0; 
  Bild.top := 0; 
  if Bild.picture.width > maxbreit 
    then begin 
    Panel1.width := maxbreit; 
    with shorz do begin 
      max := Bild.picture.width - maxbreit; 
      visible := true; 
      position := 0; 
      s := max div 100; 
      l := max div 10; 
      smallchange := s + ord(s = 0); 
      Largechange := l + ord(l = 0); 
    end; 
  end else begin 
    Panel1.width := Bild.picture.width; 
    shorz.visible := false; 
  end; 
  if Bild.picture.height > maxhoch 
    then begin 
    Panel1.height := maxhoch; 
    with svert do begin 
      max := Bild.picture.height - maxhoch; 
      visible := true; 
      position := 0; 
      s := max div 100; 
      l := max div 10; 
      smallchange := s + ord(s = 0); 
      Largechange := l + ord(l = 0); 
    end; 
  end else begin 
    svert.visible := false; 
    Panel1.height := Bild.picture.height; 
  end; 
  with shorz do begin 
    if visible then begin 
      left := Panel1.left; 
      top := Panel1.top + Panel1.height; 
      width := Panel1.width; 
    end; 
  end; 
  with svert do begin 
    if visible then begin 
      left := Panel1.left + Panel1.width; 
      top := Panel1.top; 
      height := Panel1.height; 
    end; 
  end; 
end; 
 
procedure TForm1.Ablegen(var M: TWMDropFiles); 
var 
  anzahl, x: Integer; 
  FNam: PChar; 
  b: boolean; 
begin 
  b := false; 
  Getmem(FNam, max_path); 
  anzahl := pred(DragQueryFile(M.Drop, $FFFFFFFF, nil, 0)); 
  for x := 0 to anzahl do begin 
    DragQueryFile(M.Drop, x, FNam, max_path); 
    try 
      Bild.picture.LoadFromFile(FNam); 
      einstellen; 
      b := true; 
      break; 
    except 
      continue; 
    end; 
  end; 
  Freemem(FNam); 
  if not b then 
    showmessage('Es konnte keine Datei geladen werden'); 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  bild.free; 
end; 
 
procedure TForm1.FormShow(Sender: TObject); 
begin 
  Panel1.setfocus; 
end; 
 
end.



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke