Option Compare Database
Option Explicit

'☆EXE・DLLファイル内のアイコンハンドルを取得
'   hInst:呼び出し元のウィンドウハンドル？
'   lpszExeFileName:EXE・DLLファイル
'   nIconIndex:アイコンのインデックス番号（最初は０）
'             -1を渡した場合はアイコン数
'   戻り値
'       成功：取得したアイコンハンドル
'       失敗：0
Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

'☆アイコンハンドルを元にアイコンを描写
'   hdc：描写先デバイスコンテキスト
'   X:描写先左隅座標
'   Y:描写先上隅座標
'   hIcon:描写元アイコンハンドル
'   戻り値
'   成功：TRUE
'   失敗：FALSE
Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long

'☆指定ウィンドウのデバイスコンテキストのハンドル取得
'   VBのラベルなどデバイスコンテキストを持たないコントロールに､図形などを描写する際に使います。
'   AccessではFormのデバイスコンテキストを取得するのに使用しましたがレコードセレクタに表示されます？？？。
'   ReleaseDCでデバイスコンテキストを開放する必要があります｡
'Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

'2000/07/26
'GetDCはクライアント領域のデバイスコンテキストのハンドルを取得します。
'ウィンドウズ全体のデバイスコンテキストのハンドルを取得するためにGetWindowDCを使用します。
'☆指定ウィンドウのデバイスコンテキストのハンドル取得
'   VBのラベルなどデバイスコンテキストを持たないコントロールに､図形などを描写する際に使います。
'   AccessではFormのデバイスコンテキストを取得するのに使用しましたがレコードセレクタに表示されます？？？。
'   ReleaseDCでデバイスコンテキストを開放する必要があります｡
Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long

'☆デバイスコンテキストの開放
Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

'☆指定ウィンドウハンドルのRepaint
Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long


' Background Modes
Public Const TRANSPARENT = 1    '背景を透過
Public Const OPAQUE = 2         '背景を前の背景色で塗りつぶす｡
Public Const BKMODE_LAST = 2
'背景の描写モード変更
'   hdc:対象デバイスコンテキスト
'   nBkMode:モード指定フラグ
'   戻り値
'       成功: 直前の描写モード
'       失敗：0
Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long

'☆マウスのボタンの左右の機能反転
'   bSwap：左利き設定ならTRUE､右利き設定ならFALSEを指定
'   戻り値
'       左利き設定：True
'       右利き設定：False
Declare Function SwapMouseButton Lib "user32" (ByVal bSwap As Long) As Long

'☆Windows標準のバージョン情報ダイアログ表示
'   hWnd：呼び出し元ウィンドウハンドル
'   szApp：ダイアログのタイトルと1行目のテキスト
'          文字列中に#が含まれていると、#より左の文字列がタイトルバー
'          右側の文字列がダイアログ1 行目のテキストと､それぞれ別の文字列を
'   szOtherStuff：著作権下に表示されるテキスト
'   hIcon：表示するアイコン､NULL値を指定した場合は､Windowsのロゴを表示
'   戻り値
'       成功：True
'       失敗：False
Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long

'☆他のアプリケーションも含め最前面のウィンドウハンドルを取得
'   戻り値
'   成功: 取得したウィンドウハンドル
'   失敗：0
'   他のアプリケーションも含め
'
'   参考API：GetActiveWindow（呼び出されたスレッド内での最前面のウィンドウハンドルを取得）
Declare Function GetForegroundWindow Lib "user32" () As Long

---------------------------------------------------------------------------------------------

(Form Module)

Option Compare Database
Option Explicit
    
Dim rtn As Long

Private Sub アイコン_Click()
    Dim hIcon As Long, hdc As Long, rtn As Long, whWmd As Long
    
    '環境変数 WINDIR でWindowsディレクトリを取得
    hIcon = ExtractIcon(Me.hwnd, Environ("WINDIR") & "\calc.exe", 0)
    whWmd = Me!SubForn.Form.hwnd
    '2000/07/26
    'hdc = GetDC(whWmd)
    'GetDCはクライアント領域のデバイスコンテキストのハンドルを取得します。
    'ウィンドウズ全体のデバイスコンテキストのハンドルを取得するためにGetWindowDCを使用します。
    hdc = GetWindowDC(whWmd)
    rtn = DrawIcon(hdc, 0, 0, hIcon)
    rtn = ReleaseDC(Me.hwnd, hdc)
End Sub

Private Sub バージョン表示_Click()
    Dim str1 As String, str2 As String
    
    str1 = "ShellAbout API#ShellAbout API Sample Ver1.0"
    str2 = "☆Windows標準のバージョン情報ダイアログ表示"
    rtn = ShellAbout(Me.hwnd, str1, str2, 0)
End Sub

Private Sub 右マウス_Click()
    SwapMouseButton False
End Sub

Private Sub Form_Timer()
    Me!テキスト0 = GetForegroundWindow()
    DoEvents
End Sub

Private Sub 左マウス_Click()
    SwapMouseButton True
End Sub