PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Screenshot erstellen(Windows und Linux)

https://www.purebasic.fr/german/viewtopic.php?t=3949

Seite 1 von 2

Screenshot erstellen(Windows und Linux)

Verfasst: 12.07.2005 11:07
von DarkDragon
Hallo,

Im CodeArchiv gibts schon die Windows Variante, also hab ich einfach mal einen Code für Windows und Linux gemacht:

Code: Alles auswählen

;Screenshots unter Windows und Linux erstellen
;Gemischt mit Danilos variante hier: http://www.purearea.net/pb/CodeArchiv/Windows_System/Screenshots/MakeWindowScreenshot.pb 
; Autor: DarkDragon/Danilo ;) .
;
#SCREENSHOT_MOUSE = 2

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure GetCurrentCursor(*pt.Point)
 hWindow.l
 dwThreadID.l
 dwCurrentThreadID.l
 Result = 0
 If GetCursorPos_(*pt)
   hWindow = WindowFromPoint_(*pt\x, *pt\y)
   If IsWindow_(hWindow)
     dwThreadID = GetWindowThreadProcessId_(hWindow, @nil)
     dwCurrentThreadID = GetCurrentThreadId_()
     
     If (dwCurrentThreadID <> dwThreadID)
       If AttachThreadInput_(dwCurrentThreadID, dwThreadID, 1)
         Result.l = GetCursor_()
         AttachThreadInput_(dwCurrentThreadID, dwThreadID, 0)
       EndIf
     Else
       Result.l = GetCursor_()
     EndIf
   EndIf
 EndIf
 ProcedureReturn Result
EndProcedure
CompilerEndIf

Procedure MakeDesktopScreenshot(ImageNr,x,y,Width,Height,Flags)
 CompilerIf #PB_Compiler_OS = #PB_OS_Linux
 RunProgram("import", "-window root -crop "+Str(Width)+"x"+Str(Height)+"+"+Str(x)+"+"+Str(y)+" /tmp/snapshot.bmp", "/", 1)
 hImage = LoadImage(ImageNr, "/tmp/snapshot.bmp")
 CompilerElse
 hImage = CreateImage(ImageNr,Width,Height)
 If hImage
   hDC = StartDrawing(ImageOutput())
   If hDC
     DeskDC = GetDC_(GetDesktopWindow_())
     If DeskDC
       BitBlt_(hDC,0,0,Width,Height,DeskDC,x,y,#SRCCOPY)
     EndIf
     ReleaseDC_(GetDesktopWindow_(),DeskDC)
   EndIf
   If (Flags & #SCREENSHOT_MOUSE)
     hCursor = GetCurrentCursor(@pt.Point)
     DrawImage(hCursor, pt\x-capX, pt\y-capY)
   EndIf
   StopDrawing()
 EndIf
 CompilerEndIf
 ProcedureReturn hImage
EndProcedure

Procedure ViewImage()
  If OpenWindow(1000, 0, 0, ImageWidth(), ImageHeight(), #PB_Window_SystemMenu, "Image")
    CreateGadgetList(WindowID())
    ImageGadget(1000, 0, 0, ImageWidth(), ImageHeight(), ImageID())
    
    Repeat
      Event = WaitWindowEvent()
      Delay(10)
    Until Event = #PB_Event_CloseWindow
    CloseWindow(1000)
  EndIf
EndProcedure

Delay(1000)
hImg = MakeDesktopScreenshot(0,100,300,512,256,#SCREENSHOT_MOUSE)
If hImg
ViewImage()
FreeImage(0)
EndIf
Funktioniert hier Prima :allright:

[UPDATE] - Mauszeiger hinzugefügt(Windows only, erstmal)

Re: Screenshot erstellen(Windows und Linux)

Verfasst: 12.07.2005 11:33
von Kiffi
> Funktioniert hier Prima

hier (W2K SP4) auch. Danke! :allright:

Grüße ... Kiffi

Re: Screenshot erstellen(Windows und Linux)

Verfasst: 12.07.2005 16:22
von DarkDragon
Kiffi hat geschrieben:> Funktioniert hier Prima

hier (W2K SP4) auch. Danke! :allright:

Grüße ... Kiffi
:wink: Danke für die Antwort. Nun hab ich endlich rausgefunden wie man den aktuellen Mauszeiger rausfindet. Den code oben hab ich mal aktualisiert.

Verfasst: 17.07.2005 10:22
von walker
Hi,

super! (nur unter Linux getestet).
Noch ein Hinweis: das Programm import ist Teil von ImageMagick. Dieses Paket muß also installiert sein, damit der Code funktioniert.

Wer den Breich für den Screenshot (unter Linux) mit der Maus wählen will, der muß die Zeile

Code: Alles auswählen

RunProgram("import", "-window root -crop "+Str(Width)+"x"+Str(Height)+"+"+Str(x)+"+"+Str(y)+" /tmp/snapshot.bmp", "/", 1)
mit

Code: Alles auswählen

 RunProgram("import", "/tmp/snapshot.bmp", "/", 1)
ersetzen. Nun kann der Bereich mit der Maus ausgewählt werden (links klicken, Taste gedrückt halten und einen Bereich aufziehen, taste loslassen... fertig)

Ulf

@DarkDragon : der Parameter -window root funktioniert nur, wenn ein Fenster mit dem Namen root existiert.....

Verfasst: 17.07.2005 11:17
von DarkDragon
walker hat geschrieben:@DarkDragon : der Parameter -window root funktioniert nur, wenn ein Fenster mit dem Namen root existiert.....
Steht aber so im Internet, und das soll anscheinend der Desktop sein. Achja: Wenn man das ganze per Maus wählen will:

Code: Alles auswählen

#SCREENSHOT_MOUSE = 2

ExamineDesktops()

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure GetCurrentCursor(*pt.Point)
 hWindow.l
 dwThreadID.l
 dwCurrentThreadID.l
 Result = 0
 If GetCursorPos_(*pt)
   hWindow = WindowFromPoint_(*pt\x, *pt\y)
   If IsWindow_(hWindow)
     dwThreadID = GetWindowThreadProcessId_(hWindow, @nil)
     dwCurrentThreadID = GetCurrentThreadId_()
     
     If (dwCurrentThreadID <> dwThreadID)
       If AttachThreadInput_(dwCurrentThreadID, dwThreadID, 1)
         Result.l = GetCursor_()
         AttachThreadInput_(dwCurrentThreadID, dwThreadID, 0)
       EndIf
     Else
       Result.l = GetCursor_()
     EndIf
   EndIf
 EndIf
 ProcedureReturn Result
EndProcedure
CompilerEndIf

Procedure MakeDesktopScreenshot(ImageNr,x,y,Width,Height,Flags)
 CompilerIf #PB_Compiler_OS = #PB_OS_Linux
 RunProgram("import", "-window root -crop "+Str(Width)+"x"+Str(Height)+"+"+Str(x)+"+"+Str(y)+" /tmp/snapshot.bmp", "/", 1)
 hImage = LoadImage(ImageNr, "/tmp/snapshot.bmp")
 CompilerElse
 hImage = CreateImage(ImageNr,Width,Height)
 If hImage
   hDC = StartDrawing(ImageOutput())
   If hDC
     DeskDC = GetDC_(GetDesktopWindow_())
     If DeskDC
       BitBlt_(hDC,0,0,Width,Height,DeskDC,x,y,#SRCCOPY)
     EndIf
     ReleaseDC_(GetDesktopWindow_(),DeskDC)
   EndIf
   If (Flags & #SCREENSHOT_MOUSE)
     hCursor = GetCurrentCursor(@pt.Point)
     DrawImage(hCursor, pt\x-capX, pt\y-capY)
   EndIf
   StopDrawing()
 EndIf
 CompilerEndIf
 ProcedureReturn hImage
EndProcedure

Procedure ViewImage()
  If OpenWindow(1000, 0, 0, ImageWidth(), ImageHeight(), #PB_Window_SystemMenu, "Image")
    CreateGadgetList(WindowID())
    ImageGadget(1000, 0, 0, ImageWidth(), ImageHeight(), ImageID())
    
    Repeat
      Event = WaitWindowEvent()
      Delay(10)
    Until Event = #PB_Event_CloseWindow
    CloseWindow(1000)
  EndIf
EndProcedure

InitSprite()
InitMouse()

Structure Area
  X.l
  Y.l
  Width.l
  Height.l
EndStructure

Procedure MouseControlScreenshot(Img, Flags)
  Area.Area
  MakeDesktopScreenshot(Img,0,0,DesktopWidth(0),DesktopHeight(0), Flags)
  OpenScreen(DesktopWidth(0), DesktopHeight(0), 32, "Capture")
  
  Repeat
    If IsScreenActive()
    ExamineMouse()
    
    MouseX = MouseX()
    MouseY = MouseY()
    If MouseButton(1)
      If capMouse = 0
        oMouseX = MouseX
        oMouseY = MouseY
        capMouse = 1
      EndIf
    Else
      If capMouse = 1
        If MouseX < oMouseX : v = oMouseX : oMouseX = MouseX : MouseX = v : EndIf
        If MouseY < oMouseY : v = oMouseY : oMouseY = MouseY : MouseY = v : EndIf
        Area\X = oMouseX
        Area\Y = oMouseY
        Area\Width = MouseX-oMouseX
        Area\Height = MouseY-oMouseY
        Q = 1
      EndIf
    EndIf
    
    ClearScreen(0, 0, 0)
    StartDrawing(ScreenOutput())
    DrawImage(ImageID(), 0, 0)
    DrawingMode(4|2)
    If capMouse <> 0
    Box(oMouseX, oMouseY, MouseX-oMouseX, MouseY-oMouseY)
    EndIf
    DrawingMode(2)
    Box(MouseX-1 , MouseY-10, 2 , 20)
    Box(MouseX-10, MouseY-1 , 20, 2 )
    StopDrawing()
    FlipBuffers()
    EndIf
    
    Delay(10)
  Until Q = 1
  CloseScreen()
  ImgNew = GrabImage(Img, #PB_Any, Area\X, Area\Y, Area\Width, Area\Height)
  FreeImage(Img)
  CopyImage(ImgNew, Img)
  FreeImage(ImgNew)
  ProcedureReturn ImageID()
EndProcedure

Delay(1000)
;hImg = MakeDesktopScreenshot(0,100,300,512,256,#SCREENSHOT_MOUSE)
hImg = MouseControlScreenshot(0,#SCREENSHOT_MOUSE)
If hImg
ViewImage()
FreeImage(0)
EndIf
Link

Achja: und bei mir gehts :freak:

Verfasst: 17.07.2005 12:19
von DataMiner
Funktioniert gut.
Ich habe aber zwei Monitore angeschlossen und den Desktop auf den zweiten Monitor erweitert. Screenshots klappen nur von ersten Monitor...
Ach ja, ich rede von WinXP...

Verfasst: 24.07.2005 02:18
von Falko
Hiermit geht es leider nur für Windows aber man kann damit den Desktop kopieren bzw. auch ein Windows, wenn man den Source auskommentiert und zurückädert, sowie das Windows dessen Namen angibt.
Dieser Stand im englischen forum und wurde von wayne1 gepostet.

Code: Alles auswählen

;Restored from previous forum. Originally posted by wayne1.
;capture a piece of screen 
;Und auf Desktop (abgeändert von Falko)
Procedure.l CaptureScreen(Left.l, Top.l, Width.l, Height.l)
    dm.DEVMODE
    BMPHandle.l
    srcDC = CreateDC_("DISPLAY", "", "", dm)
    trgDC = CreateCompatibleDC_(srcDC)
    BMPHandle = CreateCompatibleBitmap_(srcDC, Width, Height)
    SelectObject_( trgDC, BMPHandle)
    BitBlt_( trgDC, 0, 0, Width, Height, srcDC, Left, Top, #SRCCOPY)
    DeleteDC_( trgDC)
    ReleaseDC_( BMPHandle, srcDC)
    ProcedureReturn BMPHandle
EndProcedure

Procedure CaptureWindow(WindowName.s)
    WinHndl=GetDesktopWindow_(); Hiermit wurd  nur das Handle vom Desktop bestimmt 
    ;WinHndl = FindWindow_(0, WindowName); Oder dieses Handle für ein Windows ermittlen, wobei unten noch der Name des Fensters eingetragen werden muss
    If WinHndl
        WindowSize.RECT
        GetWindowRect_(WinHndl, @WindowSize)
        ScreenCaptureAddress = CaptureScreen(WindowSize\Left, WindowSize\Top, WindowSize\Right - WindowSize\Left, WindowSize\Bottom - WindowSize\Top)
        CreateImage(0, WindowSize\Right - WindowSize\Left, WindowSize\Bottom - WindowSize\Top)
        StartDrawing(ImageOutput())
            DrawImage(ScreenCaptureAddress, 0, 0)
        StopDrawing()
        SaveImage(0, "Screenshot.bmp")
    Else
        ProcedureReturn 0
    EndIf
    ProcedureReturn 1
EndProcedure

CaptureWindow("Name"); hier muss nur der Name des Windows  geändert  werden

Re: Screenshot erstellen(Windows und Linux)

Verfasst: 30.01.2012 01:23
von Delle
Gibt's von dem nachfolgenden Code auch schon ein Update für PB4.60 ? Bei mir meckert er wegen mehreren Sachen rum... Parameteranzahl WindowFromPoint_ usw.

Code: Alles auswählen

#SCREENSHOT_MOUSE = 2

ExamineDesktops()

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure GetCurrentCursor(*pt.Point)
hWindow.l
dwThreadID.l
dwCurrentThreadID.l
Result = 0
If GetCursorPos_(*pt)
   hWindow = WindowFromPoint_(*pt\x, *pt\y)
   If IsWindow_(hWindow)
     dwThreadID = GetWindowThreadProcessId_(hWindow, @nil)
     dwCurrentThreadID = GetCurrentThreadId_()
     
     If (dwCurrentThreadID <> dwThreadID)
       If AttachThreadInput_(dwCurrentThreadID, dwThreadID, 1)
         Result.l = GetCursor_()
         AttachThreadInput_(dwCurrentThreadID, dwThreadID, 0)
       EndIf
     Else
       Result.l = GetCursor_()
     EndIf
   EndIf
EndIf
ProcedureReturn Result
EndProcedure
CompilerEndIf

Procedure MakeDesktopScreenshot(ImageNr,x,y,Width,Height,Flags)
CompilerIf #PB_Compiler_OS = #PB_OS_Linux
RunProgram("import", "-window root -crop "+Str(Width)+"x"+Str(Height)+"+"+Str(x)+"+"+Str(y)+" /tmp/snapshot.bmp", "/", 1)
hImage = LoadImage(ImageNr, "/tmp/snapshot.bmp")
CompilerElse
hImage = CreateImage(ImageNr,Width,Height)
If hImage
   hDC = StartDrawing(ImageOutput())
   If hDC
     DeskDC = GetDC_(GetDesktopWindow_())
     If DeskDC
       BitBlt_(hDC,0,0,Width,Height,DeskDC,x,y,#SRCCOPY)
     EndIf
     ReleaseDC_(GetDesktopWindow_(),DeskDC)
   EndIf
   If (Flags & #SCREENSHOT_MOUSE)
     hCursor = GetCurrentCursor(@pt.Point)
     DrawImage(hCursor, pt\x-capX, pt\y-capY)
   EndIf
   StopDrawing()
EndIf
CompilerEndIf
ProcedureReturn hImage
EndProcedure

Procedure ViewImage()
  If OpenWindow(1000, 0, 0, ImageWidth(), ImageHeight(), #PB_Window_SystemMenu, "Image")
    CreateGadgetList(WindowID())
    ImageGadget(1000, 0, 0, ImageWidth(), ImageHeight(), ImageID())
   
    Repeat
      Event = WaitWindowEvent()
      Delay(10)
    Until Event = #PB_Event_CloseWindow
    CloseWindow(1000)
  EndIf
EndProcedure

InitSprite()
InitMouse()

Structure Area
  X.l
  Y.l
  Width.l
  Height.l
EndStructure

Procedure MouseControlScreenshot(Img, Flags)
  Area.Area
  MakeDesktopScreenshot(Img,0,0,DesktopWidth(0),DesktopHeight(0), Flags)
  OpenScreen(DesktopWidth(0), DesktopHeight(0), 32, "Capture")
 
  Repeat
    If IsScreenActive()
    ExamineMouse()
   
    MouseX = MouseX()
    MouseY = MouseY()
    If MouseButton(1)
      If capMouse = 0
        oMouseX = MouseX
        oMouseY = MouseY
        capMouse = 1
      EndIf
    Else
      If capMouse = 1
        If MouseX < oMouseX : v = oMouseX : oMouseX = MouseX : MouseX = v : EndIf
        If MouseY < oMouseY : v = oMouseY : oMouseY = MouseY : MouseY = v : EndIf
        Area\X = oMouseX
        Area\Y = oMouseY
        Area\Width = MouseX-oMouseX
        Area\Height = MouseY-oMouseY
        Q = 1
      EndIf
    EndIf
   
    ClearScreen(0, 0, 0)
    StartDrawing(ScreenOutput())
    DrawImage(ImageID(), 0, 0)
    DrawingMode(4|2)
    If capMouse <> 0
    Box(oMouseX, oMouseY, MouseX-oMouseX, MouseY-oMouseY)
    EndIf
    DrawingMode(2)
    Box(MouseX-1 , MouseY-10, 2 , 20)
    Box(MouseX-10, MouseY-1 , 20, 2 )
    StopDrawing()
    FlipBuffers()
    EndIf
   
    Delay(10)
  Until Q = 1
  CloseScreen()
  ImgNew = GrabImage(Img, #PB_Any, Area\X, Area\Y, Area\Width, Area\Height)
  FreeImage(Img)
  CopyImage(ImgNew, Img)
  FreeImage(ImgNew)
  ProcedureReturn ImageID()
EndProcedure

Delay(1000)
;hImg = MakeDesktopScreenshot(0,100,300,512,256,#SCREENSHOT_MOUSE)
hImg = MouseControlScreenshot(0,#SCREENSHOT_MOUSE)
If hImg
ViewImage()
FreeImage(0)
EndIf

Re: Screenshot erstellen(Windows und Linux)

Verfasst: 30.01.2012 01:59
von ts-soft
Okay, ein bissel aufgeräumt und angepaßt. Windows x86 und x64 funktionieren aber unter Linux hab ich mit Zeile 38 ein Problem,
wahrscheinlich nur fehlende Rechte?

Code: Alles auswählen

EnableExplicit

#SCREENSHOT_MOUSE = 2

ExamineDesktops()

CompilerIf #PB_Compiler_OS = #PB_OS_Windows
Procedure GetCurrentCursor(*pt.Point)
  Protected hWindow
  Protected dwThreadID
  Protected dwCurrentThreadID
  Protected Result, nil
  
  If GetCursorPos_(*pt)
    hWindow = WindowFromPoint_(*pt\x << 32 + *pt\y)
    If IsWindow_(hWindow)
      dwThreadID = GetWindowThreadProcessId_(hWindow, @nil)
      dwCurrentThreadID = GetCurrentThreadId_()
      
      If (dwCurrentThreadID <> dwThreadID)
        If AttachThreadInput_(dwCurrentThreadID, dwThreadID, 1)
          Result = GetCursor_()
          AttachThreadInput_(dwCurrentThreadID, dwThreadID, 0)
        EndIf
      Else
        Result = GetCursor_()
      EndIf
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure
CompilerEndIf

Procedure MakeDesktopScreenshot(ImageNr,x,y,Width,Height,Flags)
  Protected hImage, hDC, DeskDC, hCursor
  CompilerIf #PB_Compiler_OS = #PB_OS_Linux
  RunProgram("import", "-window root -crop "+Str(Width)+"x"+Str(Height)+"+"+Str(x)+"+"+Str(y)+" /tmp/snapshot.bmp", "/", 1)
  hImage = LoadImage(ImageNr, "/tmp/snapshot.bmp") ; ----- crashed?
  CompilerElse
  Protected pt.point
  hImage = CreateImage(ImageNr,Width,Height)
  If hImage
    hDC = StartDrawing(ImageOutput(ImageNr))
    If hDC
      DeskDC = GetDC_(GetDesktopWindow_())
      If DeskDC
        BitBlt_(hDC,0,0,Width,Height,DeskDC,x,y,#SRCCOPY)
      EndIf
      ReleaseDC_(GetDesktopWindow_(),DeskDC)
    EndIf
    If (Flags & #SCREENSHOT_MOUSE)
      hCursor = GetCurrentCursor(@pt.Point)
      DrawImage(hCursor, pt\x, pt\y)
    EndIf
    StopDrawing()
  EndIf
  CompilerEndIf
  ProcedureReturn hImage
EndProcedure

Procedure ViewImage()
  Protected Event
  
  If OpenWindow(0, 0, 0, ImageWidth(0), ImageHeight(0), "Image", #PB_Window_SystemMenu)
    ImageGadget(0, 0, 0, ImageWidth(0), ImageHeight(0), ImageID(0))
    
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
    CloseWindow(0)
  EndIf
EndProcedure

InitSprite()
InitMouse()

Structure Area
  X.l
  Y.l
  Width.l
  Height.l
EndStructure

Procedure MouseControlScreenshot(Img, Flags)
  Protected Area.Area
  Protected Mousex, MouseY, capMouse, oMouseX, oMouseY
  Protected v, Q, ImgNew
  
  MakeDesktopScreenshot(Img,0,0,DesktopWidth(0),DesktopHeight(0), Flags)
  OpenScreen(DesktopWidth(0), DesktopHeight(0), 32, "Capture")
  
  Repeat
    If IsScreenActive()
      ExamineMouse()
      
      MouseX = MouseX()
      MouseY = MouseY()
      If MouseButton(1)
        If capMouse = 0
          oMouseX = MouseX
          oMouseY = MouseY
          capMouse = 1
        EndIf
      Else
        If capMouse = 1
          If MouseX < oMouseX : v = oMouseX : oMouseX = MouseX : MouseX = v : EndIf
          If MouseY < oMouseY : v = oMouseY : oMouseY = MouseY : MouseY = v : EndIf
          Area\X = oMouseX
          Area\Y = oMouseY
          Area\Width = MouseX-oMouseX
          Area\Height = MouseY-oMouseY
          Q = 1
        EndIf
      EndIf
      
      ClearScreen(0)
      StartDrawing(ScreenOutput())
      DrawImage(ImageID(0), 0, 0)
      DrawingMode(4|2)
      If capMouse <> 0
        Box(oMouseX, oMouseY, MouseX-oMouseX, MouseY-oMouseY)
      EndIf
      DrawingMode(2)
      Box(MouseX-1 , MouseY-10, 2 , 20)
      Box(MouseX-10, MouseY-1 , 20, 2 )
      StopDrawing()
      FlipBuffers()
    EndIf
    
    Delay(10)
  Until Q = 1
  CloseScreen()
  ImgNew = GrabImage(Img, #PB_Any, Area\X, Area\Y, Area\Width, Area\Height)
  FreeImage(Img)
  CopyImage(ImgNew, Img)
  FreeImage(ImgNew)
  ProcedureReturn ImageID(0)
EndProcedure

Define hImg = MouseControlScreenshot(0, #SCREENSHOT_MOUSE)

If hImg
  ViewImage()
  FreeImage(0)
EndIf
Gruß
Thomas

Re: Screenshot erstellen(Windows und Linux)

Verfasst: 30.01.2012 09:56
von DarkDragon
ts-soft hat geschrieben:Okay, ein bissel aufgeräumt und angepaßt. Windows x86 und x64 funktionieren aber unter Linux hab ich mit Zeile 38 ein Problem,
wahrscheinlich nur fehlende Rechte?
Kannst ja überprüfen, aber vielleicht ist das temporary directory bei dir gar nicht an diesem festgelegten Ort. Probiers mal mit GetTemporaryDirectory() statt dem festen /tmp/.
Alle Zeiten sind UTC+02:00
Seite 1 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de