|
|
Post by ppro06 on Aug 13, 2020 5:49:06 GMT -5
test.bmp (18.8 KB) Hello All, I am trying to transfer a bitmap image into a printer DC for printing . I have invoked all the function calls I think are necessary and they return the correct values but I still can't see the image  . Please have a look I must be missing something. 'nomainwin
'hMemDC = _NULL: hBMP = _NULL
Global lpbitmap, hMemDC, hBMP, hOldBMP, hDiB, imageW, imageH, pDC, BitsPixel, NumColors, xResolution, yResolution
imageWidth = 0: imageHeight = 0
Struct doubleWord, a as Ulong
Struct ImageInfo, imgType as long, imgWidth as long, _
imgHeight as long, imgWidthBytes as long, _
imgPlanes as word, imgBitsPixel as word, imgBits as long
struct bih, biSize as Ulong, biWidth as long, biHeight as long, biPlanes as word,_
biBitCount as word, biCompression as Ulong, biSizeImage as Ulong,_
biXPelsPerMeter as long, biYPelsPerMeter as long, biClrUsed as Ulong,_
biClrImportant as Ulong
struct bmiColors, rgbBlue as Ushort, rgbGreen as Ushort, rgbRed as Ushort, rgbReserved as Ushort
struct bi, bih as struct, bmiColors as struct
WindowWidth = 570: WindowHeight = 130
UpperLeftX = Int((DisplayWidth - WindowWidth) / 2): UpperLeftY = Int((DisplayHeight - WindowHeight) / 2)
Stylebits #blt.g, 0, _WS_BORDER, 0, 0: Graphicbox #blt.g, 0, 0, 569, 129
Open "Printer Bitmap" for Window_nf as #blt
#blt "Trapclose [ClearBMP]": #blt "Font Verdana 10 Bold"
hMain = hWnd(#blt): hG = hWnd(#blt.g)
#blt.g "Down": imagePathFile$ = ""+defaultdir$+"\test.bmp" 'change path
hImage = LoadImgFromFile(imagePathFile$)
' Get the bitmap information using GetObjectA
imageDimen$ = ImageDimensions$(hImage)
imageW = Val(Word$(imageDimen$, 1, Chr$(0)))
imageH = Val(Word$(imageDimen$, 2, Chr$(0)))
' Load the bitmap in memory
loadbmp "Bizlh", hImage
#blt.g "Drawbmp Bizlh 10 10; Flush": #blt.g "Locate 0 0 "; imageW + 20;" "; imageH + 20: #blt "Refresh"
hBMP = GboxDC(hG)
gosub [PrinterGo]
hFont = CreateFont("Arial", 0, Int(ydpi*.12), 0, 0, 0, 0): hPen = CreatePen(0, 0, 200, _PS_SOLID, Int(xdpi*.01)): hBrush = CreateSolidBrush(255, 255, 255)
'set modes
Call SetTextColor pDC, 0, 0, 0: Call SetBkMode pDC, _TRANSPARENT
'select objects into device context
hOldPen = SelectObject(pDC, hPen): hOldBrush = SelectObject(pDC, hBrush): hOldFont = SelectObject(pDC, hFont)
'drawBMP = ImportBMP(pDC, xdpi, ydpi, Int(xdpi*6.4), Int(ydpi*.77), hMemDC, 0, 0, 543, 85, _SRCCOPY)
ret = SetROP2(pDC, _R2_COPYPEN): ret = CreateRectRgn(xdpi, ydpi, Int(xdpi*6.5), Int(ydpi*.78))
nScans = StretchDIBits(pDC, xdpi, ydpi, Int(xdpi*6.4), Int(ydpi*.77))
Call Rectangle pDC, xdpi, ydpi, Int(xdpi*7.4), Int(ydpi*1.8)
t$ = "Liberty Basic": Call TextOut pDC, Int(xdpi*6.73), Int(ydpi*2.31), t$
gosub [ClearPrint]
[PrinterGo]
pDC = PrinterDialogDC(): ret = StartDoc(pDC): ret = StartPage(pDC)
xdpi = Logpixelsx(pDC): ydpi = Logpixelsy(pDC): nColorBits = BitsPixel(pDC)
Horzres = Horzres(pDC): Vertres = Vertres(pDC)
return
[ClearPrint]
'end and clean up
print GlobalUnlock(hDIB): print GlobalFree(hDIB)
ret = EndPage(pDC): ret = EndDoc(pDC): hBMP = SelectObject(hMemDC, hOldBMP)
Call DeleteObject hPen: Call DeleteObject hBrush: Call DeleteObject hFont
Call DeleteObject gbDC: Call DeleteObject hMemDC: Call DeleteObject hBMP
Call DeleteDC pDC
[ClearBMP]
unloadbmp "Bizlh"
Close #blt
[Quit]
'ret = ReleaseDC(hMain)
End
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Function BitsPixel(pDC)
CallDLL #gdi32, "GetDeviceCaps", pDC As long,_
_BITSPIXEL As long, BitsPixel As long
print "ColorBits -"; BitsPixel
CallDLL #gdi32, "GetDeviceCaps", pDC As long,_
_NUMCOLORS As long, NumColors As long
print "NumColors - "; NumColors
End Function
Function Horzres(pDC) 'printable width of page in dots
CallDLL #gdi32, "GetDeviceCaps",pDC As Long, _
_HORZRES As long, Horzres As long
CallDLL #gdi32, "GetDeviceCaps",pDC As Long, _
_HORZSIZE As long, Horzsize As long
xResolution = Horzres/Horzsize
print "Horizontal res - ";xResolution
End Function
Function Vertres(pDC) 'printable height of page in dots
CallDLL #gdi32, "GetDeviceCaps", pDC As long, _
_VERTRES As long, Vertres As long
CallDLL #gdi32, "GetDeviceCaps", pDC As long, _
_VERTSIZE As long, Vertsize As long
yResolution = Vertres/Vertsize
print "Vertical res - ";yResolution
End Function
Function Logpixelsx(pDC) 'dots per inch width
CallDLL #gdi32, "GetDeviceCaps", pDC As long, _
_LOGPIXELSX As long, Logpixelsx As long
End Function
Function Logpixelsy(pDC) 'dots per inch height
CallDLL #gdi32, "GetDeviceCaps", pDC As long, _
_LOGPIXELSY As long, Logpixelsy As long
End Function
Function PhysicalWidth(pDC) 'actual paper width
CallDLL #gdi, "GetDeviceCaps", pDC As long, _
_PHYSICALWIDTH As long, PhysicalWidth As long
End Function
Function PhysicalHeight(pDC) 'actual paper height
CallDLL #gdi32, "GetDeviceCaps", pDC As long, _
_PHYSICALHEIGHT As long, PhysicalHeight As long
End Function
Function PhysicalOffsetx(pDC) 'left unprintable margin in dots per inch
CallDLL #gdi32, "GetDeviceCaps", pDC As long, _
_PHYSICALOFFSETX As long, PhysicalOffsetx As long
End Function
Function PhysicalOffsety(pDC) 'top unprintable margin in dots per inch
CallDLL #gdi32, "GetDeviceCaps", pDC As long, _
_PHYSICALOFFSETY As long, PhysicalOffsety As long
End Function
Function EndDoc(pDC) 'end document print
CallDLL #gdi32, "EndDoc",pDC As long,_
EndDoc As long
End Function
Function EndPage(pDC) 'end page/eject
CallDLL #gdi32, "EndPage",pDC As long,_
EndPage As long
End Function
Function StartPage(pDC) 'start new page
CallDLL #gdi32, "StartPage",pDC As long,_
StartPage As long
End Function
Function StartDoc(pDC) 'start document print
struct docInfo, _
cbSize As long,_
lpszDocName$ As Ptr,_
lpszOutput$ As Ptr,_
lpszDatatype$ As Ptr,_
fwType As Ulong
docInfo.cbSize.struct=Len(docInfo.struct)
docInfo.lpszDocName$.struct = "Printer Test"+Chr$(0)
CallDLL #gdi32, "StartDocA",pDC As long,_
docInfo As struct, StartDoc As long
End Function
Function PrinterDialogDC() 'printer dialog returns DC
struct PD,lStructSize As Ulong,_
hwndOwner As long,hDevMode As long,_
hDevNames As long,hDC As long,_
Flags As Ulong,nFromPage As Word,_
nToPage As Word,nMinPage As Word,_
nMaxPage As Word,nCopies As Word,_
hInstance As long,lCustData As Ulong,_
lpfnPrintHook As long,lpfnSetupHook As long,_
lpPrintTemplateName As long,lpSetupTemplateName As long,_
hPrintTemplate As long,hSetupTemplate As long
PD.Flags.struct=_PD_RETURNDC
PD.lStructSize.struct=Len(PD.struct)
CallDLL #comdlg32, "PrintDlgA",PD As struct, r As long
PrinterDialogDC=PD.hDC.struct
End Function
Function PrinterDefaultDC() 'default printer, returns DC
'setup values for GetProfileStringA
appName$ = "windows"
keyName$ = "device"
default$ = ""
result$ = Space$(49)+Chr$(0)
size = 50
'get printer and driver info
CallDLL #kernel32, "GetProfileStringA",_
appName$ As Ptr,keyName$ As Ptr,default$ As Ptr,result$ As Ptr,_
size As long,result As long
profile$ = Left$(result$, Instr(result$, Chr$(0)) - 1)
'parse returned string for individual members
j = Instr(profile$, ",", 1)
PrtName$ = Left$(profile$, j-1)
j = j + 1
k = Instr(profile$, ",", j)
Driver$ = Mid$(profile$, j, k-j)
Output$ = Right$(profile$, Len(profile$)-k)
Init = 0
'use driver info to create a Device context for printer
CallDLL #gdi32 , "CreateDCA", _
Driver$ as Ptr,PrtName$ as Ptr,Output$ as Ptr, _
Init as long, PrinterDefaultDC as long
PrinterDefaultDC = pDC
End Function
Sub DeleteDC hDC
CallDLL #gdi32, "DeleteDC", hDC as long, r as Boolean
End Sub
Sub Arc hDC,x1,y1,x2,y2,x3,y3,x4,y4
CallDLL #gdi32, "Arc",hDC as long,x1 as long,y1 as long,x2 as long,y2 as long,_
x3 as long,y3 as long,x4 as long,y4 as long,results as Boolean
End Sub
Sub Chord hDC,x1,y1,x2,y2,x3,y3,x4,y4
CallDLL #gdi32, "Chord",hDC as long,x1 as long,y1 as long,x2 as long,y2 as long,_
x3 as long,y3 as long,x4 as long,y4 as long,results as Boolean
End Sub
Sub Pie hDC,x1,y1,x2,y2,x3,y3,x4,y4
CallDLL #gdi32, "Pie",hDC as long,x1 as long,y1 as long,x2 as long,y2 as long,_
x3 as long,y3 as long,x4 as long,y4 as long,results as Boolean
End Sub
Sub Rectangle hDC,x1,y1,x2,y2
CallDLL #gdi32, "Rectangle",_
hDC as long, x1 as long, y1 as long,_
x2 as long, y2 as long, r as Boolean
End Sub
Sub RoundRect hDC,x1,y1,x2,y2
x3=Int(Abs(x1-x2)/3)
y3=Int(Abs(y1-y2)/3)
CallDLL #gdi32, "RoundRect",_
hDC as long, x1 as long, y1 as long,_
x2 as long, y2 as long, x3 as long, y3 as long,r as Boolean
End Sub
Sub Ellipse hDC,x1,y1,x2,y2
CallDLL #gdi32, "Ellipse",_
hDC as long, x1 as long, y1 as long,_
x2 as long, y2 as long, r as Boolean
End Sub
Sub DrawLine hDC,x1,y1,x2,y2
struct P,x as long, y as long
CallDLL #gdi32, "MoveToEx",hDC as long,x1 as long,y1 as long,P as struct,r as Boolean
CallDLL #gdi32, "LineTo",hDC as long,x2 as long,y2 as long,r as Boolean
End Sub
Sub TextOut hDC,x,y, t$
ln=Len(t$)
CallDLL #gdi32, "TextOutA",hDC as long,_
x as long,y as long, t$ as Ptr,_
ln as long, r as long
End Sub
Sub SetTextColor hDC,red,green,blue
crColor=red+(green*256)+(blue*256*256)
CallDLL #gdi32, "SetTextColor",hDC as long,crColor as long,result as long
End Sub
Sub SetBkMode hDC, flag 'set background mode for text printing
'1=transparent
'2=opaque
CallDLL #gdi32, "SetBkMode", hDC as long, flag as long, RESULT as long
End Sub
Function CreateRectRgn(x1, y1, x2, y2)
CallDLL #gdi32, "CreateRectRgn",x1 as long, y1 as long, x2 as long, y2 as long, ret as long
print ret
End Function
Function SetROP2(hDC, rop2)
CallDll #gdi32, "SetROP2", hDC as Ulong, rop2 as long, ret as long
setrop = ret: print setrop
End Function
Function SelectObject(hDC, hObject)
CallDLL #gdi32,"SelectObject", hDC as long, hObject as long, SelectObject as long
End Function
Sub DeleteObject hObject
CallDLL #gdi32,"DeleteObject", hObject as long, r as Boolean
End Sub
Function CreateSolidBrush(red,green,blue)
crColor=red+(green*256)+(blue*256*256)
CallDLL #gdi32, "CreateSolidBrush",crColor as long,hNewBrush as long
CreateSolidBrush=hNewBrush
End Function
Function CreateHatchBrush(red,green,blue,style)
'_HS_BDIAGONAL
'_HS_CROSS
'_HS_DIAGCROSS
'_HS_FDIAGONAL
'_HS_HORIZONTAL
'_HS_VERTICAL
crColor=red+(green*256)+(blue*256*256)
CallDLL #gdi32, "CreateHatchBrush",_
style as long, crColor as long, handleBrush as long
CreateHatchBrush=handleBrush
End Function
Function CreatePen(red,green,blue,style,width)
'style:
'_PS_SOLID
'_PS_DASH
'_PS_DOT
'_PS_DASHDOT
'_PS_DASHDOTDOT
'_PS_NULL
'_PS_INSIDEFRAME
crColor = blue*65536 + green*256 + red
CallDLL #gdi32, "CreatePen",style as long,width as long,crColor as long,handlePen as long
CreatePen=handlePen
End Function
Sub SetPixel hDC, x,y,color
CallDLL#gdi32,"SetPixel",hDC as long, x as long,y as long,color as long,result as long
End Sub
Function CreateFont(face$,width,height,bold,italic,underline,strikeout)
'bold, italic, underline strikeout = 1 for yes, 0 for no
'width can be 0 for default width
If bold>0 Then bold=700
CallDLL #gdi32, "CreateFontA", height as long, _
width as long,escapement as long,0 as long, _
weight as long,italic as long, _
underline as long,strikeout as long, _
0 as long,0 as long,0 as long,0 as long,0 as long, _
face$ as Ptr, newfont as long
CreateFont=newfont
End Function
Function GetCurrentPositionX(hdc)
struct Point, x as long, y as long
CallDLL #gdi32, "GetCurrentPositionEx",_
hdc as long, Point as struct,re as Boolean
GetCurrentPositionX=Point.x.struct
End Function
Function GetCurrentPositionY(hDC)
struct Point, x as long, y as long
CallDLL #gdi32, "GetCurrentPositionEx",_
hDC as long, Point as struct, re as Boolean
GetCurrentPositionY=Point.y.struct
End Function
Function GetStockObject(obj)
CallDLL #gdi32, "GetStockObject",obj as long,_
hObj as long
GetStockObject=hObj
End Function
Function ImageDimensions$(hImage)
lStruct = Len(ImageInfo.struct)
CallDLL #gdi32, "GetObjectA", _
hImage as Ulong, _
lStruct as Long, _
ImageInfo as struct, _
result as Long
imgWidth = ImageInfo.imgWidth.struct
imgHeight = ImageInfo.imgHeight.struct
ImageDimensions$ = Str$(imgWidth);Chr$(0);Str$(imgHeight)
End Function
Function wChar$(string$)
For i = 1 to Len(string$)
wChar$ = wChar$ + Mid$(string$, i, 1) + chr$(0)
Next i
wChar$ = wChar$ + Chr$(0) + Chr$(0)
End Function
Function LoadImgFromFile(picFile$)
Open "gdiplus.dll" for dll as #gdip
gdistart$ = Chr$(1)
For i = 1 to 15
gdistart$ = gdistart$ + Chr$(0)
Next i
Calldll #gdip,"GdiplusStartup", _
doubleWord as struct, _
gdistart$ as Ptr, _
status as Ulong
token = doubleWord.a.struct
If status <> 0 Then
LoadImgFromFile = 0
Else
wFileLoc$=wChar$(picFile$)
Calldll #gdip,"GdipCreateBitmapFromFile", _
wFileLoc$ as Ptr, _
doubleWord as struct, _
status as Ulong
hPic = doubleWord.a.struct
If status <>0 then
LoadImgFromFile=0
Else
CallDLL #gdip,"GdipCreateHBITMAPFromBitmap", _
hPic as Ulong, _
doubleWord as struct, _
0 as Ulong, _
status as Ulong
hImage=doubleWord.a.struct
If status <> 0 Then
LoadImgFromFile = 0
Else
LoadImgFromFile = hImage
End if
CallDLL #gdip,"GdipDisposeImage", _
hPic as Ulong, _
result as Ulong
End If
CallDLL #gdip,"GdiplusShutdown", _
token as Ulong, _
result as Ulong
End If
Close #gdip
End Function
Function GboxDC(hWnd)
Global gbDC, hMemDC, hBMP
CallDll #user32, "GetDC", hWnd as Ulong, ret as long 'returns handle to device context
gbDC = ret : print "ClientDC - ";gbDC
CallDll #gdi32, "CreateCompatibleDC", gbDC as Ulong, ret as Ulong 'memory DC
hMemDC = ret: print "CreateCompatibleDC() - "; hMemDC
nWidth = imageW: nHeight = imageH
CallDll #gdi32, "CreateCompatibleBitmap", hMemDC as Ulong, nWidth as long, nHeight as long, ret as Ulong
hBMP = ret: print "CreateCompatibleBitmap() - "; hBMP
hOldBMP = SelectObject(hMemDC, hBMP): ret = bitTransfer(hMemDC, 0, 0, imageW, imageH, gbDC, 0, 0, _SRCCOPY)
Getbits = GetDIBits(hMemDC, hBMP, _DIB_RGB_COLORS)
End Function
Function GlobalFree(hMem)
CallDll #kernel32, "GlobalFree", hMem as long, GlobalFree as long
End Function
Function GetLastError()
CallDll #kernel32, "GetLastError", LastError as Ulong
End Function
Function bitTransfer(hDC, x, y, cx, cy, hDCSrc, x1, y1, rop)
CallDll #gdi32, "BitBlt",_
hDC as ulong,_
x as long,_
y as long,_
cx as long,_
cy as long,_
hDCSrc as Ulong,_
x1 as long,_
y1 as long,_
rop as Ulong,_
bbit as long
print "bitTransfer - ";bbit
End Function
Function ImportBMP(hDCdest, xDest, yDest, xWidth, yHeight, hDCsource, xSrc, ySrc, wSrc, hSrc, DWROP)
CallDll #gdi32, "SetStretchBltMode", hDCdest as Ulong, _HALFTONE as long, result as long 'returns previous mode
if result = 0 then
print "SetStretchBltMode Errcode() - "; GetLastError()
else
print "SetStretchBltMode() - "; result
end if
CallDll #gdi32, "StretchBlt", _
hDCdest as Ulong,_ 'The destination DC
xDest as long,_ 'x location on destination
yDest as long,_ 'y location on destination
xWidth as long,_ 'width to transfer
yHeight as long,_ 'height to transfer
hDCsource as Ulong,_ 'The source DC
xSrc as long,_ 'x location in source
ySrc as long,_ 'y location in source
wSrc as long,_ 'width to take from source
hSrc as long,_
ROP as Ulong,_ 'The operation to be performed
drawBMP as long 'nonzero if successful
print "StretchBlt() - ";drawBMP
x =Int(xWidth*0.4): y = Int(yHeight*0.4)
CallDll #gdi32, "PatBlt",_
hDCdest as ulong,_ 'memory device context
xDest as long,_ 'x origin for transfer
yDest as long,_ 'y origin for transfer
x as long,_ 'width of area to access
y as long,_ 'height of area to access
_WHITENESS as Ulong,_ 'make specified area white
result as boolean
print "PatBlt() - "; result
End Function
Function GetDIBits(hDC, hBitmap, wUsage)
bih.biSize.struct = len(bih.struct)
CallDll #gdi32, "GetDIBits",_
hDC as Ulong,_
hBitmap as Ulong,_ 'HBITMAP
0 as Ulong,_
80 as Ulong,_
_NULL as long,_ 'LPVOID
bih as struct,_ 'LPBITMAPINFO
wUsage as Ulong,_
Getbits as Ulong
SizeImage = bih.biSizeImage.struct
if Getbits = 0 then
print "Getbits Errcode() - "; GetLastError()
else
print "Getbits - "; Getbits
print "BitCount - "; bih.biBitCount.struct: print "Width - "; bih.biWidth.struct: print "Height - "; bih.biHeight.struct
print "Planes - ";bih.biPlanes.struct: print "Compression - "; bih.biCompression.struct: print "SizeImage - ";bih.biSizeImage.struct
print "XPelsPerMeter - ";bih.biXPelsPerMeter.struct: print "YPelsPerMeter - ";bih.biYPelsPerMeter.struct
print "ClrUsed - ";bih.biClrUsed.struct: print "ClrImportant - ";bih.biClrImportant.struct
end if
End Function
Function StretchDIBits(hDCdest, xDest, yDest, xWidth, yHeight)
dwBmpSize =Int(Abs(((bih.biWidth.struct * bih.biBitCount.struct + (bih.biBitCount.struct -1)) / bih.biBitCount.struct) * 4 *bih.biHeight.struct))
CallDll #kernel32, "GlobalAlloc", _GHND as Ulong, dwBmpSize as long, Glalloc as long
if Glalloc = 0 then
print "GlobalAlloc Errcode() - "; GetLastError()
else
hDiB = Glalloc: print "GlobalAlloc() - "; hDiB
CallDll #kernel32, "GlobalLock", hDiB as long, GlobalLock as long
lpbitmap = GlobalLock
if lpbitmap = 0 then
print "GlobalLock Errcode() - "; GetLastError()
else
print "GlobalLock() - "; lpbitmap
CallDll #gdi32, "SetICMMode", hDCdest as Ulong, _ICM_ON as long, ret as long
print ret
'bih.biSize.struct = len(bih.struct): bih.biBitCount.struct = BitsPixel
'bih.biWidth.struct = imageW : bih.biHeight.struct = -85: bih.biPlanes.struct = 1
'bih.biCompression.struct = _BI_RGB: bih.biSizeImage.struct = SizeImage
'bih.biXPelsPerMeter.struct = xResolution : bih.biYPelsPerMeter.struct = yResolution
'bih.biClrUsed.struct = NumColors
CallDll #gdi32, "StretchDIBits",_
hDCdest as Ulong,_
xDest as long,_
yDest as long,_
xWidth as long,_
yHeight as long,_
0 as long,_
0 as long,_
bih.biWidth.struct as long,_
bih.biHeight.struct as long,_
lpbitmap as long,_
bih as struct,_
_DIB_RGB_COLORS as Ulong,_
_SRCCOPY as Ulong,_
StretchDIBits as Ulong
if StretchDIBits = 0 then
print "StretchDIBits Errcode() - "; GetLastError()
else
print "StretchDIBits() - "; StretchDIBits
end if: end if: end if
End Function
|
|
. Please have a look I must be missing something. 
