icon to userform titlebar

R

RB Smissaert

Using Word 2002 and 2003.
Trying to put an icon in the titlebar of
a Word userform.
I got code for this that works nicely in Excel, but in Word the icon shows
as an empty space, without the picture.
This is the code I have:

Option Explicit

Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _
As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _
As Long, ByVal dwNewLong As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" _
(ByVal hWnd As Long) As Long


Sub PastePictures()

Dim hIcon
Dim frm As Long
Dim wHandle As Long

On Error Resume Next

If Val(Application.Version) >= 9 Then
wHandle = FindWindow("ThunderDFrame", frmNotes.Caption)
Else
wHandle = FindWindow("ThunderXFrame", frmNotes.Caption)
End If

If wHandle = 0 Then
Exit Sub
Else
hIcon = frmNotes.imgPict.Picture

SendMessage wHandle, &H80, True, hIcon
SendMessage wHandle, &H80, False, hIcon

frm = GetWindowLong(wHandle, -20)
frm = frm And Not &H1
SetWindowLong wHandle, -20, frm
DrawMenuBar wHandle
End If

End Sub


Perhaps one of the API arguments (&H80 or -20) has to be different.
Thanks for any advice.


RBS
 
W

Word Heretic

G'day "RB Smissaert" <[email protected]>,

That all looks pretty good from here, I agree with your guess being
the most likely reason. The only thing that throws me is the True then
immediate False - I am sure you have a good reasons for this?


Steve Hudson - Word Heretic
Want a hyperlinked index? S/W R&D? See WordHeretic.com

steve from wordheretic.com (Email replies require payment)


RB Smissaert reckoned:
 
R

RB Smissaert

Word Heretic,

I agree it looks strange. I just copied the code and I am not sure what it
does.
It looks like one of those non-standard shortcuts. Will see if I can
re-write it.
Don't think it has anything to do with the problem though.
I posted the same question in microsoft.public.vb.api, but no reply yet.

RBS
 
R

RB Smissaert

Got this working now thanks to somebody called Colo, this is the website:
http://www.puremis.net/excel/

Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long

Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Sub ImageToTitle()

Dim hWnd As Long
Dim lngRet As Long
Dim hIcon As Long

hIcon = UserForm1.imgIcon.Picture

If Val(Application.Version) >= 9 Then
hWnd = FindWindow("ThunderDFrame", UserForm1.Caption)
Else
hWnd = FindWindow("ThunderXFrame", UserForm1.Caption)
End If

lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
lngRet = DrawMenuBar(hWnd)

End Sub

imgIcon is an Image control in the userform with the property picture set to
the icon
with the browse button.
The property visible is set to false as you want to see the icon in the
titlebar, but not in the
userform itself.
This code works both in Excel and in Word.


RBS
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top