[VB6]キャプションバーのアイコンを取得するには？
VB6で、ウィンドウのハンドルから、キャプションバーに表示される小さいアイコン(16x16)のハンドルを取得しようとしています。
以下は、アプリの小さいアイコンをPictureBoxに描画するテストコードです。
大体はうまくいくんですが、何故かＶＢアプリの場合に失敗します。
1. ＶＢアプリでは、小さいアイコンを指定すると取得できない。
2. ＶＢアプリでは、大きいアイコンを指定すると取得できるが、それを小さいアイコンに縮小表示した場合、キャプションバーに表示されているアイコンと比較すると、歪んでしまう。
以上、解決策について、ご指導お願いします。
Option Explicit
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long
Private Const GCL_HICONSM As Long = (-34)
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 Const WM_GETICON As Long = &H7F
Private Const ICON_SMALL As Long = 0
Private Const ICON_BIG As Long = 1
Private Declare Function DrawIconEx Lib "user32" _
(ByVal hdc As Long, ByVal xLeft As Long, _
ByVal yTop As Long, ByVal hIcon As Long, _
ByVal cxWidth As Long, ByVal cyWidth As Long, _
ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, _
ByVal diFlags As Long) As Long
Private Const DI_NORMAL As Long = &H3
' ＶＢアプリの小さいアイコンが取得できない例。
Private Sub Command1_Click()
Dim lResult As Long
Dim hIcon As Long
Dim hwnd As Long
hwnd = Me.hwnd ' 自アプリのウィンドウハンドルを指定
hIcon = GetClassLong(hwnd, GCL_HICONSM)
If (hIcon = 0) Then
hIcon = SendMessage(hwnd, WM_GETICON, ICON_SMALL, ByVal 0&)
End If
If (hIcon <> 0) Then
lResult = DrawIconEx(Picture1.hdc, 0, 0, hIcon, 0, 0, 0, 0, DI_NORMAL)
End If
End Sub
' ＶＢアプリの大きいアイコンを縮小表示した場合に歪んでしまう例。
Private Sub Command2_Click()
Dim lResult As Long
Dim hIcon As Long
Dim hwnd As Long
hwnd = Me.hwnd ' 自アプリのウィンドウハンドルを指定
Picture1.Picture = LoadPicture()
hIcon = GetClassLong(hwnd, GCL_HICONSM)
If (hIcon = 0) Then
hIcon = SendMessage(hwnd, WM_GETICON, ICON_SMALL, ByVal 0&)
If (hIcon = 0) Then
hIcon = SendMessage(hwnd, WM_GETICON, ICON_BIG, ByVal 0&)
End If
End If
If (hIcon <> 0) Then
lResult = DrawIconEx(Picture1.hdc, 0, 0, hIcon, 16, 16, 0, 0, DI_NORMAL)
End If
End Sub
>lResult = DrawIconEx(Picture1.hdc, 0, 0, hIcon, 16, 16, 0, 0, DI_NORMAL)
>
↑を↓に変えたらどうでしょう。(Command2_Click側)
hIcon = CopyImage(hIcon, IMAGE_ICON, 16, 16, LR_COPYFROMRESOURCE)
lResult = DrawIconEx(Picture1.hdc, 0, 0, hIcon, 0, 0, vbNull, 0, 3)
#VBのデフォルトICONは小さいアイコンはないみたいですね。＞＜
GODさん 回答ありがとうございます。
CopyImage関数のコピーフラグにLR_COPYFROMRESOURCEを指定すると、キレイに縮小された小さいアイコンを表示できました。感謝です。
これで解決と、思ったんですが、
他プロセスのＶＢアプリでは、キレイに縮小されない様です。
> #VBのデフォルトICONは小さいアイコンはないみたいですね。
EXEファイル内のアイコンリソースを調べてみると、
32 x 32 (2 色) - 序数 : 30001
32 x 32 (16 色) - 序数 : 30002
16 x 16 (16 色) - 序数 : 30003
以上の様に、小さいアイコンは、存在する様です。
何か解決する方法がないもんでしょうか？
>他プロセスのＶＢアプリでは、キレイに縮小されない様です。
>
取得したアイコンサイズを調べる必要があるのかも知れません。
16*16のアイコンを取った後に、CopyImage APIを使用してイメージ変更をするので「きたなく」なっているのだと思います。
アイコンハンドルからアイコンサイズを取得できればよいでしょうが、どうやるかは不明。
ICON_SMALLメッセージでアイコンハンドルを取れても16*16でない場合があるのでサイズの判定は必須かと。
#あと、アイコンハンドルを取得する順番を変えたほうが良いかもしれません。
hIcon = SendMessage(hwnd, WM_GETICON, ICON_SMALL, ByVal 0&)
If hIcon = 0 Then
hIcon = GetClassLong(hwnd, GCL_HICONSM)
End If
If hIcon = 0 Then
hIcon = SendMessage(hwnd, WM_GETICON, ICON_BIG, ByVal 0&)
End If
If hIcon <> 0 Then
If 16*16ではない then
hIcon = CopyImage(hIcon, IMAGE_ICON, 16, 16, LR_COPYFROMRESOURCE)
End If
If hIcon = 0 Then
lResult = DrawIconEx(Picture1.hdc, 0, 0, hIcon, 0, 0, vbNull, 0, 3)
End If
End If
IEのアイコンハンドルはGetClassLongで取るよりICON_SMALLの方がより近かった。
GODさん 回答ありがとうございます。
> 16*16のアイコンを取った後に、CopyImage APIを使用して
> イメージ変更をするので「きたなく」なっているのだと思います。
アイコンサイズが16*16の場合、
hIcon = CopyImage(hIcon, IMAGE_ICON, 16, 16, LR_COPYFROMRESOURCE)
にて作成されたコピーのhIconを使用した場合と、使用しない場合を比較したんですが、見た目には差異が認められませんでした。
GODさんのコードを試したんですが、ＶＢ製の他アプリでは状況が改善されません。
今のところ、お手上げ状態です。
| ツイート |  |