IDC资讯中心
程序在标题栏支持32位图标文件,是通过sendmessage发送消息实现重绘
模块
option explicit
private declare function getsystemmetrics lib "user32" ( _
byval nindex as long _
) as long
private const sm_cxicon = 11
private const sm_cyicon = 12
private const sm_cxsmicon = 49
private const sm_cysmicon = 50
private declare function loadimageasstring lib "user32" alias "loadimagea" ( _
byval hinst as long, _
byval lpsz as string, _
byval utype as long, _
byval cxdesired as long, _
byval cydesired as long, _
byval fuload as long _
) as long
private const lr_defaultcolor = &h0
private const lr_monochrome = &h1
private const lr_color = &h2
private const lr_copyreturnorg = &h4
private const lr_copydeleteorg = &h8
private const lr_loadfromfile = &h10
private const lr_loadtransparent = &h20
private const lr_defaultsize = &h40
private const lr_vgacolor = &h80
private const lr_loadmap3dcolors = &h1000
private const lr_createdibsection = &h2000
private const lr_copyfromresource = &h4000
private const lr_shared = &h8000&
private const image_icon = 1
private declare function sendmessagelong lib "user32" alias "sendmessagea" ( _
byval hwnd as long, byval wmsg as long, _
byval wparam as long, byval lparam as long _
) as long
private const wm_seticon = &h80
private const icon_small = 0
private const icon_big = 1
private declare function getwindow lib "user32" (byval hwnd as long, byval wcmd as long) as long
private const gw_owner = 4
public sub seticon( _
byval hwnd as long, _
byval siconresname as string, _
optional byval bsetasappicon as boolean = true _
)
dim lhwndtop as long
dim lhwnd as long
dim cx as long
dim cy as long
dim hiconlarge as long
dim hiconsmall as long
if (bsetasappicon) then
find vbs hidden parent window:
lhwnd = hwnd
lhwndtop = lhwnd
do while not (lhwnd = 0)
lhwnd = getwindow(lhwnd, gw_owner)
if not (lhwnd = 0) then
lhwndtop = lhwnd
end if
loop
end if
cx = getsystemmetrics(sm_cxicon)
cy = getsystemmetrics(sm_cyicon)
hiconlarge = loadimageasstring( _
app.hinstance, siconresname, _
image_icon, _
cx, cy, _
lr_shared)
if (bsetasappicon) then
sendmessagelong lhwndtop, wm_seticon, icon_big, hiconlarge
end if
sendmessagelong hwnd, wm_seticon, icon_big, hiconlarge
cx = getsystemmetrics(sm_cxsmicon)
cy = getsystemmetrics(sm_cysmicon)
hiconsmall = loadimageasstring( _
app.hinstance, siconresname, _
image_icon, _
cx, cy, _
lr_shared)
if (bsetasappicon) then
sendmessagelong lhwndtop, wm_seticon, icon_small, hiconsmall
end if
sendmessagelong hwnd, wm_seticon, icon_small, hiconsmall
end sub
窗体
option explicit
private sub form_load()
seticon me.hwnd, "aaa"
end sub
