Code: Alles auswählen
UsePNGImageEncoder()
UseJPEGImageEncoder()
Dateiname.s = ""
Endung.s = ""
ScreenWidth = GetSystemMetrics_(#SM_CXSCREEN)
ScreenHeight = GetSystemMetrics_(#SM_CYSCREEN)
Procedure Screenshot(ImageNr,X,Y,Width,Height)
hImage = CreateImage(ImageNr,Width,Height)
hDC = StartDrawing(ImageOutput())
DeskDC = GetDC_(GetDesktopWindow_())
BitBlt_(hDC,0,0,Width,Height,DeskDC,X,Y,#SRCCOPY)
StopDrawing()
ReleaseDC_(GetDesktopWindow_(),DeskDC)
ProcedureReturn hImage
EndProcedure
If OpenWindow(0, 0, 0, 0, 0, #PB_Window_Invisible, "Screeny")
AddSysTrayIcon(1, WindowID(), LoadImage(0, "screeny.ico"))
If CreatePopupMenu(0)
MenuTitle("Screenshot")
MenuItem(1, "In Speicher")
MenuItem(2, "In Bilddatei")
CloseSubMenu()
MenuItem(3, "Info")
MenuBar()
MenuItem(4, "Beenden")
EndIf
Repeat
Select WaitWindowEvent()
Case #WM_RButtonDown
DisplayPopupMenu(0,WindowID())
Case #PB_Event_Menu
Select EventMenuID()
Case 1
Screenshot(1000, 0, 0, ScreenWidth, ScreenHeight)
SetClipboardData(#PB_ClipboardImage, ImageID())
Case 2
Dateiname = SaveFileRequester("Dateiname zum speichern eingeben!", "screenshot" + Endung, "Bmp (*.bmp)|*.bmp|Jpg (*.jpg)|*.jpg|Png (*.png)|*.png|Alle Dateien (*.*)|*.*", 0)
If Dateiname <> ""
Dateiname = GetFilePart(Dateiname)
Select SelectedFilePattern()
Case 0
Dateiname + ".bmp"
Screenshot(1000, 0, 0, ScreenWidth, ScreenHeight)
SaveImage(1000, Dateiname, #PB_ImagePlugin_BMP)
Case 1
Dateiname + ".jpg"
Screenshot(1000, 0, 0, ScreenWidth, ScreenHeight)
SaveImage(1000, Dateiname, #PB_ImagePlugin_JPEG, 9)
Case 2
Dateiname + ".png"
Screenshot(1000, 0, 0, ScreenWidth, ScreenHeight)
SaveImage(1000, Dateiname, #PB_ImagePlugin_PNG)
EndSelect
MessageRequester("Info", Dateiname + #CRLF$ + "wurde gespeichert!", 0)
EndIf
Case 3
MessageRequester("Info", "Screenshot-Tool v1.0" + #CRLF$ + "--------------------------" + #CRLF$ + "daniel.strohmeier@hispeed.ch" + #CRLF$ + "(C)Jumpingeyes, 2005", 0)
Case 4
Quit = 1
EndSelect
Case #PB_Event_SysTray
If EventType() = #PB_EventType_RightClick
DisplayPopupMenu(0,WindowID())
EndIf
EndSelect
Until Quit = 1
EndIf
End