|
Delphi Programming / Object Pascal
  
[掲載 2017年07月15日] [更新 2017年07月15日] GDI+ 関係サンプル |
GDI+ 関係サンプル
G024_画像のピクセルの色変更等の操作 |
| 動作確認等 |
Windows 7 U64(SP1) + Delphi XE(UP1) Pro |
 |
G024_GDIPlus_PixelsColor.zip [5,775 KB] 2017年07月15日版 (EXE 同梱) |
| 画像のピクセル ( 画素 ) の色変更や塗り潰し等の操作 |
主に GUI 操作による塗り潰し等，ピクセル (画素) に関するサンプルです．
本ページには，以下のプロシージャ，関数が省略されているサンプルがあります．以下の参考リンクの記事にそれらのコードを掲載しています．そちらで確認してください．プロシージャー名，関数名が同じであれば機能も同じです．ダウンロードしたファイルには含まれています． |
| プロシージャー名 |
機能 |
| DrawPixelColorToTImage |
画像を拡大表示してピクセルの色を TImage にグリッド表示 |
| SetAlphaValueFromTBitmap |
読み込んだビットマップのアルファ値を TGPBitmap にセット
GDI+ でビットマップ画像のアルファ値を扱うための処理 |
| SetAlphaZeroPixelsSelfTGPBitmap |
読み込んだ PNG 形式画像の透明色の再設定
GDI+ で PNG 形式画像の透過色を扱うための処理 |
| ChangeColor |
指定した色のピクセルを別の色に変更 |
[備考 4]
本ページでは，以下のサイトからダウンロードした PNG 形式のアイコン画像を利用しています．
|
ピクセルの色は TGPBitmap の GetPixel メソッドで取得できます．GetPixel メソッドでピクセルの色を設定できます．それらの動作確認用のテストです．
本ページでは，全体的にこのサンプルと同じような設計仕様にしています． |
 |
図1
設計時の画面
- 操作用のボタン類は TToolBar に配置している
|
 |
図2
実行時の画面
- 左端の黒い線は，1 つづつマウスでクリックして作成している
|
 |
図3
色の選択ダイアログを表示
- マウスカーソル位置にある TImage をクリックすると表示
- この色を色変更に使用する
- 色選択ダイアログにはアルファ値の設定項目はない
|
 |
図4
半透明色にもできる
|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL, ComCtrls, ExtDlgs,
ImgList, ToolWin;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
Image3: TImage;
ImageList1: TImageList;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
Edit1: TEdit;
ColorDialog1: TColorDialog;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure Image3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Privat e 宣言 }
FPixelRectSize : Cardinal;
FMaxImgPixels : Integer;
FPixelGridColor : TColor;
FMemStream : TBytesStream;
FGPBitmap : TGPBitmap;
FBackTBitmap : TBitmap;
FGPUseColor : TGPColor;
FOperationNo : Cardinal;
procedure DisplayImageAndGridLine(NeedInvalidate: Boolean);
procedure DrawUseColorToTImage(AColor: TGPColor);
public
{ Public 宣言 }
procedure DrawPixelColorToTImage(SrcGPBitmap: TGPBitmap; DrawTimage: TImage;
PixelRectSize: Integer; MaxImgPixels: Integer; GridLineColor: TColor;
BackImage: TBitmap = nil; ShowGridLine: Boolean = True;
BackGround: Boolean = True);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
OPERATION_NONE = $00;
OPERATION_GET_PIXELCOLOR = $10;
OPERATION_SET_PIXELCOLOR = $20;
//=============================================================================
// フォーム生成時の処理
//
// TToolBarの各TToolButtonのプロパティの値を以下にしている
// この設定でTToolButton.Downプロパティの値が使用可能になる
// TToolButton.Grouped := True:;
// TToolButton.Style := tbsCheck;
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LBackGroundFile : string;
begin
//グリッド線の色とピクセルの描画サイズ等
FPixelGridColor := clGray;
FPixelRectSize := 12;
FMaxImgPixels := 128;
Image1.Transparent := False;
Image2.Transparent := False;
Image3.Transparent := False;
//背景に描画する格子状の市松模様のビットマップ画像の設定
//透過状態を確認するために施用する
FBackTBitmap := TBitmap.Create;
LBackGroundFile := ExpandFileName('.\backTexture_02.bmp');
if FileExists(LBackGroundFile) then begin
FBackTBitmap.LoadFromFile(LBackGroundFile);
end else begin
FBackTBitmap := nil;
end;
//メモリストリームに画像ファイルを読み込む
FMemStream := TBytesStream.Create;
FMemStream.LoadFromFile('livejournal.png');
//メモリストリームからTGPBitmapを作成
FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
//使用する色の初期値
FGPUseColor := ColorRefToARGB(clBlack);
DrawUseColorToTImage(FGPUseColor);
//画像とピクセルのグリッド表示
DisplayImageAndGridLine(True);
//作業の種類
//TToolButton.Downプロパティの値でどのボタンが押された状態かを知ることができるが
//ここでは作業内容を定数値で判定することにする
FOperationNo := OPERATION_NONE;
end;
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
if Assigned(FMemStream) then FreeAndNil(FMemStream);
if Assigned(FBackTBitmap) then FreeAndNil(FBackTBitmap);
end;
//=============================================================================
// ToolButton1のOnClickイベント処理
// 他のTToolButtonとの共有イベント
// 操作内容の設定
//=============================================================================
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
if Sender = ToolButton1 then begin
FOperationNo := OPERATION_NONE;
end else
if Sender = ToolButton2 then begin
FOperationNo := OPERATION_SET_PIXELCOLOR;
end else
if Sender = ToolButton3 then begin
FOperationNo := OPERATION_GET_PIXELCOLOR;
end else begin
FOperationNo := OPERATION_NONE;
end;
end;
//=============================================================================
// Image1のOnMouseDownイベント処理
// ピクセルの色の取得またはピクセルの色の変更
//
// Imaae1は画像を拡大表示したピクセルの色表示用
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
LXPos : Integer;
LYPos : Integer;
begin
if not Assigned(FGPBitmap) then exit;
if Button <> mbLeft then exit;
//実際の画像の座標値に変換
LXPos := X div FPixelRectSize;
LYPos := Y div FPixelRectSize;
if FOperationNo = OPERATION_SET_PIXELCOLOR then begin
FGPBitmap.SetPixel(LXPos, LYPos, FGPUseColor);
DisplayImageAndGridLine(True);
end else
if FOperationNo = OPERATION_GET_PIXELCOLOR then begin
FGPBitmap.GetPixel(LXPos, LYPos, FGPUseColor);
DrawUseColorToTImage(FGPUseColor);
end;
end;
//=============================================================================
// Image3のOnMouseDownイベント処理
// 色選択ダイアログを表示してピクセルの色を変更する色を選択
// TColorDialogダイアログにはアルファ値の設定機能はない
//
// Imaae3はピクセルの色変更に使用する色表示用のコントロール
//=============================================================================
procedure TForm1.Image3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ColorDialog1.Color := ARGBToColorRef(FGPUseColor);
if ColorDialog1.Execute then begin
FGPUseColor := ColorRefToARGB(ColorDialog1.Color);
DrawUseColorToTImage(FGPUseColor);
end;
end;
//-----------------------------------------------------------------------------
// TImageへの描画のコード
// 実サイズと拡大表示用グリッド表示
//-----------------------------------------------------------------------------
procedure TForm1.DisplayImageAndGridLine(NeedInvalidate: Boolean);
var
LGPGraphics : TGPGraphics;
begin
//TGPBitmapをTImageに実サイズで描画
if NeedInvalidate then begin
Image2.Picture.Assign(nil);
LGPGraphics := TGPGraphics.Create(Image2.Canvas.Handle);
LGPGraphics.DrawImage(FGPBitmap, 0, 0);
LGPGraphics.Free;
end;
//ピクセルのグリッド表示
DrawPixelColorToTImage(FGPBitmap, Image1, FPixelRectSize, FMaxImgPixels,
FPixelGridColor, FBackTBitmap);
end;
//-----------------------------------------------------------------------------
// 使用する色を表示しておくTImaeコントロールへの描画用ルーチン
//-----------------------------------------------------------------------------
procedure TForm1.DrawUseColorToTImage(AColor: TGPColor);
var
LGPGraphic : TGPGraphics;
LGPBrush : TGPSolidBrush;
LGPRect : TGPRect;
begin
Image3.Picture.Assign(nil);
//TGPSolidBrushを生成
LGPBrush := TGPSolidBrush.Create(AColor);
//描画先をTImageにしてTGPGraphics.Create
LGPGraphic := TGPGraphics.Create(Image3.Canvas.Handle);
try
//矩形を塗り潰し描画
LGPRect := MakeRect(0, 0, Image3.Width, Image3.Height);
LGPGraphic.FillRectangle(LGPBrush, LGPRect);
finally
FreeAndNil(LGPGraphic);
FreeAndNil(LGPBrush);
end;
Edit1.Text := '$' + IntToHex(AColor, 8);
end;
|
VCL の TCanvas には FloodFill という領域を塗り潰すためのメソッドがありますが，GDI+ にはそのような機能は実装されていません．
領域の塗り潰しのアルゴリズムがあるわけですが，本サンプルでは，表示中の TGPBitmap を TBitmap に変換して FloodFill で領域を塗り潰しています．塗り潰した結果の画像を TGPBitmap にします．したがって，半透明等のアルファチャンネルは扱えません．
この機能は，メタファイル等のベクタ方式の画像では正常に機能しません．ビットマップ形式，つまりラスタ方式の画像だけに対してだけ有効です．
パスで図形を作成する場合は，このような塗り潰しの機能を使用する必要はありません
|
 |
図5
設計時の画面 |
 |
図6
テスト用の EXE を起動した画面 |
 |
図7
黒で塗り潰すと透明色になってしまう |
 |
図8
領域の塗り潰しの例 |
リスト2
マウスでクリックした領域内の塗り潰し．アルファ値の操作はできない |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL, ComCtrls, ExtDlgs,
ImgList, ToolWin;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
ImageList1: TImageList;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
Edit1: TEdit;
ColorDialog1: TColorDialog;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Privat e 宣言 }
FMemStream : TBytesStream;
FGPBitmap : TGPBitmap;
FBackTBitmap : TBitmap;
FDispImgWidth : Integer;
FDispImgHeight : Integer;
FGPUseColor : TGPColor;
FOperationNo : Cardinal;
procedure DisplayImageToTImage;
procedure DrawUseColorToTImage(AColor: TGPColor);
function SetAlphaValueFromTBitmap(DstGPBitmap: TGPBitmap;
SrcBitmap: TBitmap): Boolean;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
OPERATION_NONE = $00;
OPERATION_PAINT_FLOODFILL = $100;
//=============================================================================
// フォーム生成時の処理
//
// TToolBarの各TToolButtonのプロパティの値を以下にしている
// この設定でTToolButton.Downプロパティの値が使用可能になる
// TToolButton.Grouped := True:;
// TToolButton.Style := tbsCheck;
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LBackGroundFile : string;
begin
Image1.Transparent := False;
Image2.Transparent := False;
//背景に描画する格子状の市松模様のビットマップ画像の設定
//透過状態を確認するために施用する
FBackTBitmap := TBitmap.Create;
LBackGroundFile := ExpandFileName('.\backTexture_01.bmp');
if FileExists(LBackGroundFile) then begin
FBackTBitmap.LoadFromFile(LBackGroundFile);
end else begin
FBackTBitmap := nil;
end;
//メモリストリームに画像ファイルを読み込む
FMemStream := TBytesStream.Create;
FMemStream.LoadFromFile('502.png');
//サイズを指定して画像を描画
FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
//画像とピクセルのグリッド表示
FDispImgWidth := 250;
FDispImgHeight := Trunc(FDispImgWidth * FGPBitmap.GetHeight / FGPBitmap.GetWidth);
DisplayImageToTImage;
//使用する色の初期値
FGPUseColor := ColorRefToARGB(clBlack);
DrawUseColorToTImage(FGPUseColor);
//作業の種類
//TToolButton.Downプロパティの値でどのボタンが押された状態かを知ることができるが
//ここでは作業内容を定数値で判定することにする
FOperationNo := OPERATION_NONE;
end;
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
if Assigned(FMemStream) then FreeAndNil(FMemStream);
if Assigned(FBackTBitmap) then FreeAndNil(FBackTBitmap);
end;
//=============================================================================
// ToolButton1のOnClickイベント処理
// 他のTToolButtonとの共有イベント
// 操作内容の設定
//=============================================================================
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
if Sender = ToolButton1 then begin
FOperationNo := OPERATION_NONE;
end else
if Sender = ToolButton2 then begin
FOperationNo := OPERATION_PAINT_FLOODFILL;
end;
end;
//=============================================================================
// Image1のOnMouseDownイベント処理
// クリックしたピクセルの領域内の色を変更
//
// GDI+にはGDIのFloodFillの同じ機能のメソッドない
// GDI(VCL)のTBitmapを作成してFloodFillを使用して処理
// この方法はEMF,WMF等のベクタ画像は正常に処理できない
// 黒を指定すると透明色になる
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
LGPGraphics : TGPGraphics;
LGPBitmap : TGPBitmap;
LGPTargetColor : TGPColor;
LTargetColor : TColor;
LChangedColor : TColor;
LBitmap : TBitmap;
LhBitmap : HBITMAP;
begin
if not Assigned(FGPBitmap) then exit;
if Button <> mbLeft then exit;
if FOperationNo = OPERATION_PAINT_FLOODFILL then begin
//現在の描画サイズと同じサイズのTGPBitmapを作成
if (FGPBitmap.GetWidth <> FDispImgWidth)
or (FGPBitmap.GetHeight <> FDispImgHeight) then begin
LGPBitmap := TGPBitmap.Create(FDispImgWidth, FDispImgHeight);
LGPGraphics := TGPGraphics.Create(LGPBitmap);
try
LGPGraphics.DrawImage(FGPBitmap,
MakeRect(0, 0, FDispImgWidth, FDispImgHeight),
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight,
UnitPixel);
//これでFGPBitmapが現在表示中のサイズになる
FGPBitmap := TGPBitmap(LGPBitmap.Clone);
finally
FreeAndNil(LGPBitmap);
end;
end;
LBitmap := TBitmap.Create;
try
LBitmap.PixelFormat := pf32bit;
LBitmap.AlphaFormat := afDefined;
//画像をビットマップで取得
FGPBitmap.GetHBITMAP(0, LhBitmap);
LBitmap.Handle := LhBitmap;
LBitmap.AlphaFormat := afIgnored;
//塗り潰し
FGPBitmap.GetPixel(X, Y, LGPTargetColor);
LTargetColor := ARGBToColorRef(LGPTargetColor);
LChangedColor := ARGBToColorRef(FGPUseColor);
LBitmap.Canvas.Brush.Color := LChangedColor;
LBitmap.Canvas.FloodFill(X, Y, LTargetColor, fsSurface);
//処理したTBitmapからTGPBitmapを作成
//このTGPBitmapが処理後のTGPBitmapということになる
FMemStream.Clear;
FreeAndNil(FGPBitmap);
LBitmap.SaveToStream(FMemStream);
FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
//アルファチャンネルを処理するようにする
SetAlphaValueFromTBitmap(FGPBitmap, LBitmap);
DisplayImageToTImage;
finally
FreeAndNil(LBitmap);
end;
end;
end;
//=============================================================================
// Image3のOnMouseDownイベント処理
// 色選択ダイアログを表示してピクセルの色を変更に使用する色を選択
// TColorDialogダイアログにはアルファ値の設定機能はない
//
// Imaae2はピクセルの色変更に使用する色表示用のコントロール
//=============================================================================
procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ColorDialog1.Color := ARGBToColorRef(FGPUseColor);
if ColorDialog1.Execute then begin
FGPUseColor := ColorRefToARGB(ColorDialog1.Color);
DrawUseColorToTImage(FGPUseColor);
end;
end;
//-----------------------------------------------------------------------------
// TImageへの描画のコード
//-----------------------------------------------------------------------------
procedure TForm1.DisplayImageToTImage;
var
LGPGraphics : TGPGraphics;
begin
Image1.Picture.Assign(nil);
Image1.Picture.Bitmap.SetSize(FDispImgWidth, FDispImgHeight);
LGPGraphics := TGPGraphics.Create(Image1.Canvas.Handle);
try
//背景画像の指定があれば描画
if Assigned(FBackTBitmap) then begin
Image1.Canvas.Brush.Bitmap := FBackTBitmap;
Image1.Canvas.FillRect(Image1.ClientRect);
end;
LGPGraphics.DrawImage(FGPBitmap,
MakeRect(0, 0, FDispImgWidth, FDispImgHeight),
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight,
UnitPixel);
finally
FreeAndNil(LGPGraphics);
end;
end;
//-----------------------------------------------------------------------------
// 使用する色を表示しておくTImaeコントロールへの描画用ルーチン
//-----------------------------------------------------------------------------
procedure TForm1.DrawUseColorToTImage(AColor: TGPColor);
var
LGPGraphic : TGPGraphics;
LGPBrush : TGPSolidBrush;
LGPRect : TGPRect;
begin
Image2.Picture.Assign(nil);
//TGPSolidBrushを生成
LGPBrush := TGPSolidBrush.Create(AColor);
//描画先をTImageにしてTGPGraphics.Create
LGPGraphic := TGPGraphics.Create(Image2.Canvas.Handle);
try
//矩形を塗り潰し描画
LGPRect := MakeRect(0, 0, Image2.Width, Image2.Height);
LGPGraphic.FillRectangle(LGPBrush, LGPRect);
finally
FreeAndNil(LGPGraphic);
FreeAndNil(LGPBrush);
end;
Edit1.Text := '$' + IntToHex(AColor, 8);
end;
| 03_領域内の塗り潰しでアルファチャンネルを扱う方法 |
TCanvas.FloodFill メソッドを使用して領域を塗り潰す際，アルファチャンネルも扱えるようにするための 1 つの方法です．
まず，画像では使用していないと思われる色で塗り潰します．本サンプルでは RGB(1, 1, 1) という色にしています．その後，この色のピクセルを目的の色で塗り潰します．下図は実際の操作例です． |
 |
図9
黒で塗り潰しても透明色にならない |
 |
図10
もちろん領域の塗り潰しもできる |
本サンプルには設定用の機能はありませんが，この方法であれば，以下のように半透明や透明色を指定しての塗り潰しも可能です．
下図は，コードで色を設定して実行した結果です． |
 |
図11
半透明の色で塗り潰した結果 |
 |
図12
透明色で塗り潰した結果 |
リスト3
マウスでクリックした領域内の塗り潰しで，アルファチャンネルを操作可能する例 |
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
LGPGraphics : TGPGraphics;
LGPBitmap : TGPBitmap;
LGPTargetColor : TGPColor;
LGPChangeColor : TGPColor;
LGPNewColor : TGPColor;
LTargetColor : TColor;
LChangedColor : TColor;
LBitmap : TBitmap;
LhBitmap : HBITMAP;
begin
if not Assigned(FGPBitmap) then exit;
if Button <> mbLeft then exit;
if FOperationNo = OPERATION_PAINT_FLOODFILL then begin
//現在の描画サイズと同じサイズのTGPBitmapを作成
if (FGPBitmap.GetWidth <> FDispImgWidth)
or (FGPBitmap.GetHeight <> FDispImgHeight) then begin
LGPBitmap := TGPBitmap.Create(FDispImgWidth, FDispImgHeight);
LGPGraphics := TGPGraphics.Create(LGPBitmap);
try
LGPGraphics.DrawImage(FGPBitmap,
MakeRect(0, 0, FDispImgWidth, FDispImgHeight),
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight,
UnitPixel);
//これでFGPBitmapが現在表示中のサイズになる
FGPBitmap := TGPBitmap(LGPBitmap.Clone);
finally
FreeAndNil(LGPBitmap);
end;
end;
LBitmap := TBitmap.Create;
try
LBitmap.PixelFormat := pf32bit;
LBitmap.AlphaFormat := afDefined;
//画像をビットマップで取得
FGPBitmap.GetHBITMAP(0, LhBitmap);
LBitmap.Handle := LhBitmap;
LBitmap.AlphaFormat := afIgnored;
//塗り潰し
FGPBitmap.GetPixel(X, Y, LGPTargetColor);
//暫定色を設定して領域内の指定色を暫定色で塗り潰す
LTargetColor := ARGBToColorRef(LGPTargetColor);
LChangedColor := RGB(1, 1, 1);
LBitmap.Canvas.Brush.Color := LChangedColor;
LBitmap.Canvas.FloodFill(X, Y, LTargetColor, fsSurface);
//処理したTBitmapからTGPBitmapを作成
//このTGPBitmapが処理後のTGPBitmapということになる
FMemStream.Clear;
FreeAndNil(FGPBitmap);
LBitmap.SaveToStream(FMemStream);
FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
//アルファチャンネルを処理するようにする
SetAlphaValueFromTBitmap(FGPBitmap, LBitmap);
//暫定色を目的の色で塗り潰す
//アルファ値を変更すれば半透明になる
LGPNewColor := MakeColor($FF, GetRed(FGPUseColor),
GetGreen(FGPUseColor),
GetBlue(FGPUseColor));
LGPChangeColor := ColorRefToARGB(LChangedColor);
ChangeColor(FGPBitmap, LGPChangeColor, LGPNewColor);
//描画
DisplayImageToTImage;
finally
FreeAndNil(LBitmap);
end;
end;
end;
| 04_マウスでクリックしたピクセルと同じ色を別の色に変更 |
| 前項のサンプルで使用しているピクセルの色を変更するメソッドを使用すると，指定した色のピクセルを全て別の色に変更することができます．その例です． |
 |
図13
ヒヨコの体の部分と同じ黄色い色のピクセルを黒に変更した結果 |
 |
図14
羽根の部分と同じ色を別の色に変更
- 同じピクセルをクリックしても，前項のサンプルと結果が違う
|
本サンプルには設定用の機能はありませんが，以下のように半透明の塗り潰しも可能です．
下図は，図の下に示すコードのように色を設定して実行した結果です． |
 |
図15
半透明の色で塗り潰し |
//色変更
LGPChangeColor := MakeColor($5F, GetRed(FGPUseColor),
GetGreen(FGPUseColor),
GetBlue(FGPUseColor));
FGPBitmap.GetPixel(X, Y, LGPTargetColor);
ChangeColor(FGPBitmap, LGPTargetColor, LGPChangeColor);
//変更結果を描画
DisplayImageToTImage;
リスト4
マウスでクリックしたピクセルと同じ色を別の色に変更 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL, ComCtrls, ExtDlgs,
ImgList, ToolWin;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
ImageList1: TImageList;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
Edit1: TEdit;
ColorDialog1: TColorDialog;
ToolButton3: TToolButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ToolButton3Click(Sender: TObject);
private
{ Privat e 宣言 }
FMemStream : TBytesStream;
FGPBitmap : TGPBitmap;
FBackTBitmap : TBitmap;
FDispImgWidth : Integer;
FDispImgHeight : Integer;
FGPUseColor : TGPColor;
FOperationNo : Cardinal;
procedure DisplayImageToTImage;
procedure DrawUseColorToTImage(AColor: TGPColor);
function ChangeColor(TarGPBitmap: TGPBitmap; OldColor, NewColor: TGPColor):
Boolean;
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
OPERATION_NONE = $00;
OPERATION_PAINT_CHANGECOLOR = $200;
//=============================================================================
// フォーム生成時の処理
//
// TToolBarの各TToolButtonのプロパティの値を以下にしている
// (ToolButton3を除く)
// この設定でTToolButton.Downプロパティの値が使用可能になる
// TToolButton.Grouped := True:;
// TToolButton.Style := tbsCheck;
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LBackGroundFile : string;
begin
Image1.Transparent := False;
Image2.Transparent := False;
//背景に描画する格子状の市松模様のビットマップ画像の設定
//透過状態を確認するために施用する
FBackTBitmap := TBitmap.Create;
LBackGroundFile := ExpandFileName('.\backTexture_01.bmp');
if FileExists(LBackGroundFile) then begin
FBackTBitmap.LoadFromFile(LBackGroundFile);
end else begin
FBackTBitmap := nil;
end;
//メモリストリームに画像ファイルを読み込む
FMemStream := TBytesStream.Create;
FMemStream.LoadFromFile('502.png');
//メモリストリームからTGPBitmapを作成
FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
//サイズを指定して画像を描画
FDispImgWidth := 250;
FDispImgHeight := Trunc(FDispImgWidth * FGPBitmap.GetHeight / FGPBitmap.GetWidth);
DisplayImageToTImage;
//使用する色の初期値
FGPUseColor := ColorRefToARGB(clBlack);
DrawUseColorToTImage(FGPUseColor);
//作業の種類
//TToolButton.Downプロパティの値でどのボタンが押された状態かを知ることができるが
//ここでは作業内容を定数値で判定することにする
FOperationNo := OPERATION_NONE;
end;
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
if Assigned(FMemStream) then FreeAndNil(FMemStream);
if Assigned(FBackTBitmap) then FreeAndNil(FBackTBitmap);
end;
//=============================================================================
// ToolButton1のOnClickイベント処理
// 他のTToolButtonとの共有イベント
// (ToolButton3を除く)
// 操作内容の設定
//=============================================================================
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
if Sender = ToolButton1 then begin
FOperationNo := OPERATION_NONE;
end else
if Sender = ToolButton2 then begin
FOperationNo := OPERATION_PAINT_CHANGECOLOR;
end;
end;
//=============================================================================
// ToolButton3のOnClickイベント処理
// 画像を，読み込んだ時の状態に戻す
//=============================================================================
procedure TForm1.ToolButton3Click(Sender: TObject);
begin
if not Assigned(FGPBitmap) then exit;
FreeAndNil(FGPBitmap);
FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
//描画
DisplayImageToTImage;
end;
//=============================================================================
// Image1のOnMouseDownイベント処理
// クリックしたピクセルと同じ色のピクセルを変更
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
LGPGraphics : TGPGraphics;
LGPBitmap : TGPBitmap;
LGPTargetColor : TGPColor;
begin
if not Assigned(FGPBitmap) then exit;
if Button <> mbLeft then exit;
if FOperationNo = OPERATION_PAINT_CHANGECOLOR then begin
//現在の描画サイズと同じサイズのTGPBitmapを作成
if (FGPBitmap.GetWidth <> FDispImgWidth)
or (FGPBitmap.GetHeight <> FDispImgHeight) then begin
LGPBitmap := TGPBitmap.Create(FDispImgWidth, FDispImgHeight);
LGPGraphics := TGPGraphics.Create(LGPBitmap);
try
LGPGraphics.DrawImage(FGPBitmap,
MakeRect(0, 0, FDispImgWidth, FDispImgHeight),
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight,
UnitPixel);
//これでFGPBitmapが現在表示中のサイズになる
FGPBitmap := TGPBitmap(LGPBitmap.Clone);
finally
FreeAndNil(LGPBitmap);
end;
end;
//色変更
FGPBitmap.GetPixel(X, Y, LGPTargetColor);
ChangeColor(FGPBitmap, LGPTargetColor, FGPUseColor);
//変更結果を描画
DisplayImageToTImage;
End;
end;
//=============================================================================
// Image3のOnMouseDownイベント処理
// 色選択ダイアログを表示してピクセルの色を変更に使用する色を選択
// TColorDialogダイアログにはアルファ値の設定機能はない
//
// Imaae2はピクセルの色変更に使用する色表示用のコントロール
//=============================================================================
procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ColorDialog1.Color := ARGBToColorRef(FGPUseColor);
if ColorDialog1.Execute then begin
FGPUseColor := ColorRefToARGB(ColorDialog1.Color);
DrawUseColorToTImage(FGPUseColor);
end;
end;
//-----------------------------------------------------------------------------
// TImageへの描画のコード
//-----------------------------------------------------------------------------
procedure TForm1.DisplayImageToTImage;
var
LGPGraphics : TGPGraphics;
begin
Image1.Picture.Assign(nil);
Image1.Picture.Bitmap.SetSize(FDispImgWidth, FDispImgHeight);
LGPGraphics := TGPGraphics.Create(Image1.Canvas.Handle);
try
//背景画像の指定があれば描画
if Assigned(FBackTBitmap) then begin
Image1.Canvas.Brush.Bitmap := FBackTBitmap;
Image1.Canvas.FillRect(Image1.ClientRect);
end;
LGPGraphics.DrawImage(FGPBitmap,
MakeRect(0, 0, FDispImgWidth, FDispImgHeight),
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight,
UnitPixel);
finally
FreeAndNil(LGPGraphics);
end;
end;
//-----------------------------------------------------------------------------
// 使用する色を表示しておくTImaeコントロールへの描画用ルーチン
//-----------------------------------------------------------------------------
procedure TForm1.DrawUseColorToTImage(AColor: TGPColor);
var
LGPGraphic : TGPGraphics;
LGPBrush : TGPSolidBrush;
LGPRect : TGPRect;
begin
Image2.Picture.Assign(nil);
//TGPSolidBrushを生成
LGPBrush := TGPSolidBrush.Create(AColor);
//描画先をTImageにしてTGPGraphics.Create
LGPGraphic := TGPGraphics.Create(Image2.Canvas.Handle);
try
//矩形を塗り潰し描画
LGPRect := MakeRect(0, 0, Image2.Width, Image2.Height);
LGPGraphic.FillRectangle(LGPBrush, LGPRect);
finally
FreeAndNil(LGPGraphic);
FreeAndNil(LGPBrush);
end;
Edit1.Text := '$' + IntToHex(AColor, 8);
end;
| 05_TColorMap を使用したピクセルの色の変更 |
|
GDI+ には TColorMap を使用した色の変更機能があります．それを使用したサンプルです．
この TColorMap を使用する方法は，SetRemapTable というメソッドで設定します．おそらくカラーテーブルの操作をしているものと思われます．そのため，画像によっては，思わぬピクセルの色が変更されることがあります．
本ページで使用しているヒヨコの画像に限っては前項のサンプルでの結果と同じです．
特定の色を透明色にする SetColorKey というメソッドもあります．
|
 |
図16
テスト用の EXE の起動画面 |
リスト5
TColorMap を使用したピクセルの塗り潰し |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL, ComCtrls, ExtDlgs,
ImgList, ToolWin;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
ImageList1: TImageList;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
Edit1: TEdit;
ColorDialog1: TColorDialog;
ToolButton3: TToolButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ToolButton3Click(Sender: TObject);
private
{ Privat e 宣言 }
FMemStream : TBytesStream;
FGPBitmap : TGPBitmap;
FBackTBitmap : TBitmap;
FDispImgWidth : Integer;
FDispImgHeight : Integer;
FGPUseColor : TGPColor;
FOperationNo : Cardinal;
procedure DisplayImageToTImage;
procedure DrawUseColorToTImage(AColor: TGPColor);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//-----------------------------------------------------------
// GifImagにもTColorMapの定義がある
// GifImagも使用することがあるかも知れないのでここで定義
//-----------------------------------------------------------
type
ColorMap = packed record
oldColor: TGPColor;
newColor: TGPColor;
end;
TColorMap = ColorMap;
PColorMap = ^TColorMap;
const
OPERATION_NONE = $00;
OPERATION_PAINT_COLORMAP = $300;
//=============================================================================
// フォーム生成時の処理
//
// TToolBarの各TToolButtonのプロパティの値を以下にしている
// (ToolButton3を除く)
// この設定でTToolButton.Downプロパティの値が使用可能になる
// TToolButton.Grouped := True:;
// TToolButton.Style := tbsCheck;
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LBackGroundFile : string;
begin
Image1.Transparent := False;
Image2.Transparent := False;
//背景に描画する格子状の市松模様のビットマップ画像の設定
//透過状態を確認するために施用する
FBackTBitmap := TBitmap.Create;
LBackGroundFile := ExpandFileName('.\backTexture_01.bmp');
if FileExists(LBackGroundFile) then begin
FBackTBitmap.LoadFromFile(LBackGroundFile);
end else begin
FBackTBitmap := nil;
end;
//メモリストリームに画像ファイルを読み込む
FMemStream := TBytesStream.Create;
FMemStream.LoadFromFile('502.png');
//メモリストリームからTGPBitmapを作成
FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
//サイズを指定して画像を描画
FDispImgWidth := 250;
FDispImgHeight := Trunc(FDispImgWidth * FGPBitmap.GetHeight / FGPBitmap.GetWidth);
DisplayImageToTImage;
//使用する色の初期値
FGPUseColor := ColorRefToARGB(clBlack);
DrawUseColorToTImage(FGPUseColor);
//作業の種類
//TToolButton.Downプロパティの値でどのボタンが押された状態かを知ることができるが
//ここでは作業内容を定数値で判定することにする
FOperationNo := OPERATION_NONE;
end;
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
if Assigned(FMemStream) then FreeAndNil(FMemStream);
if Assigned(FBackTBitmap) then FreeAndNil(FBackTBitmap);
end;
//=============================================================================
// ToolButton1のOnClickイベント処理
// 他のTToolButtonとの共有イベント
// (ToolButton3を除く)
// 操作内容の設定
//=============================================================================
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
if Sender = ToolButton1 then begin
FOperationNo := OPERATION_NONE;
end else
if Sender = ToolButton2 then begin
FOperationNo := OPERATION_PAINT_COLORMAP;
end;
end;
//=============================================================================
// ToolButton3のOnClickイベント処理
// 画像を，読み込んだ時の状態に戻す
//=============================================================================
procedure TForm1.ToolButton3Click(Sender: TObject);
begin
if not Assigned(FGPBitmap) then exit;
FreeAndNil(FGPBitmap);
FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
//描画
DisplayImageToTImage;
end;
//=============================================================================
// Image1のOnMouseDownイベント処理
// クリックしたピクセルと同じ色のピクセルを変更
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
LGPGraphics : TGPGraphics;
LGPBitmap : TGPBitmap;
LGPTargetColor : TGPColor;
LGPImageAttr : TGPImageAttributes;
LGPColorMap : array of TColorMap;
begin
if not Assigned(FGPBitmap) then exit;
if Button <> mbLeft then exit;
if FOperationNo = OPERATION_PAINT_COLORMAP then begin
//現在の描画サイズと同じサイズのTGPBitmapを作成
if (FGPBitmap.GetWidth <> FDispImgWidth)
or (FGPBitmap.GetHeight <> FDispImgHeight) then begin
LGPBitmap := TGPBitmap.Create(FDispImgWidth, FDispImgHeight);
LGPGraphics := TGPGraphics.Create(LGPBitmap);
try
LGPGraphics.DrawImage(FGPBitmap,
MakeRect(0, 0, FDispImgWidth, FDispImgHeight),
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight,
UnitPixel);
//これでFGPBitmapが現在表示中のサイズになる
FGPBitmap := TGPBitmap(LGPBitmap.Clone);
finally
FreeAndNil(LGPBitmap);
end;
end;
//カラーマップの設定
FGPBitmap.GetPixel(X, Y, LGPTargetColor);
SetLength(LGPColorMap, 1);
LGPColorMap[0].oldColor := LGPTargetColor;
LGPColorMap[0].newColor := FGPUseColor;
//設定した属性で現在のTGPBitmapに描画する
LGPBitmap := TGPBitmap(FGPBitmap.Clone);
LGPImageAttr := TGPImageAttributes.Create;
LGPGraphics := TGPGraphics.Create(FGPBitmap);
try
LGPImageAttr.SetRemapTable(Length(LGPColorMap), @LGPColorMap[0]);
LGPGraphics.DrawImage(LGPBitmap,
MakeRect(0, 0, LGPBitmap.GetWidth, LGPBitmap.GetHeight),
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight,
UnitPixel,
LGPImageAttr);
finally
FreeAndNil(LGPGraphics);
FreeAndNil(LGPBitmap);
FreeAndNil(LGPImageAttr);
end;
//変更結果を描画
DisplayImageToTImage;
End;
end;
//=============================================================================
// Image3のOnMouseDownイベント処理
// 色選択ダイアログを表示してピクセルの色を変更に使用する色を選択
// TColorDialogダイアログにはアルファ値の設定機能はない
//
// Imaae2はピクセルの色変更に使用する色表示用のコントロール
//=============================================================================
procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ColorDialog1.Color := ARGBToColorRef(FGPUseColor);
if ColorDialog1.Execute then begin
FGPUseColor := ColorRefToARGB(ColorDialog1.Color);
DrawUseColorToTImage(FGPUseColor);
end;
end;
//-----------------------------------------------------------------------------
// TImageへの描画のコード
//-----------------------------------------------------------------------------
procedure TForm1.DisplayImageToTImage;
var
LGPGraphics : TGPGraphics;
begin
Image1.Picture.Assign(nil);
Image1.Picture.Bitmap.SetSize(FDispImgWidth, FDispImgHeight);
LGPGraphics := TGPGraphics.Create(Image1.Canvas.Handle);
try
//背景画像の指定があれば描画
if Assigned(FBackTBitmap) then begin
Image1.Canvas.Brush.Bitmap := FBackTBitmap;
Image1.Canvas.FillRect(Image1.ClientRect);
end;
LGPGraphics.DrawImage(FGPBitmap,
MakeRect(0, 0, FDispImgWidth, FDispImgHeight),
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight,
UnitPixel);
finally
FreeAndNil(LGPGraphics);
end;
end;
//-----------------------------------------------------------------------------
// 使用する色を表示しておくTImaeコントロールへの描画用ルーチン
//-----------------------------------------------------------------------------
procedure TForm1.DrawUseColorToTImage(AColor: TGPColor);
var
LGPGraphic : TGPGraphics;
LGPBrush : TGPSolidBrush;
LGPRect : TGPRect;
begin
Image2.Picture.Assign(nil);
//TGPSolidBrushを生成
LGPBrush := TGPSolidBrush.Create(AColor);
//描画先をTImageにしてTGPGraphics.Create
LGPGraphic := TGPGraphics.Create(Image2.Canvas.Handle);
try
//矩形を塗り潰し描画
LGPRect := MakeRect(0, 0, Image2.Width, Image2.Height);
LGPGraphic.FillRectangle(LGPBrush, LGPRect);
finally
FreeAndNil(LGPGraphic);
FreeAndNil(LGPBrush);
end;
Edit1.Text := '$' + IntToHex(AColor, 8);
end;
end.
|
直線を描く際，描画の始点と終点の位置をマウスの操作で設定する方法です．このような用途にはラバーバンドを使用します．本サンプルでは，マウスのドラッグ中はらはけーバンドを描画し，マウスボタンを放したらラバーバンドの描画を終了して実際の直線を描画します．
本サンプルは画像を表示しません．空の TBPBitmap を作成してそこに描画するようにしています．
|
 |
図17
設計時の画面 |
 |
図18
ラバーバンドの描画中
- 描画開始点でマウスの左ボタンを押下
- 左ボタンを押下したままドラッグ
- 描画の終了点でボタンを放す
|
 |
図19
直線の描画例
|
 |
図20
グラデーション付きの直線 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL, ComCtrls, ExtDlgs,
ImgList, ToolWin;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
Image3: TImage;
ImageList1: TImageList;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
Edit1: TEdit;
ColorDialog1: TColorDialog;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure Image3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Privat e 宣言 }
FPixelRectSize : Cardinal;
FMaxImgPixels : Integer;
FPixelGridColor : TColor;
FGPBitmap : TGPBitmap;
FBackTBitmap : TBitmap;
FGPUseColor : TGPColor;
FOperationNo : Cardinal;
procedure DisplayImageAndGridLine(NeedInvalidate: Boolean);
procedure DrawUseColorToTImage(AColor: TGPColor);
public
{ Public 宣言 }
procedure DrawPixelColorToTImage(SrcGPBitmap: TGPBitmap; DrawTimage: TImage;
PixelRectSize: Integer; MaxImgPixels: Integer; GridLineColor: TColor;
BackImage: TBitmap = nil; ShowGridLine: Boolean = True;
BackGround: Boolean = True);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
OPERATION_NONE = $00;
OPERATION_DRAWLINE_SOLID = $30;
OPERATION_DRAWLINE_LINER = $40;
var
Flag_Continuance : Boolean = False;
Flag_DragDrawing : Boolean = False;
FStartPosX : Integer;
FStartPosY : Integer;
FPrevPosX : Integer;
FPrevPosY : Integer;
//=============================================================================
// フォーム生成時の処理
//
// TToolBarの各TToolButtonのプロパティの値を以下にしている
// (ToolButtonを除く)
// この設定でTToolButton.Downプロパティの値が使用可能になる
// TToolButton.Grouped := True:;
// TToolButton.Style := tbsCheck;
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LBackGroundFile : string;
begin
//グリッド線の色とピクセルの描画サイズ等
FPixelGridColor := clGray;
FPixelRectSize := 9;
FMaxImgPixels := 128;
Image1.Transparent := False;
Image2.Transparent := False;
Image3.Transparent := False;
//背景に描画する格子状の市松模様のビットマップ画像の設定
//透過状態を確認するために施用する
FBackTBitmap := TBitmap.Create;
LBackGroundFile := ExpandFileName('.\backTexture_02.bmp');
if FileExists(LBackGroundFile) then begin
FBackTBitmap.LoadFromFile(LBackGroundFile);
end else begin
FBackTBitmap := nil;
end;
//画像のない空のTGPBitmapを作成
FGPBitmap := TGPBitmap.Create(32, 32);
//使用する色の初期値
FGPUseColor := ColorRefToARGB(clBlack);
DrawUseColorToTImage(FGPUseColor);
//画像とピクセルのグリッド表示
DisplayImageAndGridLine(True);
//作業の種類
FOperationNo := OPERATION_NONE;
end;
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
if Assigned(FBackTBitmap) then FreeAndNil(FBackTBitmap);
end;
//=============================================================================
// ToolButton1のOnClickイベント処理
// 他のTToolButtonとの共有イベント
// (ToolButtonを除く)
// 操作内容の設定
//=============================================================================
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
if Sender = ToolButton1 then begin
FOperationNo := OPERATION_NONE;
end else
if Sender = ToolButton2 then begin
FOperationNo := OPERATION_DRAWLINE_SOLID;
end else
if Sender = ToolButton3 then begin
FOperationNo := OPERATION_DRAWLINE_LINER;
end;
end;
//=============================================================================
// ToolButton4のOnClickイベント処理
// 描画のクリア
//=============================================================================
procedure TForm1.ToolButton4Click(Sender: TObject);
var
LGPGraphics : TGPGraphics;
begin
if not Assigned(FGPBitmap) then exit;
LGPGraphics := TGPGraphics.Create(FGPBitmap);
try
LGPGraphics.Clear(0);
finally
FreeAndNil(LGPGraphics);
end;
DisplayImageAndGridLine(True);
end;
//=============================================================================
// Image1のOnMouseDownイベント処理
// ラバーバンドの描画開始
//
// Imaae1は画像を拡大表示したピクセルの色表示用
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
LPoint : TPoint;
LClipRect : TRect;
begin
if not Assigned(FGPBitmap) then exit;
if Button <> mbLeft then exit;
if (FOperationNo = OPERATION_DRAWLINE_SOLID)
or (FOperationNo = OPERATION_DRAWLINE_LINER) then begin
Flag_DragDrawing := True;
//マウスカーソルが描画用コントロールの外側に移動しないようにクリップ
LPoint := TControl(Sender).ClientToScreen(Point(0, 0));
LClipRect := Rect(LPoint.X, LPoint.Y,
LPoint.X + TControl(Sender).Width,
LPoint.Y + TControl(Sender).Height);
ClipCursor(@LClipRect);
//ラバーバンドを描画する線の設定
//ModeをpmNotXorにして重ね描画したら消去できるようにする
Image1.Canvas.Pen.Color := clBlack;
Image1.Canvas.Pen.Width := 2;
Image1.Canvas.Pen.Style := psSolid;
Image1.Canvas.Pen.Mode := pmNotXor;
//マウスダウンした位置と描画端点の座標を保持
FStartPosX := X;
FStartPosY := Y;
FPrevPosX := X;
FPrevPosY := Y;
//描画開始点にペンを移動
Image1.Canvas.MoveTo(FStartPosX, FStartPosY);
end else
if FOperationNo = OPERATION_DRAWLINE_LINER then begin
end;
end;
//=============================================================================
// Image1のOnMouseMoveイベント処理
// マウスドラック中の処理(ラバーバンド描画中の処理)
//=============================================================================
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if Flag_DragDrawing then begin
//描画した線を重ね描画して消去
Image1.Canvas.MoveTo(FStartPosX, FStartPosY);
Image1.Canvas.LineTo(FPrevPosX, FPrevPosY);
//新規に線を描画
Image1.Canvas.MoveTo(FStartPosX, FStartPosY);
Image1.Canvas.LineTo(X, Y);
//描画端点の現在の座標値を保持
FPrevPosX := X;
FPrevPosY := Y;
end;
end;
//=============================================================================
// Image1のOnMouseUpイベント処理
// マウスドラック終了(ラバーバンド描画終了)
// 実際に直線を描画する
//=============================================================================
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
LPenWidth : Single;
LGPGraphics : TGPGraphics;
LGPPen : TGPPen;
LGPLinerBrush : TGPLinearGradientBrush;
begin
if Flag_DragDrawing then begin
Flag_DragDrawing := False;
//最後の描画を重ね描画して消去
Image1.Canvas.MoveTo(FStartPosX, FStartPosY);
Image1.Canvas.LineTo(X, Y);
//マウスの移動のクリップを解除
ClipCursor(nil);
//実際の画像の座標値に変換
FStartPosX := FStartPosX div FPixelRectSize;
FStartPosY := FStartPosY div FPixelRectSize;
FPrevPosX := X div FPixelRectSize;
FPrevPosY := Y div FPixelRectSize;
//-------------------------------------------------------------------------
// ここまででラバーバンドは終了
// 以下が実際の直線の描画
// 描画はTGPBitmapに対して行い．その語そのTGPBitmapをTImageのCanvasに描画
//-------------------------------------------------------------------------
if FOperationNo = OPERATION_DRAWLINE_SOLID then begin
LPenWidth := 1.0;
LGPGraphics := TGPGraphics.Create(FGPBitmap);
LGPPen := TGPPen.Create(FGPUseColor, LPenWidth);
try
//アンチエイリアスの設定をして描画
LGPGraphics.SetSmoothingMode(SmoothingModeAntiAlias);
LGPGraphics.DrawLine(LGPPen, FStartPosX, FStartPosY, FPrevPosX, FPrevPosY);
finally
FreeAndNil(LGPGraphics);
FreeAndNil(LGPPen);
end;
end else
if FOperationNo = OPERATION_DRAWLINE_LINER then begin
LPenWidth := 3.5;
LGPLinerBrush := TGPLinearGradientBrush.Create(MakeRect(
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight),
FGPUseColor,
aclWhite,
LinearGradientModeForwardDiagonal);
LGPGraphics := TGPGraphics.Create(FGPBitmap);
LGPPen := TGPPen.Create(LGPLinerBrush, LPenWidth);
try
//端点とアンチエイリアスの設定をして描画
LGPPen.SetStartCap(LineCapRound);
LGPPen.SetEndCap(LineCapRound);
LGPGraphics.SetSmoothingMode(SmoothingModeAntiAlias);
LGPGraphics.DrawLine(LGPPen, FStartPosX, FStartPosY, FPrevPosX, FPrevPosY);
finally
FreeAndNil(LGPGraphics);
FreeAndNil(LGPPen);
FreeAndNil(LGPLinerBrush);
end;
end;
end;
//画像とピクセルのグリッド表示
DisplayImageAndGridLine(True);
end;
//=============================================================================
// Image3のOnMouseDownイベント処理
// 色選択ダイアログを表示してピクセルの色を変更する色を選択
// TColorDialogダイアログにはアルファ値の設定機能はない
//
// Imaae3はピクセルの色変更に使用する色表示用のコントロール
//=============================================================================
procedure TForm1.Image3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ColorDialog1.Color := ARGBToColorRef(FGPUseColor);
if ColorDialog1.Execute then begin
FGPUseColor := ColorRefToARGB(ColorDialog1.Color);
DrawUseColorToTImage(FGPUseColor);
end;
end;
//-----------------------------------------------------------------------------
// TImageへの描画のコード
// 実サイズと拡大表示用グリッド表示
//-----------------------------------------------------------------------------
procedure TForm1.DisplayImageAndGridLine(NeedInvalidate: Boolean);
var
LGPGraphics : TGPGraphics;
begin
//TGPBitmapをTImageに実サイズで描画
if NeedInvalidate then begin
Image2.Picture.Assign(nil);
LGPGraphics := TGPGraphics.Create(Image2.Canvas.Handle);
LGPGraphics.DrawImage(FGPBitmap, 0, 0);
LGPGraphics.Free;
end;
//ピクセルのグリッド表示
DrawPixelColorToTImage(FGPBitmap, Image1, FPixelRectSize, FMaxImgPixels,
FPixelGridColor, FBackTBitmap);
end;
//-----------------------------------------------------------------------------
// 使用する色を表示しておくTImaeコントロールへの描画用ルーチン
//-----------------------------------------------------------------------------
procedure TForm1.DrawUseColorToTImage(AColor: TGPColor);
var
LGPGraphic : TGPGraphics;
LGPBrush : TGPSolidBrush;
LGPRect : TGPRect;
begin
Image3.Picture.Assign(nil);
//TGPSolidBrushを生成
LGPBrush := TGPSolidBrush.Create(AColor);
//描画先をTImageにしてTGPGraphics.Create
LGPGraphic := TGPGraphics.Create(Image3.Canvas.Handle);
try
LGPRect := MakeRect(0, 0, Image3.Width, Image3.Height);
LGPGraphic.FillRectangle(LGPBrush, LGPRect);
finally
FreeAndNil(LGPGraphic);
FreeAndNil(LGPBrush);
end;
Edit1.Text := '$' + IntToHex(AColor, 8);
end;
| 07_マウスの移動軌跡に沿った描画と消しゴムツール |
|
マウスの左ボタンを押下したままドラッグすると，マウスの移動軌跡のピクセルを塗り潰す動作をするサンプルです．鉛筆とか，自由線の描画ということもあるようです．
考え方としてはマウスの軌跡に伴って直線を描画すればいいわけですが，直線だけだと描画が乱れることがあります．そこで本サンプルでは TGPSolidBrush による塗り潰しも実行しています．
ピクセルの色を透明にすることと，透明な色で描画することとは違います．透明な色で描画すると，色が透明ですから何も描画されません．画像のその部分は元のままです．背景が透明な画像を重ね描画する時も同じです，重ね描画した画像の透明色の部分のピクセルは透明色にはなりません．
このサンプルは少し動作が重たくなっています．工夫の余地がありそうです．
|
|
[備考 1]
このようなリアルタイムで描画に負担がかかる描画処理は，他のページの GDI+ のサンプルのように，TPanel や TPaintBox あるいは TGraphicControl の継承クラスを作成し，Paint メソッドで処理するとパフォーマンスの向上が期待できます．
本サンプルを含めて，TImage への描画のサンプルの多くは，元々 TGraphicControl の継承クラスを使用して作成したものです．サイトのサンプルとして記事にする際に TImage への描画コードに変更しています．
GDI+ は機能が豊富な分オーバーヘッドがあります．TImaage は内部でオフスクリーンビットマップを使用した処理を行いますから，更にオーバーヘッドが生じます．
|
[備考 2]
本サンプルでは TToolBar を TPanel の上に配置しています．詳しくはコード内のコメントで確認してください． |
 |
図21
マウスで文字を書いてみた |
 |
図22
ピクセルの透明化
|
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL, ComCtrls, ExtDlgs,
ImgList, ToolWin;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
ImageList1: TImageList;
Edit1: TEdit;
ColorDialog1: TColorDialog;
Panel1: TPanel;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton4Click(Sender: TObject);
procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Privat e 宣言 }
FMemStream : TBytesStream;
FGPBitmap : TGPBitmap;
FBackTBitmap : TBitmap;
FDispImgWidth : Integer;
FDispImgHeight : Integer;
FGPUseColor : TGPColor;
FOperationNo : Cardinal;
FDrawLineWidth : Single;
procedure DisplayImageToTImage;
procedure DrawUseColorToTImage(AColor: TGPColor);
procedure DrawFreeLine(ATImage: TImage; AGPBitmap: TGPBitmap; StartX,
StartY, EndX, EndY: Integer; ASize: Single; AColor: TGPColor);
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
const
OPERATION_NONE = $00;
OPERATION_PAINT_DRAGDRAW = $400;
OPERATION_PAINT_DRAGDRAW_ERASE = $500;
var
Flag_Continuance : Boolean = False;
Flag_DragDrawing : Boolean = False;
FStartPosX : Integer;
FStartPosY : Integer;
FPrevPosX : Integer;
FPrevPosY : Integer;
//=============================================================================
// フォーム生成時の処理
//
// TToolBarの各TToolButtonのプロパティの値を以下にしている
// (ToolButton4を除く)
// この設定でTToolButton.Downプロパティの値が使用可能になる
// TToolButton.Grouped := True:;
// TToolButton.Style := tbsCheck;
//
// ToolBar1.ParentDoubleBuffered := False
// Form1.DoubleBuffered := True;
//
// ToolBar1はTPanelの上に配置している
// Form1.DoubleBuffered := True;にすると描画が乱れるため
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LBackGroundFile : string;
begin
Image1.Transparent := False;
Image2.Transparent := False;
//背景に描画する格子状の市松模様のビットマップ画像の設定
//透過状態を確認するために施用する
FBackTBitmap := TBitmap.Create;
LBackGroundFile := ExpandFileName('.\backTexture_01.bmp');
if FileExists(LBackGroundFile) then begin
FBackTBitmap.LoadFromFile(LBackGroundFile);
end else begin
FBackTBitmap := nil;
end;
//メモリストリームに画像ファイルを読み込む
FMemStream := TBytesStream.Create;
FMemStream.LoadFromFile('502.png');
//メモリストリームからTGPBitmapを作成
FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
//サイズを指定して画像を描画
FDispImgWidth := 250;
FDispImgHeight := Trunc(FDispImgWidth * FGPBitmap.GetHeight / FGPBitmap.GetWidth);
DisplayImageToTImage;
//使用する色の初期値
FGPUseColor := ColorRefToARGB(clBlack);
DrawUseColorToTImage(FGPUseColor);
//作業の種類
//TToolButton.Downプロパティの値でどのボタンが押された状態かを知ることができるが
//ここでは作業内容を定数値で判定することにする
FOperationNo := OPERATION_NONE;
//描画する自由泉の太さ
FDrawLineWidth := 10.0;
end;
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
if Assigned(FMemStream) then FreeAndNil(FMemStream);
if Assigned(FBackTBitmap) then FreeAndNil(FBackTBitmap);
end;
//=============================================================================
// ToolButton1のOnClickイベント処理
// 他のTToolButtonとの共有イベント
// (ToolButton4を除く)
// 操作内容の設定
//=============================================================================
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
if Sender = ToolButton1 then begin
FOperationNo := OPERATION_NONE;
end else
if Sender = ToolButton2 then begin
FOperationNo := OPERATION_PAINT_DRAGDRAW;
end else
if Sender = ToolButton3 then begin
FOperationNo := OPERATION_PAINT_DRAGDRAW_ERASE;
end;
end;
//=============================================================================
// ToolButton4のOnClickイベント処理
// 画像を，読み込んだ時の状態に戻す
//=============================================================================
procedure TForm1.ToolButton4Click(Sender: TObject);
begin
if not Assigned(FGPBitmap) then exit;
FreeAndNil(FGPBitmap);
FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
//描画
DisplayImageToTImage;
end;
//=============================================================================
// Image1のOnMouseDownイベント処理
// クリックしたピクセルと同じ色のピクセルを変更
//=============================================================================
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
LGPGraphics : TGPGraphics;
LGPBitmap : TGPBitmap;
LPoint : TPoint;
LClipRect : TRect;
begin
if not Assigned(FGPBitmap) then exit;
if Button <> mbLeft then exit;
if (FOperationNo = OPERATION_PAINT_DRAGDRAW)
or (FOperationNo = OPERATION_PAINT_DRAGDRAW_ERASE) then begin
//現在の描画サイズと同じサイズのTGPBitmapを作成
if (FGPBitmap.GetWidth <> FDispImgWidth)
or (FGPBitmap.GetHeight <> FDispImgHeight) then begin
LGPBitmap := TGPBitmap.Create(FDispImgWidth, FDispImgHeight);
LGPGraphics := TGPGraphics.Create(LGPBitmap);
try
LGPGraphics.DrawImage(FGPBitmap,
MakeRect(0, 0, FDispImgWidth, FDispImgHeight),
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight,
UnitPixel);
//これでFGPBitmapが現在表示中のサイズになる
FGPBitmap := TGPBitmap(LGPBitmap.Clone);
finally
FreeAndNil(LGPBitmap);
end;
end;
Flag_DragDrawing := True;
//マウスカーソルが描画用コントロールの外側に移動しないようにクリップ
LPoint := TControl(Sender).ClientToScreen(Point(0, 0));
LClipRect := Rect(LPoint.X, LPoint.Y,
LPoint.X + TControl(Sender).Width,
LPoint.Y + TControl(Sender).Height);
ClipCursor(@LClipRect);
//マウスダウンした位置と描画端点の座標を保持
FStartPosX := X;
FStartPosY := Y;
FPrevPosX := X;
FPrevPosY := Y;
end;
end;
//=============================================================================
// Panel1のOnMouseMoveイベント処理
// 描画中の処理
//=============================================================================
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
LGPColor : TGPColor;
begin
if Flag_DragDrawing then begin
if (FOperationNo = OPERATION_PAINT_DRAGDRAW)
or (FOperationNo = OPERATION_PAINT_DRAGDRAW_ERASE) then begin
if FOperationNo = OPERATION_PAINT_DRAGDRAW then begin
LGPColor := FGPUseColor;
end else begin
LGPColor := 0;
end;
DrawFreeLine(Image1, FGPBitmap, FPrevPosX, FPrevPosY, X, Y,
FDrawLineWidth, LGPColor);
FPrevPosX := X;
FPrevPosY := Y;
end;
end;
end;
//=============================================================================
// Panel1のOnMouseUpイベント処理
// 描画終了
//=============================================================================
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Flag_DragDrawing then begin
Flag_DragDrawing := False;
//マウスの移動のクリップを解除
ClipCursor(nil);
end;
end;
//=============================================================================
// Image3のOnMouseDownイベント処理
// 色選択ダイアログを表示してピクセルの色を変更に使用する色を選択
// TColorDialogダイアログにはアルファ値の設定機能はない
//
// Imaae2はピクセルの色変更に使用する色表示用のコントロール
//=============================================================================
procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ColorDialog1.Color := ARGBToColorRef(FGPUseColor);
if ColorDialog1.Execute then begin
FGPUseColor := ColorRefToARGB(ColorDialog1.Color);
DrawUseColorToTImage(FGPUseColor);
end;
end;
//-----------------------------------------------------------------------------
// TImageへの描画のコード
//-----------------------------------------------------------------------------
procedure TForm1.DisplayImageToTImage;
var
LGPGraphics : TGPGraphics;
begin
Image1.Picture.Assign(nil);
if (FDispImgWidth <> Image1.Width) or (FDispImgHeight <> Image1.Height) then begin
Image1.Picture.Bitmap.SetSize(FDispImgWidth, FDispImgHeight);
end;
LGPGraphics := TGPGraphics.Create(Image1.Canvas.Handle);
try
//背景画像の指定があれば描画
if Assigned(FBackTBitmap) then begin
Image1.Canvas.Brush.Bitmap := FBackTBitmap;
Image1.Canvas.FillRect(Image1.ClientRect);
end;
LGPGraphics.DrawImage(FGPBitmap,
MakeRect(0, 0, FDispImgWidth, FDispImgHeight),
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight,
UnitPixel);
finally
FreeAndNil(LGPGraphics);
end;
end;
//-----------------------------------------------------------------------------
// 使用する色を表示しておくTImaeコントロールへの描画用ルーチン
//-----------------------------------------------------------------------------
procedure TForm1.DrawUseColorToTImage(AColor: TGPColor);
var
LGPGraphic : TGPGraphics;
LGPBrush : TGPSolidBrush;
LGPRect : TGPRect;
begin
Image2.Picture.Assign(nil);
//TGPSolidBrushを生成
LGPBrush := TGPSolidBrush.Create(AColor);
//描画先をTImageにしてTGPGraphics.Create
LGPGraphic := TGPGraphics.Create(Image2.Canvas.Handle);
try
//矩形を塗り潰し描画
LGPRect := MakeRect(0, 0, Image2.Width, Image2.Height);
LGPGraphic.FillRectangle(LGPBrush, LGPRect);
finally
FreeAndNil(LGPGraphic);
FreeAndNil(LGPBrush);
end;
Edit1.Text := '$' + IntToHex(AColor, 8);
end;
//-----------------------------------------------------------------------------
// マウスの移動に伴い描画する線のルーチン
// 動作速度に多少問題あり
// 移動速度が速いと描画が乱れる場合あり
//-----------------------------------------------------------------------------
procedure TForm1.DrawFreeLine(ATImage: TImage; AGPBitmap: TGPBitmap;
StartX, StartY, EndX, EndY: Integer; ASize: Single; AColor: TGPColor);
var
LGPGRraphic : TGPGraphics;
LGPPen : TGPPen;
LGPBrush : TGPSolidBrush;
LLeft : Single;
LTop : Single;
begin
LGPPen := TGPPen.Create(AColor, ASize);
LGPBrush := TGPSolidBrush.Create(AColor);
LGPGRraphic := TGPGraphics.Create(AGPBitmap);
try
if AColor = 0 then begin
LGPGRraphic.SetCompositingMode(CompositingModeSourceCopy);
end;
LLeft := StartX - ASize / 2.0;
LTop := StartY - ASize / 2.0;
LGPGRraphic.FillRectangle(LGPBrush, LLeft, LTop, ASize, ASize);
LGPGRraphic.DrawLine(LGPPen, StartX, StartY, EndX, EndY);
finally
FreeAndNil(LGPGRraphic);
FreeAndNil(LGPPen);
FreeAndNil(LGPBrush);
end;
DisplayImageToTImage;
end;
end.
| 08_アイコン画像の上下左右へのシフト - 画像の描画位置の調整 |
|
画像全体のピクセルの上下左右への移動操作用のサンプルです．
ピクセルを行単位あるいは列単位で移動する方式だと，逆方向の移動をすると元の画像が欠落してしまいます．そこで，TCanvas の CopyRect と同じような方法でシフトするようにしています．
読み込み可能なのは PNG 形式とビットマップ画像ファイルだけです．保存も同じです．画像ファイルを読み込むと左下のピクセルの色を強制的に透明色にします．
画像を読み込む時に 24 x 24 のサイズにリサイズすることができます．画像全体のサイズは 32 x 32 のままで，画像部分を少し小さ目にしたい場合にも利用できます．
|
 |
図23
設計時の画面 |
 |
図24
元の画像 |
 |
図25
24 x 24 にリサイズして読み込み |
 |
図26
位置の調整例 |
リスト8
画像の上下左右へのシフト - 画像の描画位置の調整 |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL, ComCtrls, ExtDlgs,
ImgList, ToolWin;
type
TForm1 = class(TForm)
Image2: TImage;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
SavePictureDialog1: TSavePictureDialog;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton7: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ImageList1: TImageList;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
CheckBox1: TCheckBox;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton2Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton8Click(Sender: TObject);
procedure ToolButton9Click(Sender: TObject);
private
{ Privat e 宣言 }
FLoadInitDir : string;
FSaveInitDir : string;
FImageFilePath : string;
FTempFilePath : string;
FSaveFilePath : string;
FPixelRectSize : Cardinal;
FMaxImgPixels : Integer;
FPixelGridColor : TColor;
FMemStream : TBytesStream;
FGPOriginBitmap : TGPBitmap;
FGPBitmap : TGPBitmap;
FBackTBitmap : TBitmap;
FUPMoveCnt : Integer;
FLeftMoveCnt : Integer;
procedure DisplayImageAndGridLine(NeedInvalidate: Boolean);
function SetAlphaValueFromTBitmap(DstGPBitmap: TGPBitmap;
SrcBitmap: TBitmap): Boolean;
function ChangeColor(TarGPBitmap: TGPBitmap; OldColor, NewColor: TGPColor):
Boolean;
public
{ Public 宣言 }
procedure DrawPixelColorToTImage(SrcGPBitmap: TGPBitmap; DrawTimage: TImage;
PixelRectSize: Integer; MaxImgPixels: Integer; GridLineColor: TColor;
BackImage: TBitmap = nil; ShowGridLine: Boolean = True;
BackGround: Boolean = True);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
var
LBackGroundFile : string;
begin
//ファイルの読み出しと保存先の初期ディレクトリ
FLoadInitDir := ExpandFileName('.\');
FSaveInitDir := ExpandFileName('.\');
//グリッド線の色とピクセルの描画サイズ等
FPixelGridColor := clGray;
FPixelRectSize := 9;
FMaxImgPixels := 128;
//読み込んだ画像を縮小リサイズ
CheckBox1.Checked := True;
Image1.Transparent := False;
Image2.Transparent := False;
//背景に描画する格子状の市松模様のビットマップ画像の設定
//透過状態を確認するために施用する
FBackTBitmap := TBitmap.Create;
LBackGroundFile := ExpandFileName('.\backTexture_02.bmp');
if FileExists(LBackGroundFile) then begin
FBackTBitmap.LoadFromFile(LBackGroundFile);
end else begin
FBackTBitmap := nil;
end;
end;
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FGPOriginBitmap) then FreeAndNil(FGPOriginBitmap);
if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
if Assigned(FMemStream) then FreeAndNil(FMemStream);
if Assigned(FBackTBitmap) then FreeAndNil(FBackTBitmap);
end;
//=============================================================================
// 画像ファイルの読み込み
// PNG形式とビットマップのみ
// 読み込み後，左下のピクセルの色を透過色として透明色に変換する
//=============================================================================
procedure TForm1.ToolButton1Click(Sender: TObject);
var
LGPGraphic : TGPGraphics;
LOriginSize : Integer;
LBitmap : TBitmap;
LGPColor : TGPColor;
begin
OpenPictureDialog1.Filter := 'PNG 画像|*.png'
+ '|ビットマップ画像|*.bmp';
OpenPictureDialog1.InitialDir := FLoadInitDir;
if not OpenPictureDialog1.Execute then exit;
FImageFilePath := OpenPictureDialog1.FileName;
FLoadInitDir := ExtractFileDir(FTempFilePath);
if Assigned(FGPOriginBitmap) then FreeAndNil(FGPOriginBitmap);
if Assigned(FGPBitmap) then FreeAndNil(FGPBitmap);
if Assigned(FMemStream) then FreeAndNil(FMemStream);
//メモリストリームに画像ファイルを読み込む
FMemStream := TBytesStream.Create;
FMemStream.LoadFromFile(FImageFilePath);
//メモリストリームからTGPBitmapを作成
//もう1つ同じものを作成しておく
FGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(FMemStream, soReference));
if UpperCase(ExtractFileExt(FImageFilePath)) = '.BMP' then begin
LBitmap := TBitmap.Create;
try
FMemStream.Position := 0;
LBitmap.LoadFromStream(FMemStream);
if LBitmap.PixelFormat = pf32bit then begin
SetAlphaValueFromTBitmap(FGPBitmap, LBitmap);
end;
finally
FreeAndNil(LBitmap);
end;
end else
if UpperCase(ExtractFileExt(FImageFilePath)) = '.PNG' then begin
//PNG形式の画像もアルファチャンネルの処理が必要な場合がある
//ここではアルファチャンネルの処理が必要ないPNG画像であると仮定
end else begin
exit;
end;
//画像の左下の色を透過色にする処理
FGPBitmap.GetPixel(0, FGPBitmap.GetHeight - 1, LGPColor);
ChangeColor(FGPBitmap, LGPColor, 0);
FGPOriginBitmap := TGPBitmap(FGPBitmap.Clone);
if CheckBox1.Checked then begin
//もう1つのTGPBitmapに読み込んだ画像を24x24にリサイズして描画
//このリサイズしたTGPBitmapをオリジナルの画像とする
LGPGraphic := TGPGraphics.Create(FGPOriginBitmap);
try
LOriginSize := 24;
LGPGraphic.Clear(0);
LGPGraphic.DrawImage(FGPBitmap,
MakeRect(0, 0, LOriginSize, LOriginSize),
0,
0,
FGPBitmap.GetWidth,
FGPBitmap.GetHeight,
UnitPixel);
FGPBitmap := TGPBitmap(FGPOriginBitmap.Clone);
finally
FreeAndNil(LGPGraphic);
end;
end;
//画像とピクセルのグリッド表示
DisplayImageAndGridLine(True);
//上下左右の移動量をリセット
FUPMoveCnt := 0;
FLeftMoveCnt := 0;
end;
//=============================================================================
// 編集結果を保存
// PNG形式とビットマップのみ
// ビットマップは32ビットのアルファチャンネル付きとなる
//=============================================================================
procedure TForm1.ToolButton2Click(Sender: TObject);
var
LImgGUID : TGUID;
LBitmap : TBitmap;
LhBitmap : HBITMAP;
begin
if not Assigned(FGPBitmap) then exit;
SavePictureDialog1.DefaultExt := '.png';
SavePictureDialog1.Filter := 'PNG 画像|*.png'
+ '|ビットマップ画像|*.bmp';
SavePictureDialog1.InitialDir := FSaveInitDir;
SavePictureDialog1.FileName := ExtractFileName(FImageFilePath);
if not SavePictureDialog1.Execute then exit;
FSaveFilePath := SavePictureDialog1.FileName;
FSaveInitDir := ExtractFileDir(FSaveFilePath);
if SavePictureDialog1.FilterIndex = 1 then begin
//PNG形式画像として保存
if GetEncoderClsid('image/png', LImgGUID) >= 0 then begin
FSaveFilePath := ChangeFileExt(FSaveFilePath, '.png');
FGPBitmap.Save(FSaveFilePath, LImgGUID);
end;
end else
if SavePictureDialog1.FilterIndex = 2 then begin
//ビットマップ画像として保存
LBitmap := TBitmap.Create;
try
FGPBitmap.GetHBITMAP(0, LhBitmap);
LBitmap.Handle := LhBitmap;
FSaveFilePath := ChangeFileExt(FSaveFilePath, '.bmp');
LBitmap.SaveToFile(FSaveFilePath);
finally
FreeAndNil(LBitmap);
end;
end;
end;
//=============================================================================
// 画像の追加描画の例
// 必要に応じて描画位置やサイズを指定して描画する
//=============================================================================
procedure TForm1.ToolButton9Click(Sender: TObject);
var
LFilePath : string;
LStream : TBytesStream;
LGPbitmap : TGPBitmap;
LGPGraphic : TGPGraphics;
LBitmap : TBitmap;
LGPColor : TGPColor;
begin
if not Assigned(FGPBitmap) then exit;
if not OpenPictureDialog1.Execute then exit;
LFilePath := OpenPictureDialog1.FileName;
//メモリストリームに画像ファイルを読み込む
LStream := TBytesStream.Create;
LStream.LoadFromFile(LFilePath);
//メモリストリームからTGPBitmapを作成
LGPBitmap := TGPBitmap.Create(TStreamAdapter.Create(LStream, soReference));
LGPGraphic := TGPGraphics.Create(FGPBitmap);
try
if UpperCase(ExtractFileExt(LFilePath)) = '.BMP' then begin
LBitmap := TBitmap.Create;
try
LStream.Position := 0;
LBitmap.LoadFromStream(LStream);
if LBitmap.PixelFormat = pf32bit then begin
SetAlphaValueFromTBitmap(LGPbitmap, LBitmap);
end;
finally
FreeAndNil(LBitmap);
end;
end else
if UpperCase(ExtractFileExt(FImageFilePath)) = '.PNG' then begin
//PNG形式の画像もアルファチャンネルの処理が必要な場合がある
//ここではアルファチャンネルの処理が必要ないPNG画像であると仮定
end else begin
exit;
end;
//画像の左下の色を透過色にする処理
LGPbitmap.GetPixel(0, LGPbitmap.GetHeight - 1, LGPColor);
ChangeColor(LGPbitmap, LGPColor, 0);
//描画
LGPGraphic.DrawImage(LGPBitmap, 0, 0);
DisplayImageAndGridLine(True);
finally
FreeAndNil(LStream);
FreeAndNil(LGPbitmap);
FreeAndNil(LGPGraphic);
end;
end;
//=============================================================================
// ToolButton3のOnClickイベント処理
// ToolButton3,ToolButton4,ToolButton5,ToolButton6共有のイベント
//
// 1ピクセル移動(上下左右共に1ピクセル単位)
//=============================================================================
procedure TForm1.ToolButton3Click(Sender: TObject);
var
LGPGraphic : TGPGraphics;
LWidth : Integer;
LHeight : Integer;
begin
if not Assigned(FGPBitmap) then exit;
LGPGraphic := TGPGraphics.Create(FGPBitmap);
try
//表示中の画像はクリア
LGPGraphic.Clear(0);
LWidth := FGPOriginBitmap.GetWidth;
LHeight := FGPOriginBitmap.GetHeight;
if Sender = ToolButton3 then begin
if FUPMoveCnt >= (LHeight - 3) then exit;
inc(FUPMoveCnt);
end else
if Sender = ToolButton4 then begin
if FUPMoveCnt <= -(LHeight - 3) then exit;
Dec(FUPMoveCnt);
end else
if Sender = ToolButton5 then begin
if FLeftMoveCnt >= (LWidth - 3) then exit;
inc(FLeftMoveCnt);
end else
if Sender = ToolButton6 then begin
if FLeftMoveCnt <= -(LWidth - 3) then exit;
Dec(FLeftMoveCnt);
end;
//元のTGPBitmapを指定ピクセル分だけ移動したTGPBitmapを作成
LGPGraphic.DrawImage(FGPOriginBitmap,
MakeRect(0, 0, LWidth, LHeight),
FLeftMoveCnt,
FUPMoveCnt,
LWidth,
LHeight,
UnitPixel);
//作成したTGPBitmapを描画
DisplayImageAndGridLine(True);
finally
FreeAndNil(LGPGraphic);
end;
end;
//=============================================================================
// 読み込んでリサイズした時の画像に戻す
//=============================================================================
procedure TForm1.ToolButton8Click(Sender: TObject);
begin
if not Assigned(FGPBitmap) then exit;
//上下左右の移動量をリセット
FUPMoveCnt := 0;
FLeftMoveCnt := 0;
FGPBitmap := TGPBitmap(FGPOriginBitmap.Clone);
DisplayImageAndGridLine(True);
end;
//-----------------------------------------------------------------------------
// TImageへの描画のコード
// 実サイズと拡大表示してグリッド線の描画
//-----------------------------------------------------------------------------
procedure TForm1.DisplayImageAndGridLine(NeedInvalidate: Boolean);
var
LGPGraphics : TGPGraphics;
begin
//TGPBitmapをTImageに実サイズで描画
if NeedInvalidate then begin
Image2.Picture.Assign(nil);
LGPGraphics := TGPGraphics.Create(Image2.Canvas.Handle);
LGPGraphics.DrawImage(FGPBitmap, 0, 0);
LGPGraphics.Free;
end;
//ピクセルのグリッド表示
DrawPixelColorToTImage(FGPBitmap, Image1, FPixelRectSize, FMaxImgPixels,
FPixelGridColor, FBackTBitmap);
end;
| 09_アイコン画像の重ね描画の例 - 画像の貼り付け |
前項のサンプルの左から 3 番目のボタンは画像の重ね描画用です．
下図のように，表示中の画像に別の画像を重ね描画します．つまり，[コピー] [貼り付け] と同じ動作になり，別のアイコン画像を作成することができます． |
 |
図27
元の画像 |
 |
図28
貼り付ける画像
- 背景が透明になっている
- 前項のサンプルでは，画像を読み込むと，強制的に左下の色を透明色にするようにしている
|
 |
図29
貼り付けた結果
- 貼り付ける画像は，左から 3 番目のボタンをクリックして読み込む
- レイヤー構造にして，各々の画像を独立して操作するようにする方法もある
|
|
上の例は画像全体をコピーして貼り付ける例です．
下に示すコードは，画像の任意の矩形領域をコピーして，別の画像の任意の場所に貼り付けする機能を実装する際の参考になるかも知れない例です．
一度にコピー貼り付けを行うようにすることもできますが，このコードではコピーする矩形サイズと同じサイズの TGPBitmap を作成してそこに描画しています．こうすることにより，コピーする部分だけに対して何かの操作を行うことができます．
このような機能の実装方法はアプリケーションによって様々です．コピーした画像をマウスでドラック移動して，貼り付け先を決定するような方式もあります．コピー元を，ラバーバンドを使用して選択する方式もあります．各々の画像をレイヤー構造とする場合もあります．実際，本サンプルでは背景の市松模様の画像と操作対象の画像の 2 つのレイヤーで構成されているとも言えます．
レイヤー構造にする場合は，操作対象のレイヤーを選択する機能が必要です．また，レイヤーの画像は重ね描画されていますから，レイヤーのサムネイル画像を表示する等して，現在どのレイヤーを操作しているかを明確にする機能も必要です．
|
[備考]
レイヤー構造とする場合，描画内容を格納する別の TGPBitmap を作成しそこに描画するようにすると便利です．この時，背景の市松模様の画像は描画しないようにします．TImage 等に描画する時は背景の市松模様を描画してからこの TGPBitmap を描画します．保存する時は，この TGPBitmap をそのまま保存します． |
 |
図30
2 つの画像を用意 |
 |
図31
貼り付けの結果
- 右の画像の右下の部分を，上下を反転してから左の画像に貼り付け
|
リスト9
画像の任意の領域を別の画像の任意の位置に貼り付ける |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, GDIPAPI, GDIPOBJ, GDIPUTIL;
type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Image2: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Privat e 宣言 }
FGPLeftBitmap : TGPBitmap;
FGPRightBitmap : TGPBitmap;
FGPCopyBitmap : TGPBitmap;
FPixelRectSize : Cardinal;
FMaxImgPixels : Integer;
FPixelGridColor : TColor;
FBackTBitmap : TBitmap;
public
{ Public 宣言 }
procedure DrawPixelColorToTImage(SrcGPBitmap: TGPBitmap; DrawTimage: TImage;
PixelRectSize: Integer; MaxImgPixels: Integer; GridLineColor: TColor;
BackImage: TBitmap = nil; ShowGridLine: Boolean = True;
BackGround: Boolean = True);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
//=============================================================================
// フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
//背景画像
FBackTBitmap := TBitmap.Create;
FBackTBitmap.LoadFromFile('backTexture_02.bmp');
//グリッド線の色とピクセルの描画サイズ等
FPixelGridColor := clGray;
FPixelRectSize := 6;
FMaxImgPixels := 128;
//左側に表示する画像の読み込みとTImageへの描画
FGPLeftBitmap := TGPBitmap.Create('emotion_smile.png');
Image1.Left := 10;
Image1.Top := 40;
DrawPixelColorToTImage(FGPLeftBitmap, Image1, FPixelRectSize, FMaxImgPixels,
FPixelGridColor, FBackTBitmap);
//右側に表示する画像の読み込みとTImageへの描画
FGPRightBitmap := TGPBitmap.Create('bullet_down.png');
Image2.Left := Image1.Left + Image1.Width + 10;
Image2.Top := Image1.Top;
DrawPixelColorToTImage(FGPRightBitmap, Image2, FPixelRectSize, FMaxImgPixels,
FPixelGridColor, FBackTBitmap);
end;
//=============================================================================
// フォーム破棄時の処理
//=============================================================================
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Assigned(FGPLeftBitmap) then FreeAndNil(FGPLeftBitmap);
if Assigned(FGPRightBitmap) then FreeAndNil(FGPRightBitmap);
if Assigned(FGPCopyBitmap) then FreeAndNil(FGPCopyBitmap);
if Assigned(FBackTBitmap) then FreeAndNil(FBackTBitmap);
end;
//=============================================================================
// 画像の一部を別の画像に貼り付ける例
//
// 別の画像に直接貼り付けるのではなく，貼り付け部分のTGPBitmapを生成する場合
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
LCopyLeft : Integer;
LCopyTop : Integer;
LCopyWidth : Integer;
LCopyHeight : Integer;
LDestLeft : Integer;
LDestTop : Integer;
LGPGraphic : TGPGraphics;
begin
if Assigned(FGPCopyBitmap) then FreeAndNil(FGPCopyBitmap);
//コピーする領域の設定
LCopyLeft := 16;
LCopyTop := 16;
LCopyWidth := 16;
LCopyHeight := 16;
//新規にTGPBitmapを作成
FGPCopyBitmap := TGPBitmap.Create(LCopyWidth, LCopyHeight);
//そこに右側に描画中の画像の一部を描画
LGPGraphic := TGPGraphics.Create(FGPCopyBitmap);
try
LGPGraphic.DrawImage(FGPRightBitmap,
MakeRect(0, 0, LCopyWidth, LCopyHeight),
LCopyLeft,
LCopyTop,
LCopyWidth,
LCopyHeight,
UnitPixel);
//貼り付けの開始位置
LDestLeft := 2;
LDestTop := 5;
//上下を反転して貼り付けることにする
FGPCopyBitmap.RotateFlip(Rotate180FlipX);
//新規に作成したTGPbitmapを左に表示中の画像に指定位置から描画
FreeAndNil(LGPGraphic);
LGPGraphic := TGPGraphics.Create(FGPLeftBitmap);
LGPGraphic.DrawImage(FGPCopyBitmap, LDestLeft, LDestTop);
//変更されたTGPBitmapをTImageに描画
DrawPixelColorToTImage(FGPLeftBitmap, Image1, FPixelRectSize, FMaxImgPixels,
FPixelGridColor, FBackTBitmap);
finally
FreeAndNil(LGPGraphic);
end;
end;
|