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

名前

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

本文

procedure TForm1.Button1Click(Sender: TObject);
const
 RATIO = 4.000;
var
 mf: TMetafile;
 rc, rc2: TRect;
 ACanvas: TMetaFileCanvas;
 AWidth : Integer;
 AHeight: Integer;
begin
 Image1.Stretch := False;
 Image2.Stretch := False;
 Image3.Stretch := False;
 Image1.Picture.Assign(nil);
 Image2.Picture.Assign(nil);
 Image3.Picture.Assign(nil);
 mf := TMetafile.Create;
 mf.Width  := Image1.Width;
 mf.Height := Image1.Height;
 try
  ACanvas := TMetafileCanvas.Create(mf, 0);
  try
   ACanvas.Brush.Color := clYellow;
   ACanvas.FillRect(ACanvas.ClipRect);
   ACanvas.Font.Size := 110;
   ACanvas.Brush.Style := bsClear;
   ACanvas.TextOut(50, 40, 'Delphi MetaFile');
   ACanvas.Pen.Width := 6;
   ACanvas.Pen.Color := clFuchsia;
   ACanvas.Rectangle(50, 40, 440, 197);
  finally
   ACanvas.Free;
  end;
  Image1.Picture.Assign(mf);
  Application.ProcessMessages;
  Sleep(1000);
  // 図形を1/4に縮小
  mf.Width  := Round(mf.Width / RATIO);
  mf.Height := Round(mf.Height / RATIO);
  Image1.Picture.Assign(mf);
  // Image2に部分描画
  Image2.Width := 100;
  Image2.Height := 40;
  Image2.Picture.Bitmap.Width := 100;
  Image2.Picture.Bitmap.Height := 40;
  Image2.Canvas.Draw(-10, -10, mf);
  // Image3に部分コピー
  Image1.Picture.Bitmap.Width := Image1.Width;
  Image1.Picture.Bitmap.Height := Image1.Height;
  Image1.Canvas.Draw(0, 0, mf);
  Image3.Width := 100;
  Image3.Height := 40;
  rc.Left := 10;
  rc.Top := 10;
  rc.Right := rc.Left + Image3.Width;
  rc.Bottom := rc.Top + Image3.Height;
  with Image3.Canvas do begin
   CopyRect(ClipRect, Image1.Canvas, rc);
  end;
  Application.ProcessMessages;
  Sleep(1000);
  // 図形を元に戻す
  mf.Width  := Round(mf.Width * RATIO);
  mf.Height := Round(mf.Height * RATIO);
  Image1.Picture.Assign(mf);

//  mf.SaveToFile(METAFILE);
 finally
  mf.Free;
 end;
end;

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

戻る