2 Attachment(s)
[RESOLVED] Savepicture when dpi aware and dpi > 96
Hi folks,
I have been updating a program to be dpi aware and have solved all the problems except one.
This is a screenshot of a picturebox...
Attachment 127191
The result of Savepicture Picturebox.picture , File$ is as above when performed in the VB6 environment but like this when run compiled.
Attachment 127193
The difference in scale is a result of snapping the second shot from the windows picture viewer. Both are actually scalled the same. The problem is that the saved graphic is cropped by the scalling factor.
If anyone can suggest a way round this, I would be eternally grateful!
I guess what I'm loking for is code to get the image from Picturebox.hdc to File.bmp without using the VB Savepicture!
Re: Savepicture when dpi aware and dpi > 96
Need more information.
What were the system DPI settings when your screenshots were taken?
What operating system are you running?
Is your application declared DPI aware via manifest?
Where is the source image coming from? file, screen capture, something else?
I doubt SavePicture is the culprit here
Re: Savepicture when dpi aware and dpi > 96
What were the system DPI settings when your screenshots were taken?
144 (150%)
What operating system are you running?
Windows 10 but same problem in 7 and 8.1
Is your application declared DPI aware via manifest?
No Via setprocessdpiaware()
Where is the source image coming from? file, screen capture, something else?
Clipboard.getdata
Re: Savepicture when dpi aware and dpi > 96
The IDE (unless tweaked or manifested) will run in virtual 96 DPI. The compiled version if DPI aware will run in 144 DPI. From your 2nd screenshot, the application window is obviously not scaled correctly when compiled. It should be a larger window, the bitmap appears to be scaled larger as does the titlebar and menubar. Are you manually scaling your form?
We may need to see some code on how you are manually scaling stuff.
Also, can you better describe what we are seeing in your screenshot. Looks like a form with a menu and a picturebox. Can't tell if the scrollbars are part of the picbox or from the picture assigned to the picbox.
Re: Savepicture when dpi aware and dpi > 96
Also, can you better describe what we are seeing in your screenshot. Looks like a form with a menu and a picturebox. Can't tell if the scrollbars are part of the picbox or from the picture assigned to the picbox.
The first screenshot is of the picturebox I am saving. It contains a screenshot of a window. Everything you can see is the window. The picturebox has no border. Anything that looks like a border is just where the picturebox was cropped out of a larger screen shot. The picturebox and its picture have already been scaled to the size I want to save it as.
From your 2nd screenshot, the application window is obviously not scaled correctly when compiled. It should be a larger window, the bitmap appears to be scaled larger as does the titlebar and menubar. Are you manually scaling your form?
Yes. The second screen shot is not the application. It is the file created by savepicture. They should be the same size. They are the same size. Savepicture has not saved the right and bottom 25% of the picture.
You can ignore the title bar and menu anomally. They have been sized larger in the Windows 10 display settings.
We may need to see some code on how you are manually scaling stuff.
Have fun.............
Code:
Sub Redraw(Frm As Form, Caption As Boolean)
Dim TheTag$
Dim xx&, yy&, zz&
Dim CtrlName$
Dim ScaleForm#
Dim MaxSize!
Dim MaxWid&, MaxHt&
Dim ScaleOdd#
'=================set edit form font============================
If Frm.Name <> "Edit" Then GoTo EditDone
On Local Error GoTo SkipEdit
SetFormFont Frm
Frm.Font.Size = Frm.Font.Size * ScaleUse
Frm.Font.Bold = Ini.FontBold
On Local Error GoTo 0
SkipEdit:
If Err > 0 Then Resume EditDone
EditDone:
ScaleForm = ScaleUse
'==========================fix for graphic editor============
CheckEditPicAgain:
If Frm.Name = "EditPic" Then
MaxWid = EditPic.AddPicFrame.Width + EditPic.HelpFrame.Width + EditPic.SaverFrame.Width
MaxHt = EditPic.CtrlFrame.Height + EditPic.SaverFrame.Height
If MaxHt * ScaleForm > Screen.Height Or MaxWid * ScaleForm > Screen.Width Then
GoSub ReduceIt
If ScaleForm > 1 Then GoTo CheckEditPicAgain
Else
GoTo SkipThis
End If
End If
'=========================Fix for 2 big forms===========================================
If ScaleForm = 1 Then GoTo SkipThis
If Frm.Name = "Edit" Then GoTo SkipThis
If Frm.Name = "YP" Then GoTo SkipThis
'.......
MaxSize = 0.95
CheckAgain:
If Frm.Height * ScaleForm > Screen.Height * MaxSize Or Frm.Width * ScaleForm > Screen.Width * MaxSize Then
GoSub ReduceIt
If ScaleForm > 1 Then GoTo CheckAgain
End If
SkipThis:
'==============================Fix for viewer > half screen width===========
CheckViewerAgain:
If Frm.Name = "Viewer" Or Frm.Name = "ViewerYP" Then
If Frm.Width * ScaleForm > Screen.Width / 2 Then
GoSub ReduceIt
If ScaleForm > 1 Then GoTo CheckViewerAgain
End If
End If
'===================Note size used for truesize sub===========================================
Frm.Tag = LTrim$(Str$(ScaleForm))
'==============================================================
For xx = 0 To Frm.Controls.Count - 1
'.....
On Local Error Resume Next
Frm.Controls(xx).Height = Frm.Controls(xx).Height * ScaleForm 'must do Height before fontsize or get 2 resizes
'------------------------------------------------------
On Local Error Resume Next
If TypeOf Frm.Controls(xx) Is LabelW Or TypeOf Frm.Controls(xx) Is ListBoxW Then
If ScaleSys > 1 Then 'High res screens
Select Case ScaleForm
Case Is >= 2
ScaleOdd = ((ScaleForm - 1) / 2) + 1
Case 1.01 To 1.99
ScaleOdd = ((ScaleForm - 1) / 3) + 1
Case Else
ScaleOdd = 0.75
End Select
Else
ScaleOdd = ScaleForm
End If
'-----------------
Frm.Controls(xx).Font.Size = Frm.Controls(xx).Font.Size * ScaleOdd
Else
Frm.Controls(xx).Font.Size = Frm.Controls(xx).Font.Size * ScaleForm
End If
'....
On Local Error Resume Next
Frm.Controls(xx).Top = Frm.Controls(xx).Top * ScaleForm
'.....
On Local Error Resume Next
Frm.Controls(xx).Left = Frm.Controls(xx).Left * ScaleForm
'...
On Local Error Resume Next
Frm.Controls(xx).Width = Frm.Controls(xx).Width * ScaleForm
'...................FONTS...............
Select Case Frm.Name
Case "Edit"
CtrlName = Frm.Controls(xx).Name
On Local Error GoTo DefaultFonts
SetCtrlFont Frm.Controls(xx)
TheTag = Frm.Controls(xx).Tag
If TheTag <> "B" Then
If InStr(CtrlName, "Button") = 0 Then Frm.Controls(xx).Font.Bold = Ini.FontBold 'Fontbold settings
End If
On Local Error GoTo 0
Case "MultiCopyOptions", "JoinOptions", "SplitOptions", "Correspondents", "Upgradev10", "ImportForm", "CP", "NewLogon", "EncryptOptions", "GifWarnForm", "DateStamp", "EditClip", "Backup", "ShutdownForm", "ViewSettingsForm", "SettingsForm", "ExcludeForm", "Viewer", "FinderForm", "YP", "ViewerYP", "EditYP", "AskActionForm", "BulkPasteOptions", "BulkPasteChoice"
On Local Error GoTo DefaultFonts
SetCtrlFont Frm.Controls(xx)
TheTag = Frm.Controls(xx).Tag
If TheTag <> "B" Then Frm.Controls(xx).Font.Bold = Ini.FontBold 'Fontbold settings
On Local Error GoTo 0
Case Else
SetCtrlFont Frm.Controls(xx)
If Frm.Name <> "EditPic" Then
TheTag = Frm.Controls(xx).Tag
If TheTag <> "B" Then
Frm.Controls(xx).Font.Bold = Ini.FontBold 'Fontbold settings
End If
End If
End Select
GoTo SkipDefaultFonts
DefaultFonts:
Resume Here
Here:
On Local Error Resume Next
Frm.Controls(xx).Font.Name = "MS Sans Serif"
TheTag = Frm.Controls(xx).Tag
If TheTag <> "B" Then Frm.Controls(xx).Font.Bold = Ini.FontBold 'Fontbold settings
SkipDefaultFonts:
On Local Error GoTo NoFont
Frm.Controls(xx).Font.Size = Frm.Controls(xx).Font.Size
NoFont:
If Err > 0 Then Resume NoFont2
NoFont2:
On Local Error Resume Next
Frm.Controls(xx).Font.Italic = False
'===========================/===============
On Local Error Resume Next
Frm.Controls(xx).X1 = Frm.Controls(xx).X1 * ScaleForm
On Local Error Resume Next
Frm.Controls(xx).X2 = Frm.Controls(xx).X2 * ScaleForm
On Local Error Resume Next
Frm.Controls(xx).Y1 = Frm.Controls(xx).Y1 * ScaleForm
On Local Error Resume Next
Frm.Controls(xx).Y2 = Frm.Controls(xx).Y2 * ScaleForm
Next xx
On Local Error GoTo 0
'==================round to pixels
For xx = 0 To Frm.Controls.Count - 1
On Local Error Resume Next
yy = Frm.Controls(xx).Top
zz = yy / TPPX
If yy Mod TPPX > 0 Then yy = zz * TPPX
On Local Error Resume Next
Frm.Controls(xx).Top = yy
'.....
yy = Frm.Controls(xx).Left
zz = yy / TPPX
If yy Mod TPPX > 0 Then yy = zz * TPPX
On Local Error Resume Next
Frm.Controls(xx).Left = yy
'.....
yy = Frm.Controls(xx).Width
zz = yy / TPPX
If yy Mod TPPX > 0 Then yy = zz * TPPX
On Local Error Resume Next
Frm.Controls(xx).Width = yy
'.....
yy = Frm.Controls(xx).Height
zz = yy / TPPX
If yy Mod TPPX > 0 Then yy = zz * TPPX
On Local Error Resume Next
Frm.Controls(xx).Height = yy
Next xx
On Local Error GoTo 0
'============================================================
If Frm.BorderStyle = 2 Then ' Sizable
Frm.Width = (Frm.Width - SysDims.SideSizable * 2) * ScaleForm + SysDims.SideSizable * 2
Else
Frm.Width = (Frm.Width - SysDims.SideFixed * 2) * ScaleForm + SysDims.SideFixed * 2
End If
'=============================================================
Dim TopBase&
If Frm.BorderStyle = 2 Then TopBase = SysDims.TopSizable * 2 Else TopBase = SysDims.TopFixed * 2
If Caption <> False Then
Frm.Height = (Frm.Height - SysDims.Caption - TopBase) * ScaleForm + SysDims.Caption + TopBase
Else
Frm.Height = (Frm.Height - TopBase) * ScaleForm + TopBase
End If
Exit Sub
'=====================
ReduceIt:
Select Case ScaleForm
Case Is <= 1.25
ScaleForm = 1
Case Is <= 1.5
ScaleForm = 1.25
Case Is <= 1.75
ScaleForm = 1.5
Case Is <= 2
ScaleForm = 1.75
Case Is > 2
ScaleForm = 2
End Select
Return
End Sub
Re: Savepicture when dpi aware and dpi > 96
I'm still kinda lost a bit. For some clarification....
At this point, your monitor is setup for 144 DPI both during IDE and running compiled, correct? If so, some more questions...
1. How is the picture property of the picturebox being set?
- LoadPicture([filename])
- Clipboard.GetData()
Or is something else going on, like maybe: saving picbox picture during IDE and loading the file in compiled app? Saving clipboard image and then reloading the saved image? Some other combination. Not sure I see where SavePicture comes into play yet.
2. The 1st screenshot is from your app running in the IDE and is simply a clipped portion of your form containing the picturebox, correct?
3. The 2nd screenshot is from your app running compiled and similar clipping, correct?
4. What does this report when uncompiled and compiled? Screen.TwipsPerPixel.X
May need to add a msgbox during form load to report back on that one
-- Note: if both report 15 when running at 144 DPI, then your compiled app is not DPI aware
May have some other questions later.
Re: Savepicture when dpi aware and dpi > 96
Cracked it!
LaVolpe - Many thanks for your interest. The problem is solved. It's always the simplest mistakes that are hardest to find!
It was simply that I had not resized the picturebox by the scale factor before painting in the graphic with paintpicture. In the IDE, it looked fine but when I put waitforkeystroke in between lines and ran it compiled, it was obvious that the picturebox wasn't big enough for the paintpicture.
Thanks any way.
Re: [RESOLVED] Savepicture when dpi aware and dpi > 96
Ok, glad you figured it out. But a point of curiosity. You do know that if the app is DPI aware, VB will resize and reposition the controls relative to the actual DPI? So, unless there is a need to custom size all your controls, might as well let VB do it.
Only 3 exceptions that come to mind:
1. A picturebox with AutoSize=True & picture assigned, will not resize based on DPI. This is because VB doesn't scale images (i.e., LoadPicture). Therefore the picturebox's image is same size in all DPIs and picturebox size is static
2. An Image control with Stretch=False, will resize but the image will not. If you want the image to resize with the control, use Stretch=True
3. Potentially any 3rd party control that resizes itself
Re: [RESOLVED] Savepicture when dpi aware and dpi > 96
Yes, I know. Unfortunately, I already offer users the chance to scale up so I could hardly take it away from someone just because they bought a 4k monitor!
Re: [RESOLVED] Savepicture when dpi aware and dpi > 96
One other tip if not already done. When trying to make your app DPI aware, use TrueType fonts, not the default font that VB offers
Re: [RESOLVED] Savepicture when dpi aware and dpi > 96
I allow users to choose their own font.
Re: [RESOLVED] Savepicture when dpi aware and dpi > 96
Quote:
Originally Posted by
JohnTurnbull
I allow users to choose their own font.
May want to try to restrict the font dialog to TrueType fonts (non bitmap fonts). Bitmap fonts are stretched whereas tt fonts are vector based and scale extremely well. Regardless, suggest tt fonts for your labels and any other control that has a text property where your customer doesn't choose the font
Re: [RESOLVED] Savepicture when dpi aware and dpi > 96
Ta.
Have a copy on me - Provided you're running at 96dpi - You'll like it!
http://m8software.com/pvt11/spartan.htm
