// 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





