Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » System

Zwischenablage lesen und schreiben 2 (Bilder)

Lizenz:Erster Autor:Letzte Bearbeitung:
FBPSLRedakteurMOD 25.09.2011

Der folgende Code zeigt auf, wie man mittels der WinAPI auf Bilder in der Zwischenablage (Clipboard) zugreift. Der Code wurde ursprünglich von XOR im Forum veröffentlicht. Da ich den Code sehr gut fand und ich denke, dass der eine oder andere ihn gebrauchen kann, habe ich ihn leicht angepasst und hochgeladen.

Const w = 800
Const h = 600

#Include "fbgfx.bi"
#Include Once "windows.bi"

Declare Function get_clip() As HBITMAP
Declare Function set_clip(bitmap As String) As HBITMAP

ScreenRes w, h, 32
'set_clip("bild.bmp")

Dim As BITMAPINFO BitmapInfo
Dim As HDC display_dc      = GetDC( NULL )
Dim As HDC bitmap_dc       = CreateCompatibleDC( display_dc )
Dim As HBITMAP bitmap      = CreateCompatibleBitmap( display_dc, w, h )
Dim As HGDIOBJ null_bitmap = SelectObject( bitmap_dc, bitmap )

bitmap = get_clip()

Dim As fb.image Ptr optr = ImageCreate( w, h )
optr->pitch = optr->Width * 4
With BitmapInfo.bmiHeader
   .biSize     = SizeOf(BITMAPINFOHEADER)
   .biWidth    = w
   .biHeight   = -h
   .biPlanes   = 1
   .biBitCount = 32
End With

getdibits( bitmap_dc, bitmap, 0, h, optr + 1, @BitmapInfo, DIB_RGB_COLORS )

SelectObject( bitmap_dc, null_bitmap )
DeleteDC( display_dc )
DeleteDC( bitmap_dc )
DeleteObject( bitmap )

Put(0, 0), optr
ImageDestroy(optr)

Sleep

Function set_clip(bitmap As String) As HBITMAP
        Dim hBmp As HANDLE
        hBmp = LoadImage(0, bitmap, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
        OpenClipboard(0)
        EmptyClipboard()
        SetClipboardData(CF_BITMAP, CopyImage(hBmp, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG))
        CloseClipboard()
        Return NULL
End Function

Function get_clip() As HBITMAP
        Dim hBmp As HANDLE
        If IsClipboardFormatAvailable(CF_BITMAP) = 0 Then
            Return NULL
        EndIf
        If OpenClipboard(0) = 0 Then
            Return NULL
        EndIf
        Function = GetClipboardData(CF_BITMAP)
        CloseClipboard()
End Function

Man könnte den Code beispielsweise in Verbindung mit dem Code-Beispiel zur Erstellung von Screenshots verwenden.


Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 25.09.2011 von RedakteurMOD angelegt.
  • Die aktuellste Version wurde am 25.09.2011 von RedakteurMOD gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen