xp操作系统－资源管理器 选文件的透明拉框，如何做出来呀

Question

请高手们先看一下效果，再回答

Answer 1

procedure TC_ReportF.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
  with scrn_rect do
  begin
    Pen.Mode := AMode;
    Rectangle(TopLeft.X, TopLeft.Y, BottomRight.X, BottomRight.Y);
  end;
end;procedure TC_ReportF.imageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
begin
  if Button = mbright then
  begin
    MouseDragging := True;
    Image.Cursor := crHandPoint;
    OldMousePos := Point(X, Y);
  end;
  mx := mouse.CursorPos.x;
  my := mouse.CursorPos.y;
  bx := x;
  by := y;
  if (not PicDraging) and (button = mbLeft) then
  begin
    mouse2down := true;
    Origin := mouse.CursorPos;          // ClientToScreen(Point(X, Y));
    MovePt := Origin;
  end;
end;procedure TC_ReportF.imageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer; Layer: TCustomLayer);
begin
  if mouse2down then
  begin
    if (x > bx) and (y > by) then
      Scrn_Rect.Pen.Color := COLOR_KUANG_BIG
    else
      Scrn_Rect.Pen.Color := COLOR_KUANG_AUTO;    DrawShape(Origin, MovePt, pmNotXor);
    Origin := mouse.CursorPos;
    DrawShape(Origin, MovePt, pmNotXor);
  end;  if MouseDragging or PicDraging then
  begin
    Image.Scroll(OldMousePos.X - X, OldMousePos.Y - Y);
    OldMousePos := Point(X, Y);
    Image.Update;
  end;end;procedure TC_ReportF.imageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
var
  dx, dy            : integer;
  rx, ry, r         : single;
  ux, uy            : integer;
  cw, ch, pw, ph    : integer;
  nowScale          : single;
begin
  if mouse2down then
  begin
    mouse2down := false;
    DrawShape(Origin, MovePt, pmNotXor);
  end;  if Button = mbRight then
  begin
    MouseDragging := False;
    if PicDraging then
      Image.Cursor := crHandPoint
    else
      Image.Cursor := crDefault
  end;  if (not PicDraging) and (Button = mbLeft) and (image.Bitmap.Width > 10) then
  begin
    nowScale := image.scale;    ux := mouse.CursorPos.X;
    uy := mouse.CursorPos.y;    if (uX > mx) and (uy > my) then     //向右下脚划，放大图片。
    begin
      dx := uX - mx;
      dy := uy - my;      rx := image.Width / dx;
      ry := image.Height / dy;      if rx <= ry then r := rx else r := ry;      NowScale := image.scale * r;      ScaleBar.Repaint;
      if (NowScale < Power(10, ScaleBar.MaxValue / 100)) then
      begin
         //image.scale := NowScale;
        scalebar.Position := round(logN(10, NowScale) * 100);
      end;
      image.Scroll(round(((bx + dx div 2) - image.Width div 2) * r), round(((by + dy div 2) - image.Height div 2) * r));
    end
    else
    begin
      NowScale := image.Width / image.Bitmap.Width;
      if NowScale > (image.height / image.Bitmap.height) then
        NowScale := (image.height / image.Bitmap.height);
      image.Scale := NowScale;
      scalebar.Position := round(logN(10, Image.Scale) * 100);
    end;
  end;
end;

Answer 2

非常感谢你的回答，这段代码和XP资源管理器上的效果一样吗？我说的透明不是只有Pen还有Brush填充的，也就是说要填充这个矩形，但要透明，可以在XP资源管理器上试试，你拉框选文件时的矩形框