怎样做一个象word2000中的选择字体的ComboBox(300分)

用Delphi6 的Comboboxex

楼上的，300分就这样？我以为还有什么玄虚呢。

to little_five_gqw:
我还在用d5,我看看这个行不行

to Jar:
麻烦你给点提示（在d3-d5下能用），好的话，分可以再加。

选字体：
－－－－－－－－－－
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ComboBox1.Items.Assign(Screen.Fonts);
ComboBox1.ItemIndex := ComboBox1.Items.IndexOf(Font.Name);
end;
－－－－－－－－－－－
得到字体！

no no
我要的是word2000中样式的，就是下拉列表中能显示出字体的形式

to little_five_gqw:
我试了试，不满足我的需要。

有现成的控件,你去国外的网站看看,要不我这里有源代码,不过速度奇慢,也是DFW里的人]
给我的.呵呵

理解错了楼主的意思，不好意思。

to 花 儿:
方便的话，寄给我一份: wanghaifeng_1@163.net

加一个TComboBox：cb，设置Style为csOwnerDrawFixed或csOwnerDrawVariable，
procedure TForm1.cbDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
cb.Canvas.Font.Name := cb.Items.Strings[Index];
cb.Canvas.TextOut(Rect.Left, Rect.Top, cb.Items.Strings[Index]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
cb.Items := Screen.Fonts;
end;
这个方法对一般的字体速度还可以，但是对字体列表前面的头上带@的字体速度就慢的很，
也可以用
procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
for i := 0 to Screen.Fonts.Count - 1 do begin
if Screen.Fonts.Strings[1] = '@' then
continue;
cb.Items.Add(Screen.Fonts.Strings);
end;
end;
或类似方法把带@的字体过滤调，速度就比较快。

还差点，主要是我想让下拉列表中显示的字体要大点，而不下拉时的宽度不能变大

什么意思？
想让字体变大直接设置ComboBox的Font的Size。
“不下拉时宽度不能变大”是什么意思？

to whf 大虾,thanx.
确实是D6有这个控件.
如果上面说的效果不满意的话,
再帮你写写找找.

to libin06:
我想要得效果：在下拉框中显示的内容是大字体的，不弹出下拉矿是显示的是小字体，就像
word2000中的效果，所以设置Font size不行

to bubble:
d6中的那个控件我试了试，好像不行，不能实现word2000中的效果。

我有用listbox做的，其实稍加修改即可。

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
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;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
ListBox1.Items := Screen.Fonts;
end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with ListBox1 do
begin
Canvas.Brush.Color := clWhite;
Canvas.FillRect(Rect);
Canvas.Font.Name := Items[Index];
if odSelected in State then
Canvas.Brush.Color := clHighLight
else
Canvas.Brush.Color := clWhite;
Canvas.TextOut(Rect.Left, Rect.Top, Items[Index]);
end;
end;

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
ListBox1.Canvas.Font.Name := ListBox1.Items[Index];
Height := 2 + ListBox1.Canvas.TextHeight(ListBox1.Items[Index]);
end;

end.


把listbox改为combobox即可

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
ListBox1.Canvas.Font.Name := ListBox1.Items[Index];
ListBox1.Canvas.Font.Size := 30; //
Height := 2 + ListBox1.Canvas.TextHeight(ListBox1.Items[Index]);
end;

要的就是这种效果，可惜改成TComboBox不行。

我原来做过，可能还要修改一部分代码，可惜我当时做的源程序被我搞丢了

太可惜了

基本的处理方法就是这样了，剩下的细节你自己改一下吧。
procedure TForm1.cbDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
cb.Canvas.Font.Name := cb.Items.Strings[Index];
if odComboBoxEdit in State then
cb.Canvas.Font.Size := 10
else
cb.Canvas.Font.Size := 20;
cb.Canvas.TextOut(Rect.Left, Rect.Top, cb.Items.Strings[Index]);
end;

procedure TForm1.cbMeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
if Index = -1 then
Height := 16
else
Height := 27;
end;

多人接受答案了。