需要用PB語言做個下拉選單（類似word和寫字板中用于更改字體的下拉選單），下拉選單中是當前系統的所有可用字體 得到用戶選中的字體，不要一個一個回填的那種 代碼越少為佳
50分
uj5u.com熱心網友回復：
沒人跟 自己頂~~~~~uj5u.com熱心網友回復：
在線等待·~~uj5u.com熱心網友回復：
在網上能找到，我記得下載過，在哪下載的？太久了，我忘了有純pb代碼版，還有dll版本，檔案名是getfont.dll
uj5u.com熱心網友回復：
網上貌似沒搜到 有其他語言的 或者是獲取了所有字體一個一個添加~~~uj5u.com熱心網友回復：
我找到一個，這是代碼$PBExportHeader$w_choosefont.srw
$PBExportComments$選擇字體對話框演示視窗
forward
global type w_choosefont from window
end type
type cb_choosefont from commandbutton within w_choosefont
end type
type mle_1 from multilineedit within w_choosefont
end type
type dw_1 from datawindow within w_choosefont
end type
type logfont from structure within w_choosefont
end type
type choosefont from structure within w_choosefont
end type
end forward
type logfont from structure
long lfheight
long lfwidth
long lfescapement
long lforientation
long lfweight
character lfitalic
character lfunderline
character lfstrikeout
character lfcharset
character lfoutprecision
character lfclipprecision
character lfquality
character lfpitchandfamily
character lffacename[32]
end type
type choosefont from structure
long lstructsize
long hwndowner
long hdc
long lplogfont
long ipointsize
long flags
long rgbcolors
long lcustdata
long lpfnhook
long lptemplatename
long hinstance
long lpszstyle
integer nfonttype
integer ___missing_alignment__
long nsizemin
long nsizemax
end type
global type w_choosefont from window
integer width = 2391
integer height = 1216
boolean titlebar = true
string title = "字體選擇對話框演示"
boolean controlmenu = true
boolean resizable = true
long backcolor = 67108864
string icon = "Function!"
cb_choosefont cb_choosefont
mle_1 mle_1
dw_1 dw_1
end type
global w_choosefont w_choosefont
type prototypes
//字體選擇函式
FUNCTION ulong ChooseFont(ref CHOOSEFONT pChoosefont) LIBRARY "comdlg32.dll" ALIAS FOR "ChooseFontA"
//記憶體函式
Function long GetLogFont(REF LOGFONT Destination, long Source, long Size) library "kernel32.dll" Alias For "RtlMoveMemory"
Function long PutLogFont(long Destination, REF LOGFONT Source, long Size) library "kernel32.dll" Alias For "RtlMoveMemory"
Function long StrCopy(long Destination, REF string Source, long Size) library "kernel32.dll" Alias for "RtlMoveMemory"
Function long LocalAlloc(long Flags, long Bytes) library "kernel32.dll"
Function long LocalFree(long MemHandle) library "kernel32.dll"
end prototypes
type variables
//指標常數
CONSTANT long CF_SCREENFONTS = 1
CONSTANT long CF_PRINTERFONTS = 2
CONSTANT long CF_BOTH = 3
CONSTANT long CF_SHOWHELP = 4
CONSTANT long CF_ENABLEHOOK = 8
CONSTANT long CF_ENABLETEMPLATE = 16
CONSTANT long CF_ENABLETEMPLATEHANDLE= 32
CONSTANT long CF_INITTOLOGFONTSTRUCT = 64
CONSTANT long CF_USESTYLE = 128
CONSTANT long CF_EFFECTS = 256
CONSTANT long CF_APPLY = 512
CONSTANT long CF_ANSIONLY = 1024
CONSTANT long CF_SCRIPTSONLY = CF_ANSIONLY
CONSTANT long CF_NOVECTORFONTS = 2048
CONSTANT long CF_NOOEMFONTS = 4096
CONSTANT long CF_NOSIMULATIONS = 8192
CONSTANT long CF_LIMITSIZE = 16384
CONSTANT long CF_FIXEDPITCHONLY = 32768
CONSTANT long CF_WYSIWYG = 65536
CONSTANT long CF_FORCEFONTEXIST = 131072
CONSTANT long CF_SCALABLEONLY = 262144
CONSTANT long CF_TTONLY = 524288
CONSTANT long CF_NOFACESEL = 1048576
CONSTANT long CF_NOSTYLESEL = 2097152
CONSTANT long CF_NOSIZESEL = 4194304
CONSTANT long CF_SELECTSCRIPT = 8388608
CONSTANT long CF_NOSCRIPTSEL = 16777216
CONSTANT long CF_NOVERTFONTS = 33554432
//字體型別常數
CONSTANT integer BOLD_FONTTYPE = 256
CONSTANT integer ITALIC_FONTTYPE = 512
CONSTANT integer REGULAR_FONTTYPE = 1024
CONSTANT integer SCREEN_FONTTYPE = 8192
CONSTANT integer PRINTER_FONTTYPE = 16384
CONSTANT integer SIMULATED_FONTTYPE = 32768
//物件私有成員常數
Private:
CONSTANT integer LMEM_ZEROINIT = 64 //記憶體常數
end variables
uj5u.com熱心網友回復：
forward prototypespublic function integer wf_center ()
end prototypes
public function integer wf_center ();//*-----------------------------------------------------------------*/
//* wf_Center: 使視窗置于螢屏中央
//*-----------------------------------------------------------------*/
int li_screenheight, li_screenwidth, li_rc, li_x=1, li_y=1
environment lenv_obj
/* 檢查同該物件相關的視窗是否存在 */
If IsNull ( this ) Or Not IsValid ( this ) Then Return -1
/* 獲取環境物件 */
If GetEnvironment ( lenv_obj ) = -1 Then Return -1
/* 確定螢屏的現在的解析度 */
li_screenheight = PixelsToUnits ( lenv_obj.ScreenHeight, YPixelsToUnits! )
li_screenwidth = PixelsToUnits ( lenv_obj.ScreenWidth, XPixelsToUnits! )
If Not ( li_screenheight > 0 ) Or Not ( li_screenwidth > 0 ) Then Return -1
/* 獲取螢屏的中心點 */
If li_screenwidth > this.Width Then
li_x = ( li_screenwidth / 2 ) - ( this.Width / 2 )
End If
If li_screenheight > this.Height Then
li_y = ( li_screenheight / 2 ) - ( this.Height / 2 )
End If
/* 使視窗置中 */
li_rc = this.Move ( li_x, li_y )
If li_rc <> 1 Then Return -1
Return 1
end function
on w_choosefont.create
this.cb_choosefont=create cb_choosefont
this.mle_1=create mle_1
this.dw_1=create dw_1
this.Control[]={this.cb_choosefont,&
this.mle_1,&
this.dw_1}
end on
on w_choosefont.destroy
destroy(this.cb_choosefont)
destroy(this.mle_1)
destroy(this.dw_1)
end on
event open;dw_1.SetTransObject(SQLCA)
dw_1.Retrieve()
wf_center()
end event
type cb_choosefont from commandbutton within w_choosefont
integer x = 64
integer y = 884
integer width = 375
integer height = 80
integer taborder = 20
integer textsize = -8
integer weight = 400
fontcharset fontcharset = ansi!
fontpitch fontpitch = variable!
fontfamily fontfamily = swiss!
string facename = "Arial"
string text = "選擇字體"
end type
event clicked;CHOOSEFONT CFont
LOGFONT LFont
//字體對話框成員變數
Long ll_RGBColors = 0
Integer li_FontType = 0
Integer li_SizeMin = 0
Integer li_SizeMax = 720
Integer li_iPointSize = 12
String ls_FaceName = "Times New Roman"
Long ll_Height = 15
Long ll_Weight = 0
Boolean lb_Italic = True
Boolean lb_Underline = True
Boolean lb_StrikeOut = False
Long flags = CF_FORCEFONTEXIST + CF_BOTH + CF_EFFECTS + CF_INITTOLOGFONTSTRUCT
//初始化結構LOGFONT成員
LFont.lfFaceName = ls_FaceName
LFont.lfHeight = ll_Height
LFont.lfWeight = ll_Weight
If lb_Italic Then LFont.lfItalic = Char(255) Else LFont.lfItalic = Char(0)
If lb_Underline Then LFont.lfUnderline = Char(1) Else LFont.lfUnderline = Char(0)
If lb_StrikeOut Then LFont.lfStrikeOut = Char(1) Else LFont.lfStrikeOut = Char(0)
uj5u.com熱心網友回復：
//初始化結構CHOOSEFONT成員CFont.lStructSize = 60
CFont.hWndOwner = Handle(Parent)
CFont.hDC = 0
CFont.lpLogFont = LocalAlloc(0,60)
PutLogFont(CFont.lpLogFont,LFont,60)
CFont.iPointSize = li_iPointSize
CFont.Flags = Flags
CFont.RGBColors = ll_RGBColors
CFont.lCustData =https://bbs.csdn.net/topics/ 0
CFont.lpfnHook = 0
CFont.lpTemplateName = 0
CFont.hInstance = 0
CFont.lpszStyle = 0
CFont.nFontType = li_FontType
CFont.nSizeMin = li_SizeMin
CFont.nSizeMax = li_SizeMax
//回傳用戶的選擇的字體
If ChooseFont(CFont) = 1 Then
GetLogFont(LFont,CFont.lpLogFont,60)
li_FontType = CFont.nFontType
ll_RGBColors = CFont.RGBColors
ls_FaceName = LFont.lfFaceName
li_iPointSize = CFont.iPointSize
ll_Height = LFont.lfHeight
ll_Weight = LFont.lfWeight
lb_Italic = (Asc(LFont.lfItalic) = 255)
lb_Underline = (Asc(LFont.lfUnderline) = 1)
lb_StrikeOut = (Asc(LFont.lfStrikeOut) = 1)
MessageBox("字體","字體是：" + &
ls_FaceName + ", 大小為：" + String(li_iPointSize/10) + ", 斜體為：" + &
String(lb_Italic) + ", 下劃線為：" + String(lb_Underline))
mle_1.FaceName = ls_FaceName
mle_1.TextSize = li_iPointSize/10
mle_1.TextColor = ll_RGBColors
If lb_Italic = True Then mle_1.Italic = True
If lb_Underline = True Then mle_1.Underline = True
Else
li_FontType = 0
ls_FaceName = ""
ll_Height = 0
ll_Weight = 0
lb_Italic = False
lb_Underline= False
lb_StrikeOut= False
End If
LocalFree(CFont.lpLogFont)
end event
type mle_1 from multilineedit within w_choosefont
integer x = 471
integer y = 872
integer width = 1801
integer height = 204
integer taborder = 30
integer textsize = -10
integer weight = 400
fontcharset fontcharset = gb2312charset!
fontpitch fontpitch = fixed!
fontfamily fontfamily = modern!
string facename = "仿宋_GB2312"
long textcolor = 33554432
string text = " 通過選擇字體按鈕呼叫字體選擇對話框，選取一種字體并設定其他屬性，本框中的字體將隨之改變。然后，單擊資料視窗中的任意一列，該列文本字體也將變為選定的字體。"
boolean displayonly = true
borderstyle borderstyle = stylelowered!
end type
type dw_1 from datawindow within w_choosefont
integer x = 50
integer y = 48
integer width = 2226
integer height = 804
integer taborder = 20
string dataobject = "d_customers"
boolean hscrollbar = true
boolean vscrollbar = true
boolean livescroll = true
borderstyle borderstyle = stylelowered!
end type
event clicked;String ls_name
ls_name = dwo.Name
If ls_name = "fname" Then
dw_1.Object.fname.Color = mle_1.TextColor
dw_1.Object.fname.Font.Face = mle_1.FaceName
If mle_1.Italic = True Then dw_1.Object.fname.Font.Italic = 1
If mle_1.UnderLine = True Then dw_1.Object.fname.Font.UnderLine = 1
ElseIf ls_name = "id" Then
dw_1.Object.id.Color = mle_1.TextColor
dw_1.Object.id.Font.Face = mle_1.FaceName
If mle_1.Italic = True Then dw_1.Object.id.Font.Italic = 1
If mle_1.UnderLine = True Then dw_1.Object.id.Font.UnderLine = 1
ElseIf ls_name = "address" Then
dw_1.Object.address.Color = mle_1.TextColor
dw_1.Object.address.Font.Face = mle_1.FaceName
If mle_1.Italic = True Then dw_1.Object.address.Font.Italic = 1
If mle_1.UnderLine = True Then dw_1.Object.address.Font.UnderLine = 1
ElseIf ls_name = "city" Then
dw_1.Object.city.Color = mle_1.TextColor
dw_1.Object.city.Font.Face = mle_1.FaceName
If mle_1.Italic = True Then dw_1.Object.city.Font.Italic = 1
If mle_1.UnderLine = True Then dw_1.Object.city.Font.UnderLine = 1
End If
end event
uj5u.com熱心網友回復：
......uj5u.com熱心網友回復：
將內容復制保存到一個檔案中，檔案名為w_choosefont.srw，在pb中使用匯入操作即可uj5u.com熱心網友回復：
http://topic.csdn.net/t/20030327/11/1583014.htmluj5u.com熱心網友回復：
幫頂uj5u.com熱心網友回復：
太復雜了uj5u.com熱心網友回復：
哎~~~~~~~uj5u.com熱心網友回復：
學習啦~~~~~~轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/76567.html
標籤：控件與界面
下一篇：關于RFID的價格