核心提示:600) this.width = 600;'>unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Gra...
600) this.width = 600;">
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes,
Graphics, Controls, Forms, Dialogs, ExtCtrls;
type
TForm1 = class(TForm)
Panel1: TPanel;
Image1: TImage;
procedure FormCreate(Sender: TObject) ;
private
originalPanelWindowProc : TWndMethod;
procedure PanelWindowProc (var Msg : TMessage) ;
procedure PanelImageDrop (var Msg : TWMDROPFILES) ;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses ShellApi;
procedure TForm1.FormCreate(Sender: TObject) ;
begin
originalPanelWindowProc := Panel1.WindowProc;
Panel1.WindowProc := PanelWindowProc;
DragAcceptFiles(Panel1.Handle,true) ;
end; (*FormCreate*)
procedure TForm1.PanelWindowProc(var Msg: TMessage) ;
begin
if Msg.Msg = WM_DROPFILES then
PanelImageDrop(TWMDROPFILES(Msg))
else
originalPanelWindowProc(Msg) ;
end; (*PanelWindowProc*)
procedure TForm1.PanelImageDrop(var Msg: TWMDROPFILES) ;
var
numFiles : longInt;
buffer : array[0..MAX_PATH] of char;
begin
numFiles := DragQueryFile(Msg.Drop, $FFFFFFFF, nil, 0) ;
if numFiles > 1 then
begin
ShowMessage('You can drop only one image file at a time!') ;
end
else
begin
DragQueryFile(Msg.Drop, 0, @buffer, sizeof(buffer)) ;
try
Image1.Picture.LoadFromFile(buffer) ;
except
on EInvalidGraphic do ShowMessage('Unsupported image file, or not an image!') ;
end;
end;
end; (*PanelImageDrop*)
end.