この発言に対し以下のコメントが寄せられています

#01137　かとちん        さん　RE:ビットマップ→アイコン ファイル変換処

#01138　かとちん        さん　重大な障害！！ 使用上の注意！！

#01141　ぜえた          さん　RE:ビットマップ→アイコン ファイル変換処




わーい。 かとちんです。＼(^0^)／



ビットマップ画像の任意の範囲(32x32 になるようにお願いします)から、
アイコンを作成する関数です。
とりあえず、16色アイコン変換しか実現できませんでした。m(_ _)m

---------------------------------------------------------------------
{
  透過したい色をあらかじめ、Base に設定しておくことで、アイコンの透過
  情報も反映されます。

  Base ... 元画像。Transparent などで透過色を決めておきましょ。
  CutRect ... アイコンにしたいエリアを指定
}

function CreateIconFromBitmap(Base: TBitmap; CutRect: TRect): TIcon;
var
  X, Y: Integer;
  TransColor: TColor;
  CutBmp: TBitmap;
  XorBmp, AndBmp: TBitmap;
  Info: TIconInfo;
begin
  CutBmp := TBitmap.Create;
  try
    CutBmp.Width := CutRect.Right - CutRect.Left;
    CutBmp.Height := CutRect.Bottom - CutRect.Top;
    CutBmp.Canvas.CopyRect(Rect(0, 0, CutBmp.Width, CutBmp.Height),
      Base.Canvas, CutRect);
    // 色々調べたけど 256色はうまくいかなかったので諦めました (T_T)
    CutBmp.PixelFormat := pf4bit; //Base.PixelFormat;

    XorBmp := TBitmap.Create;
    try
      XorBmp.Width := CutBmp.Width;
      XorBmp.Height := CutBmp.Height;
      XorBmp.PixelFormat := CutBmp.PixelFormat;

      AndBmp := TBitmap.Create;
      try
        AndBmp.Width := CutBmp.Width;
        AndBmp.Height := CutBmp.Height;

        TransColor := Base.TransparentColor;
        for Y := 0 to CutBmp.Height-1 do
        begin
          for X := 0 to CutBmp.Width-1 do
          begin
            if CutBmp.Canvas.Pixels[X, Y] = TransColor then
            begin
              XorBmp.Canvas.Pixels[X, Y] := clBlack;
              AndBmp.Canvas.Pixels[X, Y] := clWhite;
            end else begin
              XorBmp.Canvas.Pixels[X, Y] := CutBmp.Canvas.Pixels[X, Y];
              AndBmp.Canvas.Pixels[X, Y] := clBlack;
            end;
          end;
        end;
        AndBmp.PixelFormat := pf1bit;

        with Info do
        begin
          fIcon := True;
          xHotspot := 0;
          yHotspot := 0;
          hbmMask := AndBmp.Handle;
          hbmColor := XorBmp.Handle;
        end;
        Result := TIcon.Create;
        Result.Handle := CreateIconIndirect(Info);
        if Result.Handle = 0 then
        begin
          Result.Free;
          Result := nil;
          RaiseLastWin32Error;
        end;
      finally
        AndBmp.Free;
      end;
    finally
      XorBmp.Free;
    end;
  finally
    CutBmp.Free;
  end;
end;

---------------------------------------------------------------------
上記関数の使用例としてビットマップファイルからアイコンファイルを作成す
るサンプルを以下に記します。ビットマップファイルと同じフォルダに拡張子
が .ico のファイルを作成します。元画像の左上隅から 32x32 の画像を、
Transparent = True で自動的に透過色を決めさせたアイコンファイルを作成
します。
---------------------------------------------------------------------
procedure BmpToIcoFile(BmpFileName: TFileName);
var
  Bmp: TBitmap;
  Icon: TIcon;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.LoadFromFile(BmpFileName);

    with CreateIconFromBitmap(Bmp, Rect(0, 0, 32, 32)) do
    try
      SaveToFile(ChangeFileExt(BmpFileName, '.ico');
    finally
      Free;
    end;
  finally
    Bmp.Free;
  end;
end;



▲●    2000/07/10 23:56 JDX06162(とんちんかんちんかとちん)
 ■     Inprise Delphi ... The Great Development Kit
uses D2Desktop, D3CSS, D4CSS, D5ENT;
 


Original document by かとちん        氏 ID:(JDX06162)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。