[リストへもどる]
一括表示

投稿時間:2003/10/28(Tue) 04:35
投稿者名:TAK
Eメール:
URL :
タイトル:
選択範囲をクリップボードにキャプチャ
いつもお世話になっておりますTAKといいます.
こちらのHPの逆引きヘルプにあるような,スクリーンのスナップショットを
クリップボードに保存及び印刷をちょっと改良して,
マウスで選択範囲をクリップボードにキャプチャというソフトを作ってみようと
思ったのですが,
そのような事が行えるAPI関数とかってあるのですかね?

PrintScreenやAltキーのストロークをシミュレートするんじゃできないと思うので,
まずは全体画像をキャプチャして,選択範囲の左上,右下の座標値を
API関数で取得して最初の画像から切り抜くって事を考えたのですが,
この場合ですと,一度どこかにキャプチャした全体画像を貼り付けないといけないと思い・・・
何か良い方法ってありますかね?

いつも質問ばかりですみません.

投稿時間:2003/10/28(Tue) 09:48
投稿者名:とおりすがり
Eメール:
URL :
タイトル:
Re: 選択範囲をクリップボードにキャプチャ

>まずは全体画像をキャプチャして,選択範囲の左上,右下の座標値を
>API関数で取得して最初の画像から切り抜くって事を考えたのですが,
これでいいと思いますよ。

デスクトップの任意の場所をキャプチャ
'API宣言
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


Dim DeskDC As Long
DeskDC = GetDC(0)
BitBlt Picture1.hDC, 0, 0, X1-X, Y1-Y, DeskDC, X, Y, vbSrcCopy
Picture1.Refresh
'Xが始点のX座標
'Yが始点のY座標
'X1が終点のX座標
'Y1が終点のY座標

投稿時間:2003/10/29(Wed) 03:17
投稿者名:TAK
Eメール:
URL :
タイトル:
Re^2: 選択範囲をクリップボードにキャプチャ
とおりすがりさんお早い返事ありがとうございます.
やはりその方法で良いのですか,
で,早速実装しようと思い開発を始めてみたのですが.
まずは,始点と終点のX座標とY座標を取得しようと思ったのですが,

Dim start_flg As Boolean    '始点判定のフラッグ
Dim end_flg As Boolean      '終点判定のフラッグ

'API関数:マウスカーソルの位置を取得する
Private Declare Function GetCursorPos Lib "user32" _
    (lpPoint As POINTAPI) As Long

'構造体:カーソルの位置
Private Type POINTAPI
    X As Long               'マウスのX座標(スクリーン座標)を記憶する変数(構造体)
    Y As Long               'マウスのY座標(スクリーン座標)を記憶する変数(構造体)
End Type

Private u_Point As POINTAPI   'カーソル位置を記憶する変数

'キャプチャモード開始
Private Sub Command1_Click()
    start_flg = True    '始点を決定できるようにする
End Sub

Private Sub Form_Click()
    If start_flg = True And end_flg = False Then
        '始点のX座標,Y座標を取得
        GetCursorPos u_Point
        Text1.Text = u_Point.X
        Text2.Text = u_Point.Y
    Else
    End If
    
    If start_flg = True And end_flg = True Then
        '終点のX座標,Y座標を取得
        GetCursorPos u_Point
        Text3.Text = u_Point.X
        Text4.Text = u_Point.Y
        start_flg = False
        end_flg = False
    Else
    End If
    
    If start_flg = True And end_flg = False Then
        end_flg = True
    Else
    End If
End Sub

Private Sub Form_Load()
    start_flg = False
    end_flg = False
End Sub

これで,始点と終点のX座標とY座標が取得できますが,
Form_Clickを使用しているため,コマンドボタンやラベルがあると
座標値が取得できません.
あと,このフォーム内でのキャプチャしか出来ません.
何か良い方法ってあるのでしょうか?
へたくそなプログラムでごめんなさい.
分かりにくいですね・・・

投稿時間:2003/10/29(Wed) 09:41
投稿者名:花ちゃん
Eメール:
URL :
タイトル:
Re^3: 選択範囲をクリップボードにキャプチャ
下記のような方法ではだめですか?
これですと、再取得時に微調整等ができますので結構便利かと思いますが。
Private Sub Command2_Click()
    MsgBox "取得位置の左上にマウスを移動して下さい" & vbCrLf & _
           "3秒後に位置を取得します"
    Me.Visible = False
    DoEvents
    Dim lngSt As Long
    lngSt = Timer
    Do While Timer - lngSt < 3
        DoEvents
    Loop
    GetCursorPos MoP
    Text1.Text = MoP.x
    Text2.Text = MoP.y
    Me.Visible = True
    DoEvents
    MsgBox "取得位置の右下にマウスを移動して下さい" & vbCrLf & _
           "3秒後に位置を取得します"

    Me.Visible = False
    lngSt = Timer
    Do While Timer - lngSt < 3
        DoEvents
    Loop
    GetCursorPos MoP
    Text3.Text = MoP.x
    Text4.Text = MoP.y
    Me.Visible = True
    '画像のコピー処理へ
  Command1.Value = True
End Sub

投稿時間:2003/10/29(Wed) 11:00
投稿者名:魔界の仮面弁士
Eメール:
URL :
タイトル:
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

投稿時間:2003/10/29(Wed) 11:16
投稿者名:とおりすがり
Eメール:
URL :
タイトル:
Re: 選択範囲をクリップボードにキャプチャ
こんなんどうでしょう?
とりあえず適当なので、そこらへんは自己責任ってことで
用意するもの
Form1
  commandButton
  Picture1
Form2
標準モジュール



'標準モジュール@@@@@@@@@@@@@@@@@@@@@@@

Option Explicit

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

Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public DeskTopDC As Long
Public StartX As Single
Public StartY As Single
Public EndX As Single
Public EndY As Single

'Form1@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Option Explicit
Private Sub Command1_Click()
Unload Me
Load Form2
End Sub

Private Sub Form_Load()
With Picture1
    .Appearance = 0
    .AutoRedraw = True
    .BorderStyle = vbBSNone
    .ScaleMode = vbPixels
End With
Me.Show
End Sub

'Form2@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Option Explicit
Private Sub Form_Load()
With Me
    .AutoRedraw = True
    .Caption = ""
    .Width = Screen.Width
    .Height = Screen.Height
    .ScaleMode = vbPixels
End With
DeskTopDC = GetDC(0)
Me.Show
BitBlt Me.hDC, 0, 0, Screen.Width, Screen.Height, DeskTopDC, 0, 0, vbSrcCopy
Me.Refresh
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
StartX = X
StartY = Y
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
EndX = X
EndY = Y
Load Form1
BitBlt Form1.Picture1.hDC, 0, 0, EndX - StartX, EndY - StartY, DeskTopDC, StartX, StartY, vbSrcCopy
Form1.Picture1.Refresh
Unload Me
End Sub

投稿時間:2003/10/30(Thu) 19:03
投稿者名:TAK
Eメール:
URL :
タイトル:
Re^2: 選択範囲をクリップボードにキャプチャ
花ちゃんさん,魔界の仮面弁士さん,とおりすがりさん返信ありがとうございます.
3人の言われている方法を組み合わせて無事に完成しました.
あと,このHPに掲載してある,
『スクリーンのスナップショットをクリップボードに保存及び印刷』
も参考にさせて頂きます.花ちゃんさんありがとうございました♪
3人とも本当に早い返信,的確なアドバイスありがとうございました.