private const lf_facesize = 32
private const cf_printerfonts = &h2
private const cf_screenfonts = &h1
private const cf_both = (cf_screenfonts or cf_printerfonts)
private const cf_effects = &h100&
private const cf_forcefontexist = &h10000
private const cf_inittologfontstruct = &h40&
private const cf_limitsize = &h2000&
private const regular_fonttype = &h400
'charset constants
private const ansi_charset = 0
private const arabic_charset = 178
private const baltic_charset = 186
private const chinesebig5_charset = 136
private const default_charset = 1
private const easteurope_charset = 238
private const gb2312_charset = 134
private const greek_charset = 161
private const hangeul_charset = 129
private const hebrew_charset = 177
private const johab_charset = 130
private const mac_charset = 77
private const oem_charset = 255
private const russian_charset = 204
private const shiftjis_charset = 128
private const symbol_charset = 2
private const thai_charset = 222
private const turkish_charset = 162
private type logfont
lfheight as long
lfwidth as long
lfescapement as long
lforientation as long
lfweight as long
lfitalic as byte
lfunderline as byte
lfstrikeout as byte
lfcharset as byte
lfoutprecision as byte
lfclipprecision as byte
lfquality as byte
lfpitchandfamily as byte
lffacename as string * 31
end type
private type choosefont
lstructsize as long
hwndowner as long ' caller's window handle
hdc as long ' printer dc/ic or null
lplogfont as long ' ptr. to a logfont struct
ipointsize as long ' 10 * size in points of selected font
flags as long ' enum. type flags
rgbcolors as long ' returned text color
lcustdata as long ' data passed to hook fn.
lpfnhook as long ' ptr. to hook function
lptemplatename as string ' custom template name
hinstance as long ' instance handle of.exe that
' contains cust. dlg. template
lpszstyle as string ' return the style field here
' must be lf_facesize or bigger
nfonttype as integer ' same value reported to the enumfonts
' call back with the extra fonttype_
' bits added
missing_alignment as integer
nsizemin as long ' minimum pt size allowed &
nsizemax as long ' max pt size allowed if
' cf_limitsize is used
end type
private declare function choosefont lib "***dlg32.dll" alias "choosefonta" _
(byref pchoosefont as choosefont) as long
private sub ***mand1_click()
dim cf as choosefont, lfont as logfont
dim fontname as string, ret as long
cf.flags = cf_both or cf_effects or cf_forcefontexist or cf_inittologfontstruct or cf_limitsize
cf.lplogfont = varptr(lfont)
cf.lstructsize = lenb(cf)
'cf.lstructsize = len(cf) ' size of structure
cf.hwndowner = form1.hwnd ' window form1 is opening this dialog box
cf.hdc = printer.hdc ' device context of default printer (using vb's mechani**)
cf.rgbcolors = rgb(0, 0, 0) ' black
cf.nfonttype = regular_fonttype ' regular font type i.e. not bold or anything
cf.nsizemin = 10 ' minimum point size
cf.nsizemax = 72 ' maximum point size
ret = choosefont(cf) 'brings up the font dialog
if ret <> 0 then ' success
fontname = strconv(lfont.lffacename, vbunicode, &h804) 'retrieve chinese font name in english version os
fontname = left$(fontname, instr(1, fontname, vbnullchar) - 1)
'assign the font properties to text1
with text1.font
.charset = lfont.lfcharset 'assign charset to font
.name = fontname
.size = cf.ipointsize / 10 'assign point size
text1.text = .name & ":" & .charset & ":" & .size 'display data in chosen font
end with
end if
end sub
VB 選擇目錄對話方塊實現（API）
private type browseinfo hwndowner aslong pidlroot aslong pszdisplayname aslong lpsztitle aslong ulflags aslong lpfncallback aslong lparam aslong iimag...
VB6用API實現繁體簡體轉換
private declare function lcmapstring lib kernel32 alias lcmapstringa byval locale as long,byval dwmapflags as long,byval lpsrcstr as string,byval cchs...
VB6用API實現繁體簡體轉換
由於正好需要一個繁體轉簡體的事情，弄這個函式將就用一下了。private declare function lcmapstring lib kernel32 alias lcmapstringa byval locale as long,byval dwmapflags as long,byval ...
在VB中用ADO操作Excel報錯
請高手幫幫忙 vba中有下面一段 為什麼總在 rsdata.open ssql,sconnect,adopenforwardonly,adlockreadonly,adcmdtext 處提示 m jet 找不到物件 生產計劃 plan area 請確定物件是否存在,並正確的寫出它的名稱和路徑 pri...
VB呼叫系統API的宣告
有些windows api並沒有vb的封裝，這個時候需要手工在呼叫之前進行宣告，通過declare實現。具體可以參看msdn。通常我是記不住語法的，簡單而絕對正確的做法就是查詢微軟官方提供宣告。在windows中可以找到這麼一個檔案win32api.txt.如果用了google的桌面搜尋的話，找這個...