分享
 
 
 

自绘ListBox的两种效果

王朝delphi·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

本文利用Listbox自绘实现了两种特殊效果,其中第两种风格来自C++ Builder 研究 www.ccrun.com,老妖用BCB实现了,现在把它转换成Delphi代码。

演示图片:

//--------------------------------------------------------------------------

unit DrawListItem;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ImgList, jpeg, ExtCtrls;

type

TForm1 = class(TForm)

lsbRight: TListBox;

ImageList1: TImageList;

StaticText1: TStaticText;

lsbLeft: TListBox;

imgHouse: TImage;

imgHouseGray: TImage;

PRocedure FormCreate(Sender: TObject);

procedure lsbRightDrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

procedure lsbRightClick(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure lsbLeftDrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

private

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

{========================================================================

DESIGN BY : 彭国辉

DATE: 2004-11-29

SITE: http://kacarton.yeah.net/

BLOG: http://blog.csdn.net/nhconch

EMAIL: kacarton@sohu.com

文章为作者原创,转载前请先与本人联系,转载请注明文章出处、保留作者信息,谢谢支持!

=========================================================================}

procedure TForm1.FormCreate(Sender: TObject);

var

i: integer;

begin

lsbRight.Style := lbOwnerDrawFixed;

lsbRight.Ctl3D := false;

lsbRight.ItemHeight := 50;

lsbRight.Items.Add('C++ Builder 研究 www.ccrun.com'#13'致力于BCB的学习探讨和研究'#13'ccrun(老妖)');

lsbRight.Items.Add('编程手札 My Developer Knowledge Base'#13'http://blog.csdn.net/nhconch'#13'天蝎蝴蝶');

for i:=3 to 10 do begin

lsbRight.Items.Add('ListBox Items of ' + IntTostr(i) + #13'Second of '

+ IntToStr(i) + #13'Third of ' + IntToStr(i));

end;

lsbLeft.Style := lbOwnerDrawFixed;

lsbLeft.Ctl3D := false;

lsbLeft.ItemHeight := 90;

lsbLeft.Items.Add('编程手札');

lsbLeft.Items.Add('My Developer Knowledge Base');

lsbLeft.Items.Add('站长:天蝎蝴蝶');

lsbLeft.Items.Add('http://blog.csdn.net/nhconch');

end;

procedure TForm1.lsbRightDrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

var

strTemp: String;

begin

//文字颜色

lsbRight.Canvas.Font.Color := clBlack;

//设置背景颜色并填充背景

lsbRight.Canvas.Brush.Color := clWhite;

lsbRight.Canvas.FillRect (Rect);

//设置圆角矩形颜色并画出圆角矩形

lsbRight.Canvas.Brush.Color := TColor($00FFF7F7);

lsbRight.Canvas.Pen.Color := TColor($00131315);

lsbRight.Canvas.RoundRect(Rect.Left + 3, Rect.Top + 3,

Rect.Right - 2, Rect.Bottom - 2, 8, 8);

//以不同的宽度和高度再画一次,实现立体效果

lsbRight.Canvas.RoundRect(Rect.Left + 3, Rect.Top + 3,

Rect.Right - 3, Rect.Bottom - 3, 5, 5);

//如果是当前选中项

if(odSelected in State) then

begin

//以不同的背景色画出选中项的圆角矩形

lsbRight.Canvas.Brush.Color := TColor($00FFB2B5);

lsbRight.Canvas.RoundRect(Rect.Left + 3, Rect.Top + 3,

Rect.Right - 3, Rect.Bottom - 3, 5, 5);

//选中项的文字颜色

lsbRight.Canvas.Font.Color := clBlue;

//如果当前项拥有焦点,画焦点虚框,当系统再绘制时变成XOR运算从而达到擦除焦点虚框的目的

if(odFocused in State) then DrawFocusRect(lsbRight.Canvas.Handle, Rect);

end;

//画出图标

ImageList1.Draw(lsbRight.Canvas, Rect.Left + 7,

Rect.top + (lsbRight.ItemHeight - ImageList1.Height) div 2, Index, true);

//分别绘出三行文字

strTemp := lsbRight.Items.Strings[Index];

lsbRight.Canvas.TextOut(Rect.Left + 32 + 10, Rect.Top + 4

, Copy(strTemp, 1, Pos(#13, strTemp)-1));

strTemp := Copy(strTemp, Pos(#13, strTemp)+1, Length(strTemp));

lsbRight.Canvas.TextOut(Rect.Left + 32 + 10, Rect.Top + 18,

Copy(strTemp, 1, Pos(#13, strTemp)-1));

lsbRight.Canvas.TextOut(Rect.Left + 32 + 10, Rect.Top + 32,

Copy(strTemp, Pos(#13, strTemp)+1, Length(strTemp)));

end;

procedure TForm1.lsbRightClick(Sender: TObject);

begin

StaticText1.Caption := ' ' + lsbRight.Items.Strings[lsbRight.ItemIndex];

end;

procedure TForm1.FormShow(Sender: TObject);

begin

lsbRight.ItemIndex := 0;

lsbRight.Repaint();

lsbLeft.ItemIndex := 0;

lsbLeft.Repaint();

end;

procedure TForm1.lsbLeftDrawItem(Control: TWinControl; Index: Integer;

Rect: TRect; State: TOwnerDrawState);

var

r: TRect;

begin

with lsbLeft.Canvas do begin

//设置填充的背景颜色并填充背景

Brush.Color := clWhite;

FillRect (Rect);

//绘制圆角矩形

if (odSelected in State) then //选中项的圆角矩形颜色

Pen.Color := $FFB2B5

else //未选中项的圆角矩形颜色

Pen.Color := clSilver;

Brush.Style := bsClear;

SetRect(r, Rect.Left+3, Rect.Top+3, Rect.Right-3, Rect.Bottom-3);

RoundRect(r.Left, r.Top, r.Right, r.Bottom, 10, 10);

//画出图标

if (odSelected in State) then //选中项的图像

Draw(r.Left + (r.Right - r.Left - imgHouse.Width) shr 1,

r.Top + 2, imgHouse.Picture.Graphic)

else //未选中项的图像

Draw(r.Left + (r.Right - r.Left - imgHouseGray.Width) shr 1,

r.Top + 2, imgHouseGray.Picture.Graphic);

//填充文字区背景

r.Top := r.Bottom - Abs(Font.Height) - 4;

Brush.Style := bsSolid;

if (odSelected in State) then //选中项的背景颜色

Brush.Color := $FFB2B5

else //未选中项的背景颜色

Brush.Color := clSilver;

FillRect(r);

//输出文字,仅支持单行

Font.Color := clBlack;

r.Top := r.Top + 2; //计算文字顶点位置,(水平居中,DT_CENTER不可用)

DrawText(Handle, PChar(TListBox(Control).Items.Strings[Index]), -1, r

, DT_CENTER or DT_END_ELLipSIS{ or DT_Word

BREAK});

//画焦点虚框,当系统再绘制时,变成XOR运算,从而达到擦除焦点虚框的目的

if(odFocused in State) then DrawFocusRect(Rect);

end;

end;

end.

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
推荐阅读
 
 
 
>>返回首頁<<
 
靜靜地坐在廢墟上,四周的荒凉一望無際,忽然覺得,淒涼也很美
© 2005- 王朝網路 版權所有