ホーム > カテゴリ > Visual Basic >

マウス周辺をリアルタイムで拡大表示する

マウス周辺をリアルタイムで拡大表示するサンプルです。

サンプルの実行画面

APIの宣言

[GetCapture.bas]

'■SetWindowPos
'Windowの位置やサイズ等を設定する

'＜引数＞
'hWnd:            ウィンドウのハンドル
'hWndInsertAfte： 定数（HWND_××参照）
'X:               新しいX座標--->今回は使用しません
'Y:               新しいY座標--->今回は使用しません
'cx:              新しいウィンドウの幅--->今回は使用しません
'cy:              新しいウィンドウの高さ--->今回は使用しません
'wFlags：　　　　　定数（SWP_××参照）の組み合わせ

'<戻り値>
'正常終了1

Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter&, ByVal x&, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long


'■ReleaseCapture
'マウス キャプチャを解放して通常の入力処理に戻す

Public Declare Sub ReleaseCapture Lib "user32" ()


'■SendMessage
'指定のウインドウにメッセージを送る

'<引数＞
'hWnd     ウインドウのハンドル
'wMsg： 　定数(WM_××参照）
'wParam:  定数 (HTCAPTION)
'lParam:  常に0

'<戻り値>
'通常使わない

'定数はこれ以外にもある=>APIビューワー参照

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long


'■GetCursorPos
'現在のマウスカーソルの位置を取得する

'<引数>
'lpPoint:  POINTAPI構造体

Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long


'■GetCapture
'マウス入力を受け取っているウインドウのハンドルを取得する

Public Declare Function GetCapture Lib "user32" () As Long


'■ReleaseDC
'デバイスコンテキストを解放する

'<引数>
'hWnd 　ウインドウのハンドル
'hdc　デバイスコンテキストのハンドル

'<戻り値>
'正常終了0以外

Public Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hdc As Long) As Long


'■ BitBlt
'ビットマップをコピーする

'<引数>
'hDestDC   コピー先のデバイスコンテキストのハンドル
'x Long    コピー先の左上隅のx座標
'y Long    コピー先の左上隅のy座標
'nWidth    転送される幅
'nHeight   転送される高さ
'hSrcDC    コピーの元デバイスコンテキストのハンドル
'xSrc      コピー元の左上隅のx座標
'ySrc      コピー元の左上隅のy座標
'dwRop     ラスタ操作（定数SRCCOPY）

'<戻り値>
'正常終了0以外

Public Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long


'■GetWindowDC
'ウインドウのデバイスコンテキストを取得する

'<引数>
'hWnd    ウインドウのハンドル

'<戻り値>
'デバイスコンテキストのハンドル

Public Declare Function GetWindowDC Lib "user32" (ByVal hWnd As Long) As Long


Public Type POINTAPI
 x As Long  'X座標
 y As Long  'Y座標
End Type


Public Const SRCCOPY = &HCC0020      '転送先＝転送元

Public Const WM_NCLBUTTONDOWN = &HA1 '
Public Const HTCAPTION = 2           '

Public Const HWND_TOPMOST = -1       '「常に手前」にする
Public Const HWND_NOTOPMOST = -2     '「常に手前」を解除

Public Const SWP_SHOWWINDOW = &H40   '表示する
Public Const SWP_NOSIZE = &H1        'サイズを変更しない
Public Const SWP_NOMOVE = &H2        '位置を変更しない

APIの呼び出し

[GetCapture.frm]

'-------------------------------------------
'マウス周辺をリアルタイムで拡大表示するサンプル
'-------------------------------------------


Private Sub Form_Load()
    
 
'フォームを常に手前にする
  Call SetWindowPos(Form1.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE)

End Sub

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)


   If Button = 1 Then
   
      'マウスキャプチャを解放
       ReleaseCapture
       
       '「ドラッグを開始せよ」という命令を送る
       Ret = SendMessage(Form1.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
  
   Else
  
     PopupMenu Menu  'メニュ－を表示
  
   End If
 

End Sub

Private Sub Timer1_Timer()


  Dim POI As POINTAPI   'POINTAPI構造体
  Dim DC As Long        'デバイスコンテキスト廼ハンドル
  Dim nhWnd As Long     'ウインドウのハンドル
    
    
  'マウスカーソルの現在座標を取得する
     GetCursorPos POI
      
  'マウス入力を受け持っているウインドウハンドルを返す
     nhWnd = GetCapture
  
  'デバイスコンテキストのハンドルを取得する
     DC = GetWindowDC(nhWnd)
        
  'PictureBox1に転送する(値は各自で処理してください）
     Call BitBlt(Picture1.hdc, 0, 0, Screen.Width, Screen.Height, DC, POI.x - 42, POI.y - 35, SRCCOPY)
      
  'Picture1のイメージをPicture2に拡大し転送する( StretchBlt　APIを使った方が良いかな？)
     Picture2.PaintPicture Picture1.Image, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight
  
  'イメージを削除
     Picture1.Picture = LoadPicture("")
    
  'デバイスコンテキストを解放する
     Ret = ReleaseDC(Form1.hWnd, DC)

  
End Sub

Private Sub end_Click()

Unload Me
End

End Sub

ソースコード一式のダウンロード

vbapi_getcapture.zip 3.34 KB (3,430 バイト)

このサンプルの動作環境について

このサンプルは 「Windows98」及び「Microsoft Visual Basic 5.0 Professional Edition」で確認しております。環境が異なる場合は正常に動作しない場合もございますのでご了承下さい。





関連記事


前の記事：マウスの移動範囲を限定する
次の記事：マウスの現在の座標を取得する

公開日：2015年03月04日
記事NO：00366