Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Small Sudoku entering routine

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

  • Small Sudoku entering routine

    ' Small Sudoku entering routine
    '
    ' This can be used in some of my previous programs or in your own.
    '
    ' Best regards,
    '
    ' Erik Christensen --------------- April 18, 2006
    Code:
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "WIN32API.INC"
    '
    %IDD_DIALOG1             =  101
    %IDC_BUTTON1             = 1101
    %IDC_LABEL1              = 1102
    '
    CALLBACK FUNCTION ShowDIALOG1Proc()
        LOCAL i AS LONG
        STATIC hFont AS LONG
        STATIC txt AS STRING, s AS STRING
        SELECT CASE AS LONG CBMSG
            CASE %WM_INITDIALOG
                ' The height and width of this font is designed to fit one number in each cell
                hFont = CreateFont(-23,20,0,0,700,0,0,0,0,3,2,1,82,"Arial")
                FOR i=1 TO 81
                    CONTROL SET TEXT CBHNDL, i+1000, ""
                    CONTROL SEND CBHNDL, i+1000, %WM_SETFONT, hFont, %TRUE
                    CONTROL SEND CBHNDL, i+1000, %EM_SETLIMITTEXT, 1, 0
                NEXT
                CONTROL SET FOCUS CBHNDL, 1001
            CASE %WM_COMMAND
                ' Process control notifications
                SELECT CASE AS LONG CBCTL
                    CASE 1001 TO 1081 ' any textbox
                        IF CBCTLMSG=%EN_CHANGE THEN
                            CONTROL GET TEXT CBHNDL, CBCTL TO txt
                            IF LEN(txt) = 1 THEN
                               IF VERIFY(txt, "123456789 ") = 0 THEN       ' only these characters are valid
                                   IF CBCTL < 1081 THEN
                                       CONTROL SET FOCUS CBHNDL, CBCTL + 1 ' advance to next cell
                                   ELSE
                                       CONTROL SET FOCUS CBHNDL, 1001      ' set to first cell
                                   END IF
                               ELSE
                                   CONTROL SET TEXT CBHNDL, CBCTL, ""
                               END IF
                            END IF
                        END IF
                    CASE %IDC_BUTTON1 ' Finished
                        IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN
                            s=""
                            FOR i = 1 TO 81
                               CONTROL GET TEXT CBHNDL, i+1000 TO txt
                               IF LEN(txt)=0 THEN txt="0"
                               s=s+txt
                            NEXT
                            REPLACE " " WITH "0" IN s
                            MSGBOX "Length of string is"+STR$(LEN(s))+" characters  "+$CRLF+$CRLF+"String is:"+$CRLF+$CRLF+s
                            DeleteObject(hFont)
                            DIALOG END CBHNDL
                        END IF
                END SELECT
        END SELECT
    END FUNCTION
    '
    FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
        LOCAL lRslt AS LONG
        LOCAL hDlg  AS DWORD
        LOCAL i AS LONG, j AS LONG, id AS LONG, x AS LONG, y AS LONG, k AS LONG
        DIALOG NEW PIXELS, hParent, "Enter Sudoku Puzzle", , , 394, 530, _
            %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
            %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR %DS_3DLOOK OR _
            %DS_NOFAILCREATE OR %DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_LEFT _
            OR %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
        CONTROL ADD BUTTON,  hDlg, %IDC_BUTTON1, "&Finished", 130, 478, 130, 30
        CONTROL ADD LABEL,   hDlg, %IDC_LABEL1, "Enter one line " + _
            "at a time. Use 1 to 9 or Space to enter. Moves automatically to " + _
            "next cell.  You can also click on each cell and then enter the " + _
            "number. Use Del or Backspace to delete a number or a space character.", 4, 8, 386, 68, _
            %WS_CHILD OR %WS_VISIBLE OR %SS_CENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
        '
        ' make textboxes
        id = 1000
        FOR i= 0 TO 8
            y=85+i*40
            IF i>2 THEN y=y+10
            IF i>5 THEN y=y+10
            FOR j = 0 TO 8
                INCR id
                x=10+j*40
                IF j>2 THEN x=x+10
                IF j>5 THEN x=x+10
                CONTROL ADD TEXTBOX, hDlg, id, "", x, y, 30, 30
            NEXT
        NEXT
        '
        ' make frames
        id = 2000
        FOR i= 0 TO 2
            y= 79+i*130
            FOR j = 0 TO 2
                x=4+j*130
                FOR k = 0 TO 1
                    INCR id
                    CONTROL ADD LINE, hDlg, id, "", x-k, y-k, 122+2*k, 122+2*k, %WS_CHILD OR %WS_VISIBLE OR %SS_BLACKFRAME
                NEXT
            NEXT
        NEXT
        DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
        FUNCTION = lRslt
    END FUNCTION
    '
    FUNCTION PBMAIN()
        ShowDIALOG1 %HWND_DESKTOP
    END FUNCTION
    ------------------


    [This message has been edited by Erik Christensen (edited April 19, 2006).]
Working...
X