|
|
Post by Walt Decker on Dec 9, 2022 14:56:06 GMT -5
There is a routine to capture anything in the "Liberty BASIC code" thread in one of the "Share your snippets" topics. As for printing the image to a printer, I am not sure LB can do that.
PS: If you can not find it, I have the code available.
|
|
|
|
Post by Walt Decker on Dec 9, 2022 15:17:06 GMT -5
Here it is:
'
VK.LBUTTON = 01 '<--- left mouse button
VK.RBUTTON = 02 '<--- right mouse button
OPEN "User32.DLL" FOR DLL AS #USER
OPEN "Gdi32.DLL" FOR DLL AS #GDI
RetVal = 0 '<--- dummy varb
DktHndl = FN.DeskTop() '<--- desktop(monitor) handle
DktDc = FN.GetDc(DktHndl) '<--- desktop device context
DktCmDc = 0 '<--- private device context
MemBmp = 0 '<--- DIB memory bitmap handle
OldBmp = 0 '<--- Original memory bitmap handle
WinTag$ = ""
CRLF$ = CHR$(13) + CHR$(10)
Msg$ = "1. Minimize WINMAIN" + CRLF$
Msg$ = Msg$ + "2. Minimize the LB IDE" + CRLF$
Msg$ = Msg$ + "3. Right mouse click anywhere on the screen" + CRLF$
Msg$ = Msg$ + "4. Left click and drag the rectangle to the end of the CAPTURE"
Msg$ = Msg$ + "capture rectangle" + CRLF$
Msg$ = Msg$ + "5. Release the left mouse button" + CRLF$ + CRLF$
Msg$ = Msg$ + "NOTE: Be careful not to click on one of the desktop icons"
RetVal = FN.MsgBox("INSTRUCTIONS", Msg$)
[BEGIN.WAIT]
TIMER 100, [GET.VK.CODE]
[END.WAIT]
WAIT
END
'-----------------------------------------------------
'-----------------------------------------------------
[GET.VK.CODE]
BmpWide = 0 '<--- width and height of capture area
BmpHigh = 0
Key = 0 '<--- return value from FN.KeyState
Key = FN.KeyState(VK.RBUTTON) '<--- get left mouse button state
IF Key THEN
TIMER 0
RetVal = FN.RubberRect(DktDc, Ulx, Uly, Brx, Bry) '<--- draw a rectangle
'on the monitor
RetVal = FN.SwapIf(Ulx, Brx) '<--- swap rect coord if necessary
RetVal = FN.SwapIf(Uly, Bry)
BmpWide = Brx - Ulx + 1 '<--- size of memory bitmap
BmpHigh = Bry - Uly + 1
MemBmp = FN.CreateDIB(BmpWide, BmpHigh) '<--- create memory DIB bitmap
DktCmDc = FN.CompatDc(DktDc) '<--- get a private device context
OldBmp = FN.AttachObj(DktCmDc, MemBmp) '<--- make DIB active
RetVal = FN.Blt(DktCmDc, 0, 0, BmpWide, BmpHigh, DktDc, Ulx, Uly) '<--- fill it
OldBmp = FN.AttachObj(DktCmDc, OldBmp) '<--- deactivate the DIB
DktDc = FN.DetachDc(DktHndl, DktDc) '<--- release the desktop context
DktCmDc = FN.KillDc(DktCmDc) '<--- destroy the private context
BmpWide = BmpWide - 1 '<--- size of graphic control
BmpHigh = BmpHigh - 1
GfxTag$ = FN.MakeWindow$(BmpWide, BmpHigh, WinTag$) '<--- make display surface
TIMER 100, [SHOW]
WAIT
[SHOW]
TIMER 0
LOADBMP "DIB", MemBmp '<--- pass the DIB bitmap to LB
PRINT #GfxTag$, "drawbmp DIB 0 0"
PRINT #GfxTag$, "flush"
PRINT #GfxTag$, "discard"
BMPSAVE "DIB", "DESIGNER.BMP"
UNLOADBMP "DIB"
GOTO [END.WAIT]
END IF
GOTO [BEGIN.WAIT]
[END.VK.CODE]
'-----------------------------------------------------
'-----------------------------------------------------
SUB CLOSE.WIN WinHndl$
CLOSE #USER
CLOSE #GDI
CLOSE #WinHndl$
END
END SUB
'-----------------------------------------------------
'-----------------------------------------------------
FUNCTION FN.MakeWindow$(BmWide, BmHigh, BYREF Tag$)
WS.EX.TOPMOST = HEXDEC("&H00000008")
Tag$ = "#CAP"
GfxHndl = 0
GRAPHICBOX #CAP.GFX, 5, 5, BmWide, BmHigh
STYLEBITS #CAP, 0, 0, WS.EX.TOPMOST, 0
UpperLeftX = 50
UpperLeftY = 50
WindowWidth = BmWide + 26
WindowHeight = BmHigh + 48
OPEN "CAPTURE" FOR WINDOW AS #CAP
PRINT #CAP, "TRAPCLOSE CLOSE.WIN"
PRINT #CAP.GFX, "LOCATE 5 5 ";BmWide;" ";BmHigh
PRINT #CAP, "REFRESH"
FN.MakeWindow$ = "#CAP.GFX"
END FUNCTION
'-----------------------------------------------------
'-----------------------------------------------------
FUNCTION FN.SetMemBmp(Tag$, MemHndl)
LOADBMP Tag$, MemHndl
BmpHndl = HBMP(Tag$)
END FUNCTION
'-----------------------------------------------------
'-----------------------------------------------------
FUNCTION FN.RenderMemBmp(GfxTag$, MemTag$, StrtX, StrtY)
PRINT #GfxTag$, "drawbmp ";MemTag$;" ";StrtX;" ";StrtY
PRINT #GfxTag$, "flush"
END FUNCTION
'-----------------------------------------------------
'-----------------------------------------------------
FUNCTION FN.DeskTop()
'######################################################################
' Get a handle to the monitor
'######################################################################
DtHndl = 0
CALLDLL #USER, "GetDesktopWindow", DtHndl AS ULONG
FN.DeskTop = DtHndl
END FUNCTION
'---------------------------------------------------------------
'---------------------------------------------------------------
FUNCTION FN.GetDc(WinHndl)
'######################################################################
' Get a context from MSWIN for the device (form window, control,
' printer, audio, external device).
'######################################################################
WinDc = 0
CALLDLL #USER, "GetDC", WinHndl AS ULONG, WinDc AS ULONG
FN.GetDc = WinDc
END FUNCTION
'---------------------------------------------------------------
'---------------------------------------------------------------
FUNCTION FN.CompatDc(WinDc)
'######################################################################
' Create a context compatible with a device.
'
' ARGUMENTS:
' WinDc: Device context.
' Do NOT use user32.dll ReleaseDC(), use gdi32.DLL
' DeleteDC() instead.
'######################################################################
ComPatDc = 0
CALLDLL #GDI, "CreateCompatibleDC", WinDc AS ULONG, ComPatDc AS ULONG
FN.CompatDc = ComPatDc
END FUNCTION
'-------------------------------------------------------------------
'-------------------------------------------------------------------
'-------------------------------------------------------------------
'-------------------------------------------------------------------
FUNCTION FN.CompatBmp(CmPatDc, BmWide, BmHigh)
BmHndl = 0
CALLDLL #GDI, "CreateCompatibleBitmap", CmPatDc AS ULONG, BmWide AS LONG, _
BmHigh AS LONG, BmHndl AS ULONG
FN.CompatBmp = BmHndl
END FUNCTION
'-------------------------------------------------------------------
'-------------------------------------------------------------------
FUNCTION FN.CreateDIB(BmWide, BmHigh)
'##############################################################
' Create a device independant bit map. The bitmap data will
' be in the form of blue, green, red instead of red, green
' blue.
'
' ARGUMENTS:
' BmpWide: Size of the bitmap
' BmpHigh:
'##############################################################
BI.RGB = 0 '<--- type codes
DIB.RGB.COLORS = 0
STRUCT tBmInfo, _ '<--- bitmap information structure
StrSize AS ULONG, _ '<--- size of structure
Width AS LONG, _ '<--- width of bitmap
Height AS LONG, _ '<--- height of bitmap
Planes AS SHORT, _ '<--- number of color planes
BitCount AS SHORT, _ '<--- number of bits to define colors
Compression AS ULONG, _ '<--- type of compression
SizeImage AS ULONG, _ '<--- size of image
XPelsPerMeter AS LONG, _ '<--- number of pixels per meter
YPelsPerMeter AS LONG, _
ClrUsed AS ULONG, _ '<--- number of colors in the bitmap
ClrImportant AS ULONG, _ '<--- important colors
Colors AS ULONG '<--- array of color in BRG format
RetVal = 0
BmpHndl = 0
DispHndl = FN.DeskTop() '<--- get a handle to the desktop window
DispDc = FN.GetDc(DispHndl) '<--- get a device context for desktop
Tmpdc = FN.CompatDc(DispDc) '<--- create a compatible context
RetVal = FN.DetachDc(DispHndl, DispDc) '<--- release the desktop context
tBmInfo.StrSize.struct = LEN(tBmInfo.struct)
tBmInfo.Width.struct = BmWide
tBmInfo.Height.struct = -1 * BmHigh '<--- top-down instead of bottom up
tBmInfo.Planes.struct = 1
tBmInfo.BitCount.struct = 32
tBmInfo.Compression.struct = BI.RGB
CALLDLL #GDI, "CreateDIBSection", Tmpdc AS ULONG, tBmInfo AS STRUCT, _
DIB.RGB.COLORS AS LONG, 0 AS LONG, 0 AS LONG, 0 AS LONG, _
BmpHndl AS ULONG
RetVal = FN.KillDc(Tmpdc)
FN.CreateDIB = BmpHndl
END FUNCTION
'--------------------------------------------------------------
'--------------------------------------------------------------
FUNCTION FN.KillDc(WinDc)
'############################################################
' Destroy a device context and release WIN resources
'
' ARGUMENTS:
' WinDc: Device context to destroy.
' Do NOT use this function to destroy a device
' context obtained with the GetDC() function.
'############################################################
RetVal = 0
CALLDLL #GDI, "DeleteDC", WinDc AS ULONG, RetVal AS VOID
END FUNCTION
'-----------------------------------------------------------------
'-----------------------------------------------------------------
FUNCTION FN.DetachDc(WinHndl, WinDc)
'######################################################################
' Release a device context and its resources
'
' ARGUMENTS:
' WinHndl: The handle of a form window or control.
' WinDc: Device context obtained from GetDc().
'######################################################################
RetVal = 0
CALLDLL #USER, "ReleaseDC", WinHndl AS ULONG, WinDc AS ULONG, RetVal AS VOID
END FUNCTION
'---------------------------------------------------------------
'---------------------------------------------------------------
FUNCTION FN.AttachObj(WinDc, ThisObject)
'######################################################################
' Make an object (pen, brush, font, bitmap) active.
'
' ARGUMENTS:
' WinDc: Device context handle
' ThisObject: Object to make active.
'######################################################################
OrgObj = 0
CALLDLL #GDI, "SelectObject", WinDc AS ULONG, ThisObject AS ULONG, _
OrgObj AS ULONG
FN.AttachObj = OrgObj
END FUNCTION
'---------------------------------------------------------------
'---------------------------------------------------------------
FUNCTION FN.KillObj(ThisObj)
'######################################################################
' Destroy an object (brush, pen, font) and release its resources
'######################################################################
DeadObj = 0
CALLDLL #GDI, "DeleteObject", ThisObj AS ULONG, DeadObj AS VOID
END FUNCTION
'---------------------------------------------------------------
'---------------------------------------------------------------
FUNCTION FN.GetHandle(WinTag$)
'###########################################################
' Return the numeric handle of a Liberty Basic form window
' or control.
' ARGUMENTS:
' WinTag$: Form window tag or control tag.
' EXAMPLE: #1, #1.TXB, #1.GFX
'###########################################################
Hndl = 0 '<--- numeric handle returned from LB's HWND() function
'<------------------ check for proper syntax --------------->
'IF LEFT$(WinTag$, 1) <> "#" THEN WinTag$ = "#" + WinTag$
WinTag$ = FN.CheckTag$(WinTag$)
Hndl = HWND(#WinTag$) '<--- get numeric handle
FN.GetHandle = Hndl '<--- return handle
END FUNCTION
'---------------------------------------------------------------------
'---------------------------------------------------------------------
FUNCTION FN.CheckTag$(Tag$)
IF LEFT$(Tag$, 1) <> "#" THEN Tag$ = "#" + Tag$
FN.CheckTag$ = Tag$
END FUNCTION
'---------------------------------------------------------------------
'---------------------------------------------------------------------
FUNCTION FN.Rop2(WinDc, OpCode)
'##################################################
' Sets drawing mode for pens and filled objects
' ARGUMENTES:
' WinDc: Object device context
' OpCode: Raster index number
'##################################################
OrgCode = 0
CALLDLL #GDI, "SetROP2", WinDc AS ULONG, OpCode AS LONG, OrgCode AS LONG
FN.Rop2 = OrgCode
END FUNCTION
'-------------------------------------------------------------
'-------------------------------------------------------------
FUNCTION FN.StockObj(ThisObj)
'##############################################################
' Obtain an object from MS Windows' standard objects
' ARGUMENTS:
' ThisObj: Index to the object
'##############################################################
ObjHndl = 0
CALLDLL #GDI, "GetStockObject", ThisObj AS LONG, ObjHndl AS ULONG
FN.StockObj = ObjHndl
END FUNCTION
'-------------------------------------------------------------
'-------------------------------------------------------------
FUNCTION FN.KeyState(Vkey)
'################################################################
' Determine whether Vkey is pressed
'################################################################
VK.SHIFT = HEXDEC("&H10") '<--- keyboard shift key
VK.CONTROL = HEXDEC("&H11") '<--- keyboard control key
KeyPressed = 0
Value = 0
Mask = HEXDEC("&H8000") '<--- value used to determine if the
'pressed bit is set
'<--- the following checks to see if 2 keys are pressed at the same time --->
CALLDLL #USER, "GetAsyncKeyState", VK.SHIFT AS LONG, KeyPressed AS SHORT
IF KeyPressed AND Mask THEN
CALLDLL #USER, "GetAsyncKeyState", Vkey AS LONG, KeyPressed AS SHORT
IF KeyPressed AND Mask THEN
FN.KeyState = 2
EXIT FUNCTION
END IF
END IF
CALLDLL #USER, "GetAsyncKeyState", VK.CONTROL AS LONG, KeyPressed AS SHORT
IF KeyPressed AND Mask THEN
CALLDLL #USER, "GetAsyncKeyState", Vkey AS LONG, KeyPressed AS SHORT
IF KeyPressed AND Mask THEN
FN.KeyState = 2
EXIT FUNCTION
END IF
END IF
'<--- only the Vkey parameter is pressed ----------->
CALLDLL #USER, "GetAsyncKeyState", Vkey AS LONG, KeyPressed AS SHORT
IF KeyPressed AND Mask THEN FN.KeyState = 1
END FUNCTION
'------------------------------------------------------------------
'------------------------------------------------------------------
FUNCTION FN.CursorPos(BYREF Cpx, BYREF Cpy)
'################################################################
' Retrieve the position of the mouse cursor. The position is
' in screen coordinates.
'################################################################
STRUCT tPnt, _
X AS LONG, _
Y AS LONG
RetVal = 0
CALLDLL #USER, "GetCursorPos", tPnt AS STRUCT, RetVal AS VOID
Cpx = tPnt.X.struct
Cpy = tPnt.Y.struct
END FUNCTION
'------------------------------------------------------------------
'------------------------------------------------------------------
FUNCTION FN.RubberRect(WinDc, BYREF Ux, BYREF Uy, BYREF Bx, BYREF By)
HOLLOW.BRUSH = 5 '<--- index for system objects
WHITE.PEN = 6
R2.COPYPEN = 13
R2.XORPEN = 7
VK.LBUTTON = 01
RetVal = 0
OldMode = 0
OldBrsh = 0
OldPen = 0
Brsh = 0
Pen = 0
Key = 0
Cpx = -5000
Cpy = -5000
Brsh = FN.StockObj(HOLLOW.BRUSH)
Pen = FN.StockObj(WHITE.PEN)
OldBrsh = FN.AttachObj(WinDc, Brsh)
OldPen = FN.AttachObj(WinDc, Pen)
[GET.KEY]
Key = FN.KeyState(VK.LBUTTON)
IF Key = 0 THEN GOTO [GET.KEY]
RetVal = FN.CursorPos(Cpx, Cpy)
Ux = Cpx
Uy = Cpy
OldMode = FN.Rop2(WinDc, R2.XORPEN)
OPEN "Kernel32.dll" FOR DLL AS #KERN
[NXT.POINT]
Key = FN.KeyState(VK.LBUTTON)
IF Key = 0 THEN GOTO [FINAL.POINT]
RetVal = FN.CursorPos(Cpx, Cpy)
CALLDLL #GDI, "Rectangle", WinDc AS ULONG, Ux AS LONG, Uy AS LONG, _
Cpx AS LONG, Cpy AS LONG, RetVal AS VOID
CALLDLL #KERN, "Sleep", 10 AS LONG, RetVal AS VOID
CALLDLL #GDI, "Rectangle", WinDc AS ULONG, Ux AS LONG, Uy AS LONG, _
Cpx AS LONG, Cpy AS LONG, RetVal AS VOID
GOTO [NXT.POINT]
[FINAL.POINT]
CLOSE #KERN
OldMode = FN.Rop2(WinDc, R2.COPYPEN)
OldBrsh = FN.AttachObj(WinDc, OldBrsh)
OldPen = FN.AttachObj(WinDc, OldPen)
Bx = Cpx
By = Cpy
RetVal = FN.SwapIf(Ux, Bx)
RetVal = FN.SwapIf(Uy, By)
END FUNCTION
'------------------------------------------------------------------
'------------------------------------------------------------------
FUNCTION FN.SwapIf(BYREF Pnt0, BYREF Pnt1)
TmpVal = 0
IF Pnt0 > Pnt1 THEN
TmpVal = Pnt0
Pnt0 = Pnt1
Pnt1 = TmpVal
END IF
FN.SwapIf = TmpVal
END FUNCTION
'------------------------------------------------------------------
'------------------------------------------------------------------
FUNCTION FN.Blt(DestDc, Dx, Dy, Wide, High, SrcDc, Sx, Sy)
'###################################################################
' Display a memory bitmap on a form window or control OR
' place a memory bitmap on another memory bitmap.
'
' ARGUMENTS:
' DestDc: Device context that receives the memory bitmap
' Dx, Dy: Where the memory bitmap will be placed
' Wide: How much of the receiving DC will be covered
' High:
' SrcDc: Device context that supplies the image
' Sx, Sy: Coordinate from which to draw the image.
' Drawing will start here and continue until
' the destination size is filled or the size
' of the source is reached.
'####################################################################
SRCCOPY = HEXDEC("&H00CC0020") '<--- raster operation code
RetVal = 0
CALLDLL #GDI, "BitBlt", DestDc AS ULONG, Dx AS LONG, Dy AS LONG, _
Wide AS LONG, High AS LONG, SrcDc AS ULONG, _
Sx AS LONG, Sy AS LONG, SRCCOPY AS ULONG, RetVal AS LONG
FN.Blt = RetVal
END FUNCTION
'-------------------------------------------------------------
'-------------------------------------------------------------
FUNCTION FN.MsgBox(Title$, Msg$)
MB.OK = HEXDEC("&h00000000")
MB.ICONINFORMATION = HEXDEC("&h00000040")
MB.DEFBUTTON1 = HEXDEC("&h00000000")
MB.SYSTEMMODAL = HEXDEC("&h00001000")
MB.TASKMODAL = HEXDEC("&h00002000")
MB.SETFOREGROUND = HEXDEC("&h00010000")
MB.TOPMOST = HEXDEC("&h00040000")
Style = MB.OK OR MB.DEFBUTTON1 OR MB.TASKMODAL OR MB.SETFOREGROUND OR _
MB.TOPMOST OR MB.ICONINFORMATION
CALLDLL #USER, "MessageBoxA", 0 AS ULONG, Msg$ AS PTR, Title$ AS PTR, _
Style AS ULONG, RetVal AS VOID
END FUNCTION
'
|
|
|
|
Post by Rod on Dec 10, 2022 16:12:53 GMT -5
Since you capture and drawbmp back into Liberty you will find that there is a very easy and powerful PRINT SIZE graphics command. This will take any size graphic and scale it to exactly whatever size you want printed. 5000 pixel image printed 100 dots wide or 100 pixels printed 5000 dots wide. SIZE defines how many pixels fill the printed page. So a 100 pixel image can fill the printed page at low resolution or 5000 pixels can fill the printed page at high resolution.
Printform.bas ships with Liberty and shows how it is done.
|
|
