unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Button1: TButton;
    CheckBox1: TCheckBox;
    Image1: TImage;
    SpeedButton1: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CheckBox1.Checked := True;
  Image1.Center := True;
end;

//=============================================================================
//  Glyph用ビットマップを作成して表示，保存
//  添付の4つのビットマップ画像から作成する
//  添付のビックマップ画像は 32x32の24ビットのビットマップ画像ファイル
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrList : TStringList;
  LGlyphBmp : TBitmap;
  LBitmap  : TBitmap;
  LWidh    : Integer;
  LHeight  : Integer;
  LIndex   : Integer;
  LRect    : TRect;
begin
  LWidh   := 0;
  LHeight := 0;

  LStrList  := TStringList.Create;
  LGlyphBmp := TBitmap.Create;
  LBitmap   := TBitmap.Create;
  try
    //Glyph用ビットマップ画像ファイルのパス名を設定
    LStrList.Add('EMOTION_1_UP.bmp');
    LStrList.Add('EMOTION_2_DISABLE.bmp');
    LStrList.Add('EMOTION_3_CLICK.bmp');
    LStrList.Add('EMOTION_4_DOWN.bmp');

    for LIndex := 0 to LStrList.Count - 1 do begin
      LBitmap.LoadFromFile(LStrList[LIndex]);
      if LBitmap.PixelFormat = pf32bit then begin
        LBitmap.AlphaFormat := afDefined;
        LBitmap.Transparent :=False;
      end else begin
        LBitmap.Transparent :=True;
      end;

      //最初のビットマップ画像の情報を取得
      //全てのビットマップのサイズは同じでなければならない
      if LIndex = 0 then begin
        LWidh   := LBitmap.Width;
        LHeight := LBitmap.Height;

        //Glyph用ビットのマップのサイズを決定
        LGlyphBmp.AlphaFormat := LBitmap.AlphaFormat;
        LGlyphBmp.Transparent := LBitmap.Transparent;
        LGlyphBmp.SetSize(LWidh * LStrList.Count, LHeight);
      end;

      //Glyph用ビットマップのCanvasに読み込んだビットマップ画像を描画する
      //左から順番にCopyRectメソッドを使用してコピー
      LRect := Rect(LWidh * LIndex, 0, LWidh * (LIndex + 1), LHeight);
      LGlyphBmp.Canvas.CopyRect(LRect,
                               LBitmap.Canvas,
                               Rect(0, 0, LBitmap.Width, LBitmap.Height));
    end;

    //TBitBtnの設定
    BitBtn1.NumGlyphs := LStrList.Count;
    BitBtn1.Glyph.Assign(LGlyphBmp);

    //TSpeedButtonの設定
    SpeedButton1.NumGlyphs := LStrList.Count;
    SpeedButton1.Glyph.Assign(LGlyphBmp);

    Image1.Picture.Assign(LGlyphBmp);

    //Glpy用ビットマップの保存
    LGlyphBmp.SaveToFile('emotion_glyph.bmp');
  finally
    FreeAndNil(LStrList);
    FreeAndNil(LGlyphBmp);
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  Enabledプロパティの切り換え
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  BitBtn1.Enabled      := CheckBox1.Checked;
  SpeedButton1.Enabled := CheckBox1.Checked;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    Image1: TImage;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CheckBox1.Checked := True;
  Image1.Center := True;
end;

//=============================================================================
//  Glyph用ビットマップを作成して表示，保存
//  TSpeedButtonのDownプロパティの動作確認
//
//  添付の4つのビットマップ画像から作成する
//  添付のビックマップ画像は 32x32の24ビットのビットマップ画像ファイル
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LStrList  : TStringList;
  LGlyphBmp : TBitmap;
  LBitmap   : TBitmap;
  LWidh     : Integer;
  LHeight   : Integer;
  LIndex    : Integer;
  LRect     : TRect;
begin
  LWidh   := 0;
  LHeight := 0;

  //GroupIndexの値が1以上でないとDownプロパティは機能しない
  SpeedButton1.GroupIndex := 1;
  SpeedButton2.GroupIndex := 1;

  LStrList  := TStringList.Create;
  LGlyphBmp := TBitmap.Create;
  LBitmap   := TBitmap.Create;
  try
    //Glyph用ビットマップ画像ファイルのパス名を設定
    LStrList.Add('EMOTION_1_UP.bmp');
    LStrList.Add('EMOTION_2_DISABLE.bmp');
    LStrList.Add('EMOTION_3_CLICK.bmp');
    LStrList.Add('EMOTION_4_DOWN.bmp');

    for LIndex := 0 to LStrList.Count - 1 do begin
      //ビットマップ画像ファイルを読み込む
      LBitmap.LoadFromFile(LStrList[LIndex]);
      if LBitmap.PixelFormat = pf32bit then begin
        LBitmap.AlphaFormat := afDefined;
        LBitmap.Transparent :=False;
      end else begin
        LBitmap.Transparent :=True;
      end;

      //最初のビットマップ画像の情報を取得
      //全てのビットマップのサイズは同じでなければならない
      if LIndex = 0 then begin
        LWidh   := LBitmap.Width;
        LHeight := LBitmap.Height;

        //Glyph用ビットのマップのサイズを決定
        LGlyphBmp.AlphaFormat := LBitmap.AlphaFormat;
        LGlyphBmp.Transparent := LBitmap.Transparent;
        LGlyphBmp.SetSize(LWidh * LStrList.Count, LHeight);
      end;

      //Glyph用ビットマップのCanvasに読み込んだビットマップ画像を描画する
      //左から順番にCopyRectメソッドを使用してコピー
      LRect := Rect(LWidh * LIndex, 0, LWidh * (LIndex + 1), LHeight);
      LGlyphBmp.Canvas.CopyRect(LRect,
                               LBitmap.Canvas,
                               Rect(0, 0, LBitmap.Width, LBitmap.Height));
    end;

    //TSpeedButtonの設定
    //GroupIndexの値は0でない値にしないとDownプロパティは機能しない
    SpeedButton1.NumGlyphs  := LStrList.Count;
    SpeedButton1.Glyph.Assign(LGlyphBmp);

    SpeedButton2.NumGlyphs := LStrList.Count;
    SpeedButton2.Glyph.Assign(LGlyphBmp);

    Image1.Picture.Assign(LGlyphBmp);

    //Glpy用ビットマップの保存
    LGlyphBmp.SaveToFile('emotion_glyph.bmp');
  finally
    FreeAndNil(LStrList);
    FreeAndNil(LGlyphBmp);
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  TSpeedButtonのEnabledプロパティの切り換え
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  SpeedButton1.Enabled := CheckBox1.Checked;
  SpeedButton2.Enabled := CheckBox1.Checked;
end;

end.

      //ビットマップ画像ファイルを読み込む
      LBitmap.LoadFromFile(LStrList[LIndex]);
      if LBitmap.PixelFormat = pf32bit then begin
        LBitmap.PixelFormat := pf24bit;
        LBitmap.Transparent := True;
      end else begin
        LBitmap.Transparent :=True;
      end;

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    BitBtn1: TBitBtn;
    CheckBox1: TCheckBox;
    Image1: TImage;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CheckBox1.Checked := True;
end;

//=============================================================================
//  Glyphプロパティを設定
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  LFilePath : string;
  LBitmap   : TBitmap;
begin
  LFilePath := ExpandFileName('..\Images\Test_Glyph.bmp');

  LBitmap := TBitmap.Create;
  try
    LBitmap.LoadFromFile(LFilePath);
    BitBtn1.Glyph.Assign(LBitmap);
  finally
    FreeAndNil(LBitmap);
  end;
end;

//=============================================================================
//  Glyphのビットマップを取得
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  Image1.Picture.Bitmap := BitBtn1.Glyph;
end;

//=============================================================================
//  Glyphプロパティのビットマップを削除
//  ボタンにGlyphの画像を表示しなくする
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  BitBtn1.Glyph.Assign(nil);
end;

//=============================================================================
//  TBitBtnのEnabledプロパティの切り換え
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  BitBtn1.Enabled := CheckBox1.Checked;
end;

end.

      ImageList1.GetBitmap(LIndex, SpeedButton1.Glyph);

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, ImgList;

type
  TForm1 = class(TForm)
    CheckBox1: TCheckBox;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    ImageList1: TImageList;
    ImageList2: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure SetGlyphFromTImageList(AImgListUp, AImgListDisable, AImgListClick,
      AImgListDown: TImageList; AButton: TObject; AImgIndex: Integer);
  public
    { Public 宣言 }
  end;

  procedure SetBitmapAlpha(ABitmap: TBitMap);

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//  TImageListに格納したビットマップをGlyph用のビットマップして使用する方法
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  CheckBox1.Checked := True;

  //背景色は元のビットマップにはない色にする
  ImageList1.BkColor := clBlue;
  ImageList2.BkColor := clBlue;

  SetGlyphFromTImageList(ImageList1, ImageList2, nil, nil, SpeedButton1, 0);
  SetGlyphFromTImageList(ImageList1, ImageList2, nil, nil, SpeedButton2, 1);
end;

//=============================================================================
//  TSpeedButtonのEnabledプロパティの切り換え
//=============================================================================
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  SpeedButton1.Enabled := CheckBox1.Checked;
  SpeedButton2.Enabled := CheckBox1.Checked;
end;

//-----------------------------------------------------------------------------
//  TImageListに格納されている画像からGlyph用のビットマップを作成してセットする
//
//  AImgListUp      : 通常表示する画像を格納したTImageList
//  AImgListDisable : Disableな状態を表す画像を格納したTImageList
//  AImgListClick   : マウスの左ボタン押下時に表示示する画像を格納したTImageList
//  AImgListDown    : DownプロパティがTrueの時に表示する画像を格納したTImageList
//  AButtton        : TSpeedButtonまたはTBitBtn
//  AImgIndex       : TimageListの何番目の画像を使用するかの指定(0ベース)
//-----------------------------------------------------------------------------
procedure TForm1.SetGlyphFromTImageList(AImgListUp, AImgListDisable, AImgListClick,
  AImgListDown: TImageList; AButton: TObject; AImgIndex: Integer);

  procedure CopyTImgListBmpToGlyphCanvas(AImgList : TImageList; AGlyph: TBitmap;
    ANo: Integer);
  var
    LBitmap : TBitmap;
    LRect   : TRect;
  begin
    if AImgList = nil then exit;

    LBitmap := TBitmap.Create;
    try
      // GetBitmap は 透明ピクセルを処理しない (TBitmap として取得する場合)
      // そこで TBitmap を完全に透明なビットマップにしておく
      if AImgList.ColorDepth = cd32Bit then begin
        LBitmap.AlphaFormat := afDefined;
        LBitmap.SetSize(AImgList.Width, AImgList.Height);
        SetBitmapAlpha(LBitmap);
      end;

      if AImgList.GetBitmap(AImgIndex, LBitmap) then begin
        //Glyph用ビットマップのCanvasにビットマップとして取得した画像を描画する
        LRect := Rect(LBitmap.Width * ANo, 0, LBitmap.Width * (ANo + 1), LBitmap.Height);
        AGlyph.Canvas.CopyRect(LRect,
                               LBitmap.Canvas,
                               Rect(0, 0, LBitmap.Width, LBitmap.Height));
      end;
    finally
      FreeAndNil(LBitmap);
    end;
  end;

var
  LGlphBmp  : TBitmap;
  LImgCount : Integer;
begin
  if AImgListUp = nil then exit;

  LGlphBmp := TBitmap.Create;
  try
    //Glyph用ビットマップのサイズを設定
    LImgCount := 1;
    if AImgListDisable <> nil then LImgCount := 2;
    if AImgListClick <> nil   then LImgCount := 3;
    if AImgListDown <> nil    then LImgCount := 4;
    LGlphBmp.SetSize(AImgListUp.Width * LImgCount, AImgListUp.Height);
    LGlphBmp.Canvas.FillRect(LGlphBmp.Canvas.ClipRect);

    //TImageListの画像をビットマップとして取得して，GlyphのCanvasに追加していく
    CopyTImgListBmpToGlyphCanvas(AImgListUp,      LGlphBmp, 0);
    CopyTImgListBmpToGlyphCanvas(AImgListDisable, LGlphBmp, 1);
    CopyTImgListBmpToGlyphCanvas(AImgListClick,   LGlphBmp, 2);
    CopyTImgListBmpToGlyphCanvas(AImgListDown,    LGlphBmp, 3);

    //Glyphプロパティを設定
    if AButton is TSpeedButton then begin
     TSpeedButton(AButton).Glyph :=  LGlphBmp;
    end;
    if AButton is TBitBtn then begin
     TBitBtn(AButton).Glyph :=  LGlphBmp;
    end;
  finally
    FreeAndNil(LGlphBmp);
  end;
end;

//----------------------------------------------------------------------------
//  透明なビットマップ画像の作成
//  アルファチャンネルのビットマップのピクセル値のクリア
//  Red,Gree, Blue, Alphi 値を全て0 にしたビットマップにする
//----------------------------------------------------------------------------
procedure SetBitmapAlpha(ABitmap: TBitMap);
type
  TRGBQArray = array [0..High(Integer) div 4 - 1] of RGBQUAD;
  PRGBQArray = ^TRGBQArray;
var
  LPosY      : Integer;
  LPosX      : Integer;
  LScanArray : PRGBQArray;
begin
  ABitmap.Canvas.Lock;
  ABitmap.PixelFormat := pf32bit;

  for LPosY := 0 to ABitmap.Height - 1 do begin
    LScanArray := ABitmap.ScanLine[LPosY];
    for LPosX  := 0 to ABitmap.Width - 1 do begin
      LScanArray[LPosX].rgbRed      := 0;
      LScanArray[LPosX].rgbGreen    := 0;
      LScanArray[LPosX].rgbBlue     := 0;
      LScanArray[LPosX].rgbReserved := 0;
    end;
  end;

  ABitmap.Canvas.Unlock;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls;

type
  TForm1 = class(TForm)
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  SpeedButton1.GroupIndex := 1;
  SpeedButton2.GroupIndex := 2;
  SpeedButton3.GroupIndex := 3;

  SpeedButton1.AllowAllUp := True;
  SpeedButton2.AllowAllUp := True;
  SpeedButton3.AllowAllUp := True;
end;

//=============================================================================
//  TSpeedButtonのクリックイベント
//=============================================================================
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if TSpeedButton(Sender).Down then begin
    //DownプロパティがTrueになった時の処理
    //ボタンが下がった状態になった時の処理
  end else begin
    //DownプロパティがFalseになった時の処理
    //ボタンが上がった状態になった時の処理
  end;
end;

//=============================================================================
//  SpeedButton1のDown状態の変更
//  トグル操作
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
begin
  SpeedButton1.Down := not SpeedButton1.Down;
end;

//=============================================================================
//  SpeedButton2のDown状態の変更
//  トグル操作
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
begin
  SpeedButton2.Down := not SpeedButton2.Down;
end;

//=============================================================================
//  SpeedButton3のDown状態の変更
//  トグル操作
//=============================================================================
procedure TForm1.Button3Click(Sender: TObject);
begin
  SpeedButton3.Down := not SpeedButton3.Down;
end;

end.