CALENDAR
Sun Mon Tue Wed Thu Fri Sat
      1
2345678
9101112131415
16171819202122
23242526272829
30      
<< September 2018 >>
SELECTED ENTRIES
CATEGORIES
ARCHIVES
CLOCK
MOBILE
qrcode
PROFILE
RECENT COMMENTS
RECENT TRACKBACK
OTHERS

だめぽブログ

tacoさんの暇つぶしブログ
<< 空軍のミス | main | 勝手に今日気になったニュース >>
スポンサーサイト

一定期間更新がないため広告を表示しています

| Posted by スポンサードリンク | | - | - |
クリップボードの設定と取得
VB 用のクリップボードの設定と取得の関数
VBA だと Clipboard オブジェクトが(多分)無いので、Webを漁って適当に作ってみました。動けばおkとしてるんで結構適当に作ってあります^^;

おいらは GetClipData でクリップボードのデータ取得して、文字列型の変数に入れて、置換したりしつつ、その変数を SetClipData クリップボードに戻すのに使ったりしてます。


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



Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long

Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long

Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

Private Function GetClipData() As String
Dim hMem As Long
Dim p As Long
Dim RetVal As Long
Const MAXSIZE = 67108864 '<- 適当

If OpenClipboard(ByVal 0&) Then
    hMem = GetClipboardData(1)
    If hMem Then
        p = GlobalLock(hMem)
        If Not IsNull(p) Then
            GetClipData = Space$(MAXSIZE)
            RetVal = lstrcpy(GetClipData, p)
            RetVal = GlobalUnlock(hMem)
            GetClipData = Mid(GetClipData, 1, InStr(1, GetClipData, Chr$(0), 0) - 1)
        Else
            Err.Raise 51
        End If
    End If
    CloseClipboard
End If
End Function

Private Sub SetClipData(strLetter As String)
Dim hText As Long
Dim pText As Long

If OpenClipboard(ByVal 0&) Then
    hText = GlobalAlloc(&H42, LenB(strLetter) + 1)
    pText = GlobalLock(hText)
    If Not IsNull(pText) Then
        pText = lstrcpy(pText, strLetter)
        Call GlobalUnlock(hText)
        EmptyClipboard
        hText = SetClipboardData(1 Or 7, hText)
    Else
        Err.Raise 51
    End If
    CloseClipboard
End If

End Sub

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

PC が物故割れたりしても当ブログは責任を負えません><
自己責任でお願いします( ´∀`)
| Posted by tacoさん | 12:45 | comments(0) | trackbacks(1) |
スポンサーサイト
| Posted by スポンサードリンク | 12:45 | - | - |









http://invalid.jugem.jp/trackback/4
渡辺久江 画像 動画 ニュース
渡辺久江敗れる! スタンドの打撃戦で、キックボクサーのソヒがサウスポーからの左フックと首相撲からの膝蹴りを何発も当て、久江を苦しめる。ストライカーとの打撃戦を希望していた久江は、劣勢にも関わらず打撃戦に応じ気の強さを見せる。とはいえダメージが大きく、2
| 格闘家 画像 動画 通信 | 2007/02/20 12:58 PM |