急！急！急！！！一个在TBitmap上画图的问题！ ( 积分: 200 )

项目需要 我现在有一个TImage控件放在一个TPanel上，TImage上面已经load一张图片进来 我现在要达到这样的效果,
在图片区域内点鼠标左键然后按住左键拖动 而且仅限向右下拖动有效，会出现一个空心的虚线矩形框 画这个矩形并不影响下边的图片 可以随意拖动 当松开鼠标左键 则矩形消失，图片和没有画矩形前一样。也就是说不能影响图片 画这个矩形只是临时的随画随擦。我现在画线是可以画 但一是擦不干净 二图片被破坏了 画过矩形的地方都成了白色

找了好久没有合适的解决方案 希望高手们帮忙 分不够我再加！因为是项目时间很紧，所以最好能有代码例子,谢谢大家！

利用图层的概念，在上面再放一个透明image，在新的image上做图试试

用双缓冲看看可不可以。。。。
先画在一张临时的TBitmap上，再把它拷到Image上。。没动手做不知道行不行，你试试。。

lxw5214 设置TImage透明是用哪个属性呢？直接用TImage.Canvas画还是用TImage.Picture.Bitmap.Canvas画？

hwljerry就算是那样做 是不是也要在每次拖动鼠标的时候重新导入图片呢？因为每次拖动都会破坏图片 而且每拖动一下 就要把上一次画的矩形擦除 擦除很难做啊！一直没做好

在画之前先把image中的图片保存到临时的bitmap中。
然后再画，
和你重新导入的想法差不多，不过不是重新导入图片是重新画图片就是了。
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
src: TRect;
drc: TRect;
begin
if FStep = 1 then
begin
Image1.Canvas.Pen.Color := clRed;
Image1.Canvas.Rectangle(spt.X, spt.Y, ept.X, ept.Y);

ept := Point(x, y);
Image1.Canvas.Rectangle(spt.X, spt.Y, ept.X, ept.Y);

SetRect(src, spt.x, spt.y, ept.X, ept.Y);
CopyRect(drc, src);

Image1.Canvas.Draw(0, 0, Ftmp); //用保存的图片先画一次
Image1.Canvas.Rectangle(drc); //再画矩形信息
end;
end;

hwljerry 谢谢 我试试 不管成不成 一定都给分 对了 这个能解决清除已画矩形的问题吗

呵呵。笨办法。。再画一次图片
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FStep := 0;
Image1.Canvas.Draw(0, 0, Ftmp);
Ftmp.Free;
end;

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, ExtCtrls;

type
TForm1 = class(TForm)
Image1: TImage;
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
B, E: TPoint;
procedure ClearBE;
procedure DrawFocusRect;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
B := Mouse.CursorPos; //定位起始点
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then //左键按下拖动时
begin
DrawFocusRect; //擦除原有焦点框
{ 防止焦点框绘制超出Image1 }
if X > Image1.ClientWidth then X := Image1.ClientWidth;
if Y > Image1.ClientHeight then Y := Image1.ClientHeight;
E := Image1.ClientToScreen(Point(X, Y));
DrawFocusRect; //绘制新焦点框
end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
DrawFocusRect; //擦除焦点框
ClearBE; //还原起止点坐标
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ClearBE; //初始化起止点坐标
end;

procedure TForm1.ClearBE;
begin
B := Point(0, 0);
E := Point(0, 0);
end;

procedure TForm1.DrawFocusRect;
var
R: TRect;
begin
with R do
begin
{ 设定空矩形 }
Left := 0;
Top := 0;
Right := 0;
Bottom := 0;
{ 如果是向下拖动，则设定所需矩形 }
if (E.X > B.X) and (E.Y > B.Y) then
begin
TopLeft := B;
BottomRight := E;
end;
end;
{ 绘制焦点框,使用的是屏幕的DC }
windows.DrawFocusRect(GetDC(0), R);
end;

end.

异或绘图。。。
画一次出现矩形框，原位置再画一次，矩形框消失，不影响背景

lake_cx 这种方法我试了 还是会有交叉点的残留 现在我采用了在放一个TShape改变这个控件的大小的方法解决 谢谢大家了 大家的回复对我很有帮助

有交叉残留是因为你的位置不准确或者绘图次数不对，修正下就可以了