Delphi Programming / Object Pascal
サイトのトップページへ リンクのページへ ロゴマーク
[掲載 2012年10月28日] [更新 2017年05月28日] 画像・図形の移動リサイズ関係サンプル
   
画像・図形の移動リサイズ関係サンプル 
R150_リージョンによる星型画像とマウスイベント透過
動作確認等 Windows XP(SP3) + Delphi XE Pro
Windows 7 U64(SP1) + Delphi XE Pro
R150_ResizeStarShapeRgn.zip [721 KB] 2017年05月28日版(EXE同梱)







01_リージョンによる星型画像とマウスイベントの透過


リージョンを使用した星型の図形描画用クラスのテストコードです.
パスは,輪郭または塗りつぶされた一つまたは複数の図形および曲線・直線の集まりです.一方,リージョンは画像です.

指定座標値を結ぶリージョンを作成し,その内部を Brush の指定で塗り潰した後,生成したリージョンの輪郭を描画します.リージョンの場合,塗り潰しも輪郭の描画にも,現在の Brush の設定が使用されます.
リージョンは画像ですから,Brush で「塗り潰し」ということになります.塗り潰し用と,輪郭用の両方のプロパティの実装が必要となるでしょう.

作成したコントロールのクラスは,マウスイベントの透過機能を実装しています.これは,実際の画像部分以外では,マウスダウンのイベントをスルーして,このコントロールの下にあるコントロールにマウスダウンのメッセージを送ります.
リージョンのハンドルをグローバルな変数にすることにより,この機能を実現しています.

GDI+ ではパスの機能が追加されていて,パスの内部,輪郭線の検出が可能です.パスで構成した「図形」をリージョンにしなくてもマウスイベントの透過機能を実装できます.


図1
設計時画面
図2
右の画像を選択して
  • マウスカーソルを下の画像に移動
図3
マウスボタンを押下
  • マウスのイベントが透過されて,下の画像が選択される
図4
Brush のスタイルを変更
  • Brush.Style := bsDiagCross;
    Brush.Color := clGray;
    とした場合

リスト1
リージョンを使用した星型の画像描画用クラスのテストコード
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    ControlList : TList;
  end;

var
  Form1: TForm1;

implementation

uses
  plResizeBaseControl,
  plResizePicture,
  plResizeStarShapeRgn;

{$R *.DFM}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Caption        := 'リージョンによる星型画像とマウスイベント透過';
  Panel1.Caption := '';

  //チラつき防止対策
  Panel1.DoubleBuffered := True;
  Panel1.ControlStyle   := Panel1.ControlStyle + [csOpaque];

  //リサイズコントロールを格納する配列を生成
  ControlList := TList.Create;
end;

//=============================================================================
//  フォームが破棄される時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(ControlList);
end;

//=============================================================================
//  [生成]ボタン
//  リージョンを使用した星型の画像を表示
//  マウスイベントの透過テストも兼ねている
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  i      : Integer;
  Compo  : TplResizeBaseControl;
  AIndex : Integer;
begin
  //現在表示中のコントロールを全て削除
  for i := ControlList.Count - 1 downto 0 do begin
    Compo := TplResizeBaseControl(ControlList[i]);
    FreeAndNil(Compo);
    ControlList.Delete(i);
  end;

  //画像
  AIndex := ControlList.Add(TplResizePicture.Create(Self));
  with TplResizePicture(ControlList[AIndex]) do begin
    Parent     := Panel1;
    Picture.LoadFromFile('503.bmp');
    Picture.Bitmap.Transparent := True;
    SetRubberBandBounds(20, 20, width, Height);
  end;

  //星型の画像
  AIndex := ControlList.Add(TplResizeStarShapeRgn.Create(Self));
  with TplResizeStarShapeRgn(ControlList[AIndex]) do begin
    Parent      := Panel1;
    Brush.Color := clWebBlanchedAlmond;
    TransEvent  := True;
    SetRubberBandBounds(20, 20, 200, 200);

    DragResize.RubberBand.LineWidth := 1;
  end;
end;

//=============================================================================
//  Panel1のOnMouseDownイベント処理
//  選択を解除
//=============================================================================
procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i : Integer;
begin
  if Button = mbLeft then begin
    for i := 0 to ControlList.Count - 1 do begin
      TplResizeBaseControl(ControlList[i]).Selected := False;
    end;
  end;
end;

end.


リスト2
リージョンを使用した星型の画像描画用コントロールのクラス
マウスイベント透過機能付き
unit plResizeStarShapeRgn;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  plResizeBaseControl;

type
  TplResizeStarShapeRgn = class(TplResizeBaseControl)
  private
    FRgn        : HRGN;
    FTransEvent : Boolean;
  protected
    procedure CMHitTest(var Message: TCMHitTest); message CM_HITTEST;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DrawRoutine(ACanvas: TCanvas; OffSetX: Integer=0;
      OffSetY: Integer=0); override;
    property TransEvent : Boolean read FTransEvent write FTransEvent;
  end;

implementation

uses Math;

{ TplResizeStarShapeRgn }

//-----------------------------------------------------------------------------
//  Create処理
//  ペンの色とサイズ初期値を設定
//-----------------------------------------------------------------------------
constructor TplResizeStarShapeRgn.Create(AOwner: TComponent);
begin
  inherited;

  Pen.Width   := 3;
  Pen.Color   := clBlack;
  FTransEvent := False;
end;

//-----------------------------------------------------------------------------
//  Destroy処理
//  リージョンの破棄
//-----------------------------------------------------------------------------
destructor TplResizeStarShapeRgn.Destroy;
begin
  if FRgn <> 0 then DeleteObject(FRgn);
  inherited;
end;

//-----------------------------------------------------------------------------
//  CM_HITTESTメッセージ処理
//  マウスとキーのイベントを透過させるかさせないかの処理
//  リージョン内であればマウスイベントを捕捉し,それ以外は透過させる
//  このメッセージはoverrideする必要はない(TplResizeBaseControlの同名メッセージ
//  を継承する必要はない)
//-----------------------------------------------------------------------------
procedure TplResizeStarShapeRgn.CMHitTest(var Message: TWMNCHitTest);
begin
  if FRgn = 0 then begin
    inherited;
  end else begin
    if (PtInRegion(FRgn, Message.XPos, Message.YPos) or
       (not FTransEvent)) then begin
      inherited;
    end else begin
      Message.Result := 0;
    end;
  end;
end;

//-----------------------------------------------------------------------------
//  実際の描画処理を実行するRoutineメソッド
//  三角関数類の使用には,usesにMathが必要
//-----------------------------------------------------------------------------
procedure TplResizeStarShapeRgn.DrawRoutine(ACanvas: TCanvas; OffSetX: Integer=0;
  OffSetY: Integer=0);
var
  Points : array [0..4] of TPoint;
  Angle  : Single;
  HalfW  : Integer;
  HalfH  : Integer;
begin
  inherited;

  HalfW := DrawWidth  div 2;
  HalfH := DrawHeight div 2;

  //星型の座標を設定
  //頂点の数が5なので,5角形を描く時のように角度から各位置を計算
  Angle :=  DegToRad(360 / 5) * 2;
  Points[0].X := DrawLeft + HalfW;
  Points[0].Y := DrawTop;
  Points[1].X := DrawLeft + HalfW + Round(Sin(Angle) * HalfW);
  Points[1].Y := DrawTop  + DrawHeight;
  Points[2].X := DrawLeft;
  Points[2].Y := DrawTop  + HalfH - Round(Cos(Angle * 2) * HalfH);
  Points[3].X := DrawLeft + DrawWidth;
  Points[3].Y := DrawTop  + HalfH - Round(Cos(Angle * 3) * HalfH);
  Points[4].X := DrawLeft + HalfW + Round(Sin(Angle * 4) * HalfW);
  Points[4].Y := DrawTop  + DrawHeight;

  //以前のリージョンを破棄
  if FRgn <> 0 then DeleteObject(FRgn);
  //上の配列からリージョンを作成する
  FRgn := CreatePolygonRgn(Points, Length(Points), WINDING );
  try
    //リージョンを現在のBrushで塗りつぶす
    ACanvas.Brush := Brush;
    PaintRgn(ACanvas.Handle, FRgn);

    //Brushを指定して輪郭を描画する
    //リージョンの輪郭はBrushであることに注意.リージョンは図形なので
    ACanvas.Brush.Color := Pen.Color;
    ACanvas.Brush.Style := bsSolid;
    //リージョンの輪郭を描画
    FrameRgn(ACanvas.Handle, FRgn, ACanvas.Brush.Handle, Pen.Width, Pen.Width);
  finally
    //ここではリージョンを破棄しなで,マウス透過のチェックに使用する
  end;
end;

end.