Announcement

Collapse
No announcement yet.

Differences in INPUT QBasic vesus PBasic

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

  • Michael Mattias
    replied
    If you don't like it in the timeframe just because you do not understand it, then you are inherently going to want to keep it and learn because of the price

    If you can't decide in 30 days if you want it....

    A. You should not have ordered it when you did because you should have known you would not give it a fair trial
    OR
    B. It's not right for you; but you should be obliged to keep it anyway, since it took you so long to decide exactly nothing. Call it "procrastination costs" or something.

    MCM

    Leave a comment:


  • Fred Buffington
    replied
    Kevin, there is a learning curve for getting into the pbwin, but, at least for me,
    with all the great guys and gals here that so unselfishly help and submit code,
    it can really be not so lengthy a process. I still havent mastered SDK, (building custom windows/painting/etc.) but am getting into it slowly but surely. With DDT and the current enhancements I still can do all that I need to do.

    For example, my first major menu program was not with a typical menu bar but with a dialog full of buttons for different things. I also used console tools and graphics from Perfect Sync with pbcc to make my CC programs have the look and feel of a windows dialog.

    As for a trial copy, I think the only type of product like that that PB has is for pbdos. Personally I don't care for it, not because it's not a good product, but rather because, as I recall you cannot save or load programs but have to type them in each time to run them.

    Now there are plenty of samples, of course, and i was sold on PB when i saw how compatible it was with QuickBasic for input/output of files so many other commands/statements. Of course I new this was true for pbdos from the old quickbasic Bulletin boards that many times showed syntax for QB and PB if different. When I saw that PBcc and PBwin kept so many of these statements, i was sold.

    Leave a comment:


  • Chris Holbrook
    replied
    I suspect that the text editor for GRAPHIC WINDOW which I have just posted on the PBCC forum would handle six lines OK. However, it would cost you an upgrade to PBCC V5!

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Originally posted by Kevin Brown View Post
    Gosta, I pressume I can not run this on PBCC and that I would need to purchase a copy or obtain a trial copy of PBWin to run this.

    I've had a look at the code and I can see what some of it is doing.

    I don't know if there are trial copies of PBWin available.

    Kevin
    It probably won't run on PBCC (but James provided code that presumably works the same with CC). Don't have CC myself. Looking at the sample I posted again, I can see where it could have been better commented for you. At any rate, you can see PBWin is doable ("can see what is some of it is doing").

    For someone considering Windows programming, reading these forums can make it appear daunting, especially coming from a Basic\Dos background (and it can be daunting).

    However as you can see, Kevin, there's no lack of people to help a Newby get started.

    =====================================
    "The nice thing about egotists is
    they don't talk about other people."
    Lucille S. Harper
    =====================================

    Leave a comment:


  • Chris Holbrook
    replied
    Originally posted by Cliff Nichols View Post
    At least they give you the shot to try and return, no harm no foul
    That way of selling used to be called a "puppydog"!

    Leave a comment:


  • Cliff Nichols
    replied
    Like MCM said.

    But thats one of the things I LOVE about PB

    At least they give you the shot to try and return, no harm no foul

    If you don't like it in the timeframe just because you do not understand it, then you are inherently going to want to keep it and learn because of the price.

    If you don't like it just because you do not like it (not likely IMNSHO ) then at least you gave it a chance.

    If you don't like it because it does not do what you wanted? (More likely you did not research/understand enough....or they are still working on it)

    From my own personal experience, PB has been from the day I tried it ("Thinking SHYaaaa right" till this day my favorite software when it comes to speed, simplicity, complexity, and my willingness to learn

    Leave a comment:


  • Michael Mattias
    replied
    >I don't know if there are trial copies of PBWin available.

    I think PB still has the 30-day no-questions-asked money-back thing.

    But contact PB sales [email protected] or call (888) 659-8000 to get something official on this.

    Leave a comment:


  • jcfuller
    replied
    Here is another approach using ResEd by KetilO

    http://www.radasm.com/resed/

    James
    Attached Files

    Leave a comment:


  • jcfuller
    replied
    It can be done with PBCC 4.04.
    See attached.
    James
    Attached Files

    Leave a comment:


  • Kevin Brown
    replied
    Kevin, if you'd like to take a stab at using Windows instead of DOS
    Gosta, I pressume I can not run this on PBCC and that I would need to purchase a copy or obtain a trial copy of PBWin to run this.

    I've had a look at the code and I can see what some of it is doing.

    I don't know if there are trial copies of PBWin available.

    Kevin
    Last edited by Kevin Brown; 29 Oct 2008, 12:42 PM. Reason: learning how to add quotes

    Leave a comment:


  • Kevin Brown
    replied
    Dirrerences in INPUT QBasic versus PBasic

    Gents

    Adaptation of the code provided by Fred.

    Added arrays to provide 6 lines of text, use arrow up down keys to move up /down lines of text for edit.



    Kevin Brown


    Code:
     
    #COMPILE EXE
    'Power Basic Console Comiler  PBCC  4.0
    'Text Editor for editing 6 lines of text
    'Utility for other programs
    '
    ' L%   Length of string
    ' X%   Column position
    ' Y%   Row Position
    ' R%   Row 1 to 6 of text
    ' M%   Maximum number of rows
    ' Q8$  String on screen for viewer
    ' Z$   read INKEY$
    ' STT$ String after edit transfer to Q8$
    ' COL& Current cursor Column position
    ' ZZ&  Current cursor Column position
    GLOBAL Q1 AS STRING
    GLOBAL Q2 AS STRING
    GLOBAL STT$
    GLOBAL CL% 'AS INTEGER  'current line
    GLOBAL VA AS INTEGER
    GLOBAL AryT$()      'as string
    GLOBAL AryI%()
    GLOBAL Z$
    GLOBAL Z1$
    'ARRAY
    
    SUB MakeArrays
        CONSOLE NAME "Adapted 6 Line text editor utility"
    
     DIM AryI%(1 TO 6, 1 TO 5)
     DIM AryT$(1 TO 6)
     LOCAL HA AS INTEGER
     LOCAL EE%
     FOR VA =1 TO 6
              AryI%(VA,1)=VA: AryI%(VA,2)=6 :AryI%(VA,3)=10:AryI%(VA,4)=VA+4:AryI%(VA,5)=60
              AryT$(VA)= STRING$(60," ")
       NEXT VA
    
       'Display Array
       'FOR VA =1 TO 6
       '    LOCATE 14+VA,1
       '    FOR HA = 1 TO 5
       '     PRINT AryI%(VA,HA); " ";
       '    NEXT HA
       'NEXT VA
       'LOCATE 22,1
       'INPUT "AKP ",EE%
    END SUB
     
     
    
    SUB linput(X%,Y%,L%,Q8$) 'AS STRING
       CURSOR ON, 10
    
       'LOCATE Y%,X%-1
       '   PRINT "[";SPACE$(L%);TAB(71)"]";CL%  'Set up field
       'LOCATE Y%,X%
       Z$=""
     
       IF Q8$<>"" THEN
         STT$=Q8$
         LOCATE Y%,X%-1:PRINT"[" Q8$;TAB(71)"]";CL%
         LOCATE 15,1: PRINT "CONTROLS: Up/Down/Home/End/Delete/Backspace    Return/Esc to EXIT"
         '"Valid keys: Up/Down  Home/End Delete      Car.Return/Esc to Exit"
         LOCATE Y%,X%
         STT$=Q8$
       END IF
        ' Z$=""
    Start:
       WHILE Z$="":Z$=INKEY$:WEND
       IF LEN(Z$)=1 THEN
          SELECT CASE ASC(Z$)
            CASE 13 'Enter
               Z1$ = Z$
             EXIT SUB
    
            CASE 27 'Esc
                Z1$=Z$
              EXIT SUB
    
            CASE 8 'backspace destructive
              COL&=CURSORX
              XX$=MID$(STT$,1,COL&-X%+1-2)+MID$(STT$,COL&-X%+1)
              STT$=XX$
              COL&=COL&-1
              COL&=MAX(COL&,X%)
              LOCATE Y%,X%:PRINT SPACE$(L%);:LOCATE Y%,X%:PRINT STT$;TAB(71)"]";CL%    'Reprint with latest char. inserted/added
              LOCATE Y%,COL&
              Z$=""
            CASE ELSE
                      'Add char. or insert char.
                 ZZ&=CURSORX
                 STT$=MID$(STT$+SPACE$(L%),1,L%)                'Make full length string with spaces on end
                 LOCA&=ZZ&-X%+1                                 'Location where to inser/add char.
                 XXX$=MID$(STT$,1,LOCA&-1)+Z$+MID$(STT$,LOCA&)  'Add in Z$ at LOCA& position
                 STT$=XXX$
                 LOCATE Y%,X%:PRINT STT$;                       'Reprint with latest char. inserted/added
                 LOCATE Y%,X%+L%:PRINT ;TAB(71)"]"; CL%;
                 LOCATE Y%,ZZ&+1
          END SELECT
          Z$=""
          GOTO Start
       ELSEIF LEN(Z$)=2 THEN
          aa&=ASC(RIGHT$(Z$,1))
          SELECT CASE aa&
     
            CASE 71 'Home
              LOCATE Y%,X%
            CASE 72 ' UP Arrow
                Z1$ = Z$
                EXIT SUB
    
            CASE 75 'left arrow
              COL&=CURSORX
              IF COL&>X% THEN COL&=COL&-1:LOCATE Y%,COL&
            CASE 77 'right arrow
              COL&=CURSORX
              IF COL&<X%+L% THEN COL&=COL&+1:LOCATE Y%,COL&
    
            CASE 79 'End
                CURSOR ON, 10
              LOCATE Y%,X%+ LEN(STT$)-1
     
            CASE 80 'down arrow
                Z1$ = Z$
                EXIT SUB
    
            CASE 82 'insert
              'ignore for now  see above add/insert
    
            CASE 83 'delete
              CURSOR ON, 10
              COL&=CURSORX
              LOCA&=COL&-X%+1                              'Location where to delete char.
              XXX$=MID$(STT$,1,LOCA&-1)+MID$(STT$,LOCA&+1) 'Delete char. at LOCA& position
              STT$=MID$(XXX$+SPACE$(L%),1,L%)              'Make full length string with spaces on end
              LOCATE Y%,X%:PRINT STT$; ;TAB(71)"]";CL%     'Reprint with latest char. deleted
              LOCATE Y%,COL&
            CASE ELSE
          END SELECT
    
           Z$=""
           GOTO start
       ' ELSEIF LEN(Z$)=4 'mouse
           'mouse code here
       END IF
    END SUB
    
    SUB EndProg
    LOCAL StartTime AS DOUBLE
    LOCAL TimePast AS DOUBLE
    LOCAL TD AS SINGLE
       LOCATE 15,1
         PRINT STRING$(80," ")
       LOCATE 15,1
         PRINT "Program is ending, press any key to finish."
         TD = 1.0
        StartTime = TIMER
        WHILE  TimePast < TD
        TimePast = TIMER -StartTime
        WEND
        TimePast= 0
    WAITKEY$
    END SUB
     
     
    SUB MakeLines
    
       'IF CL%= 0 THEN
       CL% = AryI%(1,1)
       CONSOLE SCREEN 26,80
    
       'Fred Q6$=linput(10,5,60,"")
       CALL linput(10,AryI%(CL%,4),60,AryT$(CL%))
    Start1:
       WHILE Z1$="":Z1$=INKEY$:WEND
       IF LEN(Z1$)=1 THEN
           SELECT CASE ASC(Z1$)
            CASE 13 'Enter
               EXIT SUB
             CASE 27 'Esc
                EXIT SUB
         END SELECT
         END IF
    
       IF LEN(Z1$)=2 THEN
          aa1&=ASC(RIGHT$(Z1$,1))
          SELECT CASE aa1&
            CASE 72 ' UP Arrow
                AryT$(CL%)=STT$:STT$ =""
                IF CL% > 1 THEN CL% = CL% -1 ELSE CL% =6
                CALL linput(10,AryI%(CL%,4),60,AryT$(CL%))
            CASE 80 'Down arrow
              AryT$(CL%)=STT$:STT$=""
               IF CL% < 6 THEN  CL% = CL% + 1 ELSE CL% =1
               CALL linput(10,AryI%(CL%,4),60,AryT$(CL%))
              'Z1$=""
            ''CASE ELSE
              ' eXIT SUB
            END SELECT
         END IF
      GOTO Start1
     
    END SUB
    
    'DECLARE FUNCTION linput(X%,Y%,L%,Q8$) AS STRING
    FUNCTION PBMAIN() AS LONG
    CALL MakeArrays
    CALL MakeLines
    CALL EndProg
     
    END FUNCTION
    __________________

    Leave a comment:


  • Michael Mattias
    replied
    >Using PBCC to work with Parts via Random Access Files

    Syntax is nearly identical and usage is exactly identical to both QBasic and QuickBasic (and PowerBASIC for DOS, for that matter).

    (And now that compiler supports FIELD, you can even use those if you are comfy with them).

    Leave a comment:


  • Kevin Brown
    replied
    Differences in INPUT Qbasic versus PBasic

    Gents thank you all for you advise and suggestions, I have now have two possible solutions to my initial post.

    The first one here is one I wrote, I will also send a copy of an adaptation of the solution offered by Fred, thanks indeed Fred, did you honestly just knock that together in a few minutes ?

    Every journey starts with the first footstep, I suppose I'm at least a yard or so into the journey, now where are those bridges y'all been talking about. Seriously guys thanks for the assistance, looking forward to taking on my first real useful project below, but before that I will take a look at and try and understand the code that you all sent.

    Next Project:
    Using PBCC to work with Parts via Random Access Files, this in time will probably lead me to raise questions on databases, however for the meantime, I can work with GET and PUT from these files and work in one of these text editors to help. This will not be such as massive task but by the time I have done it I'm sure I will be asking questions on PBWin
    versus PBCC for the applications I have.




    Kevin Brown


    Code:
     
     
    '
    'Power Basic Console Compiler  PBCC  4.0
    'Text Editor for editing 6 lines of text
    'Utility for other programs
    '
    GLOBAL I$              'keyboard input
    GLOBAL FCN AS INTEGER  'Foreground
    GLOBAL BCN AS INTEGER  'Background
    GLOBAL SCN AS INTEGER  'Screen
    
    GLOBAL CP AS INTEGER   'Cursor posn
    GLOBAL IC$             'Insert mode
    GLOBAL LN AS STRING    'Line
    GLOBAL L1 AS STRING    'Line 1
    GLOBAL L2 AS STRING    '2
    GLOBAL L3 AS STRING    '3
    GLOBAL L4 AS STRING    '4
    GLOBAL L5 AS STRING    '5
    GLOBAL L6 AS STRING    '6
    GLOBAL LS AS INTEGER   'Length of string
    GLOBAL FC AS INTEGER   'First charachter
    GLOBAL CL AS INTEGER   'Current line
    GLOBAL LL AS INTEGER   'Last line
    GLOBAL FL AS INTEGER   'First line
    GLOBAL CV AS INTEGER   'Cursor Vertical Positionc
    GLOBAL FV AS INTEGER   'Firt Vertical
    GLOBAL NV AS INTEGER   'Number of verticals
    GLOBAL CS AS INTEGER   'Cursor Min Horz
    GLOBAL CM AS INTEGER   'Cursor Max Horz
    GLOBAL TD AS DOUBLE    'TimeDelay
    GLOBAL StartTime AS DOUBLE
    GLOBAL TimePast AS DOUBLE
     
    
     SUB  ColorScreen
     CONSOLE SCREEN 26,80
        PRINT "Press any key to proceed "
                   'FCN Foreground
                   'BCN Background
         IF FCN = 0 THEN FCN = 7
         IF BCN = 0 THEN BCN = 0
        COLOR FCN,BCN
        'COLOR [foreground], [background]
        '0 Black      '1 Blue    '2 Green    '3 Cyan    '4 Red    '5 Magenta    '6 Brown
        '7 White    '8 Gray    '9 Light blue    '10 Light green    '11 Light cyan    '12 Light red
        '13 Light magenta    '14 Yellow    '15 High intensity white
    END SUB
    
    SUB ArrowDown
        IF CL = LL THEN CL =1: CV =FV  ELSE CL =CL +1:CV =CV +1
        CALL LineEdit
        CP =10 + LEN(LN)
        CALL LineEdit
    END SUB
    SUB ArrowUp
        IF CL = FL THEN CL =LL: CV = FV + (NV-1) ELSE CL =CL -1 :CV =CV -1
        CALL LineEdit
        CP =10 + LEN(LN)
        CALL LineEdit
    END SUB
    SUB ArrowRight
        IF CP = CM THEN CP = 10 ELSE CP = CP +1
    END SUB
    
    SUB ArrowLeft
         IF CP =CS THEN CP =CM ELSE CP = CP -1
    END SUB
     
    SUB CharcAdd
        CALL LineEdit
        IF CP < = 69 THEN LN= LN+I$:  CP=(CP+1)
        CALL LineDone
    END SUB
    
    SUB CharcCut
        CALL LineEdit
          LN= LEFT$(LN,(CP-FC))+RIGHT$(LN,(LEN(LN)-(CP-FC+1)))
        CALL LineDone
    END SUB
    SUB CharcLastCut
        CALL LineEdit
         IF CP > 10 THEN LN= LEFT$(LN, (LEN(LN) -1)):CP =(CP -1)
        CALL LineDone
    END SUB
    
    SUB CharcFindWords
        CALL LineEdit
           CP = CP + 1
           IF CP = LEN(LN) + 10 THEN CP =10
           CP = (INSTR((CP-(10)) , LN, " ")) + 10
         CALL LineDone
    END SUB
     
    
    SUB CharcInsert
        CALL LineEdit
        IF LEN(LN) < = 59 THEN LN= LEFT$(LN,(CP-FC))+ I$ +RIGHT$(LN,(LEN(LN)-(CP-FC))): CP=(CP+1)
        CALL LineDone
    END SUB
     
    SUB CharcOverite
        CALL LineEdit
           LN= LEFT$(LN,(CP-FC))+ I$ +RIGHT$(LN,(LEN(LN)-(CP-FC+1))): CP=(CP+1)
        CALL LineDone
    END SUB
    
    SUB LineEdit
        IF CL = 1 THEN LN =L1: LS = LEN(L1)
        IF CL = 2 THEN LN =L2: LS = LEN(L2)
        IF CL = 3 THEN LN =L3: LS = LEN(L3)
        IF CL = 4 THEN LN =L4: LS = LEN(L4)
        IF CL = 5 THEN LN =L5: LS = LEN(L5)
        IF CL = 6 THEN LN =L6: LS = LEN(L6)
    END SUB
    
    SUB LineDone
        IF CL = 1 THEN L1 = LN:LS = LEN(L1)
        IF CL = 2 THEN L2 = LN: LS = LEN(L2)
        IF CL = 3 THEN L3 = LN: LS = LEN(L3)
        IF CL = 4 THEN L4 = LN: LS = LEN(L4)
        IF CL = 5 THEN L5 = LN: LS = LEN(L5)
        IF CL = 6 THEN L6 = LN: LS = LEN(L6)
    END SUB
    
    SUB KeyBoard
        FC =10
        COLOR FCN,BCN
        CONSOLE NAME "6 Line Text Editor utility"
        CURSOR ON  ,05
        'IF CP = 0 THEN CP = FC
    DO
       ' TD = 0.1
       ' StartTime = TIMER
       ' WHILE  TimePast < TD
       ' TimePast = TIMER -StartTime
       ' WEND
       ' TimePast= 0
    
        I$ = WAITKEY$  ' Wait for a key or mouse event
       FL =1
       LL =6
       FV = 9
       NV = 6
       CS =10
       CM =70
          'Current line
        IF CL = 0 THEN CL=1: I$ =""
        IF CP = 0 THEN CP =10 'CS
        IF CV = 0 THEN CV =9
        IF LEN(I$) = 1 AND ASC(I$, 1) = 13 THEN EXIT DO        'Car Return
        IF LEN(I$) = 2 AND ASC(I$, 2) = 71 THEN   CP = FC :CURSOR ON,05        ' Home
        IF LEN(I$) = 2 AND ASC(I$, 2) = 75 THEN   CALL ArrowLeft               '<
        IF LEN(I$) = 2 AND ASC(I$, 2) = 77 THEN   CALL ArrowRight              '>
        IF LEN(I$) = 2 AND ASC(I$, 2) = 80 THEN   CALL ArrowDown :CURSOR ON,05 'Down arrow
        IF LEN(I$) = 2 AND ASC(I$, 2) = 72 THEN   CALL ArrowUp:CURSOR ON,05    'UP arrow
        IF LEN(I$) = 2 AND ASC(I$, 2) = 79 THEN   CP = LS+FC :CURSOR ON,05     'End
     
              'Set up Cursor for insert /Delete
          DO
            'Insert
            IF LEN(I$) = 2 AND ASC(I$, 2) = 82 AND IC$="Insert"  THEN IC$="":CURSOR ON,05 :EXIT DO
            IF LEN(I$) = 2 AND ASC(I$, 2) = 82 AND IC$=""  THEN IC$="Insert" :CURSOR ON,75:EXIT DO
            IF LEN(I$) = 2 AND ASC(I$, 2) = 82 AND IC$="Insert"  THEN IC$="" :CURSOR ON,05:EXIT DO
            'Delete
            IF LEN(I$) = 2 AND ASC(I$, 2) = 83 THEN IC$="" :CURSOR ON,05
          LOOP UNTIL IC$ ="Insert" OR IC$=""
    
          'Tab use to find blanks between words & position cursor on each word
          IF LEN(I$) = 1 AND ASC(I$, 1) = 9  THEN CALL CharcFindWords
              DO
                 'Delete intermediate
                IF LEN(I$) = 2 AND ASC(I$, 2) = 83 AND (CP-FC)<LS THEN CALL CharcCut:EXIT DO
                 'Backspace delete intermediate charc
                 IF LEN(I$) = 1 AND ASC(I$, 1) = 8 AND (CP-FC)<LS THEN CALL CharcCut:EXIT DO
                 'Backspace delete last charc
                IF LEN(I$) = 1 AND ASC(I$, 1) = 8 AND CP = LS + FC THEN CALL CharcLastCut:EXIT DO
                  'Insert text WITH insert ON
                IF LEN(I$) = 1 AND IC$ ="Insert" AND ASC(I$, 1)> 31 AND ASC(I$, 1)< 128 THEN CALL CharcInsert:EXIT DO
                  'Insert text WITH insert OFF but cursor location to left of end
                IF LEN(I$) = 1 AND IC$="" AND CP >11  AND CP < 10+LS AND ASC(I$, 1)> 31 AND ASC(I$, 1)< 128 THEN CALL CharcOverite:EXIT DO
    
                  'Add text to end of string
                IF LEN(I$) = 1 AND IC$ ="" AND CP>= 10+LS AND ASC(I$, 1)> 31 AND ASC(I$, 1)< 128 THEN CALL CharcAdd :EXIT DO
                EXIT DO
              LOOP
    
                LOCATE 1,1
                            'Development information
                          'PRINT TAB(2)"Temporary Development Data";TAB (55) I$; TAB(65) "CHR$("; ASC(I$, 1); ")"
                          'PRINT TAB (2) ">"MID$ (LN, (CP-(10-1)),1)"<"TAB (55) I$; TAB(65) "CHR$(0,"; ASC(I$, 2); ")"
                          'PRINT TAB(2)IC$ TAB(12)"Line " CL TAB(25)"String " LS " Cursor " CP
                          PRINT""
                          PRINT""
                          PRINT""
                          PRINT ""
                          PRINT ""
                          PRINT ""
                          PRINT ""
                          PRINT TAB(9)CHR$(201) STRING$(61,CHR$(205)) CHR$(187)
                          PRINT TAB(9)CHR$(186)TAB(10) L1   TAB(71)CHR$(186)TAB(73)"1"
                          PRINT TAB(9)CHR$(186)TAB(10) L2   TAB(71)CHR$(186)TAB(73)"2"
                          PRINT TAB(9)CHR$(186)TAB(10) L3   TAB(71)CHR$(186)TAB(73)"3"
                          PRINT TAB(9)CHR$(186)TAB(10) L4   TAB(71)CHR$(186)TAB(73)"4"
                          PRINT TAB(9)CHR$(186)TAB(10) L5   TAB(71)CHR$(186)TAB(73)"5"
                          PRINT TAB(9)CHR$(186)TAB(10) L6   TAB(71)CHR$(186)TAB(73)"6"
                          PRINT TAB(9)CHR$(200) STRING$(61,CHR$(205))CHR$(188)
                          PRINT""
                          PRINT "CONTROLS: Up/Down/Home/End/Delete/Backspace/Inset/Tab   Return/Esc to EXIT"
                          LOCATE CV, (CP)
                 IF LEN(I$) = 1 AND ASC(I$, 1) = 13 THEN EXIT DO        'Car Return
                 IF LEN(I$) = 1 AND ASC(I$, 1) = 27 THEN EXIT DO        'Esc
             I$=""
       LOOP UNTIL ASC(I$, 1) = 27
    
    END SUB
    
    SUB EndProg
    
    LOCAL StartTime AS DOUBLE
    LOCAL TimePast AS DOUBLE
    LOCAL TD AS SINGLE
        LOCATE 17,1
         PRINT STRING$(80," ")
        LOCATE 17,1
         PRINT "Program is ending, press any key to finish."
         TD = 1.0
        StartTime = TIMER
        WHILE  TimePast < TD
        TimePast = TIMER -StartTime
        WEND
        TimePast= 0
    WAITKEY$
    END SUB
     
    '------------------------------
    ' Main program entry point...
    '
    FUNCTION PBMAIN () AS LONG
     CALL ColorScreen
     CALL KeyBoard
     CALL EndProg
    END FUNCTION

    Leave a comment:


  • Arie Verheul
    replied
    Example of Windows style input

    Last winter i wrote as an exercise (collected from examples on this forum) a Windows style input routine.
    It also includes a menu, and font setting.
    It takes some effort to grasp it, but if this it what you want it may be worth the trouble

    Arie Verheul

    Code:
    #Compiler PBCC
    #Console Off
    #Dim All
    %CCWIN = 1
    %NumWindows = 5
    $Include "WIN32API.INC"
    #Include "comdlg32.inc"
     
    Type WindowParm
        x       As Long
        y       As Long
        Length  As Long
    End Type
    Global WParms () As WindowParm
    Declare Function PBMenu () As Long
    Declare Sub SelectFont (hWndEdit() As Dword, Mode As Byte)
     
    ' ---------------------------------------------------------------------
    Function WinMain (ByVal hCurrInstance As Long,_
                      ByVal hPrevInstance As Long,_
                      ByVal lpCmdLine     As Asciiz Ptr,_
                      ByVal nCmdShow      As Long) As Long
      Local  msg            As tagMsg,_
             wClass         As WndClassEx,_
             hWnd           As Dword
     
    Local szAppName   As Asciiz*20        'Must be long enough
      szAppName = "Tekst Invoer"           'Set application name
      nCmdShow = %SW_Normal
      wClass.cbSize        = SizeOf(wClass)
      wClass.style         = %CS_HREDRAW Or %CS_VREDRAW
      wClass.lpfnWndProc   = CodePtr(MainWndProc)
      wClass.hInstance     = hCurrInstance
      wClass.hIcon         = LoadIcon  (%Null, ByVal %IDI_APPLICATION) 'loads an icon for use by the program
      wClass.hCursor       = LoadCursor(%Null, ByVal %IDC_ARROW)       'loads a mouse cursor for use by the program
      wClass.hbrBackground = CreateSolidBrush (RGB (0,72,0))
      wClass.lpszMenuName  = %Null
      wClass.lpszClassName = VarPtr(szAppName)
      wClass.hIConSm       = LoadIcon  (%Null, ByVal %IDI_APPLICATION) 'loads an icon for use by the program
     
      Call RegisterClassEx (wClass)                'registers a window class for the program window
                                                   'creates a window based on registered window class
      hWnd = CreateWindow (szAppName,_              'window class name
                           szAppName,_                  'window caption
                           %WS_OVERLAPPEDWIN,_          'window style
                           100,_             'initial x position
                           100,_             'initial y position
                           800,_             'initial x size
                           500,_             'initial y
                           %Null,_                      'parent window handle
                           PBMenu (),_                  'window menu handle
                           hCurrInstance,_              'program instance handle
                           %Null)                       'creation parameter
     
      ShowWindow   (hWnd, nCmdShow)         'displays the window on the screen
      While GetMessage(Msg, %Null, 0, 0)    'gets a message from the message queque
        TranslateMessage (Msg)              'translates some keyboard messages
        DispatchMessage  (Msg)              'sends a message to a window procedure
      Wend
      Function = Msg.wParam
    End Function
     
    ' ----------------------------------------------------------------------
    Function MainWndProc(ByVal hWnd    As Dword,_
                         ByVal wMsg    As Dword,_                   ' message identifier
                         ByVal wParam  As Dword,_                   ' message parameter
                         ByVal lParam  As Dword) Export As Long
     
      Dim hWndEdit(%NumWindows) As Static Dword
      Static lpCS As CREATESTRUCT Ptr
      Local TextFlags As Dword
      Local N As Long
      '--------------------------------------------------------------------
      'Window specification
      Dim WParms(%NumWindows) As WindowParm
            WParms(1).x = 200 : WParms(1).y = 100 : WParms(1).Length = 400
            WParms(2).x = 200 : WParms(2).y = 150 : WParms(2).Length = 400
            WParms(3).x = 200 : WParms(3).y = 200 : WParms(3).Length = 90
            WParms(4).x = 300 : WParms(4).y = 200 : WParms(4).Length = 300
            WParms(5).x = 200 : WParms(5).y = 250 : WParms(5).Length = 300
      '--------------------------------------------------------------------
     
        Select Case wMsg
        Case %WM_CREATE
          lpCS = lParam
          hWndEdit (0) = hWnd
          TextFlags = %WS_CHILD Or %WS_VISIBLE Or %WS_BORDER
          For N = 1 To %NumWindows
          hWndEdit(N) = CreateWindow ("Edit",_              'window class name
                                   ByVal %Null,_         'window caption
                                   TextFlags,_
                                   0,_                   'initial x position
                                   0,_                   'initial y position
                                   0,_                   'initial x size
                                   0,_                   'initial y
                                   hWnd,_                'parent window handle
                                   1,_                   'window menu handle
                                   @lpCS.hInstance,_     'program instance handle
                                   %Null)                'creation parameter
          Next
          Function = 0
        Case %WM_SETFOCUS : SetFocus (hWndEdit(1)): Function = 0
        Case %WM_SIZE : SelectFont (hWndEdit(), 0) : Function = 0
        Case %WM_COMMAND        ' Menu processing
            Select Case LoWrd(wparam)
                Case  101 :
                Case  102 :
                Case  103
                Case  201 :
                Case  202 :
                Case  203 :
                Case  204 : SelectFont (hWndEdit(), 1)
            End Select
            Function = 0
        Case %WM_DESTROY : PostQuitMessage(0) : Function = 0
     
        Case Else
            Function = DefWindowProc(hWnd, wMsg, wParam, lParam)
      End Select
    End Function
    ' --------------------------------------------------------------------------
    Function PBMenu () As Long
        Local hMenu, sMenu As Long
        hMenu = CreateMenu
        sMenu = CreatePopUpMenu
        AppendMenu hMenu, %MF_POPUP, sMenu, LSet$ ("&File", 20)
        AppendMenu sMenu,%MF_STRING,101,"&Open"
        AppendMenu sMenu,%MF_STRING,102,"&Save"
        AppendMenu sMenu,%MF_STRING,103,"&Exit"
        sMenu = CreatePopUpMenu
        AppendMenu hMenu, %MF_POPUP, sMenu, LSet$ ("&Edit", 20)
        AppendMenu sMenu,%MF_STRING,201,"&Copy"
        AppendMenu sMenu,%MF_STRING,202,"&Paste"
        AppendMenu sMenu,%MF_STRING,203,"&Delete"
        AppendMenu sMenu,%MF_STRING,204,"&Font"
        Function  = hMenu           ' Goes to CreateWindow call
    End Function
     
    ' ---------------------------------------------------------------
    Sub SelectFont (hWndEdit () As Dword, Mode As Byte)
      Local lfFont As LOGFONT
      Local hFont  As Long
      Local hFontNew As Long
      Local WindowRect    As RECT
      Local WindowHeight As Long
      Local N As Long
      N = FreeFile
      Open "D:\PBCC\SetFont.dat" For Binary As N
      If Lof(N) < 30 Then Mode = 1
      Get N,1,lfFont
                           ' Mode = 0 Restore previous font from data file
      If Mode = 1 Then     ' Mode = 1 Set Font
            Local cf As CHOOSEFONTAPI   ' Initialiseer Choosefontbox
            cf.lStructSize    = SizeOf(cf)
            cf.hWndOwner      = hWndEdit(0)
            cf.lpLogFont      = VarPtr(lfFont)
            cf.Flags          =  %CF_SCREENFONTS _
                              Or %CF_INITTOLOGFONTSTRUCT _
                              Or %CF_NOSCRIPTSEL _
                              Or %CF_TTONLY
            ChooseFont (cf)
            Put N,1,lfFont
      End If
      Close N
            hFontNew = CreateFontIndirect (lfFont)
            DeleteObject (hFont)
            hFont = hFontNew
            WindowHeight = -9 * lfFont.lfHeight \ 7
      For N = 0 To %NumWindows
            SendMessage (hWndEdit(N), %WM_SETFONT, hFontNew, 0)
            If N = 0 Then Iterate For
            GetClientRect  (hWndEdit(N), WindowRect)
            InvalidateRect (hWndEdit(N), WindowRect, %TRUE)
            MoveWindow(hWndEdit(N), WParms(N).x, WParms(N).y, WParms(N).Length, WindowHeight, %True)
       Next
     End Sub
    ' ---------------------------------------------------------------

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Originally posted by Fred Buffington View Post
    Gösta, I think he's using PBcc4
    He probably is Fred. I just thought if he wanted to take a flyer on Windows (as most of us eventually want to do), I thought a simple example might encourage him sooner. However after I cobbled the simple sample together, I guess it really doesn't look all that "simple" when compared to a Dos Basic. {sigh}. Best intentions and all that.

    ===============================================
    "There's many a bestseller that
    could have been prevented by a good teacher."
    Flannery O'Connor (1925-1964)
    ===============================================

    Leave a comment:


  • Fred Buffington
    replied
    Gösta, I think he's using PBcc4

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    Kevin, if you'd like to take a stab at using Windows instead of DOS, here's a quick sample using all the edit keys in a Textbox.

    '
    Code:
    'PBWIN 9.00 - WinApi 05/2008 - XP Pro SP3
    #Dim All 
    #Compile Exe  
    #Include "WIN32API.INC"
    '
    Global hdlg As Dword                
     
    %Id_Exit_Btn = 1000
    %Id_Sample_Textbox = 1001
    %Id_Show_Result_Btn = 1002
    ' 
    Macro Common_Locals 'Macro easier than retyping and maintains coding consistency
      Global Dlg_hght, Dlg_Wd As Long 'Global in case want to use in Controls
      Local Row, col, hght, wd, Longest,ctr, ln, ln1, i As Long
      Local  l, s As String
    End Macro  
    '
    CallBack Function Dialog_Processor              
      Common_Locals
      Select Case CbMsg     'This is TO determine the message TYPE 
         '       
         Case %WM_INITDIALOG'<- Initialiaton when the program loads 
         '
         Case %WM_SYSCOMMAND 'Traps Any Alt key but only F4 closes              
         '
         Case %WM_COMMAND  'This processes command messages
           Select Case CbCtl
             Case %Id_Show_Result_Btn 
                Control Get Text CbHndl, %Id_Sample_Textbox To l$
                  ? l$, , FuncName$
             Case %Id_Exit_Btn
               Select Case CbCtlMsg        
                  Case 0
                    Dialog End CbHndl
               End Select
           End Select
      End Select
    End Function
    '
    Function PBMain
      Common_Locals
      Dlg_hght = 400
      Dlg_Wd = 400
      Dialog New Pixels, hdlg, "Demo", , , Dlg_Wd, Dlg_Hght, %WS_SYSMENU To hdlg 'centered
     
      Row = 10
      col = 10
      Wd = 40
      Hght = 12
      Control Add Label, hdlg, -1, " Name & Address ", Col, Row, Wd, Hght
     
      s$ = "Brown, Kevin" & $CrLf & _
           "123 PBWin Avenue" & $CrLf & _
           "PowerBasic, FL 12345"
     
      Col = Col + Wd + 10 'just past label 
      Hght = 15 * 10 'Plenty room for 10 lines of text
      Wd = Dlg_Wd - 40 - 30 'minus the label and leave a little
      Control Add TextBox, hdlg, %Id_Sample_Textbox, s$, Col, Row, Wd, Hght, %ES_WantReturn Or %ES_MultiLine
     
       hght = 25   
       Wd = Dlg_Wd - 20
       Col = 10 'center
     
       Row = Dlg_hght - (Hght * 2) - 4 'Just off bottom
         Control Add Button, hdlg, %Id_Show_Result_Btn, "Show Textbox Results", col, row, Wd, Hght
     
       Row = Dlg_hght - Hght - 2 'Just off bottom
         Control Add Button, hdlg, %Id_Exit_Btn, "Abandon Ship", col, row, Wd, Hght
     
         Dialog Show Modal hDlg   Call Dialog_Processor
    End Function
    '
    ==================================
    I do not feel obliged to believe
    the same God who has endowed us
    with sense, reason, and intellect
    intended us to forgo their use.
    ~ Galileo Galilei
    ==================================
    Last edited by Gösta H. Lovgren-2; 27 Oct 2008, 08:47 PM.

    Leave a comment:


  • Chris Holbrook
    replied
    And another text input version from the past: http://www.powerbasic.com/support/pb...ext#post170768

    Leave a comment:


  • Michael Mattias
    replied
    Almost sorry you did that, Fred.

    I was thinking about updating the MS-DOS version myself, in the process attempting to set a record for "longest time ever between updates, " eclipsing the previous record, held by PowerBASIC Inc for the wait between PB/6x and PB/7x.

    (7x==>8x, 8x ==>9x, plenty quick enough).

    Leave a comment:


  • Fred Buffington
    replied
    Kevin, I think you should edit the line of characters being input and reprint them instead of clearing the screen each time.

    Here's a simple input routine i did in a few minutes. It can use some work but
    hope it helps.
    Code:
    #COMPILE EXE
    DECLARE FUNCTION linput(x%,y%,l%,Q8$) AS STRING
    FUNCTION PBMAIN() AS LONG
       CONSOLE SCREEN 26,80
    
       Q6$=linput(10,5,25,"") 'LINE INPUT x$
       PRINT:PRINT Q6$
       WAITKEY$
    END FUNCTION
    FUNCTION linput(x%,y%,l%,Q8$) AS STRING
       LOCATE y%,x%-1
       PRINT "[";SPACE$(l%);"]";
       LOCATE y%,x%
       z$=""
       IF Q8$<>"" THEN
         stt$=Q8$
         LOCATE y%,x%:PRINT Q8$;
         LOCATE y%,x%
         stt$=Q8$
       END IF
    Start:
       WHILE z$="":z$=INKEY$:WEND
       IF LEN(z$)=1 THEN
          SELECT CASE ASC(z$)
            CASE 13 'enter
               FUNCTION=stt$
               EXIT FUNCTION
            CASE 8 'backspace destructive
              col&=CURSORX
              xx$=MID$(stt$,1,col&-x%+1-2)+MID$(stt$,col&-x%+1)
              stt$=xx$
              col&=col&-1
              col&=MAX(col&,x%)
              LOCATE y%,x%:PRINT SPACE$(L%);:LOCATE y%,x%:PRINT stt$;
              LOCATE y%,col&
              z$=""
            CASE ELSE
                 zz&=CURSORX
                 'xxx$=stt$+SPACE$(L%)
                 stt$=MID$(stt$+SPACE$(L%),1,L%)
                 loca&=zz&-x%+1
                 xxx$=MID$(stt$,1,loca&-1)+z$+MID$(stt$,loca&)
    'LOCATE 1,1:PRINT "this is loca& ";loca&;:LINE INPUT zcxc$
                 stt$=xxx$
                 LOCATE y%,x%:PRINT stt$;
                 LOCATE y%,x%+L%:PRINT "]";
                 LOCATE y%,zz&+1
    
          END SELECT
          z$=""
          GOTO Start
       ELSEIF LEN(z$)=2 THEN
          aa&=ASC(RIGHT$(z$,1))
          SELECT CASE aa&
            CASE 75 'left arrow
              col&=CURSORX
              IF Col&>x% THEN Col&=Col&-1:LOCATE y%,Col&
            CASE 77 'right arrow
              col&=CURSORX
              IF Col&<x%+L% THEN Col&=Col&+1:LOCATE y%,Col&
            CASE 80 'down arrow should act like chr$(13) -- enter
                Function=stt$
                EXIT FUNCTION
            CASE 82 'insert
              'ignore for now
            CASE 83 'delete
              col&=CURSORX
              loca&=Col&-x%+1
              xxx$=MID$(stt$,1,loca&-1)+MID$(stt$,loca&+1)
              stt$=MID$(xxx$+SPACE$(L%),1,L%)
              LOCATE y%,x%:PRINT stt$;
              LOCATE y%,Col&
            CASE ELSE
              'stt$=z$
          END SELECT
           z$=""
           GOTO start
       ELSEIF LEN(Z$)=4 'mouse
           'mouse code here
       END IF
       FUNCTION=stt$
    END FUNCTION
    Last edited by Fred Buffington; 27 Oct 2008, 10:29 AM.

    Leave a comment:

Working...
X