在Listbox加背景图

2008-04-09 04:25:24来源:互联网 阅读 ()

新老客户大回馈,云服务器低至5折

1. 建立一个窗体
2. 放一个ComboBox和Listbox
3. 改变Component的Style为csOwnerDrawVariable和ListBox的Style为lbOwnerDrawVariable。
4. 声明5个TBitmap的全局变量
5. 覆盖Form的OnCreate.
6. 覆盖ComboBox的OnDraw.
7. 覆盖ComboBox的OnMeasureItem.
8. 释放资源在Form的OnClose.


unit Ownerdrw;

interface

uses
SysUtils, WinTypes, WinProcs, Messages, 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:\delphi\images\buttons\globe.bmp'''');
TheBitmap2 := TBitmap.Create;
TheBitmap2.LoadFromFile(''''C:\delphi\images\buttons\video.bmp'''');
TheBitmap3 := TBitmap.Create;
TheBitmap3.LoadFromFile(''''C:\delphi\images\buttons\gears.bmp'''');
TheBitmap4 := TBitmap.Create;
TheBitmap4.LoadFromFile(''''C:\delphi\images\buttons\key.bmp'''');
TheBitmap5 := TBitmap.Create;
TheBitmap5.LoadFromFile(''''C:\delphi\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.


//该窗体的DFM文件

object Form1: TForm1
Left = 211
Top = 155
Width = 435
Height = 300
Caption = ''''Form1''''
Font.Color = clWindowText
Font.Height = -13
Font.Name = ''''System''''
Font.Style = []
PixelsPerInch = 96
OnClose = FormClose
OnCreate = FormCreate
TextHeight = 16
object ComboBox1: TComboBox

标签:

版权申明:本站文章部分自网络,如有侵权,请联系:west999com@outlook.com
特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有

上一篇:robot对DELPHI中GRID控件的识别问题

下一篇:Delphi7目录结构----初学者参考