Got so drunk for St. Patricks Day, I programmed something in graphics...

[Kernelpanic]

Very well, Pete! Of course it also works with: Give me a drink

Mother In Laws Death 

[Steffan-68]

Updated post. Did some more highlighting using ctrl + arrows and optimized the code for home / end and cursor highlighting. Tightened up the code to disallow errant key presses.
Pete

Yes, you were probably very drunk. 

When I run the program like this and enter a website, it opens over 100 new tabs in Chrome and I can't find why.

[Pete]

Maybe you entered a website name that spawns other sites? If not, maybe you have a sticky F12 key. If that's what happened, it makes a good case for using _KeyHit instead of INKEY$. _KeyHit would allow us to wait until the key was released.

Now I love INKEY$ but it is a bit fickle. I noticed when testing, it would return a null value at times the key was  firmly held down. That ain't right! That makes it impossible to poll for that status change, unless we jimmy around with some tricks like using time loops...

Code: (Select All)

DO

    _LIMIT 60

    b$ = INKEY$

    SELECT CASE LEN(b$)

        CASE 0 ' Time loop to test for key release.

            IF LEN(oldb$) THEN

                IF ABS(z1 - TIMER) > .1 THEN

                    oldb$ = ""

                END IF

            END IF

        CASE 1

            IF b$ = CHR$(27) THEN SYSTEM ELSE PRINT b$;

        CASE 2

            IF oldb$ <> b$ THEN

                SELECT CASE b$

                    CASE CHR$(0) + CHR$(68): BEEP

                    CASE CHR$(0) + CHR$(133): PRINT "F11 "

                    CASE CHR$(0) + CHR$(134): PRINT "F12 "

                END SELECT

                oldb$ = b$

                SLEEP 1 ' Needed to prevent double entry.

            END IF

            z1 = TIMER

    END SELECT

LOOP

So hey guys, do you see the SLEEP 1 statement? For fun, take it out, run it again, and press and hold the F11 key. I always got a double printing of "F11" before it locked that key out without the SLEEP statement present. Same with F12. Adding SLEEP 1 took care of that. Another workaround was to increase the timer from .1 seconds to .5 or more. So why do either of these code modifications make a difference? Well, you might as well ask me what you get when you cross an elephant with a rhino... 

Elephino! 

Pete

[Pete]

Biggest bestest update so far. Check it out in the original post.

Also +2 to Steffan for helping me realize there was a repeating problem (fixed now) in the hypertext routine. He's probably still busy closing Chrome tabs, poor bastard!

Pete

[Pete]

Even bigger than the biggest bestest update, ever....

Now with text format control buttons. Text style and color can be manipulated the same way as in these posts, including universal replacement of highlighted text.

It's a bit buggy in the text line length restriction though. It can partially overprint the line when text character size gets stretched. I'll tighten that up sometime next week or so. I updated post #1 now, because I don't think I'll have the time to be coding for a few days.

Pete

[Pete]

Still working on length restrictions, but finished for paste and button universal font changes that affect length. Still have to work out a few over-margin errors that occur with typing. Not too much time to work on it this week, so we'll see how it goes.

Pete

[bplus]

Still working on length restrictions, but finished for paste and button universal font changes that affect length. Still have to work out a few over-margin errors that occur with typing. Not too much time to work on it this week, so we'll see how it goes.

Pete

have you discovered _Uprint and other assocuaited font tools for improved font rendering, another update to qb64pe while you were away I think. It might help but complicate controling text fitting into a box.

[Pete]

Thanks Mark, I'll have a look into it.

I got the length stuff resolved.Updated the post. Now, I need a few days to pressure test it before moving on.

Pete

[Pete]

Well this is what I came up with to work in fonts of differing heights. Click any of the 12 randomly generated text lines to move the cursor to the beginning of that line.

Code: (Select All)

$Color:32

Screen _NewImage(1100, 600, 32)

_Display ' Turn off autodisplay.

Color Black, _RGB32(255, 255, 255, 255)

Cls

_Delay .1

_ScreenMove _Middle

_Delay .1

_Clipboard$ = ""

Type textvar

    redo As Integer

    initiate As Integer ' -1 Indicates the Subroutine has been Initiated.

    nof As Integer ' Number of Fonts.

    maxchrs As Integer ' The Max Characters of a Text String. IMPORTANT: Cannot be over 255.

    fsn As Integer ' Font Selection Number 1 reg, 2 Bold, 3 Italic, 4 Bold Italic.

    noa As Integer ' Number of Text Attributes.

    lm As Integer ' Left Margin by Pixel.

    row As Integer ' Row by Pixel.

    rm As Integer ' Right Margin by Pixel.

    ccol As Integer ' Numeric Column of a Character.

    oldccol As Integer ' Numeric Column of the Previous Cursor Position.

    pixcol As Integer ' The Pixel Column the Cursor is On Currently.

    insreg As Integer ' Causes a Delay in Changing the Cursor Appearance When the Insert Key is Rapidly Pressed.

    reprnt As Integer ' Only Reprints a Row of Characters When Non-zero.

    ovr As Integer ' Overwrite mode When Non-zero, Otherwise Insert Mode.

    xl As Integer ' Pixel Column for a Character that is Part of a Link.

    mindex As Integer ' Numeric Matrix Index.

    fsize As Integer ' Font Size.

    underline As Integer ' Underline Text.

    link As Integer ' Hyperlink Text.

    c_wdth As Integer ' Cursor Width in Pixels

    c_hght As Integer ' Cursor Height in Pixels.

    numchrs As Integer ' Number of Characters in the Line of Text.

    sa As Integer ' Special Attributes for Paragraph, highlighting markers, etc.

    cchr As String ' Cursor Character.

    t As String ' Row of Text.

    m As String ' Text and Attributes to be Saved in an RA File.

    url As String ' URL Link to Follow.

    linkmap As String ' Maps Pixels for Link ID with Mouse.

    shift As Integer ' Shift Keys.

    autoshift As Integer ' Used for instances like mouse highlighting to mimic keyboard highighting.

    ctrl As Integer ' Ctrl key.

    alt As Integer ' Alt key.

    hl As Integer ' Highlighting Left (-1) or Right (+1)

    arrows As Integer ' Aids the Cursor Update Subroutine When Arrows are Used to Highliht Text.

    mouse_button1_row As Integer

    button1 As Integer

    hold_highlight As Integer

    maxhgt As Integer ''''''''''''

    tm As Integer

    tcopy As String ' Copied Text

    mcopy As String ' Copied Text Matrix

    button_map1 As String

End Type

Dim tx As textvar



Type mousevar

    mx As Integer

    my As Integer

    wh As Integer

    lb As Integer

    rb As Integer

    lb_status As Integer

    rb_status As Integer

    oldmx As Integer

    CursorStyle As Integer

    mousekey As String ' Auto Keyboard Input.

End Type

Dim m As mousevar



Dim Shared bit As _Bit

ReDim Shared cl(3) As Integer, bc(3) As Integer

ReDim Shared default_cl(3), default_bc(3)

tx.nof = 4

tx.fsize = 18

tx.maxchrs = 30 ' IMPORTANT: Cannot be over 255.

ReDim Shared fnum(tx.nof) As Long

ReDim Shared index_col(tx.maxchrs)

default_cl(1) = 0: default_cl(2) = 0: default_cl(3) = 0

default_bc(1) = 255: default_bc(2) = 255: default_bc(3) = 255

tx.fsn = 1 ' Default font style number.

tx.noa = 12 ' Number of character attributes.

''''tx.row = 100 ' Current row in pixels.

tx.lm = 100 ' Left margin in pixels. RIGHT MARGIN is assigned in SKIN subroutine.

tx.sa = 10 ' Number of special attributes.

cl(1) = default_cl(1): cl(2) = default_cl(2): cl(3) = default_cl(3)

bc(1) = default_bc(1): bc(2) = default_bc(2): bc(3) = default_bc(3)

tx.tm = 100 ' Top margin '''''''''''''''''

tx.m$ = String$(tx.sa + tx.maxchrs * (tx.noa + 1), Chr$(0)) ' Algorithm makes a 1 string field, 10 ID fields for highlighting, paragraph, plain text line, etc., and tx.noa attributes fields.

tx.t$ = String$(tx.maxchrs, Chr$(0)) ' Our text.

tx.linkmap$ = String$(_Width, Chr$(0))

' Matrix: 1-maxchrs text, maxchrs + 1 to maxchrs + 10 Special attributes, maxchrs + 11 on are attributes each tx.noa spaces long.

' Example: maxchrs = 255. tx.noa = 12. 1-255 text, 256-265 special attributes, 266-277 attributes for 1st character in text string, 278-289 2nd, etc.

f = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 18)

g = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 22)

h = _LoadFont(Environ$("SYSTEMROOT") + "\Fonts\lucon.ttf", 26)

_Font f

y = 100

noa = 2

v$ = String$(_Height, Chr$(0))

tx.ccol = 1

tx.c_wdth = 12

tx.row = tx.tm

For ii = 1 To 12

    a$ = "": tx.maxhgt = 0

    m$ = String$(500, Chr$(0))

    For i = 1 To 30

        a$ = a$ + Chr$(Rnd * 25 + 65)

    Next

    For i = 1 To Len(a$)

        c$ = Mid$(a$, i, 1)

        _Font f

        If Int(Rnd * 8) = 3 Then _Font h

        If Int(Rnd * 15) = 3 Then _Font g

        If _FontHeight > tx.maxhgt Then tx.maxhgt = _FontHeight

        Mid$(m$, 256 + 3, 1) = Chr$(tx.maxhgt)

        Mid$(m$, i, 1) = c$

        Mid$(m$, 266 + 0 + (i - 1) * noa, 1) = Chr$(_PrintWidth(c$))

        Mid$(m$, 266 + 1 + (i - 1) * noa, 1) = Chr$(_FontHeight)

        j = j + _PrintWidth(c$)

    Next

    j = 0

    tx.maxhgt = Asc(Mid$(m$, 256 + 3, 1))

    For i = 1 To Len(a$)

        c$ = Mid$(m$, i, 1)

        k = Asc(Mid$(m$, 266 + 1 + (i - 1) * noa, 1))

        Select Case k

            Case 18: _Font f

            Case 22: _Font g

            Case 26: _Font h

        End Select

        _PrintString (y + j, tx.row + tx.maxhgt - k), c$: _Display

        j = j + Asc(Mid$(m$, 266 + 0 + (i - 1) * noa, 1))

    Next

    Mid$(v$, tx.row + 1, tx.maxhgt) = String$(tx.maxhgt, Chr$(ii))

    If ii < 12 Then tx.row = tx.row + 6 + tx.maxhgt

Next

Do

    Locate 1, 620: Print m.my; "  "; ln; "  ";: _Display

    mouse m

    If Mid$(v$, m.my, 1) <> Chr$(0) Then _MouseShow "LINK" Else _MouseShow "DEFAULT"

    If m.lb_status = 1 Then

        bit = 0: text_cursor tx: bit = -1

        ln = Asc(Mid$(v$, m.my + 1))

        tx.row = InStr(v$, Chr$(ln)) - 1

    End If

    If Timer > cc! Then

        cc! = Timer + .25: If cc! > 86400 Then cc! = .25

        text_cursor tx

        bit = bit Xor 1

    End If

Loop



Sub mouse (m As mousevar)

    ' Local vars: i%,j%

    If Len(m.mousekey$) And m.lb_status <> 2 Then Exit Sub ' Bypass mouse when an automatic key was issued unless a drag event is occurring.

    While _MouseInput

        m.wh = m.wh + _MouseWheel

    Wend

    m.mx = _MouseX

    m.my = _MouseY

    m.lb = _MouseButton(1)

    m.rb = _MouseButton(2)

    Select Case m.lb

        Case 0

            Select Case m.lb_status

                Case -2

                    m.lb_status = 0 ' The clicked event and the release triggered any event structured to occur on release.

                Case -1

                    m.lb_status = -2 ' The clicked event triggered any event structured to occur on initial button press.

                Case 0

                    ' Button has not been pressed yet.

                Case 1

                    m.lb_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.

                Case 2

                    m.lb_status = 0 ' The drag event is over because the button was released.

            End Select

        Case -1

            Select Case m.lb_status ' Note drag is determined in the text highlighting routine.

                Case -1

                    ' An event occurred and the button is still down.

                Case 0

                    m.lb_status = 1

                Case 1

                    m.lb_status = -1 ' The button is down and triggered any event structured to occur on initial press.  The status will remain -1 as long as the button is depressed.

            End Select

    End Select

    Select Case m.rb

        Case 0

            Select Case m.rb_status

                Case -1

                    m.rb_status = 0 ' An event occurred and the button was released.

                Case 0

                    ' Button has not been pressed yet.

                Case 1

                    m.rb_status = 0 ' Button was released wth no event occurring.

            End Select

        Case -1

            Select Case m.rb_status

                Case -1

                    ' An event occurred and the button is still down.

                Case 0

                    m.rb_status = 1

                Case 1

                    ' The button is still down but no event occurred.

            End Select

    End Select

    m.oldmx = m.mx

End Sub



Sub text_cursor (tx As textvar)

    If bit Then ' Show cursor.

        If tx.ovr Then

            Line (tx.lm + index_col(tx.ccol - 1), tx.row)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth, tx.row + tx.maxhgt), _RGB32(0, 0, 0, 255), BF

        Else

            Line (tx.lm + index_col(tx.ccol - 1), tx.row + tx.maxhgt - 2)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth - 2, tx.row + tx.maxhgt - 2), _RGB32(default_cl(1), default_cl(2), default_cl(3), 255) ' Show blinking insert cursor.

        End If

    Else ' Hide cursor.

        Line (tx.lm + index_col(tx.ccol - 1), tx.row + tx.maxhgt - 2)-(tx.lm + index_col(tx.ccol - 1) + tx.c_wdth - 2, tx.row + tx.maxhgt - 2), _RGB32(default_bc(1), default_bc(2), default_bc(3), 255) ' Hide blinking insert cursor.

    End If

    _Display

End Sub

So to get it working in the project, I need to make a text line array, slightly change the cursor subroutine, and get the Enter key to work like a text editor. Beyond that is vertical scrolling when more lines are added than fits the page.

Pete

[Pete]

Well work went well... Updated 1st post. https://qb64phoenix.com/forum/showthread.php?tid=2531

Okay, so now we can make and save 1 page of text with up to 255 links on the page. Use the Enter key to go to a new line of text like an editor or IDE. Note there is no word wrap in this edition. Use CTRL + N for a new project, CTRL + S to save a project, and CTRL to O to open a saved project. Note this WIP release does not yet check to see if you want to save your work before starting a new project. It also does not compare your present project with a saved version, so until I get around to addressing these and other file management issues, well, just be aware they are in the works, but not in this release. Oh, I also removed link restrictions, so make sure if you want to go to a website, you start your input with http:// or https:// followed by the url like https://qb64phoenix.com. By removing that restriction we can now input things like "Notepad" into a link and it will open notepad when clicked. Notepad and some other registered Windows apps can be found by SHELL without the inclusion of a drive and path, but other programs you want to launch, using this method, will require you include the drive and path followed by the app name.

Pete