この発言に対し以下のコメントが寄せられています

#00327　凛              さん　RE:画像を範囲選択してClipBoardへ




{TImage上でラバーバンドで範囲指定した部分をクリップボードに
転送}


const
   dmClipRange =1;
   dmnone      =0;
var//実際にはTFrom1のprivateに宣言
LastPoint,Origin:TPoint;
drawmode:integer;//ここには書いてませんがメニューなどで指定して下さい

//このメニューが選択された後　画像上でmouseDown→Move→MouseUp
//して指定した矩形範囲をクリップボードに転送する
procedure TForm1.N1Click(Sender: TObject);
begin
   drawMode:=dmClipRange;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
   if (drawmode=dmClipRange) then
   begin
      origin:=point(X,Y);
      LastPoint:=origin;
      drawmode:=drawMode+1;
   end
end;

//ラバーバンドを描画する
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
   if drawmode=dmClipRange+1 then
   begin
      with image1.canvas do
      begin
         Pen.Width:=1;
         Pen.mode:=pmNot;
         brush.style:=bsclear;
         rectangle(origin.X,origin.Y,LastPoint.X,LastPoint.Y);
         rectangle(origin.x,origin.Y,X,Y);
         lastPoint:=Point(X,Y);
      end;
   end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
   dx,dy,smallX,smallY,bigX,bigY:integer;
   clipbmp:TBitmap;
begin
   if drawmode=dmClipRange+1 then
   begin
      with image1.canvas do//最後のラバーバンドを消す
      begin
         Pen.Width:=1;
         Pen.mode:=pmNot;
         brush.style:=bsClear;
         rectangle(origin.x,origin.Y,LastPoint.X,LastPoint.Y);
      end;
      drawMode:=dmNone;
      clipBmp:=TBitmap.create;
      clipBmp.PixelFormat:=Pf32bit;
      clipBmp.p
      try
         //まず、クリップする座標が逆にならないように
         dx:=abs(Lastpoint.x-Origin.x);
         dy:=abs(Lastpoint.y-Origin.y);
         smallX:=Trunc((Lastpoint.x+Origin.x-dx)/2);
         bigX:=Lastpoint.x+Origin.x-smallX;
         smallY:=Trunc((Lastpoint.y+Origin.y-dy)/2);
         bigY:=Lastpoint.y+Origin.y-smallY;
         clipBmp.canvas.CopyRect(
                       Rect(
                            0,
                            0,
                            Abs(Lastpoint.x-Origin.x),
                            Abs(LastPoint.Y-Origin.Y)),
                       clipBmp.canvas,
                       Rect(smallX,smallY,bigX,bigY));
         clipBmp.Width:=dx;
         clipBmp.Height:=dy;
         Clipboard.Assign(clipbmp);
      finally
         clipBmp.free;
      end;
   end;
end;

☆☆☆　わからないときサンプル蔵　わかったときサンプル蔵　☆☆☆
                                 97/12/13(土) 10:41 凛(MXB01744)

Original document by 凛              氏 ID:(MXB01744)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。