![]() // Im Folgenden
wird gezeigt, wie man eine
(von der Anwendung unterstützte)
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