Mega Code Archive
Tlistbox ve tcombobox bilesenleri icerisine resim yerlestirilmesi
<![CDATA[
ListBox ve ComboBox bilesenleri icerisine yerlestirilen secimlik elemanlarin, sadece metin degil, ayni zamanda BMP formatindaki resimleri de icermesi, tasarladiginiz kullanici arayüzlerinin, digerlerinden farkli olmasini saglar. Bunun icin hazirlanmis olan örnek kod asagidadir.
Unit1.pas;
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
TheBitmap1, TheBitmap2, TheBitmap3, TheBitmap4,
TheBitmap5 : TBitmap;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
TheBitmap1 := TBitmap.Create;
TheBitmap1.LoadFromFile('C:\Program Files\Borland\Delphi 3\images\buttons\globe.bmp');
TheBitmap2 := TBitmap.Create;
TheBitmap2.LoadFromFile('C:\Program Files\Borland\Delphi 3\images\buttons\video.bmp');
TheBitmap3 := TBitmap.Create;
TheBitmap3.LoadFromFile('C:\Program Files\Borland\Delphi 3\images\buttons\gears.bmp');
TheBitmap4 := TBitmap.Create;
TheBitmap4.LoadFromFile('C:\Program Files\Borland\Delphi 3\images\buttons\key.bmp');
TheBitmap5 := TBitmap.Create;
TheBitmap5.LoadFromFile('C:\Program Files\Borland\Delphi 3\images\buttons\tools.bmp');
ComboBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
ComboBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
ComboBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
ComboBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
ComboBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);
ListBox1.Items.AddObject('Bitmap1: Globe', TheBitmap1);
ListBox1.Items.AddObject('Bitmap2: Video', TheBitmap2);
ListBox1.Items.AddObject('Bitmap3: Gears', TheBitmap3);
ListBox1.Items.AddObject('Bitmap4: Key', TheBitmap4);
ListBox1.Items.AddObject('Bitmap5: Tools', TheBitmap5);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TheBitmap1.Free;
TheBitmap2.Free;
TheBitmap3.Free;
TheBitmap4.Free;
TheBitmap5.Free;
end;
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
with (Control as TComboBox).Canvas do
begin
FillRect(Rect);
Bitmap := TBitmap(ComboBox1.Items.Objects[Index]);
if Bitmap <> nil then
begin
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
Bitmap.Height), clRed);
Offset := Bitmap.width + 8;
end;
{ display the text }
TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index])
end;
end;
procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index:Integer; var Height: Integer);
begin
height:= 20;
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
with (Control as TListBox).Canvas do
begin
FillRect(Rect);
Bitmap := TBitmap(ListBox1.Items.Objects[Index]);
if Bitmap <> nil then
begin
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
Bitmap.Height), clRed);
Offset := Bitmap.width + 8;
end;
{ display the text }
TextOut(Rect.Left + Offset, Rect.Top, Listbox1.Items[Index])
end;
end;
procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
height:= 20;
end;
end.
Unit1.dfm
object Form1: TForm1
Left = 211
Top = 155
Width = 526
Height = 320
Caption = 'Form1'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'System'
Font.Style = []
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 120
TextHeight = 20
object ComboBox1: TComboBox
Left = 33
Top = 38
Width = 206
Height = 22
Style = csOwnerDrawVariable
ItemHeight = 16
TabOrder = 0
OnDrawItem = ComboBox1DrawItem
OnMeasureItem = ComboBox1MeasureItem
end
object ListBox1: TListBox
Left = 270
Top = 35
Width = 189
Height = 209
ItemHeight = 16
Style = lbOwnerDrawVariable
TabOrder = 1
OnDrawItem = ListBox1DrawItem
OnMeasureItem = ListBox1MeasureItem
end
end
]]>