Quantcast
Viewing all articles
Browse latest Browse all 1449

VB6 DPI-awareness via RC6/RC6Widgets (and Device-Independent-Pixels)

Just some Drop-In-Code (about 140 Code-Lines) for a normal VB6-Form,
producing the following output:

Image may be NSFW.
Clik here to view.
Name:  ChartDemoNormal96DPI.jpg
Views: 22
Size:  18.4 KB


For those not yet familiar with the RC5/RC6 Widget-concept, here is a Tutorial-Link:
https://www.vbforums.com/showthread....dgets-Tutorial

Ok, when we look at the above ScreenShot, we see a simple ToolBar, a StatusBar -
and in-between these two "Stripes" - a Chart-Area.

The placements (and sizes) of these 3 "Form-covering-Widgets" are given in DIP (Device-Independent-Pixels).
The same is true for all the Placements and Sizes of the other Child-Widgets within these 3 "Main-Widgets".

Not working "with Twips" - but instead with DIP (don't interchange that with DPI),
is "how it works everywhere else" (in modern Browsers, as well as in modern Graphics- and UI-Frameworks).

And what it basically means is, that:
If you work in "Standard-Resolution" of 96DPI (aka 100% Monitor-Zoom),
then "a single DIP" covers "a single, real Pixel exactly" (in your BackBuffer-Surface).

Now, when the Monitor-Resultion is switched to e.g. 200% (192DPI Screen-Resolution),
then "a single DIP" covers "a 2x2 area of real Pixels on the underlying BackBuffer".

As for: "how can I tell my Graphics- or UI-lib to change the DIP-resolution" (to e.g. 200%)?
- if you work with Cairo-Surfaces and 'CCs' directly, you have to set the Zoom manually: CC.ScaleDrawings 2, 2
- if you work with RC6-Widgets, then everything is automatic, after you set: cWidgetRoot.Zoom = 2

To find out, what the current Monitor-ZoomFactor is, one can use: New_c.Displays(1).Zoom

E.g. on my Notebook, I have a 15"-4K-Display (covering 3840x2160 real Pixels).
This is a quite large area, on a relatively small Display, so my Monitor-Zoom is set to 250% (240DPI).

Here is the above seen (96DPI) Form-ScreenShot again (now in 240DPI), from the running App with enabled DPI-awareness -
(in the compiled Exe, automatically zoomed to 250% ... given as a normal Link, because of its size):
https://vbRichClient.com/Downloads/C...50_percent.png

So, if you compare the two ScreenShots, you see that there's no problem with DPI-awareness,
all the Controls are scaled properly - there is no "smaller Texts somewhere" or "some smaller Icons" -
and also not "smaller LineWidths" (even those scaled along properly, in the Chart-Area).

With "normal VB6-drawing" (no matter if Control-placements are in Twips) you have to jump through hoops,
to achieve a clean-scaled, DPI-aware result like that.

Ok, here the code for a virginal VB6-Form... (don't forget to include Project-Refs for RC6 and RC6-Widgets)
Code:

Option Explicit 'DPI-awareness and Device-Independent-Pixels (needs References to RC6 and RC6Widgets)

Private Declare Function GetClientRect& Lib "user32" (ByVal hWnd&, Rct As Any)

Const BarHeight = 31, BarColor = &HBCAFAF

Private WithEvents pnlCover As cWidgetForm 'the Form-covering Main-Panel-Host
Private ToolB As cwToolBar, WithEvents Chart As cwCanvas, StatB As cwStatusBar 'and the 3 Main-Widgets which are sitting directly on pnlCover

Private WithEvents tbiSave As cwToolBarItem, WithEvents tbiEdit As cwToolBarItem, WithEvents tbiMove As cwToolBarItem
Private txtCh0 As cwTextBox, txtCh1 As cwTextBox
Private sta1 As cwToolBarItem, sta2 As cwToolBarItem, WithEvents staZ As cwToolBarItem, WithEvents popZ As cwMenu

Private Sub Form_Load()
  Caption = "DPI-aware Chart-Demo (Resize Me...)"
  Cairo.SetDPIAwareness 'this will make the App DPI-aware (even without a manifest)

  'first we put a few Icon-Resources into the global ImageList (the Widgets will only need their StringKeys, to render them)
  Cairo.ImageList.AddIconFromResourceFile "icoSave", "shell32", 303
  Cairo.ImageList.AddIconFromResourceFile "icoEdit", "shell32", 242
  Cairo.ImageList.AddIconFromResourceFile "icoMove", "shell32", 22
  Cairo.ImageList.AddIconFromResourceFile "icoStar", "shell32", 44
  Cairo.ImageList.AddIconFromResourceFile "icoInfo", "shell32", 1001
  Cairo.ImageList.AddIconFromResourceFile "icoZoom", "shell32", 23
 
  'now we create a form-covering Panel (which acts as the host for 3 "Main-Containers", ToolBar, Chart-Area, StatusBar)
  Set pnlCover = Cairo.WidgetForms.CreateChild(hWnd)
      pnlCover.WidgetRoot.BackColor = &H888888
     
  'Ok, so let's create these 3 "Main-Container"-Widgets on their Parent-Panel, via pnlCover.Widgets.Add(...)
  Set ToolB = pnlCover.Widgets.Add(New cwToolBar, "ToolB", 0, 0, 1, BarHeight)
      ToolB.Widget.BackColor = BarColor 'change the default-backcolor to the Value of the Const-Def
  Set Chart = pnlCover.Widgets.Add("cwCanvas", "Chart") 'the Chart-Widget will fill the space between Tool- and StatusBar
  Set StatB = pnlCover.Widgets.Add(New cwStatusBar, "StatB", 0, 0, 1, BarHeight)
      StatB.Widget.BackColor = BarColor 'change the default-backcolor to the Value of the Const-Def

  'any Controls/Widgets live in a nested Hierarchy, so now we add specific ChildWidgets into the 3 Main-Containers themselves
  '... starting with a few Child-Items on the ToolBar
  Set tbiSave = ToolB.AddItem("tbiSave", "icoSave", "Save as *.png", , "Save the current ChartArea to a file")
                ToolB.AddItem "VSep1", , "-" 'vertical separator-lines require a unique Key, and a "-" as Caption-Text
  Set tbiEdit = ToolB.AddItem("tbiEdit", "icoEdit", "Allow Edit", , "Allow Chart-Text-Editing", , True)
  Set tbiMove = ToolB.AddItem("tbiMove", "icoMove", "Allow Move", , "Allow Chart-Text-Movements", , True)
                ToolB.AddItem "VSep2", , "-" 'vertical separator-lines require a unique Key, and a "-" as Caption-Text
 
  '... same here (adding two Child-Items, of type cwTextBox) to the Chart-Container via Chart.Widgets.Add(...)
  Set txtCh0 = Chart.Widgets.Add(New cwTextBox, "txtCh0", 0, 0, 320, 50)
      txtCh0.Text = "I'm a moveable Chart-Title..."
      txtCh0.Border = False: txtCh0.Widget.BackColor = -1 'no Border and no BackGroundColor for this Text
      txtCh0.Widget.ForeColor = vbBlue: txtCh0.Locked = True 'make this TextBox initially "un-editable"
      txtCh0.Widget.FontSize = 11: txtCh0.Widget.FontBold = True: txtCh0.Widget.FontItalic = True
      txtCh0.Widget.Tag = Array(0.03, 0.03)
  Set txtCh1 = Chart.Widgets.Add(New cwTextBox, "txtCh1", 0, 0, 160, 19)
      txtCh1.Text = "I'm a moveable Point-Marker..."
      txtCh1.Widget.FocusColor = txtCh1.Widget.BorderColor 'prevent the "light-blue-framing" of this TextBox when focused
      txtCh1.Widget.FontSize = 8: txtCh1.Locked = True 'make this TextBox initially "un-editable"
      txtCh1.Widget.Tag = Array(0.6, 0.7)
     
  '... and on the last Container (our StatusBar) we add a few "inset-styled" Child-Items as well
  Set sta1 = AddStatusItem("Info-Text: 1", "icoStar", 0, 100)
            AddStatusItem "-", "", 104, 4 'add a vertical separator
  Set sta2 = AddStatusItem("Info: 2", "icoInfo", 112, 80)
            AddStatusItem "-", "", 196, 4 'add another vertical separator
  Set staZ = AddStatusItem("Zoom: " & Format(New_c.Displays(1).Zoom, "0%"), "icoZoom", 666, 115)
      staZ.ArrowType = ddDropDown 'make staZ (in addition) - show a little, clickable Arrow to the right
  Set popZ = New cwMenu '<- a Menu-Widget, which is used within the staZ_ArrowClick Eventhandler
 
  '**** Ok, Control-initialization is finished...
 
  tbiMove.Checked = True 'ensure the "Checked"-Default-State of the ToolBar-"Allow Move"-Item
 
  'finally we set the pnl-Root-Zoom, according to what we find as the current Zoom of the Main-Display
  pnlCover.WidgetRoot.Zoom = New_c.Displays(1).Zoom 'setting the Zoom on the Root, will automatically scale the whole child-hierarchy currently "on it"
  'final Movement of our TopLevel-VB6-HostForm - relating to the Zoom-Fac we've just set on our covering-Panel
  With pnlCover.WidgetRoot: Me.Move Left * .Zoom, Top * .Zoom, Width * .Zoom, Height * .Zoom: End With
End Sub
 
Private Sub Form_Resize()
  Dim R&(0 To 3): GetClientRect hWnd, R(0) 'get the inner Pixel-dimensions of the VB-Form reliably (because TwipsPerPixel is broken)
  pnlCover.Move 0, 0, R(2), R(3) 'and move the covering Widget-HostPanel accordingly (will trigger the Event below)
End Sub

'in the Evt-Handler below, the incoming dx, dy are in "Device-Independent-Pixels" (which the Widget-Positioning-Logic relies on)
Private Sub pnlCover_ResizeWithDimensionsDIP(ByVal dx As Single, ByVal dy As Single)
  ToolB.Widget.Move 0, 0, dx, BarHeight
  Chart.Widget.Move 1, BarHeight, dx - 2, dy - 2 * BarHeight
  StatB.Widget.Move 0, dy - BarHeight, dx, BarHeight
  staZ.Widget.Move dx - 123, 3, 120 'after the StatB, adjust also the staZ-Widget, because it sits RightAligned on StatB
 
  UpdateTextWidgets
End Sub

Private Sub Chart_Paint(CC As cCairoContext, ByVal dx As Double, ByVal dy As Double)
  'the current chart-content is just a mock-up (using just 3 Points, derived relatively from the current dx/dy ChartArea-Extents)
  'in production-code, one should pass the 3 incoming Params along into several SubRoutines like: DrawCurve(...), DrawCandles(...), etc.
  CC.MoveTo dx * 0.05, dy * 0.95: CC.LineTo dx * 0.3, dy * 0.2
                                  CC.LineTo dx * 0.6, dy * 0.7
                                  CC.LineTo dx * 0.9, dy * 0.1
  CC.Stroke , Cairo.CreateSolidPatternLng(vbRed) 'stroke the line-path above in vbRed
End Sub

Private Sub UpdateTextWidgets()
  Dim oW As Object, W As cWidgetBase
  For Each oW In Chart.Widgets 'loop over all Child-Widgets on our Chart-Widget
    Set W = oW.Widget 'adjust also the relative position of the current Text-Widget(s) to the just updated ChartWidget-Dimensions
    If IsArray(W.Tag) Then W.Move W.Tag(0) * Chart.Widget.Width, W.Tag(1) * Chart.Widget.Height
    If TypeOf oW Is cwTextBox Then W.Moveable = tbiMove.Checked    '<- reflect the ToolBtn state in the Moveable-Prop of the TextBox-Widgets
    If TypeOf oW Is cwTextBox Then oW.Locked = Not tbiEdit.Checked '<- reflect the ToolBtn state in the Locked-Prop of the TextBox-Widgets
  Next
End Sub
 
'**** toolbar-Item-Click-Handlers
Private Sub tbiSave_Click()
  Dim W: W = Chart.Widget.BackBuffer.Width  'get the real Pixel-Width of our Chart-area (directly from its underlying BackBuffer)
  Dim H: H = Chart.Widget.BackBuffer.Height 'same for the Height
  With pnlCover.WidgetRoot.Surface 'and our Form-covering Main-Panel also contains a BackBuffer-Surface which holds everything (any Widget-Output)
    Dim ChartSrf As cCairoSurface '... but since we want only the content of the Chart-Area-widget (including the TextBoxes), ...
    Set ChartSrf = .CropSurface((.Width - W) / 2, (.Height - H) / 2, W, H) '... we have to "cut it out" from the larger Surface via CropSurface
    Dim FName$: FName = New_c.FSO.ShowSaveDialog(OFN_EXPLORER, New_c.FSO.GetSpecialFolder(CSIDL_MYPICTURES), , "Chart.png", , "png", hWnd)
    If Len(FName) Then ChartSrf.WriteContentToPngFile FName 'if we have a valid Filename, we can finally write out our PNG
  End With
End Sub
Private Sub tbiEdit_Click()
  UpdateTextWidgets
End Sub
Private Sub tbiMove_Click()
  UpdateTextWidgets
End Sub
'**** end of toolbar-item-handlers

'**** TextBox-Handling via the "central Bubbling-Handler" (which catches all the Events - from all the Widgets currently on the Panel)
'we use it here, to catch the Events of all "moving Chart-TextBoxes" in just one single Handler-routine
Private Sub pnlCover_BubblingEvent(Sender As Object, EventName As String, P1 As Variant, P2 As Variant, P3 As Variant, P4 As Variant, P5 As Variant, P6 As Variant, P7 As Variant)
  If TypeOf Sender Is cwTextBox And EventName = "W_Moving" Then HandleTextBoxMoving Sender.Widget
End Sub
Private Sub HandleTextBoxMoving(TBW As cWidgetBase) 'store the Left/Top-Coord of the given TBW relatively in its Tag-Prop
  TBW.Tag = Array(TBW.Left / Chart.Widget.Width, TBW.Top / Chart.Widget.Height)
End Sub
'**** end of TextBox-related handler-routines

'**** Statusbar-Helpers and -Events (starting with a construction-helper)
Function AddStatusItem(Caption, ImageKey, x, dx, Optional ByVal ForeColor&) As cwToolBarItem
  Set AddStatusItem = StatB.Widgets.Add(New cwToolBarItem, "stat" & StatB.Widgets.Count, 3 + x, 3, dx, StatB.Widget.Height - 5)
  With AddStatusItem
      .Caption = Caption: .Widget.ImageKey = ImageKey: .Widget.ForeColor = ForeColor
      .IsCheckable = True: .Checked = True: .IsCheckable = False 'this locks these Stat-Items in a "checked, inset State"
  End With
End Function

Function CreatePopUpEntriesForZoom() As cMenuItem 'dynamically generated MenuData for popZ (triggered in the Handler below)
  Set CreatePopUpEntriesForZoom = Cairo.CreateMenuItemRoot("popZ", "popZ")
      CreatePopUpEntriesForZoom.AddSubItem "100", "100%", "icoZoom"
      CreatePopUpEntriesForZoom.AddSubItem "125", "125%", "icoZoom"
      CreatePopUpEntriesForZoom.AddSubItem "150", "150%", "icoZoom"
      CreatePopUpEntriesForZoom.AddSubItem "200", "200%", "icoZoom"
      CreatePopUpEntriesForZoom.AddSubItem "250", "250%", "icoZoom"
End Function

Private Sub staZ_ArrowClick() 'for the StatusBar-Items, we pulled only one ("the Zoom-Entry") into a WithEvents-Variable
  popZ.InitAndShow staZ.Widget, CreatePopUpEntriesForZoom
End Sub
Private Sub popZ_Click(ByVal CurMenuItemPath As String) 'the passed CurMenuItemPath will be: "popZ>100" or "popZ>150"
  pnlCover.Locked = True
    pnlCover.WidgetRoot.Zoom = Split(CurMenuItemPath, ">")(1) / 100 'we use the split off the right part of the CurMenuItemPath directly
    pnlCover_ResizeWithDimensionsDIP pnlCover.ScaleWidthDIP, pnlCover.ScaleHeightDIP 'run through the pnlCover_Resize Event again, to adjust
    staZ.Caption = "Zoom: " & Format(pnlCover.WidgetRoot.Zoom, "0%")
  pnlCover.Locked = False
End Sub
'**** end of statusbar-related helper-routines

Have fun,

Olaf
Attached Images
Image may be NSFW.
Clik here to view.
 

Viewing all articles
Browse latest Browse all 1449

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>