VCL だと，デバイスコンテキストが使えるので，
Halbow 資料館のコードを拝借して，こんな感じでできます．
動作確認環境は Windows 7 U64(SP1) + Delphi XE(UP1) Pro
procedure TForm1.Button1Click(Sender: TObject);
var
LTop : Integer;
LLeft : Integer;
LWidth : Integer;
LHeight : Integer;
LRGN1 : HRGN;
LCanvas : TCanvas;
LBitmap : TBitmap;
LSrcLeft : Integer;
LSrcTop : Integer;
LSrcRect : TRect;
begin
LCanvas := Image1.Picture.Bitmap.Canvas;
//リージョン作成
LTop := 70;
LLeft := 30;
LWidth := 120;
LHeight := 120;
LRGN1 := CreateEllipticRgn(LLeft, LTop, LLeft + LWidth, LTop + LHeight);
//リージョンでクリップする
SelectClipRgn(LCanvas.Handle, LRGN1);
//Image1.Picture.Bitmap.Canvasへの描画
LBitmap := TBitmap.Create;
try
LBitmap.Width := LWidth;
LBitmap.Height := LHeight;
LSrcLeft := 160;
LSrcTop := 0;
LSrcRect := Rect(LSrcLeft, LSrcTop, LSrcLeft + LWidth, LSrcTop + LHeight);
LBitmap.Canvas.CopyRect(LBitmap.Canvas.ClipRect,
Image2.Picture.Bitmap.Canvas,
LSrcRect);
LCanvas.Draw(LLeft, LTop, LBitmap);
finally
FreeAndNil(LBitmap);
end;
//格好つけてフレームを描画してみる
SelectClipRgn(LCanvas.Handle, 0);
LCanvas.Brush.Color := clBlack;
FrameRgn(LCanvas.Handle,
LRGN1,
LCanvas.Brush.Handle,
2,
2);
DeleteObject(LRGN1);
end;
end.
 |