图片拖拽程序(50分)

  • 主题发起人 主题发起人 林枫
  • 开始时间 开始时间

林枫

Unregistered / Unconfirmed
GUEST, unregistred user!
我在做一个看图的程序,想实现一个拖拽功能:
拖一个jpg文件到Timage里去,然后程序显示这个图片,
请问:应该怎么做呢?
 
代码如下:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, JPEG,
ExtCtrls, ShellApi, StdCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
var
CFileName: array[0..255] of Char;
begin
try
if DragQueryFile(Msg.Drop, 0, CFileName, SizeOf(CFileName)) > 0 then
begin
Image1.Picture.LoadFromFile(CFileName);
Msg.Result := 0;
end;
finally
DragFinish(Msg.Drop);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, TRUE);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DragAcceptFiles(Handle, FALSE);
end;

end.
 
{Here is a way to set up a form to support dragging components around
on it at run time. Each control that you want to move in this fashion
should have its mouse down, mouse move, and mouse up events set to
ControlMouseDown, ControlMouseMove and ControlMouseUp, respectively}

unit DragAroundControlsExample;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,
StdCtrls, ExtCtrls, ComCtrls, DBTables, DB;

type
TForm1 = class(TForm)
procedure ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ControlMouseMove(Sender: TObject; Shift: TShiftState;
X,Y: Integer);
procedure ControlMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
downX, downY: Integer;
dragging: Boolean;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

Type
TCracker = Class(TControl);
{ Needed since TControl.MouseCapture is protected
by declaring a descendant class we can typecast the control
to this and access its protected methods with in this unit.}

{ Control event handlers are attached to both memo and image mouse
events. }
procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
downX:= X;
downY:= Y;
dragging := True;
TCracker(Sender).MouseCapture := True;
end;

procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
If dragging Then with Sender As TControl Do Begin
Left := X-downX+Left;
Top := Y-downY+Top;
End;
end;

procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
If dragging then Begin
dragging := False;
TCracker(Sender).MouseCapture := False;
End;
end;

1、我试过是可以的,请看注释如何“安装”
2、如果你觉得拖的时候很闪的话,TForm1.DoubleBuffered设置True

希望能帮得了你
 
可以copy到clipboard,然后paste就可以了
当然实用程序不是ctrl+v+c
 
TCracker(Sender).MouseCapture := True;
是什么意思?
 
上面那句话的意思就是捕获鼠标啊。
API是SetCapture和ReleaseCapture
 
接受答案了.
 
后退
顶部