急！急！急！！！一个在TBitmap上画图的问题！

Question

项目需要 我现在有一个TImage控件放在一个TPanel上，TImage上面已经load一张图片进来 我现在要达到这样的效果,
在图片区域内点鼠标左键然后按住左键拖动 而且仅限向右下拖动有效，会出现一个空心的虚线矩形框 画这个矩形并不影响下边的图片 可以随意拖动 当松开鼠标左键 则矩形消失，图片和没有画矩形前一样。也就是说不能影响图片 画这个矩形只是临时的随画随擦。我现在画线是可以画 但一是擦不干净 二图片被破坏了 画过矩形的地方都成了白色 找了好久没有合适的解决方案 希望高手们帮忙 分不够我再加！因为是项目时间很紧，所以最好能有代码例子,谢谢大家！  

Answer 1

如果只需要一个鼠标移动显示区域的效果。可以在Image上放一个Shape控件，然后改变这个shape的属性即可达到。
源码见下：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;type
  TForm1 = class(TForm)
    Image1: TImage;
    Shape1: TShape;
    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 }
    StartP: TPoint;
  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
  begin
    StartP.X := X;
    StartP.Y := Y;
  end;
end;procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if (Shift = [ssLeft]) and (X > StartP.X) and (Y > StartP.Y) then
  begin
    Shape1.Left := StartP.X;
    Shape1.Top := StartP.Y;
    Shape1.Width := X - StartP.X;
    Shape1.Height := Y - StartP.Y;
  end
  else
  begin
    Shape1.Width := 0;
    Shape1.Height := 0;
  end;
end;procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Shape1.Width := 0;
  Shape1.Height := 0;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
  Shape1.Pen.Color := clYellow;
  Shape1.Pen.Mode := pmMask; //一定要设为Mask
  Shape1.Pen.Width := 2;
end;end.
如果想要截取获取的图形，只要算出TRect这个范围，然后调用BitBlt函数即可。

Answer 2

procedure   TForm1.Image1MouseMove(Sender:   TObject;   Shift:   TShiftState;   X, 
    Y:   Integer); 
begin 
    if   (Shift   =   [ssLeft])   and   (X   >   StartP.X)   and   (Y   >   StartP.Y)   then 
    begin 
        Shape1.Left   :=   StartP.X; 
        Shape1.Top   :=   StartP.Y; 
        Shape1.Width   :=   X   -   StartP.X; 
        Shape1.Height   :=   Y   -   StartP.Y; 
    end 
    else 
    begin 
        Shape1.Width   :=   0; 
        Shape1.Height   :=   0; 
    end; 
end; 
这行代码中的
Shape1.Left   :=   StartP.X; 
Shape1.Top   :=   StartP.Y; 
应该为：
Shape1.Left   :=   StartP.X + Image1.Left; // 你的为Panel1.Left;
Shape1.Top   :=   StartP.Y + Image.Top;  //你的为Panel1.Top;

Answer 3

感谢kongwai 的方法 初步试了一下 有效 就是要多写点代码控制画图区域 等过了加分限制的期限我会再加点分一起给的!谢谢了!

Answer 4

kongwai 的方法固然可行，但不是个很好的方法，要知道使用控件都是要消耗系统的资源的。我建议楼主将背景图片加载到TBitmap里面，在你画矩形框的时候重新画背景，然后再画你要的矩形框！

Answer 5

hmzgz81 重新画背景是直接重新给TImage.Picture.Bitmap赋值吗，画矩形框是用canvas的Draw方法吗？

Answer 6

重新给TImage.Picture.Bitmap赋值的话速度会有点慢，最好之前将你的bitmap 先加载到一个TBitmap类型的变量（TmpBmp）里，用Img.Canvas.StretchDraw(Rt, TmpBmp);
画矩形就用Img.Canvas.Rectangle就可以了。