[RESOLVED] Savepicture when dpi aware and dpi > 96

[JohnTurnbull]

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...



The result of Savepicture Picturebox.picture , File$ is as above when performed in the VB6 environment but like this when run compiled.



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!

[LaVolpe]

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

[JohnTurnbull]

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

[LaVolpe]

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.

[JohnTurnbull]

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.............

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

[LaVolpe]

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.

[JohnTurnbull]

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.

[LaVolpe]

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

[JohnTurnbull]

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!

[LaVolpe]

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

[JohnTurnbull]

I allow users to choose their own font.

[LaVolpe]

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

[JohnTurnbull]

Ta.

Have a copy on me - Provided you're running at 96dpi - You'll like it!

http://m8software.com/pvt11/spartan.htm