bmp from clipboard ?

Miscellaneous Forums/Win32 Discussion/bmp from clipboard ?

Panno
 #1
.

Suco-X
 #2
*Push*

I wrote two functions for you

Rem

Clipboard functions by Suco-X

End Rem 

Strict 



Extern "Win32"
	Function OpenClipboard(hwnd:Int)
	Function CloseClipboard()
	Function GetClipboardData:Byte Ptr(Format:Int)
	Function CreateCompatibleDC(hdc:Int)
	Function SelectObject(hdc:Int, obj:Int)
	Function CreateCompatibleBitmap(hdc:Int, width:Int, height:Int)
	Function GetPixel(dc:Int, x:Int, y:Int)
	Function CreateDIBSection(hdc:Int, pbmi:Byte Ptr, usage:Int, Bits:Byte Ptr, hSection:Int, Offset:Int)
	Function GetDIBits(hdc:Int, bitmap:Int, Start:Int, Num:Int, bits:Byte Ptr, lpbi:Byte Ptr, usage:Int)
	Function DeleteDC(hdc:Int)
End Extern 



?Win32

	Type BITMAPINFO
	
		Field biSize:Int
		Field biWidth:Int
		Field biHeight:Int
		Field biPlanes:Short
		Field biBitCount:Short
		Field biCompression:Int
		Field biSizeImage:Int
		Field biXPelsPerMeter:Int
		Field biYPelsPerMeter:Int
		Field biClrUsed:Int
		Field biClrImportant:Int
	
		
		Field R:Byte
		Field G:Byte
		Field B:Byte
		Field Res:Byte
	End Type
	
	Const CF_TEXT = $01
	Const CF_BITMAP = $02
	Const CF_DIB = 8
	
	
	Function TextFromClipboard:String()
	
		If Not Openclipboard(0)
			Return ""
		EndIf
		
		Local TextBuf:Byte Ptr
		
		TextBuf = GetClipboardData(CF_TEXT)
		CloseClipboard()
		
		Return String.FromCString(TextBuf)
	End Function 
	
	
	Function PixmapFromClipboard:TPixmap()
		
		If Not OpenClipboard(0)
			Return Null
		EndIf
		
		Local InfoBuf:Byte Ptr
		Local BitmapBuf:Byte Ptr
		Local TempInfo:BITMAPINFO
		Local DC:Int
		Local FinalPixmap:TPixmap
		
		InfoBuf   = GetClipboardData(CF_DIB)
		BitmapBuf = getClipboardData(CF_BITMAP)
		
		If InfoBuf = Null Or BitmapBuf = Null
			Return Null
		EndIf
	
		TempInfo  = New BITMAPINFO
		MemCopy TempInfo, InfoBuf, SizeOf(TempInfo)
		
		DC = CreateCompatibleDC(0)
	
		FinalPixmap = CreatePixmap(TempInfo.biWidth, TempInfo.biHeight, PF_BGR888)
		
		GetDIBits(DC, Int(BitmapBuf), 0, TempInfo.biHeight, FinalPixmap.PixelPtr(0,0),TempInfo,0)
		
		FinalPixmap = YFlipPixmap(FinalPixmap)
		CloseClipboard()
		DeleteDC(DC)
		Return FinalPixmap
	End Function 

?






Graphics 800,600,0


Local ClipPixmap:TPixmap = PixmapFromClipboard()
Local ClipText:String = TextFromClipboard()


If ClipPixmap
	DrawPixmap ClipPixmap,0,0
EndIf

If ClipText
	Print ""
	Print "Clipboard Text gefunden:"
	Print ""
	Print ClipText
	Print ""
EndIf


Flip
WaitKey()


Or read here
<CLICK>

Jim Brown
 #3
Great stuff Suco.
I've added a TextToClipboard function

*EDIT (fixes posted below added with thanks)

Rem

Clipboard functions by Suco-X

End Rem 

Strict 

Extern "Win32"
	Function OpenClipboard(hwnd:Int)
	Function CloseClipboard()
	Function EmptyClipboard()
	Function GetClipboardData:Byte Ptr(Format:Int)
	Function SetClipboardData(format:Int, hMem:Byte Ptr)
	Function CreateCompatibleDC(hdc:Int)
	Function SelectObject(hdc:Int, obj:Int)
	Function CreateCompatibleBitmap(hdc:Int, width:Int, height:Int)
	Function GetPixel(dc:Int, x:Int, y:Int)
	Function CreateDIBSection(hdc:Int, pbmi:Byte Ptr, usage:Int, Bits:Byte Ptr, hSection:Int, Offset:Int)
	Function GetDIBits(hdc:Int, bitmap:Int, Start:Int, Num:Int, bits:Byte Ptr, lpbi:Byte Ptr, usage:Int)
	Function DeleteDC(hdc:Int)
	Function GlobalAlloc(Flags:Int, Bytes:Int)
	Function GlobalFree(Mem:Int)
	Function GlobalLock:Byte Ptr(Mem:Int)
	Function GlobalUnlock(Mem:Int)
End Extern 

?Win32

	Type BITMAPINFO
	
		Field biSize:Int
		Field biWidth:Int
		Field biHeight:Int
		Field biPlanes:Short
		Field biBitCount:Short
		Field biCompression:Int
		Field biSizeImage:Int
		Field biXPelsPerMeter:Int
		Field biYPelsPerMeter:Int
		Field biClrUsed:Int
		Field biClrImportant:Int
	
		
		Field R:Byte
		Field G:Byte
		Field B:Byte
		Field Res:Byte
	End Type
	
	Const CF_TEXT = $01
	Const CF_BITMAP = $02
	Const CF_DIB = 8
	Const GMEM_MOVEABLE = 2
	Const GMEM_DDESHARE = $2000
	
	
	Function TextFromClipboard:String()
		If Not OpenClipboard(0)
			Return ""
		EndIf
		Local TextBuf:Byte Ptr
		TextBuf = GetClipboardData(CF_TEXT)
		CloseClipboard()
		Return String.FromCString(TextBuf)
	End Function 
	
	
	Function TextToClipboard(txt:String)
		
		If txt$="" Return
		
		Local TextBuf:Byte Ptr
		Local Memblock:Int
		Local DataBuf:Byte Ptr
		
		TextBuf  = Txt.ToCString()
		Memblock = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE, txt.length+1)
		DataBuf  = GlobalLock(Memblock)
		
		MemCopy DataBuf, TextBuf, Txt.length
		
		If OpenClipboard(0)
			EmptyClipboard
			SetClipboardData(CF_TEXT, DataBuf)
			CloseClipboard
		EndIf
		
		GlobalUnlock(Memblock)
		GlobalFree(Memblock)
		
	End Function
	
	
	Function PixmapFromClipboard:TPixmap()
		
		If Not OpenClipboard(0)
			Return Null
		EndIf
		
		Local InfoBuf:Byte Ptr
		Local BitmapBuf:Byte Ptr
		Local TempInfo:BITMAPINFO
		Local DC:Int
		Local FinalPixmap:TPixmap
		
		InfoBuf   = GetClipboardData(CF_DIB)
		BitmapBuf = getClipboardData(CF_BITMAP)
		
		If InfoBuf = Null Or BitmapBuf = Null
			Return Null
		EndIf
	
		TempInfo  = New BITMAPINFO
		MemCopy TempInfo, InfoBuf, SizeOf(TempInfo)
		
		DC = CreateCompatibleDC(0)
	
		FinalPixmap = CreatePixmap(TempInfo.biWidth, TempInfo.biHeight, PF_BGR888)
		
		GetDIBits(DC, Int(BitmapBuf), 0, TempInfo.biHeight, FinalPixmap.PixelPtr(0,0),TempInfo,0)
		
		FinalPixmap = YFlipPixmap(FinalPixmap)
		CloseClipboard()
		DeleteDC(DC)
		Return FinalPixmap
	End Function 

?


' -------------------------------------------------

If False
	Print "~nClipboard Text test~n"
	Local txt$="Test 1234567890 ABC £$%^&*"
	Print "To clipboard: "+txt$
	TextToClipboard txt$
	Print "From clipboard: "+TextFromClipboard()
	End
EndIf

Local ClipPixmap:TPixmap = PixmapFromClipboard()

If ClipPixmap
	Graphics ClipPixmap.Width,ClipPixmap.Height,0
	DrawPixmap ClipPixmap,0,0
	Flip
	WaitKey
	End
EndIf


Print "~n~nEnter some text for the clipboard"
Print "Alternatively, leave BLANK to see clipboard contents"
Local ctext$=Input$("> ")

If ctext$
	TextToClipboard ctext$
	Print "Text sent to clipboard."
	End
EndIf

Local ClipText:String = TextFromClipboard()
If ClipText
	Print ""
	Print "Clipboard Text:~n================="
	Print ClipText
	Print "==============="
EndIf


Suco-X
 #4
Hi
Here the new code.

Rem

Clipboard functions by Suco-X

End Rem 

Strict 

Extern "Win32"
	Function OpenClipboard(hwnd:Int)
	Function CloseClipboard()
	Function EmptyClipboard()
	Function GetClipboardData:Byte Ptr(Format:Int)
	Function SetClipboardData(format:Int, hMem:Byte Ptr)
	Function CreateCompatibleDC(hdc:Int)
	Function SelectObject(hdc:Int, obj:Int)
	Function CreateCompatibleBitmap(hdc:Int, width:Int, height:Int)
	Function GetPixel(dc:Int, x:Int, y:Int)
	Function CreateDIBSection(hdc:Int, pbmi:Byte Ptr, usage:Int, Bits:Byte Ptr, hSection:Int, Offset:Int)
	Function GetDIBits(hdc:Int, bitmap:Int, Start:Int, Num:Int, bits:Byte Ptr, lpbi:Byte Ptr, usage:Int)
	Function DeleteDC(hdc:Int)
	Function GlobalAlloc(Flags:Int, Bytes:Int)
	Function GlobalLock:Byte Ptr(Mem:Int)
	Function GlobalUnlock(Mem:Int)
End Extern 

?Win32

	Type BITMAPINFO
	
		Field biSize:Int
		Field biWidth:Int
		Field biHeight:Int
		Field biPlanes:Short
		Field biBitCount:Short
		Field biCompression:Int
		Field biSizeImage:Int
		Field biXPelsPerMeter:Int
		Field biYPelsPerMeter:Int
		Field biClrUsed:Int
		Field biClrImportant:Int
	
		
		Field R:Byte
		Field G:Byte
		Field B:Byte
		Field Res:Byte
	End Type
	
	Const CF_TEXT = $01
	Const CF_BITMAP = $02
	Const CF_DIB = 8
	Const GMEM_MOVEABLE = 2
	Const GMEM_DDESHARE = $2000
	
	
	Function TextFromClipboard:String()
		If Not OpenClipboard(0)
			Return ""
		EndIf
		Local TextBuf:Byte Ptr
		TextBuf = GetClipboardData(CF_TEXT)
		CloseClipboard()
		Return String.FromCString(TextBuf)
	End Function 
	
	
	Function TextToClipboard(txt:String)
		
		If txt$="" Return
		
		Local TextBuf:Byte Ptr
		Local Memblock:Int
		Local DataBuf:Byte Ptr
		
		TextBuf  = Txt.ToCString()
		Memblock = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE, txt.length+1)
		DataBuf  = GlobalLock(Memblock)
		
		MemCopy DataBuf, TextBuf, Txt.length
		
		GlobalUnlock(Memblock)
		
		If OpenClipboard(0)
			EmptyClipboard
			SetClipboardData(CF_TEXT, DataBuf)
			CloseClipboard
		EndIf
		
	End Function
	
	
	Function PixmapFromClipboard:TPixmap()
		
		If Not OpenClipboard(0)
			Return Null
		EndIf
		
		Local InfoBuf:Byte Ptr
		Local BitmapBuf:Byte Ptr
		Local TempInfo:BITMAPINFO
		Local DC:Int
		Local FinalPixmap:TPixmap
		
		InfoBuf   = GetClipboardData(CF_DIB)
		BitmapBuf = getClipboardData(CF_BITMAP)
		
		If InfoBuf = Null Or BitmapBuf = Null
			Return Null
		EndIf
	
		TempInfo  = New BITMAPINFO
		MemCopy TempInfo, InfoBuf, SizeOf(TempInfo)
		
		DC = CreateCompatibleDC(0)
	
		FinalPixmap = CreatePixmap(TempInfo.biWidth, TempInfo.biHeight, PF_BGR888)
		
		GetDIBits(DC, Int(BitmapBuf), 0, TempInfo.biHeight, FinalPixmap.PixelPtr(0,0),TempInfo,0)
		
		FinalPixmap = YFlipPixmap(FinalPixmap)
		CloseClipboard()
		DeleteDC(DC)
		Return FinalPixmap
	End Function 

?


' -------------------------------------------------

If True
	Print "~nClipboard Text test~n"
	Local txt$="Test 1234567890 ABC £$%^&*"
	Print "To clipboard: "+txt$
	TextToClipboard txt$
	Print "From clipboard: "+TextFromClipboard()
	End
EndIf

Local ClipPixmap:TPixmap = PixmapFromClipboard()

If ClipPixmap
	Graphics ClipPixmap.Width,ClipPixmap.Height,0
	DrawPixmap ClipPixmap,0,0
	Flip
	WaitKey
EndIf


Print "~n~nEnter some text for the clipboard"
Print "Alternatively, leave BLANK to see clipboard contents"
Local ctext$=Input$("> ")

If ctext$
	TextToClipboard ctext$
	Print "Text sent to clipboard."
	End
EndIf

Local ClipText:String = TextFromClipboard()
If ClipText
	Print ""
	Print "Clipboard Text:~n================="
	Print ClipText
	Print "==============="
EndIf


more complicated, but works fine here.

Jim Brown
 #5
Magic. Works here too.
Just a couple of questions:

1) In the TextToClipboard function should the Memblock be freed using GlobalFree() ?
2) Could you possibly write a PixmapToClipboard() function?

This stuff is a bit beyond me but thanks very much so far Suco.

Suco-X
 #6
Hi
1: You are right.
You need 

Function GlobalFree(Mem:Int)

in the extern block and this
	Function TextToClipboard(txt:String)
		
		If txt$="" Return
		
		Local TextBuf:Byte Ptr
		Local Memblock:Int
		Local DataBuf:Byte Ptr
		
		TextBuf  = Txt.ToCString()
		Memblock = GlobalAlloc(GMEM_MOVEABLE|GMEM_DDESHARE, txt.length+1)
		DataBuf  = GlobalLock(Memblock)
		
		MemCopy DataBuf, TextBuf, Txt.length
		
		If OpenClipboard(0)
			EmptyClipboard
			SetClipboardData(CF_TEXT, DataBuf)
			CloseClipboard
		EndIf
		
		GlobalUnlock(Memblock)
		GlobalFree(Memblock)
		
	End Function

is the new function.

2: Yes, it´s possible. Give me some hours.