Tips その2

色を反転するには

元の色と白（FFFFFFh）を xor するだけです。

function ColorReversal(col: TColor): TColor;
begin
  Result:= $FFFFFF xor col;
end;

これを応用して、よくあるフォーカス部分の色を反転させる処理などが書けます。

RGBをモノトーン（白黒2色表現）にするには

モノトーンにするというのは、RGBのそれぞれの要素の大きさを同じにする、ということ。その大きさは、色の「輝度」というもので決めます。輝度の計算は、ほとんど定型みたいなので、覚えておきましょう。

function ColorToMonotone(col: TColor): TColor;
var
  rgbcol : Cardinal;
  cr, cg, cb: Integer;
  brightness: Double;
  bri: Byte;
begin
  { RGBに変換 }
  rgbcol:= ColorToRGB(col);
  cr:= GetRValue(rgbcol);
  cg:= GetGValue(rgbcol);
  cb:= GetBValue(rgbcol);
  { 輝度計算 }
  brightness:= 0.299 * cr + 0.587 * cg + 0.114 * cb;
  bri:= Byte(Round(brightness));
  { モノトーン色を返す }
  Result:= RGB(bri, bri, bri);
end;

ちなみに、GetRValue()、GetGValue()、GetBValue() というのは Win32 API です。

ビットマップを作成するには

本来、コードで Windows ビットマップ（DIBというやつ）を扱うには、そのフォーマットを理解して、Win32 API を駆使しなければならないのですが、Delphi でWindows ビットマップを扱うのは非常に簡単。TBitmap という、そのまんまのオブジェクトが用意されていて、これが全ての操作を簡易化してくれるからなのです。

例えば、次のように、コードでビットマップの作成ができます。

procedure MakeBitmap;
var
  tmpBmp: TBitmap;
  cx, cy: Integer;
begin
  { ビットマップ生成 }
  tmpBmp:= TBitmap.Create;
  try

    { ここにビットマップを作成するコードを書く }
    //ここでは、ビットマップを 32*32 のサイズに設定して
    //全体を赤で塗りつぶしています...
    tmpBmp.Width:= 32;
    tmpBmp.Height:= 32;
    for cy:= 0 to 31 do begin
      for cx:= 0 to 31 do begin
        tmpBmp.Canvas.Pixels[cx, cy]:= clRed;
      end;
    end;

    { ファイルとして保存 }
    if tmpBmp <> nil then
      tmpBmp.SaveToFile('new.bmp');// new.bmp という名前で保存

  finally
    tmpBmp.Free;
  end;
end;

いかにVCLが強力かが分かるでしょ。

ビットマップのサイズを用紙サイズに最適化するには

プリンタの用紙サイズを取得するには TPrinter オブジェクトを利用します。アプリケーションの中では Printer 変数がグローバルに宣言されているので、いつでもこの変数を使用することが出来ます。そして、ビットマップのサイズを変えるには StretchBlt() Win32 API関数、または、 StretchDIBits() Win32 API関数を使用します。

以下は、StretchDIBits() を使用して、ビットマップのサイズを toRect に最適化して描画する手続きの例です。

procedure BitmapOptimizeRect(bmp   : TBitmap; // 元のビットマップ
                              toDC   : HDC;    // 描画先デバイスコンテキスト
                              toRect: TRect); // 描画先矩形のサイズ
var
  bit_count  : Integer;     // 1ピクセル当たりのビット数
  old_mode   : Integer;     // 保存用変数
  binfo      : PBitmapInfo; // 作業用ビットマップヘッダ
  binfo_size : DWORD;       // 作業用ビットマップヘッダのサイズ
  img        : Pointer;     // 作業用ビットマップデータ（実際にはそのアドレス）
  img_size   : DWORD;       // 作業用ビットマップのサイズ
  dc         : HDC;         // 作業用デバイスコンテキスト
  old_pal    : HPALETTE;    // 保存用パレット
begin

  { 1ピクセルあたりのビット数を取得 }
  bit_count:= GetDeviceCaps(bmp.Canvas.Handle, COLORRES);

  { 元のビットマップのサイズを取得 }
  GetDIBSizes(bmp.Handle, binfo_size, img_size);

  try
    { 作業用ビットマップのメモリ領域を確保 }
    binfo:= nil;
    binfo:= AllocMem(binfo_size);
    img:= nil;
    img:= AllocMem(img_size);

    { 作業用ビットマップのヘッダを初期化 }
    with binfo^.bmiHeader do begin
      biSize:= SizeOf(TBitmapInfoHeader);  // この構造体に必要なバイト数を指定
      biWidth:= bmp.Width;                 // ビットマップの幅をピクセル単位で指定
      biHeight:= bmp.Height;               // ビットマップの高さをピクセル単位で指定
      biPlanes:= 1;                        // ターゲット デバイスのプレーン数
      biBitCount:= bit_count;              // ピクセル当たりのビット数
      biCompression:= BI_RGB;              // ビットマップの圧縮の種類を指定
    end;

    dc := GetDC(0); // 作業用のデバイスコンテキストを取得
    try
      { ビットマップのパレットを設定 }
      old_pal:= 0;
      if bmp.Palette <> 0 then
        old_pal := SelectPalette(dc, bmp.Palette, True);

      { 元のビットマップから作業用ビットマップへ転送 }
      GetDIBits(dc, bmp.Handle, 0, bmp.Height, img, binfo^, DIB_RGB_COLORS);

      { パレットを元に戻す （これはお約束） }
      if old_pal <> 0 then SelectPalette(dc, old_pal, True);

      { 描画先デバイスコンテキストの拡大モードをカラーにセット }
      old_mode:= SetStretchBltMode(toDC, COLORONCOLOR);

      { StretchDIBits() Win32 API関数で toDC に描画 }
      StretchDIBits(toDC,                        // 転送先のデバイスコンテキスト
                    toRect.Left,                 // 転送先の長方形の左上隅のx座標
                    toRect.Top,                  // 転送先の長方形の左上隅のy座標
                    toRect.Right - toRect.Left, // 転送先の長方形の幅
                    toRect.Bottom - toRect.Top, // 転送先の長方形の高さ
                    0,                           // 転送元の長方形の左上隅のx座標
                    0,                           // 転送元の長方形の左上隅のy座標
                    binfo^.bmiHeader.biWidth,    // 転送元の長方形の幅
                    binfo^.bmiHeader.biHeight,   // 転送元の長方形の高さ
                    img,                         // 作業用ビットマップのアドレス
                    binfo^,                      // 作業用ビットマップヘッダのアドレス
                    DIB_RGB_COLORS,              // 使い方
                    SRCCOPY);                    // ラスタオペレーション

      { 拡大モードを元に戻す }
      SetStretchBltMode(toDC ,old_mode);

    finally
      { 使用したデバイスコンテキストの開放 }
      ReleaseDC(0, dc);
    end;

  finally
    { 確保したメモリを開放 }
    if binfo <> nil then FreeMem(binfo);
    if img <> nil then FreeMem(img);
  end;

end;

この手続きを利用して、Printer のキャンバスに描画すれば印刷できます。以下はその例です。

procedure PrintStretchBitmap(bmp: TBitmap);
var
  pr_rect: TRect;
begin

  (プリンタの設定処理)

  { 用紙の矩形を取得 }
  with pr_rect do begin
    Top:= 0;
    Left:= 0;
    Bottom:= Top + Printer.PaperHeight;
    Right:= Left + Printer.PageWidth;
  end;
  with Printer do begin
    BeginDoc;// 印刷開始
    BitmapOptimizeRect(bmp, Canvas.Handle, pr_rect);
    EndDoc;// 印刷終了
  end;
end;

これを応用すれば、ビットマップをいろいろなサイズに変形できます。

ビットマップの色を反転してフォーカス表示するには

よく、マウスでドラッグしてビットマップの一部を反転表示する処理を見ます。あの色の反転というのはどうやっているのか。要は、色の反転処理 の応用です。

以下に、指定された矩形内を反転表示する手続きの例を示します。

procedure RectFocus(dc: HDC; fcsRect: TRect);
var
  x, y   : Integer;
  col    : TColor;
  cvs    : TCanvas;
begin
  cvs:= TCanvas.Create; // 作業用キャンバス生成
  try
    cvs.Handle:= dc; // デバイスコンテキストを代入
    for y:= fcsRect.Top to fcsRect.Bottom do begin
      for x:= fcsRect.Left to fcsRect.Right do begin
        col:= cvs.Pixels[x,y];
        col:= col xor $FFFFFF;
        cvs.Pixels[x,y]:= col;
      end;
    end;
  finally
    cvs.Free; // 作業用キャンバスの開放
  end;
end;

描画先のDCに TCanvas をあてがうのがミソです。

ビットマップの背景を透過して描画するには

やり方は2通りあります。ひとつは、マスク画像がある場合のやり方、もう一つはない場合のやり方です。「マスク画像」というのは、実際に描画したい画像の描画部分を黒（或いは白）、透過部分を白（或いは黒）で塗りつぶした画像のことです。

例えば、描画する画像 s_src.gif (924 バイト) を背景 s_back.gif (1384 バイト) に重ねて描画したい場合、

透過部分を白、描画部分を黒で塗りつぶしたマスク画像 s_mask.gif (924 バイト) を用意します。

また、この場合、背景を黒で塗りつぶしたソース画像 も作成しておきます。

まずマスク画像 s_mask.gif (924 バイト) を背景 s_back.gif (1384 バイト) 上に BitBlt() API関数で AND転送すると s_before.gif (1432 バイト) のように、

白い部分が透過して（転送されないで）、黒い部分のみ描画された（転送された）状態となります。

その状態の画像 s_before.gif (1432 バイト) に、描画する画像 をBitBlt() API関数でOR転送すると、

s_after.gif (1430 バイト) のように、マスク画像の黒く描画された部分へのみ画像が転送されて、背景が透過された状態となります。

ここで、ソース画像を srcImg、マスク画像を mskImg として、コード表現したものが以下の例です。

function DrawImageTransmission(DC: HDC;         // 背景となるDC
                                srcImg: TBitmap; // ソース画像
                                mskImg: TBitmap; // マスク画像
                                dcRect: TRect    // 描画する矩形
                                ): Integer;
begin

  Result:= -1;

  if srcImg = nil then Exit; // イメージが無い場合は終了
  if mskImg = nil then Exit;

  { マスク画像をDCにAND転送する }
  if not BitBlt(DC,
                dcRect.Left,
                dcRect.Top,
                dcRect.Right - dcRect.Left,
                dcRect.Bottom - dcRect.Top,
                mskImg.Canvas.Handle,
                0,
                0,
                SRCAND) then begin
    Result:= GetLastError;
    Exit;
  end;

  { ソース画像をキャンバスにOR転送する }
  if not BitBlt(DC,
                dcRect.Left,
                dcRect.Top,
                dcRect.Right - dcRect.Left,
                dcRect.Bottom - dcRect.Top,
                srcImg.Canvas.Handle,
                0,
                0,
                SRCPAINT) then begin
    Result:= GetLastError;
  end;

end;

もう一つのやり方は、あらかじめ透過すべき色が分かっている場合に有用です。

これは BitBlt() などの Win32 API関数は使用せず、ひたすら条件判断しながらビット転送するのみです。

function DrawImageTransmission(DC       : HDC;       // 背景となるDC
                                srcImg   : TBitmap;   // ソース画像
                                trsColor : TColor;    // 透過する色
                                dcRect   : TRect      // 描画する矩形
                                ): Integer;
var
  vCanvas     : TCanvas;
  fx, fy      : Integer;
  tx, ty      : Integer;
  end_x, end_y: Integer;
begin
 
  Result:= -1;

  { イメージが無い場合は終了 }
  if srcImg = nil then Exit;
 
  vCanvas:= TCanvas.Create;
  try
    vCanvas.Handle:= DC; // デバイスコンテキストを参照

    { ループ終点を求める }
    if (dcRect.Right - dcRect.Left) > srcImg.Height then
      end_x:= dcRect.Left + srcImg.Height
    else
      end_x:= dcRect.Right;
    if (dcRect.Bottom - dcRect.Top) > srcImg.Width then
      end_y:= dcRect.Top + srcImg.Width
    else
      end_y:= dcRect.Bottom;

    { 透過色以外のPixelをキャンバスDCへ転送 }
    fx:= 0;
    fy:= 0;
    for ty:= dcRect.Top to end_y  do begin
      for tx:= dcRect.Left to end_x do begin
        if srcImg.Canvas.Pixels[fx, fy] <> trsColor then
          vCanvas.Pixels[tx, ty]:= srcImg.Canvas.Pixels[fx, fy];
        Inc(fx);
      end;
      Inc(fy);
    end;

    vCanvas.Refresh;// 再描画

  finally
    vCanvas.Free;
  end;

end;

大抵、ビットマップの透過色というのは原点の色が指定されていたりするので、

srcImg.Canvas.Pixels[0,0]

の色を trsColor としてしまっても良いかもしれません。

デバイスコンテキストに直接図形を描画するには

Windows のデバイスコンテキスト（DC）に描画する、ということと、Delphi の TCanvas に描画するということは、結局同じことです。そして、 TCanvas には、便利なメソッドやプロパティが多く用意されているので、これを利用すれば、簡単にDCに様々な図形を描画することができます。

次の例は、 を使ってDCにポリライン（折れ線）を描画する手続きの例です。

//
//  DC に Points を頂点に持つ折れ線を描画する
//
procedure DrawPolylineToDC(DC: HDC;
                            Points: Array of TPoint);
var
  Canvas : TCanvas;
begin

  if High(Points) < 1 then Exit;//点が2点に満たない場合は終了

  Canvas:= TCanvas.Create;
  try
    Canvas.Handle:= DC;            // CanvasにDCを割り当てる
    Canvas.Pen.Color:= clBlack;   // 線色を黒にする（任意）
    Canvas.Pen.Width:= 1;         // 線幅を1にする（任意）
    Canvas.Pen.Style:= psSolid;   // 線種を実線にする（任意）
    Canvas.Polyline(Points);      // ポリライン描画
  finally
    Canvas.Free;
  end;

end;

TCanvas には、Polyline 以外にも、LineTo、MoveTo、Polygon、Ellipse など、様々な図形を簡単に描画できるメソッドが用意されています。また、それらの色や線種、ハッチングなどの設定も、PenプロパティやBlushプロパティの値を設定するだけなので、Win32 APIでやるような面倒な構造体作成の作業は必要ありません。

これを応用して、DCに直接文字列やビットマップを描画することもできます。要は、 TCanvas を使えば、Win32 APIの面倒な手続きを省略できるのだ、ということ。

TStringGridをビットマップとして出力するには

TStringGrid をそのまま印刷できないものか、と作ってみたのが、以下の手続きです。QuickReport とか使えば、こんなことする必要ないのかもしれませんけどね（笑）

procedure GridToBitmap(Grid: TStringGrid;   // 描画するTStringGrid
                        Title,                // タイトル文字列
                        Copylight: String;   // 著作権表示文字列
                        TitleFontSize,        // タイトルフォントサイズ
                        DateFontSize,         // 日付フォントサイズ
                        CopyFontSize,         // 著作権表示フォントサイズ
                        FontSize,             // 表のフォントサイズ
                        Spacing,              // 表の内部スペース
                        Margin,               // 縦横のマージン
                        TitleLine,            // タイトル行
                        FromLine,             // 描画開始行
                        ToLine: Integer;     // 描画終了行
                        var bmp: TBitmap);   // 描画先ビットマップ
var
  now_pos: TPoint;
  str_date: String;
  col_cnt: Integer;
  row_cnt: Integer;

  col_width_lst : Array of Integer;//セルの幅リスト
  row_height_lst : Array of Integer;//セルの高さリスト

  tmp_width: Integer;
  tmp_height: Integer;

  cell_strs: TStringList;
  cell_line: Integer;
  cell_cnt : Integer;
  cell_tmp : Integer;
  cell_rct : TRect;

  table_top: Integer;

begin

  { 引数チェック }
  if (TitleLine < 0) or (TitleLine >= Grid.RowCount) then Exit;
  if FromLine > ToLine then Exit;
  if (FromLine < 0) or (ToLine >= Grid.RowCount) then Exit;

  now_pos.x:= 0;
  now_pos.y:= 0;

  SetLength(col_width_lst, Grid.ColCount);
  SetLength(row_height_lst, Grid.RowCount);

  with bmp.Canvas do begin

    Font.Size:= FontSize;//フォントを表の内容の文字の大きさに設定

    cell_strs:= TStringList.Create;//行分割用のリスト生成

    { タイトル行のサイズを調べる }
    for col_cnt:= 0 to Grid.ColCount - 1 do begin
      cell_strs.Clear;
      cell_line:= ReadDelimiterText(Grid.Cells[col_cnt,TitleLine], #13, cell_strs);

      if cell_line <= 0 then Continue;

      { セルの幅 }
      tmp_width:= 0;
      for cell_cnt:= 0 to cell_line - 1 do begin
        cell_tmp:= TextExtent(Trim(cell_strs[cell_cnt])).cx + Spacing * 2;
        if tmp_width < cell_tmp then
          tmp_width:= cell_tmp;
      end;

      if col_width_lst[col_cnt] < tmp_width then
        col_width_lst[col_cnt]:= tmp_width;

      { セルの高さ }
      tmp_height:= TextExtent(Grid.Cells[col_cnt,TitleLine]).cy * cell_line + Spacing * 2;
      if row_height_lst[TitleLine] < tmp_height then
        row_height_lst[TitleLine]:= tmp_height;

    end;

    { 表の縦横サイズを調べる }
    for row_cnt:= FromLine to ToLine do begin
      for col_cnt:= 0 to Grid.ColCount - 1 do begin
        cell_strs.Clear;
        cell_line:= ReadDelimiterText(Grid.Cells[col_cnt,row_cnt], #13, cell_strs);

        if cell_line <= 0 then Continue;

        { セルの幅 }
        tmp_width:= 0;
        for cell_cnt:= 0 to cell_line - 1 do begin
          cell_tmp:= TextExtent(Trim(cell_strs[cell_cnt])).cx + Spacing * 2;
          if tmp_width < cell_tmp then
            tmp_width:= cell_tmp;
        end;

        if col_width_lst[col_cnt] < tmp_width then
          col_width_lst[col_cnt]:= tmp_width;

        { セルの高さ }
        tmp_height:= TextExtent(Grid.Cells[col_cnt,row_cnt]).cy * cell_line + Spacing * 2;
        if row_height_lst[row_cnt] < tmp_height then
          row_height_lst[row_cnt]:= tmp_height;

      end;
    end;

    cell_strs.Free;

  end;

  { 表の横サイズを決定 }
  tmp_width:= 0;
  for col_cnt:= 0 to Grid.ColCount - 1 do begin
    tmp_width:= tmp_width + col_width_lst[col_cnt];
  end;
  bmp.Width:= tmp_width + 20 + Margin * 2;//※ここでtmp_widthは表の幅

  { 表の縦サイズを決定 }
  tmp_height:= 0;
  for row_cnt:= FromLine to ToLine do begin
    tmp_height:= tmp_height + row_height_lst[row_cnt];
  end;
  tmp_height:= tmp_height + row_height_lst[TitleLine];// タイトル行分

  bmp.Height:= tmp_height
             + TitleFontSize
             + DateFontSize
             + CopyFontSize
             + 65          // 予備幅
             + Margin * 2;// ※ここでtmp_heightは表の高さ

  with bmp.Canvas do begin
    Brush.Color:= clWhite; //背景色（白）
    Pen.Color:= clBlack;   //線色（黒）
    Font.Color:= clBlack;  //文字色（黒）

    FillRect(Rect(0,0,bmp.Width,bmp.Height));//背景を白く塗りつぶす

    { 表描画開始位置セット }
    now_pos.x:= 10 + Margin;
    now_pos.y:= 10 + Margin;

    { タイトル描画 }
    Font.Size:= TitleFontSize;
    TextOut(now_pos.x, now_pos.y, Title);

    now_pos.y:= now_pos.y + TextExtent(Title).cy + 10;

    { 日付描画 }
    Font.Size:= DateFontSize;
    str_date:= FormatDateTime('yyyy"年"mm"月"dd"日" hh"時"mm"分"ss"秒"', Now);
    TextOut(now_pos.x, now_pos.y, str_date);

    now_pos.y:= now_pos.y + TextExtent(str_date).cy + 10;// 位置更新

    { 内容描画 }
    Font.Size:= FontSize;

    { 表の枠を描画 }
    Rectangle(now_pos.x, now_pos.y, now_pos.x + tmp_width, now_pos.y + tmp_height);

    { 縦ラインを描画 }
    for col_cnt:= 0 to Grid.ColCount - 2 do begin
      now_pos.x:= now_pos.x + col_width_lst[col_cnt];
      MoveTo(now_pos.x, now_pos.y);
      LineTo(now_pos.x, now_pos.y + tmp_height);
    end;

    now_pos.x:= now_pos.x + col_width_lst[Grid.ColCount - 1];// 位置更新
    table_top:= now_pos.y;//この時点のY座標を保存

    { 横ラインを描画 }
    //まずタイトル行の分
    now_pos.y:= now_pos.y + row_height_lst[TitleLine];
    MoveTo(now_pos.x - tmp_width, now_pos.y);
    LineTo(now_pos.x, now_pos.y);
    for row_cnt:= FromLine to ToLine - 1 do begin
      now_pos.y:= now_pos.y + row_height_lst[row_cnt];
      MoveTo(now_pos.x - tmp_width, now_pos.y);
      LineTo(now_pos.x, now_pos.y);
    end;

    now_pos.x:= now_pos.x - tmp_width;//位置を表の左上に戻す
    now_pos.y:= table_top;

    { タイトル行を描画 }
    for col_cnt:= 0 to Grid.ColCount - 1 do begin
      cell_rct:= Rect(now_pos.x + Spacing,
                      now_pos.y + Spacing,
                      now_pos.x + col_width_lst[col_cnt] - Spacing,
                      now_pos.y + row_height_lst[TitleLine] - Spacing);

      DrawText(Handle,
               PChar(Grid.Cells[col_cnt,TitleLine]),
               -1,
               cell_rct,
               DT_CENTER);

      now_pos.x:= now_pos.x + col_width_lst[col_cnt];

    end;

    now_pos.x:= now_pos.x - tmp_width;
    now_pos.y:= now_pos.y + row_height_lst[TitleLine];

    { 文字を描画 }
    for row_cnt:= FromLine to ToLine do begin
      for col_cnt:= 0 to Grid.ColCount - 1 do begin
        cell_rct:= Rect(now_pos.x + Spacing,
                        now_pos.y + Spacing,
                        now_pos.x + col_width_lst[col_cnt] - Spacing,
                        now_pos.y + row_height_lst[row_cnt] - Spacing);

        DrawText(Handle,
                 PChar(Grid.Cells[col_cnt,row_cnt]),
                 -1,
                 cell_rct,
                 DT_CENTER);

        now_pos.x:= now_pos.x + col_width_lst[col_cnt];
      end;
      now_pos.x:= now_pos.x - tmp_width;
      now_pos.y:= now_pos.y + row_height_lst[row_cnt];
    end;

    { コピーライトを描画 }
    Font.Size:= CopyFontSize;
    now_pos.x:= now_pos.x + 5;
    now_pos.y:= now_pos.y + 5;
    TextOut(now_pos.x, now_pos.y, Copylight);

  end;

end;

この中の ReadDelimiterText() というのは、デリミタ区切りの文字列を分解する関数で、こちら で紹介しています。

[ Delphi へ戻る ]