タイトルのことを実現するのは比較的簡単である. Windowsのカーソルとアイコンは データ構造が全く同じであり,どちらもCreateIconIndirect関数を使って作成する ことができる. この関数の引数として渡すICONINFO構造体のfIconメンバをTrueおよびFalseに 設定することによって,それぞれアイコンおよびカーソルを作成することができる.
以下のコードでは,読み込んだアイコンからGetIconInfo関数を使ってICONINFO構造体を
取得し,fIconメンバをFalseに設定したのち,CreateIconIndirect関数を使って
カーソルを作成している.
ホットポイントは左上としている.
procedure TMainForm.MakeCurFromIco;
var
Icon, Cur: TIcon;
Info: TIconInfo;
begin
Icon := TIcon.Create;
Cur := TIcon.Create;
try
Icon.LoadFromFile( 'test.ico' );
GetIconInfo( Icon.Handle, Info );
Info.fIcon := False;
Info.xHotspot := 0;
Info.yHotspot := 0;
Cur.Handle := CreateIconIndirect( Info );
Cur.SaveToFile( 'test.cur' );
finally
Cur.Free;
Icon.Free;
end;
end;
以下のコードはタイトルのことを実現する.
このコードは,Windows NT系のみでは問題なく動作しアイコンが作成されるが,
Windows 9Xでは作成したアイコンをエクスプローラで読み込もうとするとエラーが発生する.
エクスプローラではアイコンの削除もできないため要注意.
procedure TMainForm.BmpToIco;
var
BmpAnd, BmpXor: TBitmap;
hBmp: HBITMAP;
IconInfo: TICONINFO;
Icon: TIcon;
begin
BmpXor := TBitmap.Create;
BmpAnd := TBitmap.Create;
Icon := TIcon.Create;
try
BmpXor.Assign( Image.Picture.Bitmap );
with BmpAnd do
begin
Assign( BmpXor );
Canvas.Brush.Color := Canvas.Pixels[ 0, 0 ];
Monochrome := True;
end;
with BmpXor.Canvas do
begin
CopyMode := cmSrcAnd;
Font.Color := clWhite;
Brush.Color := clBlack;
Draw( 0, 0, BmpAnd );
end;
IconInfo.fIcon := TRUE;
IconInfo.xHotspot := 0;
IconInfo.yHotspot := 0;
IconInfo.hbmMask := BmpAnd.Handle;
IconInfo.hbmColor := BmpXor.Handle;
Icon.Handle := CreateIconIndirect( IconInfo );
Icon.SaveToFile( ChangeFileExt( FFileName, '.ico' ) );
Icon.ReleaseHandle;
finally
Icon.Free;
BmpAnd.Free;
BmpXor.Free;
end;
end;
タイトルのことを実現するには,TJPEGImageクラスを使う.
以下の例はImageコンポーネントに読み込んだビットマップをJPEGファイルに変換するものである.
procedure TMainForm.ConvBtnClick(Sender: TObject);
var
Jpeg: TJPEGImage;
S: String;
begin
Screen.Cursor := crHourGlass;
S := ChangeFileExt( 'test.bmp', '.jpg' );
Jpeg := TJPEGImage.Create;
try
Jpeg.Assign( Image.Picture.Bitmap );
Jpeg.Compress;
Jpeg.SaveToFile( S );
MessageDlg( 'Conversion has been completed successfully!',
mtInformation, [ mbOK ], 0 );
finally
Screen.Cursor := crDefault;
Jpeg.Free;
end;
end;
お絵描きソフトなどでマウスの左ボタンを押してドラッグしながら線を引くとき, 最終的にボタンを離した位置までの線だけが残り,ドラッグ中の軌跡は残らないようにする.
PenのModeプロパティをpmNotXorにして同じ線を2回描けば元に戻ることを利用する.
すなわち,ドラッグ中はPenのModeプロパティをpmNotXorにしておき,
一旦軌跡を描いた後,次の軌跡を描く直前に上描きすれば,元の状態に戻る.
var
XOrg, YOrg, XPos, YPos: Integer;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
XOrg := X; // 線の始点および終点
YOrg := Y;
XPos := X;
YPos := Y;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if ssLeft in Shift then
begin
with Image1.Canvas do
begin
Pen.Mode := pmNotXor; // ModeをpmNotXorにする
PenPos := Point( XOrg, YOrg );
LineTo( XPos, YPos ); // 直前に描いた軌跡を上書きする
XPos := X; // 線の新たな終点
YPos := Y;
PenPos := Point( XOrg, YOrg );
LineTo( XPos, YPos ); // 次の軌跡を描く
end;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
with Image1.Canvas do
begin
Pen.Mode := pmCopy; // ModeをpmCopyにし,最後の線を描く
PenPos := Point( XOrg, YOrg );
LineTo( XPos, YPos );
end;
end;
TFontクラスには文字列の描画方向に関するプロパティは無いので,斜めに文字列を描画する ときはTLogFont構造体に描画方向などの値を設定し,CreateFontInDirect関数で直接フォントを 生成する. CreateFontInDirect関数は生成したフォントのハンドルを返すので,この値を予め生成しておいた TFontオブジェクトのHandleプロパティに代入してやれば,あとは通常のTFontオブジェクトと 同じように扱うことができる.
以下は,PaintBoxのCanvas上に放射状に文字列を描画するコードである.
var
FontColors: array[ 0..7 ] of TColor
= ( clBlack, clMaroon, clGreen, clOlive, clNavy, clPurple, clTeal, clRed );
procedure TForm1.PaintBoxPaint(Sender: TObject);
var
TempFont: TFont;
LF: TLogFont;
X, Y, Theta, ColorIndex: Integer;
Center: TPoint;
begin
X := PaintBox.Width div 2;
Y := PaintBox.Height div 2;
Theta := 0;
ColorIndex := 0;
while Theta < 3600 do
begin
TempFont := TFont.Create; // 一時的なTFontオブジェクトを生成
try
TempFont.Assign( PaintBox.Canvas.Font ); // 現在のPaintBoxのフォントを割り当て,
GetObject( TempFont.Handle, SizeOf( LF ), @LF ); // フォント情報を取得
LF.lfEscapement := Theta; // 描画方向を水平軸からの角度(単位は0.1deg)を指定
LF.lfOrientation := Theta; // この指定は無くてもいいようである
TempFont.Handle := CreateFontIndirect( LF ); // フォントを生成し,一時フォントに割り当てる
TempFont.Color := FontColors[ ColorIndex ];
PaintBox.Canvas.Font := TempFont;
PaintBox.Canvas.TextOut( X, Y, ' Hello World!' );
finally
TempFont.Free;
end;
Inc( Theta, 450 );
Inc( ColorIndex );
end;
end;
TColor型変数のRGB値を取得するにはWindows APIのGetRValueマクロなどを使う. Delphiにマクロという概念は無いので,これらは関数として実装されている. ここでは,少々回りくどい方法でRGB値を求めてみる.
R値を取り出す場合は,TColor型変数と$000000FFとのandを取り,結果をByte型にキャストするだけでよい. しかしながら,G値およびB値を取り出す場合は,$0000FF00や$00FF0000とのandの結果が 第8ビットよりも上位のビットに格納されるため,Byte型にキャストすることができない. このような場合は,andの結果をG値のときは8ビット,B値のときは16ビットだけ右にシフトしたのち, Byte型にキャストすればよい.
以下のプログラムは選択された色のRGB値を取り出して表示するものである.
procedure TForm1.PanelClick(Sender: TObject);
var
R, G, B: Byte;
begin
ColorDlg.Color := Panel.Color;
if ColorDlg.Execute then
begin
Panel.Color := ColorDlg.Color;
Panel.Caption := ColorToString( Panel.Color );
GetRGBValues( Panel.Color, R, G, B );
R_Edit.Text := IntToStr( R );
G_Edit.Text := IntToStr( G );
B_Edit.Text := IntToStr( B );
end;
end;
procedure TForm1.GetRGBValues( AColor: TColor; var R, G, B: Byte );
const
MASK_RED = $000000FF;
MASK_GREEN = $0000FF00;
MASK_BLUE = $00FF0000;
var
Masked: Integer;
begin
R := Byte( AColor and MASK_RED );
G := Byte( ( AColor and MASK_GREEN ) shr 8 );
B := Byte( ( AColor and MASK_BLUE ) shr 16 );
end;
このようにしてみると,clGreenが$0000FF00ではなく,実は$00008000であったりすることがわかる.
GetWindowDCを使えば,指定したウィンドウのデバイスコンテキスト(DC)を得ることができる. 得られたDCは,タイトルバー,メニュー,スクロールバー,ウィンドウ枠などの 非クライアント領域を含んでいる. このDCを使うことにより,これらの非クライアント領域に描画することが可能になる (ただし,Microsoftは非クライアント領域への描画を推奨していない).
例えば,独自のタイトルバーを描画する場合,WM_NCPAINTおよび
WM_NCACTIVATEのメッセージハンドラを以下のように書く.
フォームのCaptionプロパティは空白にしておく.
procedure TMainForm.WMNCPaint( var Msg: TMessage );
var
WinDC: HDC;
OldFont: HFONT;
AFont: TFont;
S: String;
begin
inherited;
WinDC := GetWindowDC( Self.Handle ); // 非クライアント領域のDCを取得
AFont := TFont.Create; // 新しいフォントを作成
AFont.Charset := DEFAULT_CHARSET; // CharsetをDEFAULT_CHARSETにする.
AFont.Height := GetSystemMetrics( SM_CYCAPTION ) - 4; // 高さをタイトルバーの高さよりも4ピクセル小さくする.
AFont.Name := 'Times New Roman'; // フォント名をTimes New Romanにする.
AFont.Style := [ fsBold, fsItalic ]; // 太字の斜体にする.
OldFont := SelectObject( WinDC, AFont.Handle ); // 新しいフォントをDCに選択する.
if GetForegroundWindow = Self.Handle then // キャプションの色を設定
SetTextColor( WinDC, GetSysColor( COLOR_CAPTIONTEXT ) )
else
SetTextColor( WinDC, GetSysColor( COLOR_INACTIVECAPTIONTEXT ) );
SetBkMode( WinDC, TRANSPARENT ); // 背景モードを設定
S := 'KYUSHU UNIVERSITY';
TextOut( WinDC, // キャプションを描画
GetSystemMetrics( SM_CXEDGE ) + GetSystemMetrics( SM_CXSMICON ) + 6,
GetSystemMetrics( SM_CYEDGE ) + 3,
PChar( S ), Length( S ) );
SelectObject( WinDC, OldFont );
ReleaseDC( Self.Handle, WinDC );
AFont.Free;
end;
procedure TMainForm.WMNCActivate( var Msg: TMessage );
begin
inherited;
Perform( WM_NCPAINT, 0, 0 );
end;
通常のウィンドウのDCは,必要なときに作成される一時的なものである. したがって,ウィンドウに描画する際には,ペン,ブラシおよびフォントの選択や背景モードの設定 をDCを取得する度に行う必要がある.
しかし,WNDCLASS構造体にCS_OWNDCを指定してウィンドウを作成すると, そのウィンドウはプライベートなDCを持つようになる. この場合,DCの属性は永続的であり,一旦DCの属性を変更すると, 次回に取得したDCにもその変更が反映されている. したがって,SelectObjectのオーバーヘッドがなくなり,パフォーマンスが幾分向上する. ただし,一つのウィンドウにつき約800バイトのメモリを余分に必要とする.
次のコードはプライベートなDCを持つウィンドウを作成した例である.
var
NewBrush, OldBrush: HBRUSH;
procedure TMainForm.CreateParams( var Params: TCreateParams );
begin
inherited CreateParams( Params ); // Paramsをデフォルト値で初期化
Params.WindowClass.Style := Params.WindowClass.style or CS_OWNDC; // CS_OWNDCを指定 (*)
end;
procedure TMainForm.FormActivate(Sender: TObject);
var
TempDC: HDC;
begin
TempDC := GetDC( Self.Handle ); // プライベートなDCを取得
NewBrush := CreateHatchBrush( HS_DIAGCROSS, clRed ); // 新しいブラシを作成し,
OldBrush := SelectObject( TempDC, NewBrush ); // DCに設定する.
ReleaseDC( Self.Handle, TempDC );
end;
procedure TMainForm.FormPaint(Sender: TObject);
var
TempDC: HDC;
begin
TempDC := GetDC( Self.Handle ); // DCを取得する.このDCはFormActivateで取得したものと同じである.
Rectangle( TempDC, 0, 0, Self.ClientWidth, Self.ClientHeight ); // 長方形を描く.このときはFormActivateで
ReleaseDC( Self.Handle, TempDC ); // 選択したブラシが使われる.
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
SelectObject( GetDC( Self.Handle ), OldBrush );
DeleteObject( NewBrush );
end;
(*)の行をコメントアウトすれば,FormActivateで選択したDCのブラシは,FormPaintの中では無効であるから, 実行結果は次のようになる.
ここ に移動した.
ここ に移動した.
ここから ダウンロードできるgrade32.dllを使えば,グラデーション領域を簡単に描画できる. ドキュメントには「VBとVCで使用できます」としか書かれていないが,当然Delphiでも使える. grade32.dllはフリーソフトである.
例えば,矩形領域を水平方向に変化していくグラデーションを描画するには,
GD_FillRectH関数を使う.
この関数のプロトタイプは,
GD_FillRectH(HDC hdc, 出力先のデバイスコンテキストハンドル
int left, int top, Rect 左上座標
int right, int bottom, Rect 右下座標
COLORREF StartColor, はじめの色
COLORREF MidColor, 中間の色
COLORREF EndColor, おわりの色
int MidPosition); MidColor の位置
function GD_FillRectH( HDC: THandle; Left, Top, Right, Bottom: Integer;
StartColor, MidColor, EndColor: COLORREF; MidPosition: Integer ): BOOL;
stdcall; external 'grade32.dll';
procedure TForm1.FormPaint(Sender: TObject);
begin
GD_FillRectH( Canvas.Handle, 0, 0, ClientWidth, ClientHeight,
clRed, clBlue, clYellow, 50 );
end;
パレットの処理もきちんと行われているようで,256色環境でもディザリングなどによって きれいなグラデーションが表示される. 以下は256色環境での実行結果である.
GD_FillRectHの他にも垂直方向のグラデーションを描画する関数や 円の内部にグラデーションを描画する関数も用意されている.
Windows APIのDrawFrameControlを使えば,簡単にくぼんだ領域を描画することができる.
利用例を以下に示す.
procedure TForm1.PaintBoxPaint(Sender: TObject);
var
PaintRect: TRect;
begin
PaintRect := PaintBox.ClientRect;
DrawFrameControl( PaintBox.Canvas.Handle, PaintRect,
DFC_BUTTON, DFCS_BUTTONPUSH or DFCS_ADJUSTRECT or DFCS_PUSHED );
PaintBox.Canvas.TextOut( 10, 10, 'embossed region' );
end;
中村拓男さん作の TNkDIBクラスはすごい! DelphiのTBitmapも多機能なクラスだが, PixelFormatプロパティを変更して減色処理を行った場合,減色後の画像は見れたものではない. TBitmapはパレットの面倒まで見てくれないからである.
TNkDIBはTBitmapとほぼ互換であって使いやすく,減色処理の際には最適な色の組み合わせを計算し, パレットに設定するため,減色による画像の劣化は最小限にくい止められる. フルカラーから256色への減色例を以下に示す.
procedure TMainForm.QuantizeBtnClick(Sender: TObject);
begin
Image.Picture.Bitmap.PixelFormat := pf8bit;
end;
procedure TMainForm.QuantizeBtnClick(Sender: TObject);
var
DIB: TNkDIB;
begin
DIB := TNkDIB.Create;
DIB.Assign( Image.Picture.Bitmap );
DIB.PixelFormat := nkPF8bit;
Image.Picture.Bitmap.Assign( DIB );
DIB.Free;
end;
上で示した256色に減色した画像のパレットエントリーを取得し,PaintBoxに表示してみる.
まず,SelectPalette APIでImageに読み込んだ画像のパレットをPaintBoxに選択する.
このAPIのプロトタイプは以下の通り.
function SelectPalette( DC: HDC; Palette: HPALETTE; ForceBackground: Bool ): HPALETTE; stdcall;
SelectPaletteで論理パレットを選択したら,RealizePalette APIで選択した論理パレットを システムパレットにマッピングしなければならない. このAPIにはSelectPaletteのDCパラメータで指定したデバイスコンテキストを指定する.
以下のコードはImage.Picture.Bitmap.PaletteをPaintBox.Canvasに選択し,
256色のカラーテーブルとして表示するものである.
procedure TForm1.PaintBoxPaint(Sender: TObject);
var
L, T, D, I, J: Integer;
ColorRect: TRect;
begin
SelectPalette( PaintBox.Canvas.Handle,
Image.Picture.Bitmap.Palette, False );
RealizePalette( PaintBox.Canvas.Handle );
D := 15;
T := 0;
for I := 0 to 7 do
begin
L := 0;
for J := 0 to 31 do
begin
PaintBox.Canvas.Brush.Color := PALETTEINDEX( 32 * I + J );
PaintBox.Canvas.Rectangle( L, T, L + D, T + D );
Inc( L, D );
end;
Inc( T, D );
end;
end;
なお,PaintBoxに描画したカラーテーブルをクリップボードにコピーする場合は,
以下のようなコードを書けばよい.
procedure TForm1.CopyBtnClick(Sender: TObject);
var
Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.Handle := CreateCompatibleBitmap( PaintBox.Canvas.Handle,
PaintBox.Width, PaintBox.Height );
Bmp.Canvas.CopyRect( Rect( 0, 0, Bmp.Width, Bmp.Height ),
PaintBox.Canvas, Rect( 0, 0, Bmp.Width, Bmp.Height ) );
Clipboard.Assign( Bmp );
finally
Bmp.Free;
end;
end;
ビットマップの回転は単なる配列のコピーであるから,Canvasオブジェクトの Pixelsプロパティを使えば簡単である. ただし,ビットマップのサイズが大きい場合は相応の時間がかかる.
以下のRotateBmp関数は,引数として渡されたTBitmapオブジェクトを
時計方向あるいは反時計方向に90°回転させたTBitmapオブジェクトを返す.
function RotateBmp( Src: TBitmap; Clockwise: Boolean ): TBitmap;
var
Bmp: TBitmap;
W, H, I, J: Integer;
begin
W := Src.Width;
H := Src.Height;
Bmp := TBitmap.Create;
Bmp.Handle := CreateCompatibleBitmap( Src.Canvas.Handle, H, W );
for J := 0 to H - 1 do
begin
for I := 0 to W - 1 do
begin
if Clockwise then
Bmp.Canvas.Pixels[ H - 1 - J, I ]
:= Src.Canvas.Pixels[ I, J ]
else
Bmp.Canvas.Pixels[ J, W - 1 - I ]
:= Src.Canvas.Pixels[ I, J ];
end;
end;
Result := Bmp;
end;
引数ClockwiseがTrueのときは時計方向に,Falseのときは反時計方向に回転させる. 実行結果は以下の通り.
上の画像は湖畔に大三元字一色が佇んでいる何とも幻想的なものであるが, この画像から背景だけの画像
を差し引くと,以下のように大三元字一色だけの画像が得られる.
コードは以下の通り.
procedure TForm1.Button3Click(Sender: TObject);
var
Back: TBitmap;
I, J, W, H: Integer;
ThePixel: TColor;
begin
Screen.Cursor := crHourGlass;
Back := TBitmap.Create;
try
Back.LoadFromFile( 'back.bmp' );
W := Image.Picture.Bitmap.Width;
H := Image.Picture.Bitmap.Height;
for J := 0 to H - 1 do
begin
for I := 0 to W - 1 do
begin
ThePixel := Image.Picture.Bitmap.Canvas.Pixels[ I, J ];
if ThePixel = Back.Canvas.Pixels[ I, J ] then
Image.Picture.Bitmap.Canvas.Pixels[ I, J ] := RGB( 255, 255, 255 );
end;
end;
finally
Back.Free;
Screen.Cursor := crDefault;
end;
end;
SEO | [PR] 爆速!無料ブログ 無料ホームページ開設 無料ライブ放送 | ||