如何在Timage控件中实现上图的拖动画框的效果?(90分)

  • 主题发起人 主题发起人 wnhoo
  • 开始时间 开始时间
W

wnhoo

Unregistered / Unconfirmed
GUEST, unregistred user!
http://www.delphibbs.com/keylife/images/u150182/hua.jpg
如何在Timage控件中实现上图的拖动画框的效果,并且鼠标松开后消失。
纪录鼠标画的这个框的两个对角在实际图中的位置,并且在图上对应位置画出这个框!
要求:
1、实现一个虚的框
2、取得虚框的位置
3、画出这个框

谢谢!
 
首先取得第一次单击时的位置,用一个POINTE来保存,
明天有时候我贴上来吧!今天太晚了,呵呵
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ExtDlgs, Jpeg, Math;

type
TForm1 = class(TForm)
btnLoadFile: TButton;
pl: TPanel;
OD: TOpenDialog;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure btnLoadFileClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

TmImage = class(TCustomControl)
private
FSRect: TRect;
FSr: TBitmap;
FBmp: TBitmap;
FDown: Boolean;
procedure WMLButtonDown(var message: TWMMouse); message WM_LButtonDown;
procedure WMLButtonUp(var message: TWMMouse); message WM_LButtonUp;
procedure WMMouseMove(var message: TWMMouse); message WM_MouseMove;
procedure WMSize(var message: TWMSize); message WM_Size;
procedure WMPaint(var message: TWMPaint); message WM_Paint;
procedure WMERASEBKGND(var message: TMessage); message WM_ERASEBKGND;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure GetFile(fn: string);
end;
var
Form1: TForm1;
mI: TmImage;

implementation

{$R *.dfm}

{ TmImage }

constructor TmImage.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csReplicatable];

SetRectEmpty(FSRect);
FBmp := TBitmap.Create;
FSr := TBitmap.Create;

FBmp.Canvas.Pen.Style := psDot;
FBmp.Canvas.Pen.Color := clRed;
FBmp.Canvas.Brush.Style := bsClear;

FBmp.Width := Width;
FBmp.Height := Height;
FSr.Width := Width;
FSr.Height := Height;

FDown := false;
end;

destructor TmImage.Destroy;
begin
FreeAndNil(FBmp);
FreeAndNil(FSr);
inherited;
end;

procedure TmImage.GetFile(fn: string);
begin
FSr.LoadFromFile(fn);
Repaint;
end;

procedure TmImage.WMERASEBKGND(var message: TMessage);
begin
message.Result := 1;
end;

procedure TmImage.WMLButtonDown(var message: TWMMouse);
begin
inherited;
FSRect.Top := message.YPos;
FSRect.Left := message.XPos;

FDown := true;
end;

procedure TmImage.WMLButtonUp(var message: TWMMouse);
begin
inherited;

if not FDown then exit;
Repaint;

FDown := false;
SetRectEmpty(FSRect);
end;

procedure TmImage.WMMouseMove(var message: TWMMouse);
var
temp: integer;
begin
inherited;

if not FDown then exit;

FSRect.Bottom := message.YPos;

FSRect.Right := message.XPos;

Repaint;
end;

procedure TmImage.WMPaint(var message: TWMPaint);
var
DestDC, SrcDC: HDC;
w, h: integer;
begin
inherited;
DestDC := FBmp.Canvas.Handle;
SrcDC := FSr.Canvas.Handle;
w := FSr.Width;
h := FSr.Height;

BitBlt(DestDC, 0, 0, w, h, SrcDC, 0, 0, SRCCOPY );
FBmp.Canvas.Rectangle(FSRect);

BitBlt(Canvas.Handle, 0, 0, Width, Height, FBmp.Canvas.Handle, 0, 0, SRCCOPY);
end;

procedure TmImage.WMSize(var message: TWMSize);
begin
inherited;
FBmp.Width := message.Width;
FSr.Width := message.Width;
FBmp.Height := message.Height;
FSr.Height := message.Height;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
mI := TmImage.Create(nil);
mI.Parent := pl;
mI.Align := alClient;
end;

procedure TForm1.btnLoadFileClick(Sender: TObject);
begin
if (OD.Execute) then
begin
mI.GetFile(OD.FileName);
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(mI);
end;

end.
 
多人接受答案了。
 
后退
顶部