グラフィック


アイコンをカーソルに変換する
ビットマップをアイコンに変換する
JPEGファイルを作成する
軌跡を消しながら線を描く
文字列を斜めに描画する
ビットシフトでRGB値を取得する
独自のタイトルバー
プライベートなデバイスコンテキストを持つウィンドウ
拡張メタファイルを作成する
拡張メタファイルを旧メタファイルに変換する
グラデーションDLL
くぼんだ領域の描画
TNkDIBクラスを使ったフルカラー画像の減色
256色に減色した後のパレット
ビットマップの回転
背景を差し引く


アイコンをカーソルに変換する

タイトルのことを実現するのは比較的簡単である. 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;


JPEGファイルを作成する

タイトルのことを実現するには,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;


ビットシフトでRGB値を取得する

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の中では無効であるから, 実行結果は次のようになる.


拡張メタファイルを作成する

ここ に移動した.


拡張メタファイルを旧メタファイルに変換する

ここ に移動した.


グラデーションDLL

ここから ダウンロードできる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 の位置

である.Delphi風に書き直した関数宣言は以下のようになる.

function  GD_FillRectH( HDC: THandle; Left, Top, Right, Bottom: Integer;
      StartColor, MidColor, EndColor: COLORREF; MidPosition: Integer ): BOOL;
       stdcall; external 'grade32.dll';

例えば,メインフォームのOnPaintイベントに次のように書けば,以下の出力が得られる.

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クラスを使ったフルカラー画像の減色

中村拓男さん作の TNkDIBクラスはすごい! DelphiのTBitmapも多機能なクラスだが, PixelFormatプロパティを変更して減色処理を行った場合,減色後の画像は見れたものではない. TBitmapはパレットの面倒まで見てくれないからである.

TNkDIBはTBitmapとほぼ互換であって使いやすく,減色処理の際には最適な色の組み合わせを計算し, パレットに設定するため,減色による画像の劣化は最小限にくい止められる. フルカラーから256色への減色例を以下に示す.

減色した結果を以下に示すが,TNkDIBによる減色がTBitmapによる減色よりも いかに鮮明かがわかる.
原画像
TBitmapを使った減色
TNkDIBを使った減色


256色に減色した後のパレット

上で示した256色に減色した画像のパレットエントリーを取得し,PaintBoxに表示してみる. まず,SelectPalette APIでImageに読み込んだ画像のパレットをPaintBoxに選択する. このAPIのプロトタイプは以下の通り.

function SelectPalette( DC: HDC; Palette: HPALETTE; ForceBackground: Bool ): HPALETTE; stdcall;

DCはパレット選択の対象となるデバイスコンテキストであり,Paletteは 選択したい論理パレットのハンドルである. また,ForceBackgroundは論理パレットがシステムパレットにマッピングされる タイミングを規定するためのパラメータである. 通常はFalseでいいようだ.

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;

TBitmapあるいはTNkDIBを使って減色した画像のパレットエントリーは以下のようになる.
TBitmap
TNkDIB

なお,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;

まずTBitmap型のオブジェクトを作成し,CreateCompatibleBitmap APIを使って 元のビットマップのデバイスコンテキストと互換性のあるビットマップを作成する. このとき,作成するビットマップの幅は元のビットマップの高さに, 高さは元のビットマップの幅に設定する. CreateCompatibleBitmap APIが成功すると,互換性のあるビットマップのハンドルを返ってくるので, このハンドルをTBitmapオブジェクトのHandleプロパティに割り当てれば, あとは通常のTBitmapオブジェクトと同じように扱える.

引数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;

実際は差し引いた後,差し引いた部分の白黒を反転させている. このような手法は画像処理等で背景のノイズを除去するのに用いられている.


お問い合わせはメールにて: akasaka@klc.ac.jp

戻る
SEO [PR] 爆速!無料ブログ 無料ホームページ開設 無料ライブ放送