'================================================================
'= クリップボードへ転送と取り出し(TEXT)
'=    (GetClipboardData.bas)
'================================================================
#include "Windows.bi"

' クリップボードをオープン
Declare Function Api_OpenClipboard& Lib "user32" Alias "OpenClipboard" (ByVal hWnd&)

' クリップボードをクローズ
Declare Function Api_CloseClipboard& Lib "user32" Alias "CloseClipboard" ()

' クリップボードを空にする
Declare Function Api_EmptyClipboard& Lib "user32" Alias "EmptyClipboard" ()

' クリップボードにデータを設定
Declare Function Api_SetClipboardData& Lib "user32" Alias "SetClipboardData" (ByVal wFormat&, ByVal hMem&)

' クリップボードから指定フォーマットのデータを検索
Declare Function Api_GetClipboardData& Lib "user32" Alias "GetClipboardData" (ByVal wFormat&)

' メモリブロックを確保しハンドルを取得
Declare Function Api_GlobalAlloc& Lib "kernel32" Alias "GlobalAlloc" (ByVal wFlags&, ByVal dwBytes&)

' メモリブロックのロックを解放
Declare Function Api_GlobalFree& Lib "kernel32" Alias "GlobalFree" (ByVal hMem&)

' ヒープに確保されたメモリをロック
Declare Function Api_GlobalLock& Lib "kernel32" Alias "GlobalLock" (ByVal hMem&)

' メモリブロックのロックを解除
Declare Function Api_GlobalUnlock& Lib "kernel32" Alias "GlobalUnlock" (ByVal hMem&)

' グローバルメモリオブジェクトのサイズを取得
Declare Function Api_GlobalSize& Lib "kernel32" Alias "GlobalSize" (byval hMem&)

' メモリの指定領域をコピー
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination&, ByVal Source&, ByVal Length&)

' 文字列をコピーする
Declare Function Api_lstrcpy& Lib "kernel32" Alias "lstrcpy" (ByVal lpString1 As Any, ByVal lpString2 As Any)

#define GMEM_DDESHARE &H2000            'DDE 関数が使用するメモリを確保する
#define GMEM_FIXED &H0                  '固定メモリブロックを割り当てる
#define GMEM_MOVEABLE &H2               '移動可能メモリブロックを割り当てる
#define GMEM_ZEROINIT &H40              '割り当てたメモリブロックをゼロで初期化する
#define CF_TEXT 1                       'テキスト形式のデータ。各行は復帰改行(CR-LF)コードで終わる
#define MAXSIZE 4096

Var Shared Edit1 As Object
Var Shared Text1 As Object
Var Shared Button(2) As Object

Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
For i = 0 To 2
    Button(i).Attach GetDlgItem("Button" & Trim$(Str$(i + 1))) : Button(i).SetFontSize 14
Next

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var MyStr As String
    Var hMem As Long
    Var lpMem As Long
    Var Size As Long
    Var Ret As Long
    
    MyStr = Edit1.GetWindowText

    If Api_OpenClipboard(ByVal 0) Then
        'クリップボードを空にする
        Ret = Api_EmptyClipboard

        'Nullの分を追加(+1)
        Size = Len(MyStr) + 1
        hMem = Api_GlobalAlloc(GMEM_MOVEABLE, Size)

        'メモリをロック
        lpMem = Api_GlobalLock(hMem)
        MoveMemory lpMem, StrAdr(MyStr), Size

        'ロックを解除
        Ret = Api_GlobalUnlock(hMem)
        
        'クリップボードにコピー
        Ret = Api_SetClipboardData(CF_TEXT, hMem)

        'メモリブロックのロックを解放
        Ret = Api_GlobalFree(hMem)

        'クリップボードを閉じる
        Ret = Api_CloseClipboard()
    End If
End Sub

'================================================================
'= F-Basicでクリップボードへコピー
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var MyStr As String

    SetMapMode 0
    ClearCB
    SetCBFormat "CF_TEXT"

    Edit1.SetSelText 0, -1
    Edit1.Copy
    Edit1.SetSelText -1, -1
End Sub

'================================================================
'= クリップボードデータ(TEXT)を取り出す
'================================================================
Declare Sub Button3_on edecl ()
Sub Button3_on()
    Var hMem As Long
    Var lpMem As Long
    Var MyStr As String
    Var Ret As Long
    
    If Api_OpenClipboard(0) = 0 Then
        A% = MessageBox("", "クリップボードが開きません", 0, 0)
        Exit Sub
    End If

    Text1.SetWindowText ""
   
    'テキストを参照しているグローバルメモリのブロックへのハンドルを取得
    hMem = Api_GetClipboardData(CF_TEXT)

    'クリップボードのメモリをロックし、実際の文字列を参照
    lpMem = Api_GlobalLock(hMem)
    
    If lpMem <> 0 Then
        MyStr = Space$(MAXSIZE)
        Ret = Api_lstrcpy(MyStr, lpMem)
        Ret = Api_GlobalUnlock(hMem)
        
        'nullを削除
        MyStr = Left$(MyStr, InStr(MyStr, Chr$(0)) - 1)
        Text1.SetWindowText MyStr
    Else
        A% = MessageBox("", "文字列を参照できません！", 0, 0)
    End If

    Ret = Api_CloseClipboard()
End Sub

'================================================================
'=
'================================================================
Declare Sub Edit1_SetFocus edecl ()
Sub Edit1_SetFocus()
    Text1.SetWindowText ""
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End