F
flyman1
Unregistered / Unconfirmed
GUEST, unregistred user!
《Delphi 2.0高级程序设计指南》教程中第三章字符串列表及应用中的一道例题
设置自画风格。我按照教程编写如下:
unit owndraw;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Tabs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
TabSet1: TTabSet;
procedure FormCreate(Sender: TObject);
procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure TabSet1DrawTab(Sender: TObject; TabCanvas: TCanvas; R: TRect;
Index: Integer; Selected: Boolean);
procedure TabSet1MeasureTab(Sender: TObject; Index: Integer;
var TabWidth: Integer);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
Bitmap: TBitMap;
begin
Listbox1.Items := Screen.Fonts;
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('PHONE.BMP');
Tabset1.Tabs.AddObject('phone',Bitmap);
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('PRINTER.BMP');
Tabset1.Tabs.AddObject('printer ',Bitmap);
end;
procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
with ListBox1.Canvas do
begin
Font.Name := ListBox1.Items[Index];
Height := TextHeight('A');
end;
end;
procedure TForm1.TabSet1DrawTab(Sender: TObject; TabCanvas: TCanvas;
R: TRect; Index: Integer; Selected: Boolean);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap(TabSet1.Tabs.Objects[Index]);
with TabCanvas do
begin
Draw(R.Left, R.Top + 4, Bitmap);
TextOut(R.Left + 2 + Bitmap.Width,R.Top + 2, TabSet1.Tabs[Index]);
end;
end;
procedure TForm1.TabSet1MeasureTab(Sender: TObject; Index: Integer;
var TabWidth: Integer);
var
BitmapWidth: Integer;
begin
BitmapWidth := TBitmap( TabSet1.Tabs.Objects[Index]).Width;
Inc(TabWidth, 2 + BitmapWidth);
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with ListBox1.Canvas do
begin
FillRect(Rect);
Font.Name := ListBox1.Items[Index];
TextOut(Rect.Left, Rect.Top, ListBox1.Items[Index]);
end;
end;
end.
结果无法在listbox中用相应的字体显示字体名,tabset的标签也无法显示
对应的图像,请问各位大侠这是什么原因,该如何解决?
[]
设置自画风格。我按照教程编写如下:
unit owndraw;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Tabs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
TabSet1: TTabSet;
procedure FormCreate(Sender: TObject);
procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure TabSet1DrawTab(Sender: TObject; TabCanvas: TCanvas; R: TRect;
Index: Integer; Selected: Boolean);
procedure TabSet1MeasureTab(Sender: TObject; Index: Integer;
var TabWidth: Integer);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
Bitmap: TBitMap;
begin
Listbox1.Items := Screen.Fonts;
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('PHONE.BMP');
Tabset1.Tabs.AddObject('phone',Bitmap);
Bitmap := TBitmap.Create;
Bitmap.LoadFromFile('PRINTER.BMP');
Tabset1.Tabs.AddObject('printer ',Bitmap);
end;
procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
with ListBox1.Canvas do
begin
Font.Name := ListBox1.Items[Index];
Height := TextHeight('A');
end;
end;
procedure TForm1.TabSet1DrawTab(Sender: TObject; TabCanvas: TCanvas;
R: TRect; Index: Integer; Selected: Boolean);
var
Bitmap: TBitmap;
begin
Bitmap := TBitmap(TabSet1.Tabs.Objects[Index]);
with TabCanvas do
begin
Draw(R.Left, R.Top + 4, Bitmap);
TextOut(R.Left + 2 + Bitmap.Width,R.Top + 2, TabSet1.Tabs[Index]);
end;
end;
procedure TForm1.TabSet1MeasureTab(Sender: TObject; Index: Integer;
var TabWidth: Integer);
var
BitmapWidth: Integer;
begin
BitmapWidth := TBitmap( TabSet1.Tabs.Objects[Index]).Width;
Inc(TabWidth, 2 + BitmapWidth);
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with ListBox1.Canvas do
begin
FillRect(Rect);
Font.Name := ListBox1.Items[Index];
TextOut(Rect.Left, Rect.Top, ListBox1.Items[Index]);
end;
end;
end.
结果无法在listbox中用相应的字体显示字体名,tabset的标签也无法显示
对应的图像,请问各位大侠这是什么原因,该如何解决?
[]