Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2020年04月25日] [更新 2020年04月25日]　Delphi 一般・その他
TCanvas における描画のクリップ
動作確認等 Windows 7 U64(SP1) + Delphi XE5(UP2) Pro VCL-32
[整理番号 - 0890]






描画領域のクリッピング


パスやリージョンの関数類を使用すると、描画をクリップすることができますが、本ページで扱っているのは、矩形領域を指定してクリップする描画です。



本ページでは、クリップの設定に 以下の Windows API の関数を使用しています。






01_クリップ領域 TCanvas.ClipRect の値を変更


TImage 等のグラフィックス描画用のコントロールにおける描画範囲は、そのコントロールのサイズである矩形範囲となります。その矩形範囲を越えた部分には描画されません。これが、そのコントロールのデフォルトのクリップ領域です。この矩形クリップ範囲は、読み出し専用の TCanvs.ClipRect プロパティで取得できます。
TCanvs.ClipRect プロパティは読み出し専用ですから設定はできません。IntersectClipRect 関数を使用してクリップ領域を設定すると、TCanvas.ClipRect の値は、IntersectClipRect 関数そ設定した値になります。






02_TCanvas における矩形クリップ領域の設定


IntersectClipRect 関数で矩形範囲を指定すると、元のクリップ領域と、IntersectClipRect 関数で設定した矩形領域と重なる矩形範囲内だけ描画するようになります。
以下は、フォームの Canvas (TCanvas 型のオブジェクト) に図形を描画する例です。Button1 をクリックすると、クリップなしで図形を描画します。Button2 をクリックすると、矩形クリップ領域を設定してから図形を描画します。



図1
クリップなし
図2
クリップを設定してから描画した結果
  • IntersectClipRect 関数で設定した矩形領域内だけに描画される

Button2 をクリックすると、矩形クリップ領域を設定してから図形を描画します。その後、Button1 をクリックすると、クリップなしの描画となります。



図3
Button2 クリップでクリップ描画した後に、 Button1 をクリック
  • クリップなしになっている

リスト1
TCanvas における矩形クリップ領域の設定		 
//=============================================================================
//  TCanvas へ図形を描画
//  クリップなし
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Canvas.Brush.Style := bsSolid;

  // TCanvas を白で塗り潰す (描画のクリア)
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Canvas.ClipRect);

  // 描画ルーチンを実行
  DrawToCanvas(Self.Canvas);
end;

//=============================================================================
//  TCanvas へ図形を描画
//  矩形領域のクリップあり
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LLeft   : Integer;
  LTop    : Integer;
  LRight  : Integer;
  LBottom : Integer;
begin
  Canvas.Brush.Style := bsSolid;

  // TCanvas を白で塗り潰す (描画のクリア)
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Canvas.ClipRect);


  // 描画をクリップする矩形領域を設定
  LLeft   := 20 + 30;
  LTop    := 70;
  LRight  := LLeft + 90;
  LBottom := LTop + 80;
  IntersectClipRect(Canvas.Handle, LLeft, LTop, LRight, LBottom);

  // 描画ルーチンを実行
  DrawToCanvas(Self.Canvas);
end;

//-----------------------------------------------------------------------------
//  TCanvaws へのテスト用描画ルーチン
//-----------------------------------------------------------------------------
procedure TForm1.DrawToCanvas(ACanvas: TCanvas);
begin
  ACanvas.Brush.Style := bsSolid;

  // 矩形を描画
  ACanvas.Brush.Color := clRed;
  ACanvas.FillRect(Rect(20, 20, 180, 120));

  // 楕円を描画
  ACanvas.Pen.Color := clBlack;
  ACanvas.Brush.Color := clGreen;
  ACanvas.Ellipse(80, 90, 180, 190);
end;


上のサンプルでは、utton2 クリックで描画をクリップした 後に Button1 をクリックすると、クリップなしの描画となりました。
イベントは手続き (メソッドあるいは関数) として実行することができます。そこで、以下の Button2 クリックイベントのコードは、クリップ領域を設定してから図形を描画した後に Button1Click(nil) を実行して、 Button1 のコードを実行するようにしています。EXE を起動して Button2 をクリックした結果が下図です。クリップが解除されずに描画されています。

イベントのコードは、イベントとして実行された時と、単なる手続き (メソッドあるいは関数) として実行した時とでは違いがあることが確認できます。

このサンプルでは、Button1 のコードを実行する前に Repaint を実行すれば、クリップ領域がリセットされて描画内容もクリアされ、Button1 をクリックした時と同じ結果になります。



図4
Button2 クリップでクリップ描画した後に、クリップなしの Button1 のコードを実行
  • クリップが解除されていない

リスト2
TCanvas における矩形クリップ領域の設定
イベントのコードを実行しても、イベントとして処理されるわけではない		 
//=============================================================================
//  TCanvas へ図形を描画
//  クリップなし
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Canvas.Brush.Style := bsSolid;

  // TCanvas を白で塗り潰す (描画のクリア)
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Canvas.ClipRect);

  // 描画ルーチンを実行
  DrawToCanvas(Self.Canvas);
end;

//=============================================================================
//  TCanvas へ図形を描画
//  矩形領域のクリップあり
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LLeft   : Integer;
  LTop    : Integer;
  LRight  : Integer;
  LBottom : Integer;
begin
  Canvas.Brush.Style := bsSolid;

  // TCanvas を白で塗り潰す (描画のクリア)
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Canvas.ClipRect);


  // 描画をクリップする矩形領域を設定
  LLeft   := 20 + 30;
  LTop    := 70;
  LRight  := LLeft + 90;
  LBottom := LTop + 80;
  IntersectClipRect(Canvas.Handle, LLeft, LTop, LRight, LBottom);

  // 描画ルーチンを実行
  DrawToCanvas(Self.Canvas);

  // Repaint を実行するとクリップがリセットされて描画もクリフされる
  // Repaint;

  // Button1 クリックイベントのコードを実行
  // クリップは解除されない 
  Button1Click(nil);
end;

//-----------------------------------------------------------------------------
//  TCanvaws へのテスト用描画ルーチン
//-----------------------------------------------------------------------------
procedure TForm1.DrawToCanvas(ACanvas: TCanvas);
begin
  ACanvas.Brush.Style := bsSolid;

  // 矩形を描画
  ACanvas.Brush.Color := clRed;
  ACanvas.FillRect(Rect(20, 20, 180, 120));

  // 楕円を描画
  ACanvas.Pen.Color := clBlack;
  ACanvas.Brush.Color := clGreen;
  ACanvas.Ellipse(80, 90, 180, 190);
end;



03_印刷時 ( Printer.Canvas ) の矩形クリップ領域の設定


TPrinter.Canvas のクリップ、つまり印刷領域のクリップの例です。印刷可能な領域と用紙の上下左右との間の長さを余白といっています。IntersectClipRect 関数は、余白の設定にも使用できますが、クリップする前の描画はそのままです。、IntersectClipRect 関数によるクリップは、下図の結果で確認できるように、ページ単位です。

このサンプルでは、用紙の指定、余白と図形の描画を mm (ミリメートル) 単位で設定するために、拙作のプリンタ設定コンポーネント TplSetPrinter を使用しています。
文書としてのテキスト (文字列) の印刷の場合、余白の設定も、IntersectClipRect 関数で矩形範囲をクリップしても、その右端で文字列が自動的に折り返し描画するわけではありません。
文書としてのテキスト (文字列) の印刷には、TRichEdit の機能を使用する方法や、TCanvas.TextRect メソッドを使用する方法があります。



図5
1 ページ目はクリップあり
  • これは印刷スプールの画像
図6
2 ページ以降はクリップなし
  • これは印刷スプールの画像

リスト3
印刷時の矩形クリップ領域の設定。IntersectClipRect 関数によるクリップはページ単位		 
  function mmToPixelsX(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
  function mmToPixelsY(ASetPrt: TplSetPrinter; AValue: Integer): Integer;

var
  Form1: TForm1;

implementation

uses
  Printers;

{$R *.dfm}

//=============================================================================
//  Printer.Canvas へ図形を描画
//  IntersectClipRect 関数による矩形領域のクリップ
//  クリップの処理はページ単位で必要
//
//  uses に Printers が必要
//  拙作のプリンタ設定コンポーネント TplSetPrinter も使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LLeft   : Integer;
  LTop    : Integer;
  LRight  : Integer;
  LBottom : Integer;
begin
  plSetPrinter1.PaperNumber := DMPAPER_A4;
  plSetPrinter1.Orientation := poLandscape;

  Printer.Title := '描画領域のクリップ';
  Printer.BeginDoc;
  try
    while True do begin
      if Printer.PageNumber = 1 then begin
        // 描画をクリップする矩形領域を設定
        LLeft   := mmToPixelsX(plSetPrinter1, 20 + 30);
        LTop    := mmToPixelsY(plSetPrinter1, 70);
        LRight  := LLeft + mmToPixelsX(plSetPrinter1, 90);
        LBottom := LTop + mmToPixelsY(plSetPrinter1, 80);
        IntersectClipRect(Printer.Canvas.Handle, LLeft, LTop, LRight, LBottom);
      end;

      Canvas.Brush.Style := bsSolid;

      // 描画ルーチンを実行
      DrawToCanvas(Printer.Canvas);

      if Printer.PageNumber = 2 then Break;
      Printer.NewPage;
    end;
  finally
    Printer.EndDoc;
  end;
end;

//-----------------------------------------------------------------------------
//  TCanvaws へのテスト用描画ルーチン
//-----------------------------------------------------------------------------
procedure TForm1.DrawToCanvas(ACanvas: TCanvas);
var
  LX1 : Integer;
  LX2 : Integer;
  LY1 : Integer;
  LY2: Integer;
begin
  ACanvas.Brush.Style := bsSolid;

  // 矩形を描画
  ACanvas.Brush.Color := clRed;
  LX1 := mmToPixelsX(plSetPrinter1, 20);
  LY1 := mmToPixelsX(plSetPrinter1, 20);
  LX2 := mmToPixelsY(plSetPrinter1, 180);
  LY2 := mmToPixelsY(plSetPrinter1, 120);
  ACanvas.FillRect(Rect(LX1, LY1,LX2, LY2));

  // 楕円を描画
  ACanvas.Pen.Color := clBlack;
  ACanvas.Brush.Color := clGreen;
  LX1 := mmToPixelsX(plSetPrinter1, 80);
  LY1 := mmToPixelsX(plSetPrinter1, 90);
  LX2 := mmToPixelsY(plSetPrinter1, 180);
  LY2 := mmToPixelsY(plSetPrinter1, 190);
  ACanvas.Ellipse(LX1, LY1,LX2, LY2);
end;

//-----------------------------------------------------------------------------
//  mm 単位を TPrinter.Canvas のピクセル数に変換
//  横方向用
//-----------------------------------------------------------------------------
function mmToPixelsX(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
begin
  Result := Trunc(AValue * ASetPrt.XResolution / 25.4);
end;

//-----------------------------------------------------------------------------
//  mm 単位を TPrinter.Canvas のピクセル数に変換
//  縦方向用
//-----------------------------------------------------------------------------
function mmToPixelsY(ASetPrt: TplSetPrinter; AValue: Integer): Integer;
begin
  Result := Trunc(AValue * ASetPrt.YResolution / 25.4);
end;



04_ExcludeClipRect 関数による描画のクリップ


ExcludeClipRect 関数で矩形範囲を指定すると、元のクリップ領域と、ExcludeClipRect 関数で設定した矩形領域と重なる矩形範囲内は描画しないようにすることができます。その例です。
ExcludeClipRect 関数によるクリップでは、TCanvs.ClipRect プロパティの値は変わりません。



図7
クリップなし
図8
クリップした結果
  • ExcludeClipRect 関数で設定した矩形領域内は描画しない

リスト4
ExcludeClipRect 関数による描画のクリップ		 
//=============================================================================
//  TCanvas へ図形を描画
//  クリップなし
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  Canvas.Brush.Style := bsSolid;

  // TCanvas を白で塗り潰す (描画のクリア)
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Canvas.ClipRect);

  // 描画ルーチンを実行
  DrawToCanvas(Self.Canvas);
end;

//=============================================================================
//  TCanvas へ図形を描画
//  ExcludeClipRect 関数によるクリップ
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  LLeft   : Integer;
  LTop    : Integer;
  LRight  : Integer;
  LBottom : Integer;
begin
  Canvas.Brush.Style := bsSolid;

  // TCanvas を白で塗り潰す (描画のクリア)
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Canvas.ClipRect);


  // 描画をクリップする矩形領域を設定
  LLeft   := 20 + 30;
  LTop    := 70;
  LRight  := LLeft + 90;
  LBottom := LTop + 80;
  ExcludeClipRect(Canvas.Handle, LLeft, LTop, LRight, LBottom);

  // 描画ルーチンを実行
  DrawToCanvas(Self.Canvas);
end;

//-----------------------------------------------------------------------------
//  TCanvaws へのテスト用描画ルーチン
//-----------------------------------------------------------------------------
procedure TForm1.DrawToCanvas(ACanvas: TCanvas);
begin
  ACanvas.Brush.Style := bsSolid;

  // 矩形を描画
  ACanvas.Brush.Color := clRed;
  ACanvas.FillRect(Rect(20, 20, 180, 120));

  // 楕円を描画
  ACanvas.Pen.Color := clBlack;
  ACanvas.Brush.Color := clGreen;
  ACanvas.Ellipse(80, 90, 180, 190);
end;



ExcludeClipRect 関数によるクリップも、IntersectClipRect 関数によるクリップも、クリップする前の描画内容はそのままです。
下図では、フォームの Canvas 全体を塗り潰してから ExcludeClipRect 関数でクリップ領域を設定しています。その後に図形を描画していますが、クリップした部分は塗り潰した色になっています。



図9
クリップした結果
  • ExcludeClipRect 関数で設定した矩形領域内は、クリップする前の描画のまま

リスト5
ExcludeClipRect 関数で設定した矩形領域内は、クリップする前の描画のまま		 
//=============================================================================
//  TCanvas へ図形を描画
//  ExcludeClipRect 関数による矩形領域のクリップ
//  クリップする前の描画はそのまま
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LLeft   : Integer;
  LTop    : Integer;
  LRight  : Integer;
  LBottom : Integer;
begin
  Canvas.Brush.Style := bsSolid;

  // TCanvas を塗り潰す
  Canvas.Brush.Color := clSkyBlue;
  Canvas.FillRect(Canvas.ClipRect);

  // 描画をクリップする矩形領域を設定
  LLeft   := 20 + 30;
  LTop    := 70;
  LRight  := LLeft + 90;
  LBottom := LTop + 80;
  ExcludeClipRect(Canvas.Handle, LLeft, LTop, LRight, LBottom);

  // 描画ルーチンを実行
  DrawToCanvas(Self.Canvas);
end;

//-----------------------------------------------------------------------------
//  TCanvaws へのテスト用描画ルーチン
//-----------------------------------------------------------------------------
procedure TForm1.DrawToCanvas(ACanvas: TCanvas);
begin
  ACanvas.Brush.Style := bsSolid;

  // 矩形を描画
  ACanvas.Brush.Color := clRed;
  ACanvas.FillRect(Rect(20, 20, 180, 120));

  // 楕円を描画
  ACanvas.Pen.Color := clBlack;
  ACanvas.Brush.Color := clGreen;
  ACanvas.Ellipse(80, 90, 180, 190);
end;