IDC资讯中心
类中的各种属性与方法，主要用于外部调用
friend property let bordercolor(byval vdata as long)
if m_lngbrdcolor <> vdata then
m_lngbrdcolor = vdata
if m_lngbrdstyle > 3 then refresh
end if
end property
friend property get bordercolor() as long
bordercolor = m_lngbrdcolor
end property
friend property let backpicture(byval vdata as string)
if vdata <> “” and dir(vdata) <> “” then
if lcase(m_strbkpicture) <> lcase(vdata) then
m_strbkpicture = vdata
set mpicbk = loadpicture(m_strbkpicture)
refresh
end if
else
set mpicbk = nothing
m_strbkpicture = “”
end if
end property
friend property get backpicture() as string
backpicture = m_strbkpicture
end property
friend property let fontname(byval vdata as string)
dim s as string, i as long
vdata = trim(vdata)
s = strconv(font.lffacename, vbunicode)
i = instr(1, s, chr(0))
if i > 0 then
s = left$(s, i – 1)
end if
if s <> vdata then
copymemory font.lffacename(0), byval vdata, lstrlen(vdata)
refresh
end if
end property
friend property get fontname() as string
dim s as string, i as long
s = strconv(font.lffacename, vbunicode)
i = instr(1, s, chr(0) – 1)
if i > 0 then
fontname = left$(s, i – 1)
else
fontname = s
end if
end property
friend property let fontunderline(byval vdata as boolean)
dim i as long
i = iif(vdata, 1, 0)
if font.lfunderline <> i then
font.lfunderline = i
refresh
end if
end property
friend property get fontunderline() as boolean
fontunderline = (font.lfunderline = 1)
end property
friend property let fontitalic(byval vdata as boolean)
dim i as long
i = iif(vdata, 1, 0)
if font.lfitalic <> i then
font.lfitalic = i
refresh
end if
end property
friend property get fontitalic() as boolean
fontitalic = (font.lfitalic = 1)
end property
friend property let fontbold(byval vdata as boolean)
dim i as long
i = iif(vdata, 700, 400)
if font.lfweight <> i then
font.lfweight = i
refresh
end if
end property
friend property get fontbold() as boolean
fontbold = (font.lfweight = 700)
end property
friend property let fontsize(byval vdata as long)
if font.lfheight <> vdata and vdata >= 7 and vdata <= 16 then
font.lfheight = vdata
font.lfwidth = 0
refresh
end if
end property
friend property get fontsize() as long
fontsize = font.lfheight
end property
friend property let borderstyle(byval vdata as long)
if m_lngbrdstyle <> vdata then
m_lngbrdstyle = vdata
refresh
end if
end property
friend property get borderstyle() as long
borderstyle = m_lngbrdstyle
end property
friend property let texthicolor(byval vdata as long)
m_lngtexthicolor = vdata
end property
friend property get texthicolor() as long
texthicolor = m_lngtexthicolor
end property
friend property let textcolor(byval vdata as long)
if m_lngtextcolor <> vdata then
m_lngtextcolor = vdata
refresh
end if
end property
friend property get textcolor() as long
textcolor = m_lngtextcolor
end property
friend property let backcolor(byval vdata as long)
if m_lngbackcolor <> vdata then
m_lngbackcolor = vdata
if mpicbk is nothing then refresh
end if
end property
friend property get backcolor() as long
backcolor = m_lngbackcolor
end property
friend sub bindtoolbar(byval hwnd as long)
if m_hwnd = 0 then
m_hwnd = hwnd
if m_hwnd then
oldwindowproc = getwindowlong(m_hwnd, gwl_wndproc)
setwindowlong m_hwnd, gwl_wndproc, addressof tbsubclass
end if
refresh
end if
end sub
private sub class_initialize()
dim rc as rect, hbrush as long, i as long
m_lngtextcolor = vbblack
m_lngtexthicolor = vbred
m_lngbackcolor = &hd7e9eb
m_lngbrdcolor = &h0
mlngbtnhialpha = 96
mlngbtndownalpha = 192
rc.bottom = 128
rc.right = 128
i = getdc(0)
mdcwhite = newmyhdc(i, rc.right, rc.bottom)
releasedc 0, i
hbrush = createsolidbrush(vbwhite)
fillrect mdcwhite.hdc, rc, hbrush
deleteobject hbrush
with font
.lfcharset = 1
.lfheight = 12
.lfweight = 400
end with
end sub
private sub class_terminate()
setwindowlong m_hwnd, gwl_wndproc, oldwindowproc
mdcwhite = delmyhdc(mdcwhite)
set mpicbk = nothing
end sub
friend sub refresh()
dim rc as rect
if m_hwnd <> 0 then
showwindow m_hwnd, 0
showwindow m_hwnd, 5
end if
end sub
