Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Resizing Program Window and Font
#1
Some folks were asking online about resizing a program window, and scaling, and changing text sizes and all. I thought I'd share this simple little demo for them for a quick little demo of the process.

Code: (Select All)
Dim f(10 To 36) As Long

Screen _NewImage(640, 480, 32)
For i = 10 To 36 Step 2
f(i) = _LoadFont("courbd.ttf", i, "monospace")
Next
fs = 16
_Font f(fs)

$Resize:On
Do
Cls
k = _KeyHit
Select Case k
Case 19712, 18432 'increase size
fs = fs + 2: If fs > 32 Then fs = 32
_Font f(fs)
Case 19200, 20480
fs = fs - 2: If fs < 10 Then fs = 10
_Font f(fs)
End Select

If _Resize Then
_Resize Off
Screen _NewImage(_ResizeWidth, _ResizeHeight, 32)
_Delay .2
_Resize On
junk = _Resize
End If



Locate 1, 21 'to test a line with an offset
test$ = "This is a very long sentence which runs on and on and one and even contains tipos and errors and goofs and mistakes and all sorts of junk, but it is good for testing if we have word breaks working properly for us!"
WordWrap test$, -1
Print 'to test a line from the starting point
WordWrap test$, -1
Print
Print "=============="
Print
WordWrap test$, 0 'And this shows that we can wordwrap text without automatically moving to a new line
WordWrap test$, -1 'As this line picks up right where the last one left off.

_Limit 30
_Display
Loop

Sub WordWrap (text As String, newline)
Dim BreakPoint As String
BreakPoint = ",./- ;:!" 'I consider all these to be valid breakpoints. If you want something else, change them.

w = _Width
pw = _PrintWidth(text)
x = Pos(0): y = CsrLin
If _PixelSize <> 0 Then x = x * _FontWidth
firstlinewidth = w - x + 1
If pw <= firstlinewidth Then
Print text;
If newline Then Print
Else
'first find the natural length of the line
For i = 1 To Len(text)
p = _PrintWidth(Left$(text, i))
If p > firstlinewidth Then Exit For
Next
lineend = i - 1
t$ = RTrim$(Left$(text, lineend)) 'at most, our line can't be any longer than what fits the screen.
For i = lineend To 1 Step -1
If InStr(BreakPoint, Mid$(text, i, 1)) Then lineend = i: Exit For
Next
Print Left$(text, lineend)
WordWrap LTrim$(Mid$(text, lineend + 1)), newline
End If
End Sub

Note that this incorporates an already existing simple WordWrap routine, which you can find here on the forums elsewhere. All I really did for this demo was toss in a quick $RESIZE:ON routine and a bit of code to handle resizing, and a quick set of fonts that we can change as we desire with in size with the arrow keys.

Grab an edge and freely resize your window as you like. Use the arrow keys to make the font the size you want.

If you'd like, you could always calculate the fontsize in proportion to the screen size and then automagically change it so the text just scales with the window, but the problem with that is the text might become too small to read if you scale the window smaller than original. Use the method that works best for you, but as you can see, this is a pretty simple way to resize a window and scale a font both. Maybe it'll be some use for anyone who needs to do this type of thing. Wink
Reply
#2
Have you thought about implementing this into the QB64 project with a _VIAGRA keyword? Of course users would have to seek IT attention for a window running maximised for 4 hours or more.

Pete Big Grin
Reply
#3
Okay, now that I have some time, I wanted to discuss the what's holding me back from the QB64 perspective. One thing that bugs me about the resizable window is the inability to control the window color. It's all Henry Ford GLUT based black, period. When we color the background and drag the window a black border keeps appearing as the window is resized, which produces a very unprofessional appearance compared to Win32 apps.

Example: Blue background with white text like the standard IDE...

Code: (Select All)
Dim f(10 To 36) As Long

Screen _NewImage(640, 480, 32)
For i = 10 To 36 Step 2
    f(i) = _LoadFont("courbd.ttf", i, "monospace")
Next
fs = 16
_Font f(fs)

$Resize:On
Do
    Cls , _RGB32(0, 0, 128)
    k = _KeyHit
    Select Case k
        Case 19712, 18432 'increase size
            fs = fs + 2: If fs > 32 Then fs = 32
            _Font f(fs)
        Case 19200, 20480
            fs = fs - 2: If fs < 10 Then fs = 10
            _Font f(fs)
    End Select

    If _Resize Then
        _Resize Off
        Screen _NewImage(_ResizeWidth, _ResizeHeight, 32)
        _Delay .2
        _Resize On
        junk = _Resize
    End If


    ' Locate 1, 21 'to test a line with an offset
    test$ = "This is a very long sentence which runs on and on and one and even contains tipos and errors and goofs and mistakes and all sorts of junk, but it is good for testing if we have word breaks working properly for us!"
    WordWrap test$, -1
    Color _RGB32(255, 255, 255), _RGB32(0, 0, 128)
    Print 'to test a line from the starting point
    WordWrap test$, -1
    Print
    Print "=============="
    Print
    WordWrap test$, 0 'And this shows that we can wordwrap text without automatically moving to a new line
    WordWrap test$, -1 'As this line picks up right where the last one left off.

    _Limit 30
    _Display
Loop

Sub WordWrap (text As String, newline)
    Dim BreakPoint As String
    BreakPoint = ",./- ;:!" 'I consider all these to be valid breakpoints.  If you want something else, change them.
    Color _RGB32(255, 255, 255), _RGB32(0, 0, 128)
    w = _Width
    pw = _PrintWidth(text)
    x = Pos(0): y = CsrLin
    If _PixelSize <> 0 Then x = x * _FontWidth
    firstlinewidth = w - x + 1
    If pw <= firstlinewidth Then
        Print text;
        If newline Then Print
    Else
        'first find the natural length of the line
        For i = 1 To Len(text)
            p = _PrintWidth(Left$(text, i))
            If p > firstlinewidth Then Exit For
        Next
        lineend = i - 1
        t$ = RTrim$(Left$(text, lineend)) 'at most, our line can't be any longer than what fits the screen.
        For i = lineend To 1 Step -1
            If InStr(BreakPoint, Mid$(text, i, 1)) Then lineend = i: Exit For
        Next
        Print Left$(text, lineend)
        WordWrap LTrim$(Mid$(text, lineend + 1)), newline
    End If
End Sub

Oh, I remarked out the offset, to avoid the locate error you'll get when downsizing the window past the offset margin.

Pete
Shoot first and shoot people who ask questions, later.
Reply


Possibly Related Threads…
Thread Author Replies Views Last Post
  Windows Font List SMcNeill 27 6,197 01-20-2026, 05:50 PM
Last Post: SMcNeill

Forum Jump:


Users browsing this thread: 1 Guest(s)