Mega Code Archive
Tlistbox ve tcombobox bileşenleri içerisine resim yerleştirilmesi
<![CDATA[
Codec By GeNiUS !
genius@turkiye.com
ListBox ve ComboBox bileşenleri içerisine yerleştirilen seçimlik elemanların, sadece metin değil, aynı zamanda BMP formatındaki resimleri de içermesi, tasarladığınız kullanıcı arayüzlerinin, diğerlerinden farklı olmasını sağlar. Bunun için hazırlanmış olan örnek kod aşağıdadır.
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
]]>