如何产生图片拖最时的需虚框？(100分)

如何产生图片拖最时的需虚框？

用到DrawFocusRect
例如下

private
{ Private declarations }
OldX,
OldY,
OldLeft,
OldTop : Integer;
ScreenDC : HDC;
MoveRect : TRect;
Moving : Boolean;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
SetCapture(Panel1.Handle);
ScreenDC := GetDC(0);
OldX := X;
OldY := Y;
OldLeft := X;
OldTop := Y;
MoveRect := BoundsRect;
DrawFocusRect(ScreenDC,MoveRect);
Moving := True;
end;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Moving then begin
DrawFocusRect(ScreenDC,MoveRect);
OldX := X;
OldY := Y;
MoveRect := Rect(Left+OldX-OldLeft,Top+OldY-OldTop,
Left+Width+OldX-OldLeft,Top+Height+OldY-OldTop);
DrawFocusRect(ScreenDC,MoveRect);
end;
end;

procedure TForm1.Panel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then begin
ReleaseCapture;
DrawFocusRect(ScreenDC,MoveRect);
Left := Left+X-OldLeft;
Top := Top+Y-OldTop;
ReleaseDC(0,ScreenDC);
Moving := False;
end;
end;

试了一下。可行。

拖的时候自己画个虚线矩形！

1. 橡皮线功能
implementation

{$R *.DFM}
var
drawing:Boolean=false;
oPoint,sPoint:TPoint;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
spoint:=Point(x,y);
opoint:=sPoint;
drawing:=true;
Canvas.Brush.Style := bsclear;
Canvas.Pen.Style := psDot;
Canvas.Pen.Mode :=pmNotXor;
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if not(drawing) then exit;
canvas.Ellipse(spoint.x,spoint.y,opoint.x,opoint.y);
canvas.Ellipse(spoint.x,spoint.y,x,y);
oPoint:=point(x,y);
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if not(drawing) then exit;
canvas.Ellipse(spoint.x,spoint.y,opoint.x,opoint.y);
Canvas.Pen.Style := psSolid;
canvas.Ellipse(spoint.x,spoint.y,x,y);
Drawing:=false;

end;

end.

有没有不通过异或画点而快速操作的方法，就是快速的局部重画的方法？

unit MouseF;

interface

uses Windows, Classes, Graphics, Controls, Forms, SysUtils;

type
TMouseForm = class(TForm)
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
fDragging: Boolean;
fRect: TRect;
public
{ Public declarations }
end;

var
MouseForm: TMouseForm;

implementation

{$R *.DFM}

procedure TMouseForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
fDragging := True;
Mouse.Capture := Handle;
fRect.Left := X;
fRect.Top := Y;
fRect.BottomRight := fRect.TopLeft;
Canvas.DrawFocusRect(fRect); // 这个是你要的效果吧
end;
end;

procedure TMouseForm.FormMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if fDragging then
begin
// remove and redraw the dragging rectangle
Canvas.DrawFocusRect (fRect); // 这个是你要的效果吧
fRect.Right := X;
fRect.Bottom := Y;
Canvas.DrawFocusRect (fRect); // 这个是你要的效果吧
end
end;

procedure TMouseForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if fDragging then
begin
Mouse.Capture := 0; // calls ReleaseCapture
fDragging := False;
Invalidate;
end;
end;

procedure TMouseForm.FormPaint(Sender: TObject);
begin
Canvas.Rectangle (fRect.Left, fRect.Top,
fRect.Right, fRect.Bottom);
end;

end.