コマンドボタンにEXEファイルのアイコンを表示

2023/07/27 22:19

このQ&Aのポイント

VB6 Pro SP6を使用して、コマンドボタンにEXEファイルのアイコンを表示しようとしていますが、うまくいきません。
ExtractIconEx関数を使用して、EXEファイルからアイコンを抽出し、DrawIconEx関数を使用してボタンに描画しようとしています。
しかし、コードを実行してもアイコンは表示されません。Windows2000 Proの環境でテストしています。原因を教えてください。

ベストアンサー

コマンドボタンにEXEファイルのアイコンを表示

2003/05/27 01:10

コマンドボタンにEXEファイルのアイコンの表示についてWebで色々と調べてやってみたのですが、どうも上手くいきません・・・。（＾＾；下記の条件・コードでやってみました。原因等わかる方いましたら、どうか宜しくお願いします。 ---環境--- OS:Windows2000 Pro VB:VB6 Pro SP6 ---ソースコード（標準モジュール）--- Public Declare Function DrawIconEx Lib "USER32" (ByVal hDC&, ByVal xLeft&, _ ByVal yTop&, ByVal hIcon&, ByVal cxWidth&, ByVal cyWidth&, ByVal istepIfAniCur&, _ ByVal hbrFlickerFreeDraw&, ByVal diFlags&) As Long Public Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" _ (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, _ phiconSmall As Long, ByVal nIcons As Long) As Long Public Const DI_NORMAL = &H3 ---ソースコード（フォームモジュール）--- Private Sub Command1_Click() Dim Ret As Long Dim nFile As String Dim L As Long Dim S As Long nFile = "C:\Windows\calc.exe" Ret = ExtractIconEx(nFile, 0, L, S, 1) DrawIconEx Form1.Picture1.hDC, 0, 0, L, 0, 0, vbNull, 0, DI_NORMAL Set Form1.Command1.Picture = Form1.Picture1.Image End Sub

noname#191236

Visual Basic
回答数1
ありがとう数1

みんなの回答 （1）
専門家の回答

質問者が選んだベストアンサー

ベストアンサー

todo36
ベストアンサー率58% (728/1234)

2003/05/27 11:25 回答No.1

昔、検討したことあるけど、一旦BMPファイルに保存する位ですかね。もっといい方法があればいいのだが

質問者

お礼 2003/05/27 11:45

お返事どうもありがとうございます。＾＾あれから自分でも検索しつづけていた所、つい先ほど PictureボックスのAutoRedrawの変更が必要と分かりました。アドバイスありがとうございました。

関連するQ&A

VBAでSetTextColorがうまくいかない
EXCELのVBAでユーザーフォームを使ったグラフィック表示のプログラムを作っているのですが、SetTextColorでテキスト色の設定をしようとしてもうまくいきません。何故か設定しようとする色の値が無視されて「1304008」が設定されてしまいます。(GetTextColorで確認) そしてそれ以降何を設定してもこの状態のままです。何か考えられることがありますでしょうか。下にそのプログラムを示します。ちなみにSetBKColorやAngleArcなど他のグラフィック命令は問題なく動いていてSetTextColorだけがうまくいってない状態です。 '------------------------------------------------- ' ユーザーフォーム用プログラム '------------------------------------------------- Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpszClass As String, _ ByVal lpszWindow As String) As Long Private Declare Function GetDC Lib "user32" ( _ ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hdc As Long) As Long Private Declare Function SetTextColor Lib "gdi32" _ (ByVal hdc As Long, crColor As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _ (ByVal hdc&, ByVal x&, _ ByVal y&, ByVal lpString$, ByVal nCount&) As Long Dim hWnd As Long Dim hdc As Long Public Sub UserForm_Activate() DoEvents hWnd = FindWindowEx(GetActiveWindow, 0, "F3 Server 60000000", "") hdc = GetDC(hWnd) ret = SetTextColor(hdc, RGB(255, 0, 0)) ret = TextOut(hdc, 0, 0, "abc", 3) Call ReleaseDC(hWnd, hdc) End Sub '-------------------------------------------------
- ベストアンサー
- Visual Basic
画像の90度回転表示の処理時間を短縮したい
今、PictureBox に読み込んだ画像を90度回転して別の PictureBox に表示していますが、処理にとても時間がかかっています。（480×640ピクセルを右90度変換するのに約3.5秒）もっと処理が早くなる方法があれば教えてください。よろしくお願いします。 ---現在の処理（Picture1 → Picture2）--- Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long Dim p1sw　　As Long　　'Picture1.ScaleWidth Dim p1sh　　As Long　　'Picture1.ScaleHeight Dim x1　　　 As Long Dim y1　　　 As Long Dim c　　　　As Long　　'カラーコード Dim hDC1　　As Long　　'Picture1.hDC Dim hDC2　　As Long　　'Picture2.hDC Dim X　　　　As Long Dim Y　　　　As Long '縦横サイズを逆転する With Picture1 　　p1sw = .ScaleWidth 　　p1sh = .ScaleHeight 　　hDC1 = .hdc End With With Picture2 　　.Height = Picture1.Width 　　.Width = Picture1.Height 　　hDC2 = .hdc End With p1sw = p1sw - 1 p1sh = p1sh - 1 'ピクチャを90度回転 For X = 0 To p1sw　　　　　　　　　'Picture1のＸ座標　　y1 = X 　　For Y = 0 To p1sh　　　　　　　'Picture1のＹ座標　　　　x1 = p1sh - Y 　　　　c = GetPixel(hDC1, X, Y)　'カラー情報の取得　　　　'取得したカラーを指定位置に設定する　　　　If c <> -1 Then Call SetPixelV(hDC2, x1, y1, c) 　　Next Y Next X # OSはWindows95、VB6.0(SP5)を使用しています。
- ベストアンサー
- Visual Basic
VBAでIEの「ファイルのダウンロード」ダイアログを制御
VBではなくVBAにて、IEの「ファイルのダウンロード」ダイアログを制御したいと思い、過去の同様の質問等を参考に下記のソースを作成して動かしてみましたが、「ファイルのダウンロード」画面で、「保存(S)」ボタンのハンドルを取得するところまではできましたが、sendMessageでクリックができず、次に進むことが出来ませんでした。手動で「保存(S)」ボタンを押下して、強制的に「名前を付けて保存」画面に遷移させた後プログラムを再開すると、同画面の「保存(S)」ボタンのクリックはできました。同じロジックで「名前を付けて保存」画面の「保存(S)」は動くのに、「ファイルのダウンロード」画面の「保存(S)」が動かないのはなぜでしょうか。どなたかおわかりになる方がいらっしゃいましたら、ご回答をお願いします。 ***使用環境*** OS: XP pro IE: 6 OFFICE:2002 ***以下作成したソース（エラー制御は省略）*** Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 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 GetDlgCtrlID Lib "user32" (ByVal hwnd As Long) As Long Private Sub Test() Dim ret1 As Long Dim ret2 As Long Const WM_COMMAND As Long = &H111 ret1 = FindWindow("#32770", "ファイルのダウンロード") ret2 = FindWindowEx(ret1, 0, "Button", "保存(&S)") Call SendMessage(ret1, WM_COMMAND, GetDlgCtrlID(ret2), ByVal ret2) ret1 = FindWindow("#32770", "名前を付けて保存") ret2 = FindWindowEx(ret1, 0, "Button", "保存(&S)") Call SendMessage(ret1, WM_COMMAND, GetDlgCtrlID(ret2), ByVal ret2) End Sub ***以上ソース終わり***
- 締切済み
- Visual Basic
マウスのある個所の色
お世話になりますよろしくお願いします PictureboxをクリックされたときにそのPictureboxがクリックされた箇所の色を16進数で取得したいのですがうまくいきませんどこが間違っているのか教えてもらえないでしょうか？ソースは Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Type POINTAPI x As Long y As Long End Type Private Sub Picture1_Click() Dim Poi As POINTAPI Dim iro As Long GetCursorPos Poi iro = GetPixel(Me.Picture1.hdc, Poi.x, Poi.y) Me.Label2.Caption = Poi.x Me.Label3.Caption = Poi.y Me.Label1.Caption = iro CloseHandle (Me.Picture1.hdc) End Sub GetPixcelの引数に-1しか入りませんあと、もし数値で取れたとしてそれを16進数にする方法を教えてくださいよろしくお願いします
- ベストアンサー
- Visual Basic
ExcelVBAでフォームのタイトルバーで右クリックした場合などに閉じるボタンが有効化されないようにするコード
Excelのプログラムで、最小化ボタンを有効にし、閉じるボタンを無効にする質問をしたんですが、うまくいったと思ったのですがフォームが開き、タイトルバーで右クリックした場合などは閉じるボタンが有効化されてしまうのでこれを無効のままにするコードを教えてください。作ったプログラムは以下の通りです。標準モジュール Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function DrawMenuBar Lib "user32" _ (ByVal hWnd As Long) As Long Public Declare Function GetSystemMenu Lib "user32.dll" _ (ByVal hWnd As Long, ByVal bRevert As Long) As Long Public Declare Function EnableMenuItem Lib "user32" _ (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long Public Const MF_DISABLED = &H2& Public Const GWL_STYLE = (-16) Public Const WS_MINIMIZEBOX = &H20000 Public Const MF_BYCOMMAND = &H0& Public Const SC_CLOSE = &HF060& Dim hSysMenu As Long UserForm_Initializeプロシージャ Dim fRet As Long Dim hWnd As Long Dim fStyle As Long hWnd = FindWindow("ThunderDFrame", "UserForm1") fStyle = GetWindowLong(hWnd, GWL_STYLE) fStyle = (fStyle Or WS_THICKFRAME Or WS_MINIMIZEBOX) fRet = SetWindowLong(hWnd, GWL_STYLE, fStyle) hSysMenu = GetSystemMenu(hWnd, 0) EnableMenuItem hSysMenu, SC_CLOSE, MF_BYCOMMAND Or MF_DISABLED fRet = DrawMenuBar(hWnd) 回答よろしくお願いします。
- ベストアンサー
- Visual Basic
MoveWindow
現在、vb2008でウィンドウを管理するアプリケーションを製作しております。本来ならほかのアプリケーションのウィンドウを操作しなければいけないわけですが、テストのために下のようなコードを実行しても希望した結果（Form2が画面いっぱいに表示される)になりません。なお、Form2 FormBorderStyle はNoneで、最大化はされていません。 Public Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long Sub Test() Dim NewWin as New Form2 NewWin.Show() Dim Ptr As System.IntPtr = NewWin.Handle Dim Ret As Long = MoveWindow(Ptr.ToInt64d, 0, 0, _ Screen.PrimaryScreen.WorkingArea.Width, _ Screen.PrimaryScreen.WorkingArea.Height, 1) End Sub
- ベストアンサー
- Visual Basic
Excel2003VBAでクリップボードにあるビットマップの操作について
Excel2003VBAにおいてクリップボードにあるビットマップの画像の任意の1pxの色を、ペイントのスポイトツールのように取得するマクロを作成したいのですが GetPixelという関数で画像の任意1pxの色を取得できる所までは調べられたのですが、それをクリップボードの画像で使用することができませんでした。以下は、GetPixel関数を試してみた時のソースになります。 '------------------------------------------------------------------ Option Explicit Declare Function GetDesktopWindow Lib "user32" () As Long Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long Sub ピクセル色獲得() Dim hwnd As Long Dim hdc As Long hwnd = GetDesktopWindow() hdc = GetWindowDC(hwnd) Debug.Print Hex(GetPixel(hdc, 100, 200)) End Sub '------------------------------------------------------------------ 上記ソースで任意1pxの色を取得できたためクリップボードの画像の色を取得するマクロを下記のように作成しました。 '--------------------------------------------------------------- Option Explicit Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal Y As Long) As Long Sub クリップボードピクセル色獲得() Dim CB As Variant Dim i As Long CB = Application.ClipboardFormats Debug.Print Hex(GetPixel(CB, 100, 200)) End Sub '--------------------------------------------------------------- 型が一致しませんと言われ動きません。以上です、よろしくお願いいたします。
- 締切済み
- オフィス系ソフト
クリップボードにアクティブウィンドウが貼り付けられません。
Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) Private Sub Command1_Click() Clipboard.Clear Form2.Picture1.AutoRedraw = True Form1.SetFocus keybd_event vbKeySnapshot, 0, 0, 0 Do While Clipboard.GetFormat(vbCFBitmap) = False DoEvents Loop Form2.Picture1.Picture = Clipboard.GetData() End Sub keybd_eventを使って、こんな感じでForm2のピクチャーにForm1を貼付けしたいのですが、画面全体がコピーされてしまいます。アクティブウィンドウのみコピーするにはどうしたら良いですか？
- ベストアンサー
- Visual Basic
WinAPIで電卓をクリック
現在、WinAPIを勉強しており、練習としてVBAを用いて、電卓アプリのボタンをクリックしようとしています。キーを送るのではなく、クリックで行いたいたいと考えています。ボタンのハンドルを取得するところまではできましたが、sendMessageでクリックできず、EditBoxに数字が入りません。どのようにすればよいのかご教授ください。よろしくお願い致します。環境: WinXP home、 Excel2002、Win付属アプリの電卓v5.1 ---作成したプログラム---- '標準モジュールの中身 Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 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 SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Sub Main() Dim lngWindWnd As Long 'ウィンドウハンドル Dim ret As Long Dim hCalc As Long 'アプリケーションタイトルより、ウィンドウハンドルを得ます lngWindWnd = FindWindow(vbNullString, "電卓") '８ボタンのハンドル（確実に取れていることを確認 hCalc = FindWindowEx(lngWindWnd, 0, "Button", "8") ret = SetForegroundWindow(lngWindWnd) ret = SendMessage(hCalc, WM_LBUTTONDOWN, 0, 0) End Sub
- ベストアンサー
- Visual Basic
他のアプリケーションの hDC を取得したい
　ＡＰＩの初歩的なことですみません他のアプリケーションのｈＤＣを取得して GetPixel() API等を使用したいのですがどうもうまくいきません hDC や hWnd あたりがよくわからないのが原因だと思いますが、分かる方教えてください　ソースは以下の様な感じです Private Declare Function FindWindowA Lib "user32" (ByVal cnm As String, ByVal cap As String) As Long Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long lhWnd = FindWindowA(vbNullString, "ExpApp") lColor = GetPixel(lhWnd, ix, iy)
- ベストアンサー
- Visual Basic