Программирование Delphi

Программа показывает, как помещать изображения в такие компоненты, как:

• ComboBox
• ListBox
• TabControl
• ToolBar

В список вносятся все жесткие диски системы.

Каждый диск имеет собственное изображение.

Каждое изображение хранится в ImageList.

Не забудьте установить свойство Style в OwnerDraw...

ToolBar имеет собственный ImageList, куда будут помещены изображения.

unit Unit1; 

interface 

uses 
  Windows, Messages, SysUtils, Classes, 
  Graphics, Controls, Forms, Dialogs, 
  StdCtrls, ImgList, ExtCtrls, ComCtrls, ToolWin; 

type 
  TForm1 = class(TForm) 
    ComboBox1: TComboBox; 
    Button1: TButton; 
    ImageList1: TImageList; 
    ImageList2: TImageList; 
    ImageList3: TImageList; 
    ImageList4: TImageList; 
    ImageList5: TImageList; 
    ImageList6: TImageList; 
    ListBox1: TListBox; 
    Label1: TLabel; 
    Label2: TLabel; 
    Label3: TLabel; 
    TabControl1: TTabControl; 
    ToolBar1: TToolBar; 
    ImageList7: TImageList; 
    procedure Button1Click(Sender: TObject); 
    procedure FormCreate(Sender: TObject); 
    procedure ListBox1DrawItem(
        Control: TWinControl; Index: Integer; 
        Rect: TRect; State: TOwnerDrawState); 
  private 
    { Private declarations } 
    procedure MyDraw(Control: TWinControl; Index: Integer; 
        Rect: TRect; State: TOwnerDrawState); 
  public 
    { Public declarations } 
  end; 

var 
  Form1: TForm1; 

implementation 

{$R *.DFM} 

procedure TForm1.Button1Click(Sender: TObject); 
var Drive : Char; 
    i,j   : integer; 
begin 
  For i:=ToolBar1.ComponentCount -1 downto 0 do 
  begin 
    ToolBar1.Components[i].Destroy; 
  end; 
  ToolBar1.Visible := False; 
  i := 0;ImageList1.Clear; 
  //To Get The Drives Listed From A to Z In A Toolbar 
  //You Have To Go From 'z' downto 'a' Or The Toolbar 
  //Will Display The Drives Beginning With The Last One. 
  For Drive := 'z' downto 'a' do 
  begin 
    Case GetDriveType(PChar(Drive + ':\')) of 
      DRIVE_REMOVABLE : 
      begin 
        With TToolButton.Create(Toolbar1) do 
        begin 
          Parent := Toolbar1; 
          Style := tbsButton; 
          ImageList7.AddImages(ImageList2); 
          Height := Toolbar1.Height; 
          ImageIndex := i; Inc(i); 
          Caption := UpperCase(Drive) + ':\'; 
        end; 
      end; 
      DRIVE_FIXED : 
      begin 
        With TToolButton.Create(Toolbar1) do 
        begin 
          Parent := Toolbar1; 
          Style := tbsButton; 
          ImageList7.AddImages(ImageList3); 
          Height := Toolbar1.Height; 
          ImageIndex := i; Inc(i); 
          Caption := UpperCase(Drive) + ':\'; 
        end; 
      end; 
      DRIVE_CDROM : 
      begin 
        With TToolButton.Create(Toolbar1) do 
        begin 
          Parent := Toolbar1; 
          Style := tbsButton; 
          ImageList7.AddImages(ImageList4); 
          Height := Toolbar1.Height; 
          ImageIndex := i; Inc(i); 
          Caption := UpperCase(Drive) + ':\'; 
        end; 
      end; 
      DRIVE_REMOTE : 
      begin 
        With TToolButton.Create(Toolbar1) do 
        begin 
          Parent := Toolbar1; 
          Style := tbsButton; 
          ImageList7.AddImages(ImageList5); 
          Height := Toolbar1.Height; 
          ImageIndex := i; Inc(i); 
          Caption := UpperCase(Drive) + ':\'; 
        end; 
      end; 
      DRIVE_RAMDISK : 
      begin 
        With TToolButton.Create(Toolbar1) do 
        begin 
          Parent := Toolbar1; 
          Style := tbsButton; 
          ImageList7.AddImages(ImageList6); 
          Height := Toolbar1.Height; 
          ImageIndex := i; Inc(i); 
          Caption := UpperCase(Drive) + ':\'; 
        end; 
      end; 
    end; 
  end; 
  Dec(i); 
  ToolBar1.Visible := True; 
  ComboBox1.Clear;ImageList1.Clear;ListBox1.Clear;TabControl1.Tabs.Clear; 
  For Drive := 'a' to 'z' do 
  begin 
    Case GetDriveType(PChar(Drive + ':\')) of 
      DRIVE_REMOVABLE : 
      begin 
        ComboBox1.Items.Add(UpperCase(Drive) + ':\'); 
        ListBox1.Items.Add(UpperCase(Drive) + ':\'); 
        TabControl1.Tabs.Add(UpperCase(Drive) + ':\'); 
        ImageList1.AddImages(ImageList2); 
      end; 
      DRIVE_FIXED : 
      begin 
        ComboBox1.Items.Add(UpperCase(Drive) + ':\'); 
        ListBox1.Items.Add(UpperCase(Drive) + ':\'); 
        TabControl1.Tabs.Add(UpperCase(Drive) + ':\'); 
        ImageList1.AddImages(ImageList3); 
      end; 
      DRIVE_CDROM : 
      begin 
        ComboBox1.Items.Add(UpperCase(Drive) + ':\'); 
        ListBox1.Items.Add(UpperCase(Drive) + ':\'); 
        TabControl1.Tabs.Add(UpperCase(Drive) + ':\'); 
        ImageList1.AddImages(ImageList4); 
      end; 
      DRIVE_REMOTE : 
      begin 
        ComboBox1.Items.Add(UpperCase(Drive) + ':\'); 
        ListBox1.Items.Add(UpperCase(Drive) + ':\'); 
        TabControl1.Tabs.Add(UpperCase(Drive) + ':\'); 
        ImageList1.AddImages(ImageList5); 
      end; 
      DRIVE_RAMDISK : 
      begin 
        ComboBox1.Items.Add(UpperCase(Drive) + ':\'); 
        ListBox1.Items.Add(UpperCase(Drive) + ':\'); 
        TabControl1.Tabs.Add(UpperCase(Drive) + ':\'); 
        ImageList1.AddImages(ImageList6); 
      end; 
    end; 
  end; 
  ComboBox1.Itemindex := 0; 
  ListBox1.Itemindex  := 0; 
end; 

procedure TForm1.MyDraw(Control: TWinControl; Index: Integer; Rect: TRect; 
  State: TOwnerDrawState); 
begin 
  With (Control As TComboBox).Canvas do 
  begin 
    FillRect(Rect); 
    ImageList1.Draw(Combobox1.Canvas,Rect.Left,Rect.Top + 2,Index,True); 
    TextOut(Rect.Left + 20,Rect.Top,(Control as TComboBox).Items[Index]); 
  end; 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  ComboBox1.OnDrawItem := MyDraw; 
end; 

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
begin 
  With (Control As TListbox).Canvas do 
  begin 
    FillRect(Rect); 
    ImageList1.Draw(Listbox1.Canvas,Rect.Left,Rect.Top,Index,True); 
    TextOut(Rect.Left + 20,Rect.Top + 2,(Control As TListBox).Items[Index]); 
  end; 
end; 

end. 

По материалам http://delphi3000.com