HughLerwill
Programmer
Dear all,
I am adjusting some of my software to accomodate use when screen resolution is set to a value greater than the normal 96 dpi in Windows display properties dialog - Settings tab - Advanced button - General tab
The code below prints a bitmap containing a company logo in the top right of a printed or previewed (PictureBox) page. The size of the bitmap image printed/ previwed is reduced with an increased screen dpi unless steps are taken.
Modifications made for increased dpi are detailed in the code comments.
The problem is that MS Paint which is typically used to create bitmaps does not give the option to select dpi when a file is created or record the dpi it was created with in the bitmap file header. Thus 1) the value of 96 dpi is assumed if the bitmap's PelsPerMeter property is set to zero and 2) I have to recommend that Logo files are created on a Windows system using a 96 dpi display property setting or 3) I have to recommend that Logo files are created with a program such as PaintShop Pro which allows specification of dpi and saves it in the bitmap.
Am I giving myself a hard time using bitmaps for the logos, and would other file formats be more suitable?
Function PrntCoLogo(Pdevice As Object, BitMapFile$) As Boolean
'does the company logo on reports
Dim PrntHeight!, PrntWidth!
Dim Prntx&
Dim pic As New StdPicture
If Len(Dir$(Path2LogoFiles$() & "\" & BitMapFile$)) Then
'if using Printer it must be initialized.
If Pdevice Is Printer Then Pdevice.Print " "
Set pic = LoadPicture(Path2LogoFiles$() & "\" & BitMapFile$)
'scalemode of StdPicture object is fixed Himetric
'pic.Scalemode does not work
'however all the work is done in pixels.
Pdevice.ScaleMode = vbPixels
'so convert himetric to pixels, and reduce image to half size to reduce jagginess
'next 2 lines modified to accomodate use of screen dpis greater than the standard 96
'PrntHeight = Pdevice.ScaleY(pic.Height / 2, vbHimetric, vbPixels) * GetWindowsDPI(0)
'PrntWidth = Pdevice.ScaleX(pic.Width / 2, vbHimetric, vbPixels) * GetWindowsDPI(1)
'GetWindowsDPI
gets the DPI setting in Windows display properties
'GetBitMapDpi gets the DPI setting from the bitmap header(if PelsPerMeter set to zero 96 dpi is assumed/ returned)
'args for both; ; (0) for Xdpi, (1) fpr Ydpi
PrntHeight = Pdevice.ScaleY(pic.Height / 2, vbHimetric, vbPixels) _
* GetWindowsDPI(0) / GetBitMapDpi(Path2LogoFiles$() & "\" & BitMapFile$, 0)
PrntWidth = Pdevice.ScaleX(pic.Width / 2, vbHimetric, vbPixels) _
* GetWindowsDPI(1) / GetBitMapDpi(Path2LogoFiles$() & "\" & BitMapFile$, 1)
'position picture to the extreme top right of the page
Prntx = Pdevice.ScaleWidth - PrntWidth - 1
On Error Resume Next
Pdevice.PaintPicture pic, Prntx, 0, PrntWidth, PrntHeight
If Err Then
MsgBox "Error " & Err & " printing graphics based header" & ret$ & "Text based header printed", vbInformation
Else
PrntCoLogo = True
End If
On Error GoTo 0
Set pic = Nothing
End If
End Function
regards Hugh
I am adjusting some of my software to accomodate use when screen resolution is set to a value greater than the normal 96 dpi in Windows display properties dialog - Settings tab - Advanced button - General tab
The code below prints a bitmap containing a company logo in the top right of a printed or previewed (PictureBox) page. The size of the bitmap image printed/ previwed is reduced with an increased screen dpi unless steps are taken.
Modifications made for increased dpi are detailed in the code comments.
The problem is that MS Paint which is typically used to create bitmaps does not give the option to select dpi when a file is created or record the dpi it was created with in the bitmap file header. Thus 1) the value of 96 dpi is assumed if the bitmap's PelsPerMeter property is set to zero and 2) I have to recommend that Logo files are created on a Windows system using a 96 dpi display property setting or 3) I have to recommend that Logo files are created with a program such as PaintShop Pro which allows specification of dpi and saves it in the bitmap.
Am I giving myself a hard time using bitmaps for the logos, and would other file formats be more suitable?
Function PrntCoLogo(Pdevice As Object, BitMapFile$) As Boolean
'does the company logo on reports
Dim PrntHeight!, PrntWidth!
Dim Prntx&
Dim pic As New StdPicture
If Len(Dir$(Path2LogoFiles$() & "\" & BitMapFile$)) Then
'if using Printer it must be initialized.
If Pdevice Is Printer Then Pdevice.Print " "
Set pic = LoadPicture(Path2LogoFiles$() & "\" & BitMapFile$)
'scalemode of StdPicture object is fixed Himetric
'pic.Scalemode does not work
'however all the work is done in pixels.
Pdevice.ScaleMode = vbPixels
'so convert himetric to pixels, and reduce image to half size to reduce jagginess
'next 2 lines modified to accomodate use of screen dpis greater than the standard 96
'PrntHeight = Pdevice.ScaleY(pic.Height / 2, vbHimetric, vbPixels) * GetWindowsDPI(0)
'PrntWidth = Pdevice.ScaleX(pic.Width / 2, vbHimetric, vbPixels) * GetWindowsDPI(1)
'GetWindowsDPI
'GetBitMapDpi gets the DPI setting from the bitmap header(if PelsPerMeter set to zero 96 dpi is assumed/ returned)
'args for both; ; (0) for Xdpi, (1) fpr Ydpi
PrntHeight = Pdevice.ScaleY(pic.Height / 2, vbHimetric, vbPixels) _
* GetWindowsDPI(0) / GetBitMapDpi(Path2LogoFiles$() & "\" & BitMapFile$, 0)
PrntWidth = Pdevice.ScaleX(pic.Width / 2, vbHimetric, vbPixels) _
* GetWindowsDPI(1) / GetBitMapDpi(Path2LogoFiles$() & "\" & BitMapFile$, 1)
'position picture to the extreme top right of the page
Prntx = Pdevice.ScaleWidth - PrntWidth - 1
On Error Resume Next
Pdevice.PaintPicture pic, Prntx, 0, PrntWidth, PrntHeight
If Err Then
MsgBox "Error " & Err & " printing graphics based header" & ret$ & "Text based header printed", vbInformation
Else
PrntCoLogo = True
End If
On Error GoTo 0
Set pic = Nothing
End If
End Function
regards Hugh