下拉列表框中如何显示系统全部字体?

[herolion2010]

请问兄弟们,下拉列表框中如何显示系统全部字体?

[xuam]

有控件吧？
要不用ole插入字体控件

[yyoinge]

保存为w_get_font.srw，然后导入pbl中

$PBExportHeader$w_get_font.srw
forward
global type w_get_font from window
end type
type cb_2 from commandbutton within w_get_font
end type
type cb_1 from commandbutton within w_get_font
end type
type ddplb_1 from dropdownpicturelistbox within w_get_font
end type
end forward

global type w_get_font from window
integer width = 914
integer height = 284
boolean titlebar = true
string title = "字体选择"
boolean controlmenu = true
windowtype windowtype = response!
long backcolor = 67108864
string icon = "AppIcon!"
boolean center = true
cb_2 cb_2
cb_1 cb_1
ddplb_1 ddplb_1
end type
global w_get_font w_get_font

forward prototypes
public function long wf_get_font (ref string as_fontname[])
end prototypes

public function long wf_get_font (ref string as_fontname[]);environment l_env

if GetEnvironment ( l_env ) <> 1 then return 0

Long ll_FontCount
Integer li_EndPos, li_EndPos1, li_EndPos2, I

If l_env.OSType = WindowsNT! Then //NT系统
  	//枚举所有字体名称
	RegistryValues( "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion\Fonts", as_FontName)
Elseif l_env.OSType = Windows! then	//系统为Windows 9X	
	//枚举所有字体名称
	RegistryValues( "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Fonts", as_FontName)
End If

//获取字体的总数目
ll_FontCount = UpperBound(as_FontName)

//去除字体名称中的类型表述
For I = 1 To ll_FontCount
	li_EndPos1 = Pos(as_FontName[I], "Plain:1.0", 1)
	li_EndPos2 = Pos(as_FontName[I], "&", 1)
	If li_EndPos1 = 0 And li_EndPos2 = 0 Then
		li_EndPos = Pos(as_FontName[I], "(", 1)
		as_FontName[I] = Mid(as_FontName[I], 1, li_EndPos - 2)
	ElseIf li_EndPos1 <> 0 And li_EndPos2 = 0 Then
		as_FontName[I] = Mid(as_FontName[I], 1, li_EndPos1 - 2)
	ElseIf li_EndPos1 = 0 And li_EndPos2 <> 0 Then
		as_FontName[I] = Mid(as_FontName[I], 1, li_EndPos2 - 2)
	End If
Next

//更改常用的字体名称为实际名称
For I = 1 To ll_FontCount
	If as_FontName[I] = "楷体" Then as_FontName[I] = "楷体_GB2312"
	If as_FontName[I] = "仿宋体" Then as_FontName[I] = "仿宋_GB2312"
Next

as_FontName[ll_FontCount] = "新宋体"

//返回字体数目
Return ll_FontCount
end function

on w_get_font.create
this.cb_2=create cb_2
this.cb_1=create cb_1
this.ddplb_1=create ddplb_1
this.Control[]={this.cb_2,&
this.cb_1,&
this.ddplb_1}
end on

on w_get_font.destroy
destroy(this.cb_2)
destroy(this.cb_1)
destroy(this.ddplb_1)
end on

event open;String ls_FontName[], ls_def
Long ll_FontCount, I

ls_def = message.stringparm
if ls_def = '' then ls_def = '华文彩云'
//获取字体列表
ll_FontCount = wf_Get_Font(ls_FontName)

//将字体列表添加到下拉列表框中
For I = 1 To ll_FontCount
	if ls_FontName[I] <> '' then ddplb_1.AddItem(ls_FontName[I], 1)
Next

//列表框的初始值为文本编辑框的字体类型
ddplb_1.Text = ls_def

//重画窗口
//This.SetReDraw(True)

end event

type cb_2 from commandbutton within w_get_font
integer x = 485
integer y = 112
integer width = 293
integer height = 76
integer taborder = 20
integer textsize = -9
integer weight = 400
fontcharset fontcharset = gb2312charset!
fontpitch fontpitch = variable!
string facename = "宋体"
string text = "取消(&C)"
end type

event clicked;closewithreturn(parent,'')
end event

type cb_1 from commandbutton within w_get_font
integer x = 128
integer y = 112
integer width = 293
integer height = 76
integer taborder = 20
integer textsize = -9
integer weight = 400
fontcharset fontcharset = gb2312charset!
fontpitch fontpitch = variable!
string facename = "宋体"
string text = "确定(&O)"
end type

event clicked;closewithreturn(parent,ddplb_1.text)
end event

type ddplb_1 from dropdownpicturelistbox within w_get_font
integer x = 5
integer width = 901
integer height = 620
integer taborder = 10
integer textsize = -9
integer weight = 400
fontcharset fontcharset = gb2312charset!
fontpitch fontpitch = variable!
string facename = "宋体"
boolean hscrollbar = true
boolean vscrollbar = true
borderstyle borderstyle = stylelowered!
string picturename[] = {"StaticText!","StaticHyperLink!"}
long picturemaskcolor = 12632256
end type

[yyoinge]

或者下载这个dll
http://www.hur.cn/Soft/2005/2780.html
发布一个强劲的DLL文件，看了就知道了