TPaintBoxで図形を拡大／縮小表示するには (ID:29632)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

うんとさん、Mr.XRAYさん、尋ねよ、さらば見出さんさん ご回答ありがとうございます。

ビットマップとメタファイルについて調べてみました。
１．ビットマップは、ピクセルと呼ばれる小さい正方形をイメージの最小
    単位として。各ピクセルの色情報を格納したバイト型の配列である。
２．メタファイルは、イメージをベクターベースの型式で保存したものであ    る。イメージの描画方法に関する指示の集合を保存する。

私が、扱おうとしているのは画像データではなく、単にキャンバスに
MoveTo,LineTo等で描画した線／図形を拡大／縮小したいと考えております。
Mr.XRAYさん、尋ねよ、さらば見出さんさん のコードを合わせて以下の
コードで拡大／縮小した図形のある矩形領域を別のイメージにコピーする
ことが出来ました。

procedure TForm1.Button1Click(Sender: TObject);
var
     AMetaFile : TMetafile;
     ACanvas   : TMetaFileCanvas;
     AWidth    : Integer;
     AHeight   : Integer;

rc: TRect;
begin
     Self.VertScrollBar.Visible := False;
     Self.HorzScrollBar.Visible := False;

Image1.Stretch := True;
     Image1.Picture.Assign(nil);

AMetaFile:=TMetafile.Create;
     AMetaFile.Width  := Image1.Width;
     AMetaFile.Height := Image1.Height;
     try
       ACanvas:=TMetafileCanvas.Create(AMetaFile,0);

try
         //Canvasの全領域を塗潰す
         ACanvas.Brush.Color := clSilver;
         ACanvas.FillRect(ACanvas.ClipRect);

//指定サイズの文字サイズで文字を描く
         ACanvas.Font.Size := 50;
         ACanvas.Brush.Style:=bsClear;
         ACanvas.TextOut(0,0,'Delphi');

//四角形を描画
         ACanvas.Pen.Width := 6;
         ACanvas.Pen.Color := clGreen;
         ACanvas.Rectangle(30,10,130,70);

//直線を画
        ACanvas.MoveTo(10,10);
        ACanvas.LineTo(100,100);

//四角形を描画
        ACanvas.Rectangle(100, 100, 150, 150);

finally
         ACanvas.Free;
       end;
       Image1.Picture.Assign(AMetaFile);

AMetaFile.Width := Round(AMetaFile.Width*1.5);
       AMetaFile.Height := Round(AMetaFile.Height*1.5);

Image2.Picture.Bitmap.Width := Image2.Width;
       Image2.Picture.Bitmap.Height := Image2.Height;
       Image2.Canvas.Draw(0, 0, AMetaFile);

rc.Left := 100;
       rc.Top := 100;
       rc.Right := 100;
       rc.Bottom := 100;

Image3.Width := rc.Right;
       Image3.Height := rc.Bottom;
       Image3.Canvas.Brush.Color := clSilver;
       Image3.Canvas.FillRect(Image3.Canvas.ClipRect);
       BitBlt(Image3.Canvas.Handle,0,0,Image3.Width,Image3.Height,Image2.Canvas.Handle,rc.Left,rc.Top, SRCCOPY);

finally
       AMetaFile.Free;
     end;
end;

うんとさん、Mr.XRAYさん、尋ねよ、さらば見出さんさん ご教示
誠にありがとうございました。

←解決時は質問者本人がここをチェックしてください。

戻る