 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
 Verfasst am: 23.06.2013, 21:56 Titel: screenshot als fbimage |
 |
|
Hi leute,
ich suche nach einem weg den ganzen bildschirm also ein Screenshot als fbimage zu speichern.
Im Portal gibt es ein Beispielcode in welchem 2 Funktionen sind. Davon hab ich die erste genommen und versucht meinen bedingungen anzupassen.
im Bsp soll am ende ein ausschnitt vom screenshot angezeigt werden.
leider wird nichts angezeigt und bei tastendruck sagt win7 fbidetmp.exe funktioniert nicht mehr.
Ich vermute das Dim as HWND hWndSRC falsch ist ?!
| Code: |
#include once "windows.bi"
'Function CaptureWindow( ByVal hwndSrc As HWND) As Any Ptr
dim AS HWND hWndSrc
SetForegroundWindow(hWndSrc)
Sleep 30 'SetForegroundWindow etwas Zeit geben
Dim As RECT r
GetWindowRect(hWndSrc, @r) 'Fenstergroesse feststellen
Dim As Integer b = r.right - r.left
Dim As Integer h = r.bottom - r.top
Dim As Any Ptr img = ImageCreate(b, h)
b = (b+3) and -4 'Bildbreite glatt durch 4 teilbar
Dim As HDC hdcSrc = GetWindowDC(hWndSrc)
Dim As HDC hdcMem = CreateCompatibleDC(hdcSrc)
Dim As HBITMAP hBmp = CreateCompatibleBitmap(hdcSrc, b, h)
SelectObject(hdcMem, hBmp)
BitBlt(hdcMem, 0, 0, b, h, hdcSrc, 0, 0, SRCCOPY)
Dim As BITMAPINFO bmi
With bmi.bmiHeader
.biSize = SizeOf(BITMAPINFOHEADER)
.biWidth = b 'breite
.biHeight = -h '-hoehe (sonst Kopfstand)
.biPlanes = 1
.biCompression = BI_RGB
.biBitCount = 32
End With
If (img) Then 'Bilddaten in das Image kopieren
GetDIBits(hdcMem, hBmp, 0, h, img + 32, @bmi, DIB_RGB_COLORS)
End If
DeleteObject(hBmp)
DeleteDC(hdcMem)
ReleaseDC(hWndSrc, hdcSrc)
Screenres 800,500, 32
screenlock: put (1, 1), img, (50, 50) - step(50, 50), pset: screenunlock
getkey
'Return img
IMAGEDESTROY img
'End Function |
|
|
| Nach oben |
|
 |
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4699
Wohnort: ~/
|
| Verfasst am: 23.06.2013, 22:00 Titel: |
|
|
Wenn "Dim as HWND hWndSRC" falsch wäre, würdest du bereits einen Compiler-Fehler bekommen. Es klingt mir etwas nach Speicherzugriffsfehler - hast du schon mal mit -exx compiliert und in einer Konsole ausgeführt?
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 23.06.2013, 22:12 Titel: |
|
|
ja danke. cmd sagt illegaler funktionsaufruf
| Code: | | put (1, 1), img, (50, 50) - step(50, 50), pset |
|
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4699
Wohnort: ~/
|
| Verfasst am: 23.06.2013, 22:16 Titel: |
|
|
Wie groß ist denn das Bild?
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 23.06.2013, 22:21 Titel: |
|
|
| hab gerade heraus gefunden das b und h jeweils 0 ist, mein desktop ist aber 1024x600 |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 23.06.2013, 22:31 Titel: |
|
|
Natürlich ist das 0, was soll es auch sonst sein? Du gibst bei GetWindowRect ja kein gültiges Fenster an, dessen Größe berechnet werden soll, da hWndSrc nie initialisiert wird. Evtl solltest du hWndSrc den Rückgabewert von GetDesktopWindow zuweisen.
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
| Nach oben |
|
|
St_W
Anmeldungsdatum: 22.07.2007
Beiträge: 956
Wohnort: Austria
|
| Verfasst am: 23.06.2013, 23:30 Titel: |
|
|
Zusätzlich zu dem Fehler, auf den Jojo bereits hingewiesen hat, musst du auch noch den Grafikmodus initialisieren, bevor du ImageCreate verwenden kannst.
Also den ScreenRes Aufruf ganz an den Programmanfang (oder zumindest vor den ImageCreate Aufruf) geben, da sonst ImageCreate nicht funktioniert und null zurückgibt.
_________________
Aktuelle FreeBasic Builds, Projekte, Code-Snippets unter http://users.freebasic-portal.de/stw/
http://www.mv-lacken.at Musikverein Lacken (MV Lacken) |
|
| Nach oben |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 23.06.2013, 23:56 Titel: |
|
|
ich danke euch
der screenrestipp war auch gut, daran hatte ich gar nicht mehr gedacht |
|
| Nach oben |
|
|
volta
Anmeldungsdatum: 04.05.2005
Beiträge: 1876
Wohnort: D59192
|
| Verfasst am: 24.06.2013, 12:21 Titel: |
|
|
Hi,
| Code: | #Include Once "windows.bi"
Const CaptureBlt = &H40000000
Screen 18, 32,,-1
Dim As HWND hWndSrc = GetDesktopWindow
Dim As RECT r
GetWindowRect(hWndSrc, @r) 'Fenstergroesse feststellen
Dim As Integer b = r.right - r.left
Dim As Integer h = r.bottom - r.top
Dim As Any Ptr img = ImageCreate(b, h)
b = (b+3) And -4 'Bildbreite glatt durch 4 teilbar
Dim As HDC hdcSrc = GetWindowDC(hWndSrc)
Dim As HDC hdcMem = CreateCompatibleDC(hdcSrc)
Dim As HBITMAP hBmp = CreateCompatibleBitmap(hdcSrc, b, h)
SelectObject(hdcMem, hBmp)
BitBlt(hdcMem, 0, 0, b, h, hdcSrc, 0, 0, SRCCOPY Or CaptureBlt)
Dim As BITMAPINFO bmi
With bmi.bmiHeader
.biSize = SizeOf(BITMAPINFOHEADER)
.biWidth = b 'breite
.biHeight = -h '-hoehe (sonst Kopfstand)
.biPlanes = 1
.biCompression = BI_RGB
.biBitCount = 32
End With
If (img) Then 'Bilddaten in das Image kopieren
GetDIBits(hdcMem, hBmp, 0, h, img + 32, @bmi, DIB_RGB_COLORS)
End If
DeleteObject(hBmp)
DeleteDC(hdcMem)
ReleaseDC(hWndSrc, hdcSrc)
If img Then
ImageInfo (img, b , h)
ScreenRes b, h, 32
WindowTitle "CaptureWindow"
Put (1,1), img, PSet
End If
BSave "CaptureWindow.bmp",img
If img <> 0 Then ImageDestroy img
Sleep |
_________________
Warnung an Choleriker:
Dieser Beitrag kann Spuren von Ironie & Sarkasmus enthalten.
Zu Risiken & Nebenwirkungen fragen Sie Ihren Therapeuten oder Psychiater. |
|
| Nach oben |
|
|
Cherry
Anmeldungsdatum: 20.06.2007
Beiträge: 249
|
| Verfasst am: 24.06.2013, 19:22 Titel: |
|
|
Mein Vorschlag:
| Code: | #Include "windows.bi"
#Include "fbgfx.bi"
' Funktion die einen Screenshot erzeugt und den Image-Pointer zurückgibt
Function Screenshot() As FB.IMAGE Ptr
Dim size As SIZE = (GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN))
Dim image As FB.IMAGE Ptr = ImageCreate(size.cx, size.cy, 0, 32)
If image = NULL Return NULL
size.cx = (size.cx + 3) And -4
Var hdcScreen = CreateDC("DISPLAY", NULL, NULL, NULL)
Var hdcShot = CreateCompatibleDC(hdcScreen)
Var hBitmapShot = CreateCompatibleBitmap(hdcScreen, size.cx, size.cy)
Var hBitmapOld = SelectObject(hdcShot, hBitmapShot)
BitBlt(hdcShot, 0, 0, size.cx, size.cy, hdcScreen, 0, 0, SRCCOPY)
Dim bmi As BITMAPINFO = ((SizeOf(BITMAPINFOHEADER), size.cx, -size.cy, 1, 32, BI_RGB, 0, 0, 0, 0, 0), {NULL})
GetDIBits(hdcShot, hBitmapShot, 0, size.cy, image + 1, @bmi, DIB_RGB_COLORS)
SelectObject(hdcShot, hBitmapOld)
DeleteObject(hBitmapShot)
DeleteDC(hdcShot)
DeleteDC(hdcScreen)
Return image
End Function
' Zuerst Screen initialisieren, sonst funktioniert es nicht
ScreenRes 800, 500, 32
' Screenshot machen
Var image = Screenshot()
If image Then
' Oberen linken 800x500 Pixel großen Teil zeichnen
Put (0, 0), image, (0, 0) - (799, 499), PSet
' Image wieder löschen
ImageDestroy(image)
EndIf
Sleep |
Zuletzt bearbeitet von Cherry am 25.06.2013, 12:08, insgesamt 3-mal bearbeitet |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 24.06.2013, 21:12 Titel: |
|
|
Soweit ich das sehe, wird in deiner Variante nicht dafür gesorgt, dass die Breite des Bildes durch vier Teilbar ist. Möchte man also z.B. einen Bildbereich, der 801 Pixel breit ist damit capturen, wird das schiefgehen, da das Alignment im FB-Bildpuffer nicht mehr stimmt.
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
Cherry
Anmeldungsdatum: 20.06.2007
Beiträge: 249
|
| Verfasst am: 25.06.2013, 12:05 Titel: |
|
|
Das stimmt, das hab ich übersehen. Normalerweise hat man aber auch keine Bildschirmauflösung die nicht durch 4 teilbar ist.
Editiert. |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 25.06.2013, 12:33 Titel: |
|
|
"Normalerweise" gibt's nicht. In einer VM kann man z.B. typischerweise die Bildschirmauflösung beliebig wählen, da würde das zu Problemen führen. Und im Allgemeinen kann die Funktion ja nicht nur für den kompletten Bildschirm, sondern auch für beliebige Teilfenster verwendet werden, die auch eine beliebige Größe haben können.
Edit: Nicht getestet, aber soweit ich das sehe, kann man auch den Pitch-Wert eines fb.Image-headers maniuplieren. Wird halt geschwindigkeitsmäßig vergleichweise vmtl nicht so toll sein... Jedenfalls muss man sich so nicht drauf verlassen, dass das Zeilen-Alignment immer 16 ist.
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| Nach oben |
|
|
braesident
Anmeldungsdatum: 15.04.2008
Beiträge: 189
Wohnort: Berlin
|
| Verfasst am: 25.06.2013, 16:48 Titel: |
|
|
wie könnte ich das umsetzen das sich mein Screenshot immer aktuallisiert?
Also es geht darum das das durch ein objekt der desktop durchschimmert. Soweit geht es ja nur wenn sich jetzt was im hintergrund ändert muss es das ja auch im screenshot tun. - Ich hoffe ihr habt mich jetzt verstanden.
in meinen versuchen wird mein objekt aber immer weiß - scheint sich also nur zu überlagern.
zum beenden mit maus anklicken und sofort esc.
| Code: | #INCLUDE ONCE "fbgfx.bi"
#include once "windows.bi"
SCREENRES 1024, 600, 32,, FB.GFX_SHAPED_WINDOW or FB.GFX_ALWAYS_ON_TOP
Color ,&hFF00FF: CLS
Windowtitle "haschdich"
Sleep 30
DIM AS HWND myhwnd = FindWindow(0, "haschdich")
declare sub scrns ()
? myhwnd
Dim Shared AS BYTE PTR Bild
Dim Shared As Any Ptr img
Bild = ImageCreate (200, 200, &hffffff)
Draw String Bild, (3, 3), "200 x 200", &h000000
DO
scrns
SetForegroundWindow (myhwnd)
Sleep 25
ScreenLock
cls
put (50, 50), img, (50, 50) - step(100, 100), pset
Put (50, 50), Bild, alpha, 200
ScreenUnLock
Loop Until Inkey = Chr(27)
Bild = ImageCreate (100, 100, &hffffff)
Draw String Bild, (6, 6), "gross", &h000000
ScreenLock: Put (50, 50), Bild, alpha, 127: ScreenUnLock
GetKey
End
Sub Scrns ()
dim AS HWND hWndSrc = GetDesktopWindow()
SetForegroundWindow(hWndSrc)
Sleep 30 'SetForegroundWindow etwas Zeit geben
Dim As RECT r
GetWindowRect(hWndSrc, @r) 'Fenstergroesse feststellen
Dim As Integer b = r.right - r.left
Dim As Integer h = r.bottom - r.top
Dim AS Integer zeigeB = b, zeigeH = h
img = ImageCreate(b, h)
b = (b+3) and -4 'Bildbreite glatt durch 4 teilbar
Dim As HDC hdcSrc = GetWindowDC(hWndSrc)
Dim As HDC hdcMem = CreateCompatibleDC(hdcSrc)
Dim As HBITMAP hBmp = CreateCompatibleBitmap(hdcSrc, b, h)
SelectObject(hdcMem, hBmp)
BitBlt(hdcMem, 0, 0, b, h, hdcSrc, 0, 0, SRCCOPY)
Dim As BITMAPINFO bmi
With bmi.bmiHeader
.biSize = SizeOf(BITMAPINFOHEADER)
.biWidth = b 'breite
.biHeight = -h '-hoehe (sonst Kopfstand)
.biPlanes = 1
.biCompression = BI_RGB
.biBitCount = 32
End With
If (img) Then 'Bilddaten in das Image kopieren
GetDIBits(hdcMem, hBmp, 0, h, img + 32, @bmi, DIB_RGB_COLORS)
End If
DeleteObject(hBmp)
DeleteDC(hdcMem)
ReleaseDC(hWndSrc, hdcSrc)
End Sub
|
|
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4699
Wohnort: ~/
|
| Verfasst am: 25.06.2013, 17:51 Titel: |
|
|
Nur mal so als Idee (weiß nicht ob es daran liegt und kann windowsspezifische Sachen hier nicht testen):
Du verwendest de Farben &h000000 usw., d. h. der Alphawert ist hier &h00. Damit sollte es unsichtbar sein. Du brauchst also &hFF000000 = RGB(0, 0, 0) = RGBA(0, 0, 0, 255).
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
