画像・図形の移動リサイズ関係サンプル
R050_コンテナコントロールと描画コントロールの操作 |
| 動作確認等 |
Windows 7 U64(SP1) + Delphi XE(UP1) Pro |
 |
R050_ContainerOperation.zip [5,467 KB] 2017年09月24日版 (EXE 同梱) |
|
2017年09月より以前に提供していた [画像・図形の移動リサイズサンプル] では，コンテナ用コントロールは機能を逐次追加していく方式の記事でした．2017年09月の更新では最初からある程度整備した状態で提供しています．
既に画像描画用と直線描画用のコントロールの説明をしていますのです，本ページではそれらとコンテナ用のコントロールを組み合せた動作についてテストしていきます． |
描画コントロールは CtrlList という配列で管理するようにしています．
描画コントロールを生成して Parent プロパティでこのコンテナコントロールを指定すると自動的にこの配列に格納されます．Add メソッドで追加する必要はありません．また，解放，破棄の処理もこの配列が自動で実行するようにしています． |
TplContainerPanel.CtrlList : TplCtrlList
TplCtrlList = class(TList<TplBaseDragResize>)
| 02_ラバーバンドによる描画コントロールの選択と移動 |
|
描画コントロールはマウスボタンでクリックすると選択状態になります．
複数の描画コントロールを選択する方法としてラバーバンドによる方法があります．[Ctrl] キーを押下したままで描画コントロール以外の場所をマウスでクリックして，そのままドラックします．ドラッグを開始したら [Ctrl] を押下していなくてもラバーバンドは描画されます．
選択操作を中断したい場合は [ESC] キーを押します．
[Ctrl] を押さないで描画コントロール以外の場所をクリックすると，全ての描画コントロールの選択の解除となりますが，SelectMode プロパティの値を True にすると，[Ctrl] キーを押さなくてもラバーバンドの描画を開始できます．SelectMode の値は，意識的に False にしない限り True のままです．
複数の描画コントロールが選択された状態で，選択中のどれかの描画コントロールを移動すると，選択中の全ての描画コントロールも同時に移動します．リサイズは同時にできません．
SelectAllCtrls メソッドを実行すると全ての描画コントロールを選択状態にすることができます．
|
TplContainerPanel.SelectMode : Boolean
TplContainerPanel.SelectAllCtrls
 |
図1
ラバーバンドによる複数の描画コントロールの選択 |
 |
図2
選択された状態
- 同時移動ができる
- リサイズは同時にできない
- グラブハンドルを操作すると選択が解除される
|
| 03_[ Ctrl ] キーと描画コントロールクリックによる複数選択 |
| [Ctrl] キーを押したまま描画コントロールをクリックすることでも，複数の描画コントロールを選択することができます． |
| 04_矢印キーによる描画コントロールの移動とリサイズ |
|
選択中の描画コントロールは矢印キーで移動リサイズできます．
ただし，親フォームの ActiveControl の値がコンテナコントロールになっていないとキー操作は無効です．描画コントロールまたはコンテナコントロールの任意の場所をクリックすると，コンテナコントロールを，親フォームの ActiveControl にすることができます．
[Shift] を押したままの状態で矢印キーを押すとリサイズになります．
移動，リサイズは 1 ピクセル単位での操作となっています．
|
| コンテナコントロール上で，描画コントロール以外の場所をマウスの左ボタンをクリックすると全ての選択状態を解除します．また，DeSelectAllCtrls メソッドは全ての選択を解除します． |
TplContainerPanel.DeSelectAllCtrls
| DeleteCtrl メソッドは指定インデックスの描画コントロールを削除します．また，DeleteAllCtrls メソッドは全ての描画コントロールを削除します． |
TplContainerPanel.DeleteCtrl(AIndex : Integer)
TplContainerPanel.DeleteAllCtrls
| 07_ポップアップメニュー ( TPopupMenu ) の実装 |
| ポップアップメニューは，コンテナコントロールと描画コントロール用と別々に設定しておくと便利かも知れません．描画コントロールは個別にポップアップメニューを指定することができます． |
TplContainerPanel.PopupMenu
TplBaseDragResize.PopupMenu
[備考]
図では [削除] に [Del] キー等を割り当てていますが，これは TPopupMenu に直接ショートカットを設定しても [Del] キーは検出できません．TActionManager のアクションとしてグローバルに設定して，そのアクションを TPopupMenu の該当項目に設定すれば検出できます．
|
 |
図3
単独選択状態の時のポップアップメニューの例
|
 |
図4
複数選択状態の時のポップアップメニューの例
|
| 08_選択中の描画コントロールの整列 ( 位置合わせ ) |
| 描画コントロールの位置合わせ用に以下のメソッドを実装しています．AlignSelectedCtrls メソッドで alCustom を指定すると左右の中央合わせになります．CascadeSelectedCtrls はカスケード表示用のメソッドです．引数の値だけ移動した位置に描画コントロールを表示します． |
TplContainerPanel.AlignSelectedCtrls(AType: TAlign)
TplContainerPanel.CascadeSelectedCtrls(ADistance: Integer)
 |
図5
上端揃えの例 |
 |
図6
左端揃えの例 |
 |
図7
カスケード表示の例 |
| 下の図は右端揃えの例ですが，直線描画コントロールの場合は描画コントロールの右端ではなく，実際の描画範囲の右端になります． |
 |
図8
右端揃えの例
- 直線描画コントロールの画像は，描画コントロールの右端ではなく描画範囲の右端が対象となる
|
リスト1
選択中の描画コントロールの位置合わせの例 |
//=============================================================================
// 左端揃え
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
FBackCtrl.AlignSelectedCtrls(alLeft);
end;
//=============================================================================
// 上端揃え
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
begin
FBackCtrl.AlignSelectedCtrls(alTop);
end;
//=============================================================================
// カスケード整列
//=============================================================================
procedure TForm1.Button5Click(Sender: TObject);
begin
FBackCtrl.CascadeSelectedCtrls(20);
end;
| 選択中の描画コントロールのインデックスは，ItemIndex プロパティで取得できます．この値から実際の描画コントロールのオブジェクトを以下に示すコードで取得できます． |
TplContainerPanel.CtrlList.ItemIndex : Integer
 |
図9
選択中の描画コントロールの取得 |
//=============================================================================
// 選択中の描画コントロールを取得
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
LIndex : Integer;
LCtrl : TplBaseDragResize;
LText : string;
begin
//選択中の描画コントロールのインデックスを取得
//複数選択の時はZオーダ(作成順)の一番下のインデックス
LIndex := FBackCtrl.CtrlList.ItemIndex;
//そのインデックスの描画コントロールのオブジェクトを取得
LCtrl := FBackCtrl.CtrlList[LIndex];
//確認のためにクラス名を表示
LText := 'クラス名' + sLineBreak + LCtrl.ClassName;
MessageBox(Handle, PChar(LText), '取得結果', MB_ICONINFORMATION);
end;
| 10_描画コントロールの Z オーダ ( 重なり順序 ) の変更 |
|
Z オーダは描画コントロールの作成順と同じ意味で，描画コントロールの配列の格納順です．
最初に生成した描画コントロールは Z オーダが一番低く，最背面に表示され，最後に生成した描画コントロールは最前面に表示されます．この順番を変更します．
BringToFrontCtrl メソッドは，指定インデックスの描画コントロールを最前面に表示するようにします．インデックスの指定がない場合は選択中の描画コントロールを最前面に表示します．複数の描画コントロールが選択されている時は，Z オーダが一番低い描画コントロールが対象となります．
SendToBackCtrl( は指定インデックスの描画コントロールを最背面に移動します．インデックスの指定がない場合は選択中の描画コントロールを最背面に移動します．
SetZOrderCtrl は，指定描画コントロールまたは指定インデックスの描画コントロールを，指定の Z オーダに配置します．
インデックスが 0 の描画コントロールは最背面の描画コントロールです．最前面の描画コントロールのインテックスは描画コントロールの数より 1 だけ少ない値で，CtrlList.Count - 1 と同じ値です．
下の図とコードは，Z オーダを 1 つだけ上に移動する例です．
|
TplContainerPanel.BringToFrontCtrl(AIndex)
TplContainerPanel.SendToBackCtrl(AIndex)
TplContainerPanel.SetZOrderCtrl(ACtrl, NewIndex)
TplContainerPanel.SetZOrderCtrl(OldIndex, NewIndex)
 |
図10
Z オーダ変更前 |
 |
図11
背景が透明のヒヨコの画像を 1 つ上に移動 |
//=============================================================================
// 描画コントロールのZオーダを変更
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
LIndex : Integer;
begin
LIndex := 1;
//現在よりもZオーダを1つ上にする
FBackCtrl.SetZOrderCtrl(LIndex, LIndex + 1);
end;
| 11_選択中の描画を TGPBitmap または TBitmap に変換 |
|
以下のメソッドを使用すると，選択中の描画を合成した結果としての画像を取得することができます．
GPBitmapFromSelectedCtrls は TGPBitmap のオブジェクト， BitmapFromSelectedCtrls は TBitmap の画像として取得します．
本サンプルではまず TGPbitmap を取得し，それを TBitmap の画像としてメモリストリームに保存しています．保存したそのビットマップを TImage のビットマップに読み込んで表示します．
次のボタンクリックのコードでは，TBitmap の画像として取得し，それを TImage に表示します．
|
TplContainerPanel.GPBitmapFromSelectedCtrls: TGPBitmap
TplContainerPanel.BitmapFromSelectedCtrls(ABitmap: TBitmap)
 |
図12
合成画像の作成
- 複数の描画コントロールを選択
- これらを 1 つの「画像」にして右側の TImage に表示
|
リスト4
選択中の描画を TGPBitmap または TBitmap に変換 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtDlgs, ExtCtrls, plGPResizeImage, Menus,
plBaseDragResize, GDIPAPI, GDIPOBJ, GDIPUTIL, plContainerPanel;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Panel2: TPanel;
Image1: TImage;
Splitter1: TSplitter;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private 宣言 }
FBackCtrl : TplContainerPanel;
FResizeImage : TplGPResizeImage;
FLoadInitDir : string;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
uses
Math,
plGPResizeLine;
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Panel1.Caption := '';
Panel2.Caption := '';
FLoadInitDir := ExpandFileName('..\..\Images');
//背景用のコントロール生成
FBackCtrl := TplContainerPanel.Create(Self);
FBackCtrl.Parent := Self;
FBackCtrl.Align := alClient;
end;
//=============================================================================
// 画像ファイルを読み込み直線描画コントロールも生成して表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LFilePath : array [0..2] of string;
LNo : Integer;
FResizeLine : TplGPResizeLine;
begin
FBackCtrl.DeleteAllCtrls;
LFilePath[0] := ExpandFileName('..\..\Images\503.bmp');
LFilePath[1] := ExpandFileName('..\..\Images\503_Transe.bmp');
LFilePath[2] := ExpandFileName('..\..\Images\046641.gif');
for LNo := 0 to Length(LFilePath) - 1 do begin
FResizeImage := TplGPResizeImage.Create(Self);
FResizeImage.Parent := FBackCtrl;
FResizeImage.InverseDisp := True;
FResizeImage.LoadFromFile(LFilePath[Lno]);
FResizeImage.Left := LNo * 50;
FResizeImage.Top := LNo * 50;
end;
FResizeLine := TplGPResizeLine.Create(Self);
FResizeLine.Parent := FBackCtrl;
FResizeLine.InverseDisp := True;
FResizeLine.PenWidth := 20.0;
FResizeLine.PenColor := $FF00A0FF;
FResizeLine.StartArrow := True;
FResizeLine.Left := 200;
FResizeLine.Top := 200;
end;
//=============================================================================
// 選択中の描画コントロールを削除
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
FBackCtrl.DeleteCtrl();
end;
//=============================================================================
// TplContainerScrollBox.GPBitmapFromSelectedCtrlsメソッドの使用例
// 選択中の描画のTGPBitmapを取得してビットマップとしてメモリストリームに保存
//
// 保存したTBitmapをTImageに表示
// TImageへの表示はコーディングによって表示結果が異なる
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
LGPBitmap : TGPbitmap;
LStream : TMemoryStream;
LImgGUID : TGUID;
begin
if FBackCtrl.CtrlList.Count = 0 then exit;
Image1.Picture.Assign(nil);
LStream := TMemoryStream.Create;
//新規にTGPBitmapを生成して選択中の描画を取得
LGPBitmap := TGPBitmap.Create;
LGPBitmap := FBackCtrl.GPBitmapFromSelectedCtrls;
try
Image1.Width := LGPBitmap.GetWidth;
Image1.Height := LGPBitmap.GetHeight;
//それをビットマップ画像としてメモリストリームに保存
if GetEncoderClsid('image/bmp', LImgGUID) >= 0 then begin
LGPBitmap.Save(TStreamAdapter.Create(LStream), LImgGUID);
LStream.Position := 0;
//保存したビットマップ画像を読み出してTimageに表示
Image1.Picture.Bitmap.AlphaFormat := afDefined;
Image1.Picture.Bitmap.LoadFromStream(LStream);
end;
finally
FreeAndNil(LGPBitmap);
FreeAndNil(LStream);
end;
end;
//=============================================================================
// TplContainerScrollBox.BitmapFromSelectedCtrlsメソッドの使用例
// 選択中の描画をTBitmapとして取得
//
// 取得したしたTBitmapをTImageに表示
// TImageへの表示はコーディングによって表示結果が異なる
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
LBitmap : TBitmap;
begin
if FBackCtrl.CtrlList.Count = 0 then exit;
Image1.Picture.Assign(nil);
LBitmap := TBitmap.Create;
try
LBitmap.AlphaFormat := afDefined;
FBackCtrl.BitmapFromSelectedCtrls(LBitmap);
Image1.Width := LBitmap.Width;
Image1.Height := LBitmap.Height;
Image1.Picture.Bitmap.Assign(LBitmap);
finally
FreeAndNil(LBitmap);
end;
end;
end.
| 12_選択中の描画を合成して 1 つの別の画像として表示 |
選択中の描画内容を合成して 1 つの画像にするサンプルです．
方法は前項のサンプルと同じです．合成した画像としての TGPBitmap オブジェクトを取得したら，画像描画用のコントロールを新規に作成します．そしてその GPbitmap プロパティに取得した TGPbitmap を代入するだけです． |
TplContainerPanel.GPBitmapFromSelectedCtrls: TGPBitmap
TplGPResizeImage.GPBitmap: TGPBitmap
 |
図13
合成画像の作成
|
 |
図14
処理結果としての画像
- 新規に作成した画像描画用のコントロールで表示 (右側)
|
リスト5
選択中の描画を合成して画像にし，別の画像描画用コントロールで表示 |
//=============================================================================
// TplContainerScrollBox.GPBitmapFromSelectedCtrlsメソッドの使用例
// 選択中の描画を1つのTGPBitmap画像して描画コントロールで表示
//
// つまり合成画像の作成
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
LGPBitmap : TGPbitmap;
begin
if FBackCtrl.CtrlList.Count = 0 then exit;
LGPBitmap := TGPBitmap.Create;
LGPBitmap := FBackCtrl.GPBitmapFromSelectedCtrls;
try
//取得したTGPBitmapを画像描画コントロールを作成してそこに表示
FResizeImage := TplGPResizeImage.Create(Self);
FResizeImage.Parent := FBackCtrl;
FResizeImage.InverseDisp := True;
FResizeImage.GPBitmap := LGPBitmap;
finally
FreeAndNil(LGPBitmap);
end;
end;
|
描画コントロールのダブルクリックは，コンポーネントの実行時生成と同じように，OnDblClick プロパティにメソッドを設定します．
描画コントロールをダブルクリックすると，その描画コントロールだけが選択状態になります．
例えば描画コントロールのサイズ，画像描画用コントロールでは画像のサイズの設定や画像編集用ダイアログの表示，図形では色設定ダイアログの表示等の用途に利用できます．
|
 |
図15
描画コントローをダブルクリックしてダイアログを表示
- ダブルクリックした描画コントロールだけが選択状態となる
|
リスト6
描画コントロールの OnDblClick イベントを設定してイベントを実行 |
//-----------------------------------------------------------------------------
// 描画コントロールのタプルクリックの例
// OnDblClickイベントにResizeCtrlDblClickメソッドを指定している場合
//-----------------------------------------------------------------------------
procedure TForm1.ResizeCtrlDblClick(Sender: TObject);
var
LText : string;
begin
if Sender is TplGPResizeImage then begin
LText := '画像 : ';
end else
if Sender is TplGPResizeLine then begin
LText := '直線 : ';
end;
LText := LText + TplBaseDragResize(Sender).ClassName;
MessageBox(Handle, pChar(LText), '情報', MB_ICONINFORMATION);
end;
|
描画コントロールを継承したクラスでは，WM_LBUTTONDBLCLK メッセージでダブルクリックを検出できます．こメッセージ内でダブルクリックした時の処理を実行することができます．
|
リスト7
継承したクラスては WM_LBUTTONDBLCLK メッセージでダブルクリックの処理ができる |
type
TplResizeImageEx = class(TplGPResizeImage)
protected
procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
message WM_LBUTTONDBLCLK;
end;
{ TplResizeImageEx }
//-----------------------------------------------------------------------------
// 描画コントロールのクラスを継承したクラスのWM_LBUTTONDBLCLKメッセージ
// ダブルクリックすると発生するメッセージ
//-----------------------------------------------------------------------------
procedure TplResizeImageEx.WMLButtonDblClk(var Message: TWMLButtonDblClk);
var
LIndex : Integer;
LText : string;
begin
inherited;
LIndex := Form1.FBackCtrl.CtrlList.ItemIndex;
LText := IntToStr(LIndex + 1) + ' ' + '番目の描画コントロール';
MessageBox(Form1.Handle, PChar(LText), '情報', MB_ICONINFORMATION);
end;
| 14_独自のマウスイベントの実装方法 - 画像のピクセルの色変更 |
|
ExitMouseEvent プロパティの値を True にすると独自のマウスイベントのコードが実行できるようになります．
描画用のコントロールでのマウス操作は移動リサイズです．コンテナコントロールでは描画コントロールの選択操作にマウスイベントを使用しています．ExitMouseEvent
の値を True すると，それらのマウスイベント (正確にはマウスメソッド) のコードを実行しなくります．
ただし注意が必要です．ExitMouseEvent
を False にすると元のマウスイベントのコードを実行するようになりますが，追加したコードも実行されてしまいます．その対策処理が必要です．具体的な処理方法はサンプルのコードで確認してください．
マウスのボタンを押下したら，マウスカーソル下の描画オブジェクトを GetPtInResizeCtrl で取得します．取得したら DrawRoutine で現在表示中の TGPBitmap を取得します．この TGPBitmap に何かしらの操作を実行して，その結果を GPBitmap プロパティに代入します．すると，画像が，代入した内容に置き換わります．
本サンプルでは「何かしらの操作」として，クリックしたマウスカーソル位置のピクセルと同じ色を別の色に変更します．
当然ですが，このような操作は画像描画用のコントロールに対して有効な操作です．ベクタ形式の描画である直線描画用コントロールでは，塗り潰し等はプロパティやメソッドで対応します．ベクタ形式の描画ではピクセルに対する操作という概念はありません．
|
TplContainerPanel.ExitMouseEvent: Boolean
TplContainerPanel.GetPtInResizeCtrl(X, Y): TplBaseDragResize
TplGPResizeImage.DrawRoutine (nil, AGPBitmap)
TplGPResizeImage.GPBitmap: TGPBitmap
[備考]
画像の加工や編集は，対象の画像だけを別画面で表示して行うという考え方もあります．そのような場合は描画用のコントロールとして，TplBaseDragResize またはその継承クラスを使用する必要はありません．
例えば TGraphicControl の派生コントロール等を生成して, そこに描画すればマウスイベントを自由に実装することができます．
|
 |
図16
EXE を起動して画像を読み込む |
 |
図17
[色変更モードにする] ボタンをクリック
|
 |
図18
操作モードを変更するまで何回も実行可能 |
リスト8
独自のマウスイベントの実装方法 - 画像のピクセルの色変更 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtDlgs, plContainerPanel, ExtCtrls, plGPResizeImage,
Buttons, plBaseDragResize, GDIPOBJ, GDIPAPI, GDIPUTIL;
type
OperateMode = (omNormal, omChangeColor);
TplContainerCtrl = class(TplContainerPanel)
private
FPixelColor : TGPColor;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
public
function ChangeColor(TarGPBitmap: TGPBitmap; OldColor, NewColor:
TGPColor): Boolean;
property PixelColor : TGPColor read FPixelColor write FPixelColor;
end;
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private 宣言 }
FBackCtrl : TplContainerCtrl;
FResizeImage : TplGPResizeImage;
FOperateMode : OperateMode;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
// コンテナコントロールを配置
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Panel1.Caption := '';
//コンテナコントロール生成
FBackCtrl := TplContainerCtrl.Create(Self);
FBackCtrl.Parent := Self;
FBackCtrl.Align := alClient;
end;
//=============================================================================
// 画像ファイルを読み込んで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LFilePath : array [0..1] of string;
LNo : Integer;
begin
//表示中の全ての描画コントロールを削除
FBackCtrl.DeleteAllCtrls;
//操作モードの初期設定
Button3Click(nil);
LFilePath[0] := ExpandFileName('..\..\Images\503.bmp');
LFilePath[1] := ExpandFileName('..\..\Images\503_Transe.bmp');
for LNo := 0 to Length(LFilePath) - 1 do begin
FResizeImage := TplGPResizeImage.Create(Self);
FResizeImage.Parent := FBackCtrl;
FResizeImage.InverseDisp := True;
FResizeImage.LoadFromFile(LFilePath[Lno]);
FResizeImage.Left := LNo * 30 + 20;
FResizeImage.Top := LNo * 30 + 20;
end;
end;
//=============================================================================
// 選択中の描画コントロールを削除
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
FBackCtrl.DeleteCtrl();
end;
//=============================================================================
// 操作モードの変更
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
if (FOperateMode = omChangeColor) or (Sender = nil) then begin
FOperateMode := omNormal;
FBackCtrl.ExitMouseEvent := False;
Button3.Caption := '色変更モードにする';
end else
if FOperateMode = omNormal then begin
FOperateMode := omChangeColor;
FBackCtrl.ExitMouseEvent := True;
FBackCtrl.PixelColor := aclRed;
Button3.Caption := '通常操作モードにする';
end;
end;
{ TplContainerCtrl }
//=============================================================================
// MouseDownメソッド処理
// マウスカーソル位置の色を取得してその色と同じピクセルの色を変更
//
// アンチエイリアスなしの拡大表示では換算係数を1のままで操作しても同じ
//=============================================================================
procedure TplContainerCtrl.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
LZoom : Integer;
LCtrl : TplBaseDragResize;
LRatio : Single;
LCtrlPos : TPoint;
LCtrlWidth : Integer;
LCtrlHeight : Integer;
LGPBitmap : TGPBitmap;
LOldColor : TGPColor;
LText : string;
begin
inherited;
//必ずこのコードを入れておく
if not Self.ExitMouseEvent then exit;
if Button <> mbLeft then exit;
//拡大表示している場合の換算係数
LZoom := ZoomValue;
LRatio := 100 / ZoomValue;
LCtrl := GetPtInResizeCtrl(X, Y);
if LCtrl <> nil then begin
if LCtrl is TplGPResizeImage then begin
//拡大前の画像の座標値に変換
LCtrlPos := Point(Trunc((X - LCtrl.Left) * LRatio),
Trunc((Y - LCtrl.Top) * LRatio));
//拡大前のサイズでTGPBitmapを作成
LCtrlWidth := Trunc(LCtrl.Width * LRatio);
LCtrlHeight := Trunc(LCtrl.Height * LRatio);
LGPBitmap := TGPBitmap.Create(LCtrlWidth, LCtrlHeight);
try
//拡大率を100%にして作成したTGPBitmapを取り出してピクセルの色を取得
SetZoomValue;
LCtrl.DrawRoutine(nil, LGPBitmap);
LGPBitmap.GetPixel(LCtrlPos.X, LCtrlPos.Y, LOldColor);
//そのピクセルと同じ色を全て指定した色に変更して，新しいGPBitmapとする
ChangeColor(LGPBitmap, LOldColor, FPixelColor);
TplGPResizeImage(LCtrl).GPBitmap := LGPBitmap;
finally
FreeAndNil(LGPBitmap);
end;
//拡大率を元にもどしておく
SetZoomValue(LZoom);
end else begin
LText := '画像が対象の操作です' + sLineBreak
+ '必要なら画像に変換してから操作してください';
MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
end;
end;
end;
//-----------------------------------------------------------------------------
// 指定した色のピクセルを別の色に変更する関数
//
// GDI+にはTColorMapで色を変更できるがTColorMapはカラーマップの変更なので
// 画面上では指定した色でないピクセルの色が変更される場合がある
//-----------------------------------------------------------------------------
function TplContainerCtrl.ChangeColor(TarGPBitmap: TGPBitmap; OldColor,
NewColor: TGPColor): Boolean;
var
LImgWidth : Integer;
LImgHeight : Integer;
LBmpData : TBitmapData;
LScanLine : PByte;
LpRGBQuad : PRGBQuad;
LDataStride : Integer;
LXPos : integer;
LYPos : Integer;
LAValue : Byte;
LRValue : Byte;
LGValue : Byte;
LBValue : Byte;
LOldColor : TGPColor;
begin
Result := False;
LImgWidth := TarGPBitmap.GetWidth;
LImgHeight := TarGPBitmap.GetHeight;
//TGPBitmapのビットマップデータ取得
if TarGPBitmap.LockBits(MakeRect(0, 0, LImgWidth, LImgHeight), ImageLockModeWrite,
PixelFormat32bppARGB, LBmpData) <> Ok then exit;
LScanLine := LBmpData.Scan0;
LDataStride := LBmpData.Stride;
for LYPos := 0 to LImgHeight - 1 do begin
LpRGBQuad := PRGBQuad(LScanLine);
for LXPos := 0 to LImgWidth - 1 do begin
LAValue := LpRGBQuad^.rgbReserved;
LRValue := LpRGBQuad^.rgbRed;
LGValue := LpRGBQuad^.rgbGreen;
LBValue := LpRGBQuad^.rgbBlue;
LOldColor := MakeColor(LAValue, LRValue, LGValue, LBValue);
if LOldColor = OldColor then begin
LpRGBQuad^.rgbReserved := GetAlpha(NewColor);
LpRGBQuad^.rgbRed := GetRed(NewColor);
LpRGBQuad^.rgbGreen := GetGreen(NewColor);
LpRGBQuad^.rgbBlue := GetBlue(NewColor);
end;
Inc(LpRGBQuad);
end;
Inc(LScanLine, LDataStride);
end;
TarGPBitmap.UnlockBits(LBmpData);
Result := True;
end;
end.
| 15_独自のマウスイベントの実装方法 - 矩形領域の選択操作 |
|
以下も ExitMouseEvent プロパティの値を True にして独自のマウスイベントのコードを実行するサンプルプログラムです．
今度はマウスの左ボタンを押すと，ラバーバンドを表示します．このラバーバンドは描画コードがない移動リサイズコントロールです．したがって，マウスあるいはキー操作で移動リサイズできます．ラバーバンドの移動可能な範囲は描画コントロールの領域内です．
位置とサイズが決まったら [決定実行] ボタンをクリックします．すると，ラバーバンドで指定した矩形領域内を指定の色で塗り潰します．
|
 |
図19
EXE を起動して画像を読み込む |
 |
図20
[領域選択モードにする] ボタンをクリック
- 画像描画コントロールでマウス左ボタンを押下するとラバーバンドを表示
- 処理の中止は [ESC] キー
- [ESC] キーが機能しない時は，ラバーバンドをクリックして再度 [ESC] を押下
|
 |
図21
マウスまたはキー操作で位置とサイズ設定
- 位置とサイズが決まったら [決定実行] ボタンをクリック
|
 |
図22
操作モード変更まで何度でも実行可能 |
|
選択した矩形範囲をコピーして別の描画コントロールを新規に生成してそこに描画するような場合は，以下のように選択操作モードを解除してください．
そうしないと，新規に作成した描画コントロールは移動リサイズできるのに，その他の描画コントロールは矩形範囲の選択モードのままとなってしまいます．それでは操作の一貫性が保てません．
|
SetZoomValue(LZoom);
//別の描画コントロールを生成した場合は選択操作モードを終了する
Form1.Button3Click(nil);
end;
リスト9
独自のマウスイベントの実装方法 - 矩形領域の選択操作 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtDlgs, plContainerPanel, ExtCtrls, plGPResizeImage,
Buttons, plBaseDragResize, GDIPOBJ, GDIPAPI, GDIPUTIL;
type
OperateMode = (omNormal, omSelectRect);
TplRectSelector = class(TplBaseDragResize)
private
FResizeCtrl : TplBaseDragResize;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
end;
TplContainerCtrl = class(TplContainerPanel)
private
FRectSelctor : TplRectSelector;
FResizeCtrl : TplBaseDragResize;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
public
procedure DeleteRectSelector;
procedure OperateFillRect(AGPColor: TGPColor);
end;
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private 宣言 }
FBackCtrl : TplContainerCtrl;
FResizeImage : TplGPResizeImage;
FOperateMode : OperateMode;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Panel1.Caption := '';
//コンテナコントロール生成
FBackCtrl := TplContainerCtrl.Create(Self);
FBackCtrl.Parent := Self;
FBackCtrl.Align := alClient;
//操作モードの初期設定
Button3Click(nil);
end;
//=============================================================================
// 画像ファイルを読み込んで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LFilePath : array [0..1] of string;
LNo : Integer;
begin
//表示中の全ての描画コントロールを削除
FBackCtrl.DeleteAllCtrls;
//操作モードの初期設定
Button3Click(nil);
LFilePath[0] := ExpandFileName('..\..\Images\503_Transe.bmp');
LFilePath[1] := ExpandFileName('..\..\Images\503.bmp');
for LNo := 0 to Length(LFilePath) - 1 do begin
FResizeImage := TplGPResizeImage.Create(Self);
FResizeImage.Parent := FBackCtrl;
FResizeImage.InverseDisp := True;
FResizeImage.LoadFromFile(LFilePath[Lno]);
FResizeImage.Left := LNo * 30 + 20;
FResizeImage.Top := LNo * 30 + 20;
end;
end;
//=============================================================================
// 選択中の描画コントロールを削除
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
FBackCtrl.DeleteCtrl();
end;
//=============================================================================
// 操作モードの変更
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
if (FOperateMode = omSelectRect) or (Sender = nil) then begin
FBackCtrl.FResizeCtrl := nil;
FBackCtrl.DeleteRectSelector;
FOperateMode := omNormal;
FBackCtrl.ExitMouseEvent := False;
Button3.Caption := '領域選択モードにする';
end else
if FOperateMode = omNormal then begin
FOperateMode := omSelectRect;
FBackCtrl.ExitMouseEvent := True;
Button3.Caption := '通常操作モードにする';
end else
end;
//=============================================================================
// 決定実行
// 指定した矩形領域に対して何かを実行
// ここでは矩形領域の塗り潰し
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
LText : string;
begin
if Assigned(FBackCtrl.FRectSelctor) then begin
FBackCtrl.OperateFillRect(aclBlue and $5FFFFFFF);
end else
if FBackCtrl.CtrlList.Count = 0 then begin
LText := '操作対象の描画オブジェクトがありません';
MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
end else begin
LText := '領域選択モードにして矩形領域を設定してください';
MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
end;
end;
{ TplContainerCtrl }
//=============================================================================
// コンテナコントロールを継承したクラスのMouseDownメソッド
// マウスクリックの位置に矩形領域選択用の移動リサイズコントロールを表示
//=============================================================================
procedure TplContainerCtrl.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
var
LRatio : Single;
LText : string;
begin
inherited;
//必ずこのコードを入れておく
if not ExitMouseEvent then exit;
if Button <> mbLeft then exit;
//拡大表示している場合の換算係数
LRatio := 100 / ZoomValue;
FResizeCtrl := GetPtInResizeCtrl(X, Y);
if FResizeCtrl <> nil then begin
DeleteRectSelector;
if FResizeCtrl is TplGPResizeImage then begin
//矩形領域指定用の移動リサイズコントロールを作成
//ラバーバンドとグラブハンドルを変更してみる
FRectSelctor := TplRectSelector.Create(nil);
FRectSelctor.Parent := Self;
FRectSelctor.GrabCornerOnly := True;
FRectSelctor.RubberBand.Pen.Style := psSolid;
FRectSelctor.RubberBand.Pen.Width := 2;
FRectSelctor.RubberBand.Pen.Color := clRed;
FRectSelctor.GrabBrushColor := clBlack;
FRectSelctor.GrabHandleSize := 6;
FRectSelctor.SetBounds(Trunc(X * LRatio), Trunc(Y * LRatio),
Trunc(FResizeCtrl.Width / 3 * LRatio),
Trunc(FResizeCtrl.Height/ 5 * LRatio));
FRectSelctor.FResizeCtrl := FResizeCtrl;
end else begin
LText := '画像が対象の操作です' + sLineBreak
+ '必要なら画像に変換してから操作してください';
MessageBox(Handle, PChar(LText), '情報', MB_ICONINFORMATION);
end;
end;
end;
//-----------------------------------------------------------------------------
// 引数で指定した色の矩形を描画する関数
// アンチエイリアスなしの拡大表示では換算係数を1のままで操作しても同じ
//
// はみ出し部部の調整はマウスとキーによる移動リサイズの際にも制限可能
// ただし本サンプルは描画コントロール内の塗り潰しなので描画はクリップされる
// したがってこの処理は実際には不要．矩形部分のコピー等の際は必要となる
//-----------------------------------------------------------------------------
procedure TplContainerCtrl.OperateFillRect(AGPColor: TGPColor);
var
LZoom : Integer;
LRatio : Single;
LSelLeft : Integer;
LSelTop : Integer;
LSelWidth : Integer;
LSelHeight : Integer;
LCtrlWidth : Integer;
LCtrlHeidht : Integer;
LGPBitmap : TGPBitmap;
LGPRect : TGPRect;
LGPPen : TGPPen;
LGPBrush : TGPSolidBrush;
LGPGraphics : TGPGraphics;
begin
if not Assigned(FResizeCtrl) then exit;
if not Assigned(FRectSelctor) then exit;
//拡大表示している場合の換算係数
LZoom := ZoomValue;
LRatio := 100 / LZoom;
LSelLeft := Trunc((FRectSelctor.Left - FResizeCtrl.Left) * LRatio);
LSelTop := Trunc((FRectSelctor.Top - FResizeCtrl.Top) * LRatio);
LSelWidth := Trunc(FRectSelctor.Width * LRatio);
LSelHeight := Trunc(FRectSelctor.Height * LRatio);
LCtrlWidth := Trunc(FResizeCtrl.Width * LRatio);
LCtrlHeidht := Trunc(FResizeCtrl.Height * LRatio);
//はみ出している部分の調整
if LSelLeft < 0 then begin
LSelWidth := LSelWidth + LSelLeft;
LSelLeft := 0;
end;
if LSelTop < 0 then begin
LSelHeight := LSelHeight + LSelTop;
LSelTop := 0;
end;
if (LSelLeft + LSelWidth) > LCtrlWidth then begin
LSelWidth := LCtrlWidth - LSelLeft;
end;
if (LSelTop + LSelHeight) > LCtrlHeidht then begin
LSelHeight := LCtrlHeidht - LSelTop;
end;
SetZoomValue;
LGPBitmap := TGPBitmap.Create(LCtrlWidth, LCtrlHeidht);
FResizeCtrl.DrawRoutine(nil, LGPBitmap);
LGPRect := MakeRect(LSelLeft, LSelTop, LSelWidth, LSelHeight);
LGPBrush := TGPSolidBrush.Create(AGPColor);
LGPPen := TGPPen.Create(LGPBrush);
LGPGraphics := TGPGraphics.Create(LGPBitmap);
LGPGraphics.FillRectangle(LGPBrush, LGPRect);
TplGPResizeImage(FResizeCtrl).GPBitmap := LGPBitmap;
FreeAndNil(LGPGraphics);
FreeAndNil(LGPPen);
FreeAndNil(LGPBrush);
FreeAndNil(LGPBitmap);
SetZoomValue(LZoom);
//用が済んだら矩形選択用の移動リサイズコントロールは削除
DeleteRectSelector;
end;
//-----------------------------------------------------------------------------
// 領域設定用の移動リサイズコントロールの削除
// 領域指定が終了したら用がないので削除しておく
//-----------------------------------------------------------------------------
procedure TplContainerCtrl.DeleteRectSelector;
var
LCtrlNo : Integer;
LCtrl : TplBaseDragResize;
begin
//領域指定用の移動リサイズコントロールは別のクラス名なのでそれで判定
for LCtrlNo := CtrlList.Count - 1 downto 0 do begin
LCtrl := CtrlList[LCtrlNo];
if LCtrl is TplRectSelector then begin
DeleteCtrl(LCtrlNo);
break;
end;
end;
//変数のオブジェクトも一応nilにしておく
if Assigned(FRectSelctor) then begin
FRectSelctor := nil;
end;
//リサイズコントロールを削除すると次のZオーダのコントロールが選択される
//そこでZオーダの最前面の選択をFalseにする
if Assigned(FResizeCtrl) then begin
if CtrlList.Count >= 1 then begin
CtrlList[CtrlList.Count - 1].Selected := False;
end;
FResizeCtrl.Selected := True;
end;
end;
//=============================================================================
// ここでキー操作による移動リサイズの制限を実行
// 動作仕様はいろいろ考えてみる必要があるかも知れない
//=============================================================================
procedure TplContainerCtrl.KeyDown(var Key: Word; Shift: TShiftState);
var
LRight : Integer;
LBottom : Integer;
begin
//必ずこのコードを入れておく
if not ExitMouseEvent then begin
inherited;
exit;
end;
if not Assigned(FResizeCtrl) then exit;
LRight := FResizeCtrl.Left + FResizeCtrl.Width;
LBottom := FResizeCtrl.Top + FResizeCtrl.Height;
//矩形領域の選択操作の中断
if Key = VK_ESCAPE then begin
DeleteRectSelector;
Exit;
end;
if Key = VK_RIGHT then begin
if ((FRectSelctor.Left) >= (LRight - 5)) then begin
Key := 0;
end else begin
//継承元のコンテナコントロールのキー操作を実行
inherited;
end;
end;
if Key = VK_LEFT then begin
if ((FRectSelctor.Left + FRectSelctor.Width) <= (FResizeCtrl.Left + 5)) then begin
Key := 0;
end else begin
//継承元のコンテナコントロールのキー操作を実行
inherited;
end;
end;
if Key = VK_UP then begin
if ((FRectSelctor.Top + FRectSelctor.Height) <= (FResizeCtrl.Top + 5)) then begin
Key := 0;
end else begin
//継承元のコンテナコントロールのキー操作を実行
inherited;
end;
end;
if Key = VK_DOWN then begin
// if ((FRectSelctor.Top + FRectSelctor.Height) >= LBottom) then begin
if ((FRectSelctor.Top) >= (LBottom - 5)) then begin
Key := 0;
end else begin
//継承元のコンテナコントロールのキー操作を実行
inherited;
end;
end;
end;
{ TplRectSlector }
//=============================================================================
// 領域指定用移動リサイズコントロールのMouseDownメソッド
// マウスカーソルの移動制限(マウスクリップ)の設定のみ
//
// [備考]
// TplBaseDragResizeはMouseDownでコンテナコントロール範囲にマウスクリップする
// MouseUpでマウスクリップを解除するようになっている
//=============================================================================
procedure TplRectSelector.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
LClipRect : TRect;
begin
inherited;
if Button <> mbLeft then exit;
LClipRect := Bounds(FResizeCtrl.Left, FResizeCtrl.Top,
FResizeCtrl.Width, FResizeCtrl.Height);
LClipRect.TopLeft := Parent.ClientToScreen(LClipRect.TopLeft);
LClipRect.BottomRight := Parent.ClientToScreen(LClipRect.BottomRight);
ClipCursor(@LClipRect);
end;
end.
| 16_拡大表示と画像描画用コントロールのアンチエイリアス処理 |
|
このコンテナコントロールは拡大表示の機能を実装しています．拡大表示は % で指定します．指定可能範囲は 20 から 1500 までです．拡大表示の倍率は SetZoomValue メソッドの引数で指定します．拡大率を 100 か引数なしで実行すると元に戻ります．ZoomValue は拡大率取得用の読み出し専用のプロパティです．
拡大表示にすると，画像描画コントロールに表示している画像はアンチエイリアスの処理をしないで描画するようになっています．画像のピクセルの状態が確認できます．
|
TplContainerPanel.SetZoomValue(AZoomValue)
TplContainerPanel.ZoomValue
[備考]
この拡大表示の機能は TWinControl.ScaleBy を使用しています．
|
 |
図23
拡大表示 |
 |
図24
拡大表示の最大は 1500 (15 倍) |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtDlgs, plContainerPanel, ExtCtrls, plGPResizeImage,
Buttons;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
ScrollBox1: TScrollBox;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure ScrollBox1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
private
{ Private 宣言 }
FBackCtrl : TplContainerPanel;
FResizeImage : TplGPResizeImage;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
// コンテナコントロールはTScrollBoxの上に配置
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Panel1.Caption := '';
Edit1.Text := '500';
//コンテナコントロール生成
FBackCtrl := TplContainerPanel.Create(Self);
FBackCtrl.Parent := ScrollBox1;
FBackCtrl.SetBounds(0, 0, 500, 250);
end;
//=============================================================================
// 画像ファイルを読み込んで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LFilePath : array [0..2] of string;
LNo : Integer;
begin
FBackCtrl.DeleteAllCtrls;
LFilePath[0] := ExpandFileName('..\..\Images\000.bmp');
LFilePath[1] := ExpandFileName('..\..\Images\503_Transe.bmp');
LFilePath[2] := ExpandFileName('..\..\Images\046641.gif');
for LNo := 0 to Length(LFilePath) - 1 do begin
FResizeImage := TplGPResizeImage.Create(Self);
FResizeImage.Parent := FBackCtrl;
FResizeImage.InverseDisp := True;
FResizeImage.LoadFromFile(LFilePath[Lno]);
FResizeImage.Left := LNo * 20;
FResizeImage.Top := LNo * 20;
end;
end;
//=============================================================================
// 選択中の描画コントロールを削除
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
FBackCtrl.DeleteCtrl();
end;
//=============================================================================
// 拡大表示
// 設定可能な値は20～1500(値は%)
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
var
LZoom : Integer;
begin
if FBackCtrl.CtrlList.Count = 0 then exit;
LZoom := StrToInt(Edit1.Text);
FBackCtrl.SetZoomValue(LZoom);
end;
//=============================================================================
// 原寸表示
// 拡大率を100%にする
//=============================================================================
procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
if FBackCtrl.CtrlList.Count = 0 then exit;
FBackCtrl.SetZoomValue;
end;
//=============================================================================
// OnMouseWheelイベント処理
// TScrollBoxのスクロール制御
// [Ctrl]押下の状態でホイールを操作すると横スクロールとなる
//=============================================================================
procedure TForm1.ScrollBox1MouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
LDelta : Integer;
begin
LDelta := WheelDelta div 5;
if ssCtrl in Shift then begin
ScrollBox1.HorzScrollBar.Position := ScrollBox1.HorzScrollBar.Position - LDelta;
end else begin
ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - LDelta;
end;
end;
end.
| 17_ビットマップ形式 ( ラスタ形式 ) 描画とベクタ形式描画の拡大表示 |
|
拡大表示は画像描画用コントロールで表示するビットマップ形式 (ラスタ形式) の描画の時に意味があります．直線描画用コントロールのようにベクタ形式の描画では，たとえアンチエイリアスを無効にしていても，ベクタ形式での描画となります．
下の左側は，直線描画用コントロールで描画した矢印です．右は，それをビットマップに変換した画像を拡大表示しています．
|
 |
図25
拡大表示におけるビットマップ形式とラスタ形式の違い
|
|
拡大表示している時は，拡大表示の状態の画像を保存することができます．以下のコードで実際の保存結果を確認することができます．
|
//=============================================================================
// 通常保存
// 拡大前の画像を保存
// 拡大率を100%にしてTGPBitmapを取得してそれを保存
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
var
LGPBitmap : TGPBitmap;
LImgGUID : TGUID;
LZoom : Integer;
begin
LZoom := FBackCtrl.ZoomValue;
FBackCtrl.SetZoomValue(100);
LGPBitmap := FBackCtrl.GPBitmapFromSelectedCtrls;
try
//取得したら保存する
if GetEncoderClsid('image/png', LImgGUID) >= 0 then begin
LGPBitmap.Save('000.png', LImgGUID);
end;
finally
FreeAndNil(LGPBitmap);
end;
//拡大率を現在の値に戻しておく
FBackCtrl.SetZoomValue(LZoom);
end;
//=============================================================================
// 拡大表示状態での保存
//=============================================================================
procedure TForm1.Button4Click(Sender: TObject);
var
LGPBitmap : TGPBitmap;
LImgGUID : TGUID;
begin
LGPBitmap := FBackCtrl.GPBitmapFromSelectedCtrls;
try
//取得したら保存する
if GetEncoderClsid('image/png', LImgGUID) >= 0 then begin
LGPBitmap.Save('000.png', LImgGUID);
end;
finally
FreeAndNil(LGPBitmap);
end;
end;
| 19_画像の重ね描画と Z オーダの利用 - レイヤー機能 |
|
複数の画像を重ね描画する例です．いわゆるレイヤー構造的な表示です．
描画コントロールをそのまま表示したのでは，マウスクリックで選択状態になり移動リサイズとなってしまいます．そこで，描画コントロールの DispOnly プロパティを True にします．True にすると本来のマウスイベントは実行されなくなりますが，マウスイベントは発生します．
このサンプルでは，TplGPResizeImage の継承クラスを作成して，その継承クラスでマウスイベントを処理しています．ただし，単に MouseDown メソッドで画像のピクセルの色を取得するだけです．
拡大表示しているので，GPBitmap プロパティで元の TGPBitmap オブジェクトを取得して，そこから実際のピクセルの色を取得しています．
このような機能を実現するのに，移動リサイズのサンプルで提供している描画用コントロールもコンテナコントロールも使用する必然性はありませんが，配列やリストを使用して画像を管理する機能が必要となります．
|
TplBaseDragResize.DispOnly : Boolean
TplGPResizeImage.GPBitmap: TGPBitmap
TplContainerPanel.GPBitmapFromSelectedCtrls: TGPBitmap
 |
図26
PNG 形式のアイコン画像を複数読み込んで重ね描画
- 拡大表示している
元の画像サイズは 32 x 32
- 「合成」しているわけではない
- [PNG 保存] 時は合成画像を作成
|
 |
図27
1 番目の画像の Z オーダを変更
|
 |
図28
画像のピクセルの色を取得
|
 |
図29
ピクセルの色を取得する対象の画像
|
下図は保存した画像の例です．サンプルプログラム集のプログラムで表示した結果です．
画像を合成して 1 つの画像にするには，GPBitmapFromSelectedCtrls, BitmapFromSelectedCtrls というメソッドは現在の表示状態を画像として取得します．そこで拡大率を 100 % にしてから合成画像をしています．合成画像を取得したら現在の表示倍率に戻しています． |
 |
図30
保存した PNG 形式の画像 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtDlgs, plContainerPanel, ExtCtrls, plGPResizeImage,
Buttons, CheckLst, GDIPOBJ, GDIPAPI, GDIPUTIL;
type
TMyGPImageCtrl = class(TplGPResizeImage)
protected
LForm : TForm;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
Y: Integer); override;
end;
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
Panel2: TPanel;
CheckListBox1: TCheckListBox;
SpeedButton1: TSpeedButton;
Panel3: TPanel;
Label1: TLabel;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure CheckListBox1Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
FBackCtrl : TplContainerPanel;
FResizeImage : TMyGPImageCtrl;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
Panel1.Caption := '';
Panel2.Caption := '';
Panel3.Caption := '';
Panel3.ParentBackground := False;
//コンテナコントロール生成
FBackCtrl := TplContainerPanel.Create(Self);
FBackCtrl.Parent := Self;
FBackCtrl.Align := alClient;
end;
//=============================================================================
// 画像ファイルを読み込んで表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LFilePath : array [0..2] of string;
LNo : Integer;
begin
//表示中の描画コントロールを全て削除
FBackCtrl.DeleteAllCtrls;
//表示倍率の設定
//親コントロールの生成か完了していないと設定できないのでここで設定
FBackCtrl.SetZoomValue(900);
//テスト用の画像を読み込んで表示
LFilePath[0] := ExpandFileName('billiard_marker.png');
LFilePath[1] := ExpandFileName('bug_report.png');
LFilePath[2] := ExpandFileName('bullet_valid.png');
for LNo := 0 to Length(LFilePath) - 1 do begin
FResizeImage := TMyGPImageCtrl.Create(Self);
FResizeImage.Parent := FBackCtrl;
FResizeImage.AntiAliasing := False;
FResizeImage.DispOnly := True;
FResizeImage.LoadFromFile(LFilePath[Lno]);
FResizeImage.Left := 0;
FResizeImage.Top := 0;
Application.ProcessMessages;
end;
CheckListBox1.CheckAll(cbChecked);
end;
//=============================================================================
// 描画コントロールの表示・非表示の設定
//=============================================================================
procedure TForm1.CheckListBox1Click(Sender: TObject);
var
LNo : Integer;
begin
if FBackCtrl.CtrlList.Count = 0 then exit;
for LNo := 0 to CheckListBox1.Items.Count - 1 do begin
FBackCtrl.CtrlList[LNo].Visible := CheckListBox1.Checked[LNo];
end;
end;
//=============================================================================
// 描画コントロールのZオーダを変更
// ここでは0を1にする
// 1番目を2番目にして元の2番目より前面に表示
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if FBackCtrl.CtrlList.Count = 0 then exit;
FBackCtrl.SetZOrderCtrl(0, 1);
end;
//=============================================================================
// 保存
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
LSavePath : string;
LZoom : Integer;
LGPBitmap : TGPBitmap;
LImgGUID : TGUID;
begin
//元の画像がPNG形式なので同じ形式で保存してみることにする
LSavePath := ExpandFileName('000.png');
//拡大率を100%(オリジナルのサイズ)にしてから取得
LZoom := FBackCtrl.ZoomValue;
FBackCtrl.SetZoomValue;
//画像を取得(VisibleプロパティがFalseの画像は取得できない
LGPBitmap := FBackCtrl.GPBitmapFromSelectedCtrls;
try
//取得したら保存する
if GetEncoderClsid('image/png', LImgGUID) >= 0 then begin
LGPBitmap.Save(LSavePath, LImgGUID);
end;
finally
FreeAndNil(LGPBitmap);
end;
//拡大率を現在の値にしておく
FBackCtrl.SetZoomValue(LZoom);
end;
{ TMyGPImageCtrl }
//=============================================================================
// MouseDownメソッドの処理
// マウスの左ボタン押下位置の画像のピクセルの色を取得
//=============================================================================
procedure TMyGPImageCtrl.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
var
LParentForm : TForm1;
LBackCtrl : TplContainerPanel;
LCtrl : TplGPResizeImage;
LZoomValue : Integer;
LIndex : Integer;
LGPBitmap : TGPBitmap;
LGPColor : TGPColor;
LPosX : Integer;
LPosY : Integer;
begin
inherited;
if not DispOnly then exit;
if Button <> mbLeft then exit;
LParentForm := TForm1(GetParentForm(Self));
LBackCtrl := LParentForm.FBackCtrl;
LZoomValue := LBackCtrl.ZoomValue div 100;
LParentForm.Panel3.Color := clWhite;
//Zオーダが一番上の描画コントロールを対象とする
LIndex := LBackCtrl.CtrlList.Count - 1;
LCtrl := TplGPResizeImage(LBackCtrl.CtrlList[LIndex]);
if LCtrl.Visible then begin
//表示中の画像を取得．これに対して操作する
LGPBitmap := LCtrl.GPBitmap;
try
//拡大表示しているので元の画像の座標値に変換
LPosX := X div LZoomValue;
LPosY := Y div LZoomValue;
LGPBitmap.GetPixel(LPosX, LPosY, LGPColor);
LParentForm.Panel3.Color := ARGBToColorRef(LGPColor);
LParentForm.Label1.Caption := 'ARGB($' + IntToHex(LGPColor, 8) + ')';
finally
FreeAndNil(LGPBitmap);
end;
end;
end;
end.
|
