Announcement

Collapse
No announcement yet.

Dumb Question On Control Creation

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • #21
    Originally posted by colin glenn View Post
    Need to have mouseover detection though, and the idea of wrapping a few hundred controls with a common subclass is NOT very good programming practice.
    You can get mouseover detection by using a timer routine to test mouse
    location at regular intervals and do something if necessary.
    Code:
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "win32api.inc"
    ENUM controlids SINGULAR
        id_txt01 = 500
        id_btnopen
        id_btnsave
        id_btnquit
        id_timer
    END ENUM
    FUNCTION PBMAIN () AS LONG
        LOCAL strtemp, strdir, strtoread AS STRING, hWin AS DWORD, hfont AS LONG
        DIALOG NEW PIXELS, 0, "TextBox Editor", , , 320, 240, %DS_MODALFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX TO hWin
        CONTROL ADD TEXTBOX, hWin, %id_txt01, "", 75, 5, 240, 230, %ES_MULTILINE OR %ES_WANTRETURN OR %WS_VSCROLL OR %ES_NOHIDESEL OR %WS_TABSTOP
        CONTROL ADD LABEL, hWin, %id_btnopen, "Open File", 5,   5, 65, 75, %SS_NOTIFY OR %SS_CENTER
        CONTROL ADD LABEL, hWin, %id_btnsave, "Save File", 5,  82, 65, 75, %SS_NOTIFY OR %SS_CENTER
        CONTROL ADD LABEL, hWin, %id_btnquit, "Quit Prog", 5, 160, 65, 75, %SS_NOTIFY OR %SS_CENTER
        FONT NEW "comic sans ms", 18 TO hfont
        CONTROL SET COLOR hWin, %id_btnopen, %RGB_DARKGRAY, %GRAY
        CONTROL SET FONT hWin, %id_btnopen, hfont
        CONTROL SET COLOR hWin, %id_btnsave, %RGB_DARKGRAY, %GRAY
        CONTROL SET FONT hWin, %id_btnsave, hfont
        CONTROL SET COLOR hWin, %id_btnquit, %RGB_DARKGRAY, %GRAY
        CONTROL SET FONT hWin, %id_btnquit, hfont
        settimer(hWin, %id_timer, 50, 0)
        DIALOG SHOW MODAL hWin CALL DlgProc
        FONT END hfont
    END FUNCTION
    CALLBACK FUNCTION DlgProc() AS LONG
        LOCAL strfilename, strtext AS STRING, hfile, lfile AS LONG, pt AS POINT
        STATIC highlighted AS LONG
        SELECT CASE CB.MSG
            CASE %WM_TIMER
                getcursorpos(pt)
                lfile = testpoint(CB.HNDL, pt)
                IF lfile THEN
                    GOSUB highlighting
                ELSE
                    IF highlighted THEN
                        CONTROL SET COLOR CB.HNDL, highlighted, %RGB_DARKGRAY, %GRAY
                        CONTROL REDRAW CB.HNDL, highlighted
                        highlighted = 0
                    END IF
                END IF
            CASE %WM_COMMAND
                SELECT CASE CB.CTL
                    CASE %id_btnopen
                        IF CB.CTLMSG = %STN_CLICKED THEN
                            DISPLAY OPENFILE CB.HNDL, , , "Open File", "",_
                                CHR$("Text File", 0, "*.txt", 0), "", "txt", 0 TO strfilename
                            IF strfilename = "" THEN EXIT FUNCTION
                            hfile = FREEFILE
                            TRY
                                OPEN strfilename FOR BINARY AS #hfile
                            CATCH
                                ? "Unable to open file for read operation."
                                EXIT FUNCTION
                            END TRY
                            lfile = LOF(#hfile)
                            GET$ #hfile, lfile, strtext
                            CLOSE #hfile
                            CONTROL SET TEXT CB.HNDL, %id_txt01, strtext
                            CONTROL SET FOCUS CB.HNDL, %id_txt01
                        END IF
                    CASE %id_btnsave
                        IF CB.CTLMSG = %STN_CLICKED THEN
                            DISPLAY SAVEFILE CB.HNDL, , , "Save File", "",_
                                CHR$("text", 0, "*.txt", 0), "text01", "txt", %OFN_OVERWRITEPROMPT  TO strfilename
                            IF strfilename = "" THEN EXIT FUNCTION
                            CONTROL GET TEXT CB.HNDL, %id_txt01 TO strtext
                            hfile = FREEFILE
                            TRY
                                OPEN strfilename FOR OUTPUT AS #hfile
                            CATCH
                                ? "Unable to open file for write operation."
                                EXIT FUNCTION
                            END TRY
                            PRINT #hfile, strtext
                            CLOSE #hfile
                            ? "File Saved."
                        END IF
                    CASE %id_btnquit
                        IF CB.CTLMSG = %STN_CLICKED THEN DIALOG END CB.HNDL
                    CASE %IDCANCEL: DIALOG END CB.HNDL
                END SELECT
        END SELECT
    EXIT FUNCTION
        highlighting:
            IF highlighted = lfile THEN RETURN
            IF highlighted THEN CONTROL SET COLOR CB.HNDL, highlighted, %RGB_DARKGRAY, %GRAY: CONTROL REDRAW CB.HNDL, highlighted
            CONTROL SET COLOR CB.HNDL, lfile, %YELLOW, %BLACK
            highlighted = lfile
            CONTROL REDRAW CB.HNDL, lfile
        RETURN
    END FUNCTION
    FUNCTION testpoint(dlg AS DWORD, pt AS POINT) AS LONG
        LOCAL x, xx, y, yy, offx, offy AS LONG
        LOCAL testtext AS STRING
        DIALOG GET LOC dlg TO offx, offy
        offx += METRICS(EDGE.X)
        offy += METRICS(EDGE.Y) * 2 + METRICS(CAPTION)
        CONTROL GET LOC dlg, %id_btnopen TO x, y
        CONTROL GET SIZE dlg, %id_btnopen TO xx, yy
        IF (pt.x < x + offx) OR (pt.x > offx + x + xx) THEN EXIT FUNCTION
        IF (pt.y < y + yy + offy) THEN FUNCTION = %id_btnopen: EXIT FUNCTION
        CONTROL GET LOC dlg, %id_btnsave TO x, y
        CONTROL GET SIZE dlg, %id_btnsave TO xx, yy
        IF (pt.y < y + yy + offy) THEN FUNCTION = %id_btnsave: EXIT FUNCTION
        FUNCTION = %id_btnquit
    END FUNCTION
    Last edited by Kurt Kuzba; 29 Jan 2016, 05:05 AM. Reason: Added example code for mouseover
    The world is strange and wonderful.*
    I reserve the right to be horrifically wrong.
    Please maintain a safe following distance.
    *wonderful sold separately.

    Comment

    Working...
    X