| 投稿日 | ： 2003/10/29(Wed) 11:00 |
| 投稿者 | ： 魔界の仮面弁士 |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^3: 選択範囲をクリップボードにキャプチャ |
> まずは，始点と終点のX座標とY座標を取得しようと思ったのですが，
GetCapture/SetCapture/ReleaseCapture APIを使ってみては如何でしょうか。
フォームに、Image1とPicture1だけを貼っておいて下さい。
Image1をクリックするとドラッグモードが開始され、マウスカーソルが変化します。
その後、デスクトップ上の任意の位置でドラッグして、範囲を決定してください。
# Form_MouseMoveにて、デスクトップ上に矩形を表示させると、それっぽくなるかも。
Option Explicit
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private 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
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (ByVal lpPoint As Long) As Long
Private Type mCapturePositionType
Left As Long
Top As Long
Right As Long
Bottom As Long
IsCapturing As Boolean
End Type
Private mCapture As mCapturePositionType
Private Sub Form_Load()
Picture1.AutoRedraw = True
Picture1.BackColor = vbBlack
Image1.MousePointer = vbUpArrow
'Image1に、ドラッグ中のカーソルを指定しておく
Set Image1.Picture = LoadPicture("C:\Program Files\Microsoft Visual Studio\Common\Graphics\Cursors\CROSS03.CUR")
Set Image1.MouseIcon = Image1.Picture
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If mCapture.IsCapturing Then
GetCursorPos VarPtr(mCapture.Left)
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
With mCapture
If .IsCapturing Then
.IsCapturing = False
GetCursorPos VarPtr(.Right)
Image1.MousePointer = vbUpArrow
Dim XPos(1) As Long, YPos(1) As Long
If .Left < .Right Then
XPos(0) = .Left
XPos(1) = .Right - .Left
Else
XPos(0) = .Right
XPos(1) = .Left - .Right
End If
If .Top < .Bottom Then
YPos(0) = .Top
YPos(1) = .Bottom - .Top
Else
YPos(0) = .Bottom
YPos(1) = .Top - .Bottom
End If
Picture1.Cls
BitBlt Picture1.hDC, 0, 0, XPos(1), YPos(1), GetDC(0), XPos(0), YPos(0), vbSrcCopy
Picture1.Refresh
'ReleaseCapture
End If
End With
End Sub
Private Sub Image1_Click()
mCapture.IsCapturing = True
Image1.MousePointer = vbCustom
SetCapture Me.hWnd
End Sub