把图像加入字符串列表
上节已介绍如何把对象加入字符串列表例程把位图对象加入Tabset的Tabs中
procedure TFormFormCreate(Sender: TObject);
var
Bitmap: TBitMap;
begin
ListboxItems := ScreenFonts;
Bitmap := TBitmapCreate;
BitmapLoadFromFile(PHONEBMP);
TabsetTabsAddObject(phoneBitmap);
Bitmap := TBitmapCreate;
BitmapLoadFromFile(PRINTERBMP);
TabsetTabsAddObject(printer Bitmap);
end;
绘制自画项目
当部件的Style属性是自画式时Windows不再绘制部件相反Windows为每个可视项目产生事件而应用程序必须在事件中绘制项目
在应用程序绘制自画控制之前Windows产生测量项目事件这个事件告诉程序项目显示的位置
通常由Windows决定项目显示的大小但应用程序可以处理这个事件并自己选择显示区域例如程序要用位图代替文本显示则需要把区域设置成位图的大小测量项目事件的名称随部件的名称不同而不同对于列表框和组合框该事件叫OnMeasureItem对于Tabset该事件叫OnMeasureTab
测量项目事件有两个重要参数: 项目索引号与项目的大小这个大小是变化的后继项目的输出位置由前面项目的大小决定例如在自画式列表框中如果应用程序把第一个项目的高度设置成个象素点则第二个项目在第六个象素点开始输出列表框和组合框中应用程序只能设置成项目的高度而项目的宽度就是部件的高度在Tabset中tabs的宽度是可变的而高度则是固定的自画式网格允许应用程序改变网格单元的高度和宽度
OnMeasureItem的声明如下
ListBox MeasureItem(Control: TwinControl;Index: Integer; var Height: Integer);
例程中响应OnMeasureItem事件的代码如下:
procedure TFormListBoxMeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
with ListBoxCanvas do
begin
FontName := ListBoxItems[Index];
Height := TextHeight(A);
end;
end;
procedure TFormTabSetMeasureTab(Sender: TObject; Index: Integer;
var TabWidth: Integer);
var
BitmapWidth: Integer;
begin
BitmapWidth := TBitmap( TabSetTabsObjects[Index])Width;
Inc(TabWidth + BitmapWidth);
end;
在OnMeasureItem事件发生后Windows激发一个叫OnDrawItem的事件这个事件也随部件名称不同而不同常见的有OnDrawItemOnDrawTabOnDrawCell
OnMeasureItem的声明如下
DrawItem( Control: TWinControl; Index: integer; Rect: TRect; State: TOwnerDraw);
其中Control是包含项目的部件引用
Index是项目的索引号
Rect 是绘制的矩形
State 是项目的状态如选中得到焦点等
在例程的列表框中所列项目是屏幕支持的各种字体名称当列表框发生OnDrawItem事件时程序把输出字体设置成该项目所代表的字体因而列表框的项目呈现出不同的字体其代码如下
procedure TFormDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with ListBoxCanvas do
begin
FillRect(Rect);
FontName := ListBoxItems[Index];
TextOut(RectLeft RectTop ListBoxItems[Index]);
end;
end;
在Tabset部件中则把位图与文本同时输出其代码如下
procedure TFormTabSetDrawTab(Sender: TObject; TabCanvas: TCanvas;
R: TRect; Index: Integer; Selected: Boolean);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap(TabSetTabsObjects[Index]);
with TabCanvas do
begin
Draw(RLeft RTop + Bitmap);
TextOut(RLeft + + BitmapWidth
RTop + TabSetTabs[Index]);
end;
end;
