|
Post by Carl Gundel on May 4, 2020 13:04:35 GMT -5
I'm pretty sure this topic has been covered in the past, but I'm having trouble finding it. Perhaps it was material that existed on the conforums site.
Does anyone here have handy a short routine to capture the whole screen, or part of it and save it to a file?
-Carl
|
|
|
Post by Rod on May 4, 2020 13:56:41 GMT -5
John Davidson's tweak of Ken's screen capture. A shed load of API. I found it daunting, but I think most of what you need is in the screeshot sub. They confused everyone by plastering the screen image with transparent text so there is more code than you need.
'Released to the public domain 'Nov 12,2002 'By John Davidson 'johnshomeport@yahoo.com
'This app places the words "Liberty BASIC v3.02" on the desktop in ' transparent letters.
'The code used to take the snapshot of the desktop was taken directly 'from Liberty BASIC SnapShot by Ken Lewis, Sr. 'Liberty BASIC SnapShot is available in the files section of the 'Liberty BASIC Support Group. 'http://groups.yahoo.com/group/libertybasic/ 'Look in the " Ken Lewis, Sr." folder for 1screenShot.bas
' The code used to create the transparent text was posted by Alyce Watson. ' to The Official Liberty BASIC Support Group at ' http://groups.yahoo.com/group/libertybasic/ ' see message #10276 ' 'For more information on graphics see 'Mastering Liberty BASIC 3 'available at 'http://iquizme.0catch.com/lb/lbw3/master.html ' ' 'Note: 'To exit out of this program just press a mouse button or any key. '----------------------------------------------------------------- 'requires LB3 If Val(Left$(Version$,1))<3 Then Notice "Sorry"+Chr$(13)+_ "This application requires Liberty BASIC 3.0 or higher."+Chr$(13)+_ "Please visit LibertyBasic.com for the latest verson." End End If 'Take a screenshot of the desktop Call screenShot 0,0,DisplayWidth,DisplayHeight
NoMainWin WindowWidth=DisplayWidth WindowHeight=DisplayHeight
Graphicbox #1.gb1,0,0,DisplayWidth,DisplayHeight Open "test" For window_popup As #1 Print #1.gb1, "when leftButtonDown [quit]" Print #1.gb1, "when rightButtonDown [quit]" Print #1.gb1, "setfocus;when characterInput [quit]" Print #1.gb1, "fill buttonface;flush" Print #1.gb1, "font times_new_roman 48 bold"
hDC=GetDC(hWnd(#1.gb1)) Call SetBkMode hDC, 1 Call ReleaseDC hWnd(#1.gb1),hDC Print #1.gb1,"drawbmp Snapshot 1 1" Print #1.gb1, "flush" X=Int(DisplayWidth/2) -300 Y=Int((DisplayHeight)/2)-25 'added by Kevin to for any string, and check string width '''''''''''''''''''''''''''''''''''' string$ = "Groooovy!" Prompt "enter your text";string$ #1.gb1, "stringwidth? string$ widthInPixels" incrementX = 1 incrementY = 2 '''''''''''''''''''''''''''''''''''' Timer 10,[changeColors] Wait [quit] UnloadBmp "Snapshot" Close #1 End
[changeColors] 'added by Kenny to for iradic movement '''''''''''''''''''''''''''''''''''' Iradic = Int(Rnd(1)*100)+ 1
Select Case Iradic Case 1 incrementX = incrementX * -1 Case 2 incrementY = incrementY *-1 End Select '''''''''''''''''''''''''''''''''''' 'added by Kevin for bouncing off the walls '''''''''''''''''''''''''''''''''''' If X > (WindowWidth - widthInPixels - incrementX) Then incrementX = (Int(Rnd(1)*3)+1)*-1 End If
If X < 0 Then incrementX = (Int(Rnd(1)*3+1)) End If
If Y > (WindowHeight - incrementY) Then incrementY = (Int(Rnd(1)*3)+1)*-1 End If
If Y < 48 Then incrementY = (Int(Rnd(1)*3)+1) End If
X = X + incrementX : Y = Y + incrementY ''''''''''''''''''''''''''''''''''''' 'tweeked by Kenny for throbbing colors ' increment rgb value up until maximum (255) is reached then ' decrement until minimum is reached If redForward=0 Then red=red+10 If red>=255 Then red=255:redForward=1 Else red=red-10 If red<1 Then red=1:redForward=0 End If
If greenForward=0 Then green=green+100 If green>255 Then green=255:greenForward=1 Else green=green-10 If green<1 Then green=1:greenForward=0 End If
If blueForward=0 Then blue=blue+5 If blue>=255 Then blue=255:blueForward=1 Else blue=blue-100 If blue<1 Then blue=1:blueForward=0 End If
Print #1.gb1, "discard" ' added by Kevin to keep the memory free Print #1.gb1, "color ";red;" ";green;" ";blue Print #1.gb1, "place ";X;" "; Y Print #1.gb1, "\";string$ Wait
Function createCompatibleBitmap(hdc,nWidth,nHeight) CallDLL #gdi32,"CreateCompatibleBitmap",_ hdc As long,_ 'the handle to the compatible DC nWidth As long,_ 'width of the bitmap nHeight As long,_ 'height of the bitmap createCompatibleBitmap As long 'the functions return is the handle to the compatible bitmap End Function
Function selectObject(hdc,hObject) CallDLL #gdi32,"SelectObject",_ hdc As long,_ 'handle of the compatible DC to select the compatible bitmap into hObject As long,_ 'handle of the compatible bitmap to select, or the handle to the selected bitmap to release selectObject As long End Function
Function createDC(lpDriverName$,lpDeviceName$,lpOutput$,lpInitData$) 'DC = device context CallDLL #gdi32, "CreateDCA",_ lpDriverName$ As ptr,_ 'this is the only parameter we use here, the rest are passed as null strings lpDeviceName$ As ptr,_ lpOutput$ As ptr,_ lpInitData$ As ptr,_ createDC As long 'this function returns the handle to the display DC that is created End Function
Function createCompatibleDC(hdc) CallDLL #gdi32,"CreateCompatibleDC",_ hdc As long,_ 'this is the handle to our display device context createCompatibleDC As long 'this function returns the handle of the compatible DC that is created End Function
Sub SetBkMode hDC, flag '1=transparent '2=opaque CallDLL #gdi32, "SetBkMode",hDC As long,_ flag As long, RESULT As long End Sub
Function GetDC(hWnd) CallDLL #user32, "GetDC",hWnd As long,_ GetDC As long End Function
Sub ReleaseDC hWnd, hDC CallDLL#user32,"ReleaseDC",hWnd As long,_ hDC As long,result As long End Sub
Sub deleteObject hObject CallDLL #gdi32,"DeleteObject",_ hObject As long,_ 'delete the selected object to free up resources ret As boolean End Sub
Sub deleteDC hdc CallDLL #gdi32,"DeleteDC",_ hdc As long,_ 'handle to dc used to free up resources when dc is no longer needed ret As boolean End Sub
Sub screenShot xOrgSrc,yOrgSrc,xExtent,yExtent 'x and y OrgSrc is the upperleft corner where our bitmap starts hdcScr=createDC("DISPLAY",null$(1),null$(1),null$(1)) 'we create a device context for the screen hdcCom=createCompatibleDC(hdcScr) 'then we create a compatible device context hbmScr=createCompatibleBitmap(hdcScr,xExtent,yExtent) 'then we need a compatible bitmap hmemBmp=selectObject(hdcCom,hbmScr) 'now we select the bitmap into the device context Call bitBlt hdcCom,0,0,xExtent,yExtent,hdcScr,xOrgSrc,yOrgSrc,_SRCCOPY 'here we copy the screen bit by bit into the device context hdcScr=selectObject(hdcCom,hmemBmp) 'we have to release the bitmap to use it in LB LoadBmp "Snapshot", hdcScr 'load the bitmap into LB Call deleteObject hmemBmp 'release resources to prepare for the next shot Call deleteDC hdcScr Call deleteDC hdcCom End Sub
Sub bitBlt hDestDC,x,y,nWidth,nHeight,hSrcDC,xSrc,ySrc,dwRop CallDLL #gdi32,"BitBlt",_ hDestDC As long,_ 'destination dc for the bit transfer x As long,_ 'x coordinate for upper left corner of destination y As long,_ 'y coordinate for upper left corner of destination nWidth As long,_ 'width of both source and destination nHeight As long,_ 'height of both source and destination hSrcDC As long,_ 'source dc for the bit transfer xSrc As long,_ 'x coordinate to begin bit transfer from source ySrc As long,_ 'y coordinate to begin bit transfer from source' dwRop As long,_ 'type of transfer (source copy, merge, etc.) ret As long End Sub
|
|
|
Post by Rod on May 4, 2020 14:01:16 GMT -5
Another less complicated version where the screen shot is grabbed then you have to box select the desired portion of the screen by leftclick drag and it is then displayed.
'from Liberty BASIC SnapShot by Ken Lewis, Sr. 'pause a little to let the Liberty BASIC compiling dialog disappear timer 200,[delay] wait [delay] timer 0
nomainwin
[getCaptureArea] WindowWidth=DisplayWidth WindowHeight=DisplayHeight 'take an initial screenshot of the whole desktop call screenShot 0,0,DisplayWidth,DisplayHeight graphicbox #1.gb,0,0,DisplayWidth,DisplayHeight Open "Motion Capture" For window_popup As #1 #1.gb "setfocus ; when characterInput [quit]" 'hDC=GetDC(hWnd(#1.gb)) 'Call SetBkMode hDC, 1 'Call ReleaseDC hWnd(#1.gb),hDC #1.gb "down ; drawbmp Snapshot -1 -1"
#1.gb "when leftButtonDown [startBox]" #1.gb "when leftButtonUp [endBox]" wait
[startBox] #1.gb "discard ; drawbmp Snapshot -1 -1"
startX = MouseX startY = MouseY wait
[endBox] #1.gb "color black" #1.gb "place "; startX; " "; startY #1.gb "box "; MouseX; " "; MouseY #1.gb "place "; startX; " "; startY #1.gb "box "; MouseX; " "; MouseY endY = MouseY endX = MouseX #1.gb "place ";startX;" ";startY-10;" ;\";startX;" ";startY;" - ";endX;" ";endY;" "
[accept] #1.gb "when leftButtonDown" #1.gb "when leftButtonUp" unloadbmp "Snapshot" call screenShot startX,startY,endX-startX,endY-startY #1.gb "cls ; drawbmp Snapshot 0 0" wait
hDC=GetDC(hWnd(#1.gb)) Call SetBkMode hDC, 1 Call ReleaseDC hWnd(#1.gb),hDC [quit] UnloadBmp "Snapshot" Close #1 End
Function createCompatibleBitmap(hdc,nWidth,nHeight) CallDLL #gdi32,"CreateCompatibleBitmap",_ hdc As ulong,_ 'the handle to the compatible DC nWidth As long,_ 'width of the bitmap nHeight As long,_ 'height of the bitmap createCompatibleBitmap As ulong 'the functions return is the handle to the compatible bitmap End Function
Function selectObject(hdc,hObject) CallDLL #gdi32,"SelectObject",_ hdc As ulong,_ 'handle of the compatible DC to select the compatible bitmap into hObject As ulong,_ 'handle of the compatible bitmap to select, or the handle to the selected bitmap to release selectObject As ulong End Function
Function createDC(lpDriverName$,lpDeviceName$,lpOutput$,lpInitData$) 'DC = device context CallDLL #gdi32, "CreateDCA",_ lpDriverName$ As ptr,_ 'this is the only parameter we use here, the rest are passed as null strings lpDeviceName$ As ptr,_ lpOutput$ As ptr,_ lpInitData$ As ptr,_ createDC As ulong 'this function returns the handle to the display DC that is created End Function
Function createCompatibleDC(hdc) CallDLL #gdi32,"CreateCompatibleDC",_ hdc As ulong,_ 'this is the handle to our display device context createCompatibleDC As ulong 'this function returns the handle of the compatible DC that is created End Function
Sub SetBkMode hDC, flag '1=transparent '2=opaque CallDLL #gdi32, "SetBkMode",hDC As ulong,_ flag As long, RESULT As long End Sub
Function GetDC(hWnd) CallDLL #user32, "GetDC",hWnd As ulong,_ GetDC As ulong End Function
Sub ReleaseDC hWnd, hDC CallDLL#user32,"ReleaseDC",hWnd As ulong,_ hDC As ulong,result As long End Sub
Sub deleteObject hObject CallDLL #gdi32,"DeleteObject",_ hObject As ulong,_ 'delete the selected object to free up resources ret As long End Sub
Sub deleteDC hdc CallDLL #gdi32,"DeleteDC",_ hdc As ulong,_ 'handle to dc used to free up resources when dc is no longer needed ret As long End Sub
Sub screenShot xOrgSrc,yOrgSrc,xExtent,yExtent 'x and y OrgSrc is the upperleft corner where our bitmap starts hdcScr=createDC("DISPLAY",null$(1),null$(1),null$(1)) 'we create a device context for the screen hdcCom=createCompatibleDC(hdcScr) 'then we create a compatible device context hbmScr=createCompatibleBitmap(hdcScr,xExtent,yExtent) 'then we need a compatible bitmap hmemBmp=selectObject(hdcCom,hbmScr) 'now we select the bitmap into the device context Call bitBlt hdcCom,0,0,xExtent,yExtent,hdcScr,xOrgSrc,yOrgSrc,_SRCCOPY 'here we copy the screen bit by bit into the device context hdcScr=selectObject(hdcCom,hmemBmp) 'we have to release the bitmap to use it in LB LoadBmp "Snapshot", hdcScr 'load the bitmap into LB Call deleteObject hmemBmp 'release resources to prepare for the next shot Call deleteDC hdcScr Call deleteDC hdcCom End Sub
Sub bitBlt hDestDC,x,y,nWidth,nHeight,hSrcDC,xSrc,ySrc,dwRop CallDLL #gdi32,"BitBlt",_ hDestDC As ulong,_ 'destination dc for the bit transfer x As long,_ 'x coordinate for upper left corner of destination y As long,_ 'y coordinate for upper left corner of destination nWidth As long,_ 'width of both source and destination nHeight As long,_ 'height of both source and destination hSrcDC As ulong,_ 'source dc for the bit transfer xSrc As long,_ 'x coordinate to begin bit transfer from source ySrc As long,_ 'y coordinate to begin bit transfer from source' dwRop As long,_ 'type of transfer (source copy, merge, etc.) ret As long End Sub
|
|
|
Post by Carl Gundel on May 4, 2020 15:46:33 GMT -5
Another less complicated version where the screen shot is grabbed then you have to box select the desired portion of the screen by leftclick drag and it is then displayed. Thanks Rod. Here is my repurposed version of it. This will grab any specified part of the screen, save it to a file and send it to the default printer. -Carl leftX = 1 leftY = 1 rightX = DisplayWidth rightY = DisplayHeight
call screenShot 1,1,DisplayWidth,DisplayHeight
bmpsave "Snapshot", "screenshot.bmp" confirm "Send to printer?"; conf$ if conf$ = "yes" then run "mspaint /pt screenshot.bmp" end
Sub screenShot xOrgSrc,yOrgSrc,xExtent,yExtent 'x and y OrgSrc is the upperleft corner where our bitmap starts hdcScr=createDC("DISPLAY",null$(1),null$(1),null$(1)) 'we create a device context for the screen hdcCom=createCompatibleDC(hdcScr) 'then we create a compatible device context hbmScr=createCompatibleBitmap(hdcScr,xExtent,yExtent) 'then we need a compatible bitmap hmemBmp=selectObject(hdcCom,hbmScr) 'now we select the bitmap into the device context Call bitBlt hdcCom,0,0,xExtent,yExtent,hdcScr,xOrgSrc,yOrgSrc,_SRCCOPY 'here we copy the screen bit by bit into the device context hdcScr=selectObject(hdcCom,hmemBmp) 'we have to release the bitmap to use it in LB LoadBmp "Snapshot", hdcScr 'load the bitmap into LB Call deleteObject hmemBmp 'release resources to prepare for the next shot Call deleteDC hdcScr Call deleteDC hdcCom End Sub
Sub bitBlt hDestDC,x,y,nWidth,nHeight,hSrcDC,xSrc,ySrc,dwRop CallDLL #gdi32,"BitBlt",_ hDestDC As ulong,_ 'destination dc for the bit transfer x As long,_ 'x coordinate for upper left corner of destination y As long,_ 'y coordinate for upper left corner of destination nWidth As long,_ 'width of both source and destination nHeight As long,_ 'height of both source and destination hSrcDC As ulong,_ 'source dc for the bit transfer xSrc As long,_ 'x coordinate to begin bit transfer from source ySrc As long,_ 'y coordinate to begin bit transfer from source' dwRop As long,_ 'type of transfer (source copy, merge, etc.) ret As long End Sub
Function createCompatibleBitmap(hdc,nWidth,nHeight) CallDLL #gdi32,"CreateCompatibleBitmap",_ hdc As ulong,_ 'the handle to the compatible DC nWidth As long,_ 'width of the bitmap nHeight As long,_ 'height of the bitmap createCompatibleBitmap As ulong 'the functions return is the handle to the compatible bitmap End Function
Function selectObject(hdc,hObject) CallDLL #gdi32,"SelectObject",_ hdc As ulong,_ 'handle of the compatible DC to select the compatible bitmap into hObject As ulong,_ 'handle of the compatible bitmap to select, or the handle to the selected bitmap to release selectObject As ulong End Function
Function createDC(lpDriverName$,lpDeviceName$,lpOutput$,lpInitData$) 'DC = device context CallDLL #gdi32, "CreateDCA",_ lpDriverName$ As ptr,_ 'this is the only parameter we use here, the rest are passed as null strings lpDeviceName$ As ptr,_ lpOutput$ As ptr,_ lpInitData$ As ptr,_ createDC As ulong 'this function returns the handle to the display DC that is created End Function
Function createCompatibleDC(hdc) CallDLL #gdi32,"CreateCompatibleDC",_ hdc As ulong,_ 'this is the handle to our display device context createCompatibleDC As ulong 'this function returns the handle of the compatible DC that is created End Function
Sub SetBkMode hDC, flag '1=transparent '2=opaque CallDLL #gdi32, "SetBkMode",hDC As ulong,_ flag As long, RESULT As long End Sub
Function GetDC(hWnd) CallDLL #user32, "GetDC",hWnd As ulong,_ GetDC As ulong End Function
Sub ReleaseDC hWnd, hDC CallDLL#user32,"ReleaseDC",hWnd As ulong,_ hDC As ulong,result As long End Sub
Sub deleteObject hObject CallDLL #gdi32,"DeleteObject",_ hObject As ulong,_ 'delete the selected object to free up resources ret As long End Sub
Sub deleteDC hdc CallDLL #gdi32,"DeleteDC",_ hdc As ulong,_ 'handle to dc used to free up resources when dc is no longer needed ret As long End Sub
|
|
|
Post by Rod on May 5, 2020 3:39:29 GMT -5
Cool, this is it distilled down to absolute essentials.
nomainwin WindowWidth = 800 WindowHeight = 600 UpperLeftX=int((DisplayWidth-WindowWidth)/2) UpperLeftY=int((DisplayHeight-WindowHeight)/2) open "Snap" for graphics as #g #g "down ; fill black ;trapclose [quit]"
x=0 y=0 w=100 h=100
loadbmp "snap",screenShot(x,y,w,h) 'loads desired screen area as bmp #g "drawbmp snap 0 0" wait
[quit] close #g end
function screenShot(x,y,w,h) n$=chr$(0) CallDLL #gdi32,"CreateDCA","DISPLAY" As ptr,n$ As ptr,n$ As ptr,n$ As ptr,scrDC As ulong CallDLL #gdi32,"CreateCompatibleDC",scrDC As ulong,comDC As ulong
CallDLL #gdi32,"CreateCompatibleBitmap",scrDC As ulong,w As long,h As long, bmp As ulong CallDLL #gdi32,"SelectObject",comDC As ulong, bmp As ulong, mbmp As ulong CallDLL #gdi32,"BitBlt",comDC As ulong,0 As long,0 As long,w As long,h As long,_ scrDC As ulong,x As long,y As long,_SRCCOPY As long,ret As long CallDLL #gdi32,"SelectObject",comDC As ulong, mbmp As ulong, screenShot As ulong CallDLL #gdi32,"DeleteObject",mbmp As ulong,ret As long CallDLL #gdi32,"DeleteDC",scrDC As ulong,ret As long CallDLL #gdi32,"DeleteDC",comDC As ulong,ret As long end function
|
|