home *** CD-ROM | disk | FTP | other *** search
/ Taifun Collection / Taifun_Collection_Vol_1.iso / richter / 8417 / 8417.mhs / RICHTER.DTP / CLP142 / !CLP142.EXE / CLPTEST.PRG < prev    next >
Text File  |  1993-07-01  |  22KB  |  656 lines
  1. *:*********************************************************************
  2. *:
  3. *:        Program: CLPTEST.PRG
  4. *:
  5. *:         System: ClpTest 1.42
  6. *:         Author: E. Schuster
  7. *:      Copyright (c) 1993, E. Schuster
  8. *:  Last modified: 07/03/93     12:56
  9. *:
  10. *:  Procs & Fncts: PD_SETUP
  11. *:               : POP_SETUP
  12. *:               : MY_FUNC()
  13. *:               : POP101()
  14. *:               : POP10103()
  15. *:               : POP105()
  16. *:               : POP203()
  17. *:               : POP205()
  18. *:               : USERHELP
  19. *:
  20. *:          Calls: WIN_INIT       (procedure in CLPWINDW.PRG)
  21. *:               : GET_DRIVE()    (function  in CLPFUNC2.PRG)
  22. *:               : WIN_CREATE     (procedure in CLPWINDW.PRG)
  23. *:               : MIDDLE()       (function  in CLPFUNC1.PRG)
  24. *:               : WIN_MAIN       (procedure in CLPWINDW.PRG)
  25. *:               : WIN_CLOSE      (procedure in CLPWINDW.PRG)
  26. *:
  27. *:      Documented 07/03/93 at 12:58                SNAP!  version 4.02
  28. *:*********************************************************************
  29.  
  30. msys = 'Datei, Programme, Optionen, Hilfe'
  31. DO win_init WITH msys, 4, 2, 1, 3, 10, 10
  32.  
  33. statfile = 'CLPTEST.STA'
  34. pdshadow = .T.
  35. DEBUG = .T.
  36. box_hlp = 0
  37. box_msg = 3
  38.  
  39. *******************************************************************************
  40. * Setzen eigener Variablen                                                    *
  41. *******************************************************************************
  42. mjn1 = '√'
  43. mjn2 = '√'
  44. mjn3 = '√'
  45. mjn4 = '√'
  46. mjn5 = '√'
  47.  
  48. mdir   = Curdir()
  49. mdir   = IF(EMPTY(mdir),'',Alltrim(mdir)+'\')
  50. mdrive = get_drive(mdir)
  51.  
  52. *******************************************************************************
  53. * Start des Hauptprogramms                                                    *
  54. *******************************************************************************
  55. anw_id   = 'CLP'
  56. anw_ver  = '1.42'
  57. anw_name = 'Demo der Clipper-Funktionen'
  58. anw_cr   = '(C) Copyright Erich Schuster 1993'
  59.  
  60. DO win_create WITH anw_id, anw_ver, anw_name
  61.  
  62. @ 4, 0 SAY middle('Das ist eine Demonstration der Clipper-Funktionen',80)
  63. @ 5, 0 SAY middle('- CLPWINDW mit CLPCOLOR -',80)
  64. @ 6, 0 SAY middle('- CLPFILES mit CLPFUNC1 und CLPFUNC2 -',80)
  65. @ 7, 0 SAY middle('- CLPNUMTO -',80)
  66.  
  67. DO win_main WITH 'my_func'
  68.  
  69. DO win_close WITH 'CLPTEST '+anw_ver+' - '+anw_name+'   '+anw_cr
  70.  
  71. *!*********************************************************************
  72. *!
  73. *!      Procedure: PD_SETUP
  74. *!
  75. *!      Called by: PD_MENU()      (function  in CLPWINDW.PRG)
  76. *!               : PD_MENU2()     (function  in CLPWINDW.PRG)
  77. *!
  78. *!*********************************************************************
  79. PROCEDURE pd_setup
  80. PARAMETER menuid
  81.  
  82. DO CASE
  83.  
  84.    &&------------------------------------------------------------------------&&
  85.    && PULL-DOWN-MENU 1
  86.    &&------------------------------------------------------------------------&&
  87. CASE menuid = 1
  88.    pull_down[01] = ' Pop-Up Screen 101 ...  F5 '
  89.    pull_down[02] = ' Pop-Up Menu   102 ...  F6 '
  90.    pull_down[03] = '───────────────────────────'
  91.    pd_valid[03]  = .F.
  92.    pull_down[04] = ' Pop-Up Screen 104 ...     '
  93.    pull_down[05] = ' Pop-Up Screen 105 ...     '
  94.    pull_down[06] = '───────────────────────────'
  95.    pd_valid[06]  = .F.
  96.    pull_down[07] = ' Programm beenden       F3 '
  97.  
  98.    pd_hilfe[01] = 1
  99.    pd_hilfe[02] = 2
  100.    pd_hilfe[04] = 3
  101.    pd_hilfe[05] = 4
  102.    pd_hilfe[07] = 5
  103.  
  104.    &&------------------------------------------------------------------------&&
  105.    && PULL-DOWN-MENU 2
  106.    &&------------------------------------------------------------------------&&
  107. CASE menuid = 2
  108.    pull_down[01] = ' Verzeichnis...   Strg+V '
  109.    pull_down[02] = '─────────────────────────'
  110.    pd_valid[02]  = .F.
  111.    pull_down[03] = ' Zahlen umsetzen...      '
  112.    pull_down[04] = '─────────────────────────'
  113.    pd_valid[04]  = .F.
  114.    pull_down[05] = ' Datumsroutinen...       '
  115.    pull_down[06] = '─────────────────────────'
  116.    pd_valid[06]  = .F.
  117.    pull_down[07] = ' Dateien anschauen       '
  118.  
  119.    pd_hilfe[01] = 6
  120.    pd_hilfe[03] = 7
  121.    pd_hilfe[05] = 8
  122.    pd_hilfe[07] = 9
  123.  
  124.    &&------------------------------------------------------------------------&&
  125.    && PULL-DOWN-MENU 3
  126.    &&------------------------------------------------------------------------&&
  127. CASE menuid = 3
  128.    pull_down[01] = ' Farben ändern...  Strg+F '
  129.    pull_down[02] = ' weitere Optionen        '
  130.    pull_down[03] = '──────────────────────────'
  131.    pd_valid[03]  = .F.
  132.    pull_down[04] = ' Optionen sichern         '
  133.  
  134.    pd_hilfe[01] = 10
  135.    pd_hilfe[02] = 11
  136.    pd_hilfe[04] = 12
  137.  
  138.    &&------------------------------------------------------------------------&&
  139.    && PULL-DOWN-MENU 302
  140.    &&------------------------------------------------------------------------&&
  141. CASE menuid = 302
  142.    pull_down[01] = mjn1+' Automatischer Cursorsprung  '
  143.    pull_down[02] = mjn2+' Warnton bei den Meldungen   '
  144.    pull_down[03] = mjn3+' Schatten bei PopUp-Fenstern '
  145.    pull_down[04] = mjn4+' Schatten bei PullDown-Menüs '
  146.    pull_down[05] = mjn5+' Push-Button mit Eingabetaste'
  147.  
  148.    pd_hilfe[01] = 13
  149.    pd_hilfe[02] = 14
  150.    pd_hilfe[03] = 15
  151.    pd_hilfe[04] = 16
  152.    pd_hilfe[05] = 17
  153.  
  154.    &&------------------------------------------------------------------------&&
  155.    && PULL-DOWN-MENU 4
  156.    &&------------------------------------------------------------------------&&
  157. CASE menuid = 4
  158.    pull_down[01] = ' Allgemeine Hilfe...  '
  159.    pull_down[02] = ' Hilfe für Tasten...  '
  160.    pull_down[03] = '──────────────────────'
  161.    pd_valid[03]  = .F.
  162.    pull_down[04] = ' Über "'+anw_id+' '+anw_ver+'"... '
  163.    pull_down[05] = '──────────────────────'
  164.    pd_valid[05]  = .F.
  165.    pull_down[06] = ' Shareware-Hinweis... '
  166.  
  167.    pd_hilfe[01] = 18
  168.    pd_hilfe[02] = 19
  169.    pd_hilfe[04] = 20
  170.    pd_hilfe[06] = 21
  171.  
  172. ENDCASE
  173. RETURN
  174.  
  175. *!*********************************************************************
  176. *!
  177. *!      Procedure: POP_SETUP
  178. *!
  179. *!      Called by: POP_SCREEN()   (function  in CLPWINDW.PRG)
  180. *!               : POP_MENU()     (function  in CLPWINDW.PRG)
  181. *!               : POP101()       (function  in CLPTEST.PRG)
  182. *!
  183. *!*********************************************************************
  184. PROCEDURE  pop_setup
  185. PARAMETERS menuid
  186.  
  187. DO CASE
  188.  
  189.    &&------------------------------------------------------------------------&&
  190.    && POP_UP_SCREEN 101
  191.    &&------------------------------------------------------------------------&&
  192. CASE menuid = 101
  193.    pop_title  = 'Pop-Up Screen 101'
  194.    pop_bot1   = ''
  195.    pop_bot2   = ' <Sichern>  <Abbrechen>  <Pop-Up> '
  196.    pbut_activ = 1
  197.  
  198.    &&------------------------------------------------------------------------&&
  199.    && POP_UP_SCREEN 10103
  200.    &&------------------------------------------------------------------------&&
  201. CASE menuid = 10103
  202.    pop_title  = 'Pop-Up Screen 10103'
  203.    pop_bot1   = ''
  204.    pop_bot2   = ' <OK>  <Abbrechen> '
  205.    pbut_activ = 1
  206.  
  207.    &&------------------------------------------------------------------------&&
  208.    && POP_UP_SCREEN 102
  209.    &&------------------------------------------------------------------------&&
  210. CASE menuid = 102
  211.    pop_opt[1] = ' 1. Das ist ein Beispiel '
  212.    pop_opt[2] = ' 2. für ein PopUp Menü!  '
  213.    pop_opt[3] = '─────────────────────────'
  214.    pop_valid[3] = .F.
  215.    pop_opt[4] = ' 4. Datei Drucken        '
  216.    pop_opt[5] = '─────────────────────────'
  217.    pop_valid[5] = .F.
  218.    pop_bot1   = ''
  219.    pop_bot2   = ' <OK>  <Abbrechen> '
  220.    pbut_activ = 1
  221.  
  222.    &&------------------------------------------------------------------------&&
  223.    && POP_UP_SCREEN 105
  224.    &&------------------------------------------------------------------------&&
  225. CASE menuid = 105
  226.    pop_title  = 'Pop-Up Screen 105  (über den ganzen Bildschirm)'
  227.    pop_bot1   = ''
  228.    pop_bot2   = ' <OK> '
  229.    pbut_activ = 1
  230.  
  231.    &&------------------------------------------------------------------------&&
  232.    && POP_UP_SCREEN 203
  233.    &&------------------------------------------------------------------------&&
  234. CASE menuid = 203
  235.    pop_title  = 'Zahlen umsetzen'
  236.    pop_bot1   = ''
  237.    pop_bot2   = ' <Deutsche Form>  <Amerikanisch>  <In Worten>  <Abbrechen> '
  238.    pbut_activ = 1
  239.  
  240.    &&------------------------------------------------------------------------&&
  241.    && POP_UP_SCREEN 205
  242.    &&------------------------------------------------------------------------&&
  243. CASE menuid = 205
  244.    pop_title  = 'Datumsroutinen'
  245.    pop_bot1   = ''
  246.    pop_bot2   = ' <OK> '
  247.    pbut_activ = 1
  248.  
  249. ENDCASE
  250. RETURN
  251.  
  252. *!*********************************************************************
  253. *!
  254. *!       Function: MY_FUNC()
  255. *!
  256. *!          Calls: POP_SCREEN()   (function  in CLPWINDW.PRG)
  257. *!               : STR_PAD()      (function  in CLPFUNC1.PRG)
  258. *!               : POP_MENU()     (function  in CLPWINDW.PRG)
  259. *!               : SHOW_MSG()     (function  in CLPFUNC1.PRG)
  260. *!               : POP_MSG()      (function  in CLPWINDW.PRG)
  261. *!               : FILELIST()     (function  in CLPFILES.PRG)
  262. *!               : MIDDLE()       (function  in CLPFUNC1.PRG)
  263. *!               : NUM2WORD()     (function  in CLPNUMTO.PRG)
  264. *!               : DATUM()        (function  in CLPFUNC1.PRG)
  265. *!               : SEL_ONE()      (function  in CLPFUNC1.PRG)
  266. *!               : FILEBROWSE()   (function  in CLPFILES.PRG)
  267. *!               : WIN_COLOR      (procedure in CLPCOLOR.PRG)
  268. *!               : WIN_HELP       (procedure in CLPWINDW.PRG)
  269. *!
  270. *!*********************************************************************
  271. FUNCTION my_func
  272. PARAMETER menusel
  273. PRIVATE mreturn              &&  0 = Abbrechen   1 = Zurück   2 = Weiter
  274. PRIVATE mch, mstat, Savescr, mret
  275. mreturn = 1
  276. DO CASE
  277. CASE menusel = 1001 .OR. menusel = -4
  278.    getloop = .T.
  279.    pop_screen(101, 5, 12, 18, 50, box_pop, 'POP101')
  280.    getloop = .F.
  281.    @ 12, 3 SAY 'PopUp-'
  282.    @ 13, 3 SAY 'Screen'
  283. CASE menusel = 1002 .OR. menusel = -5
  284.    mch = 1
  285.    @  9, 45 SAY str_pad('PopUp Menü',30)
  286.    @ 10, 45 SAY SPACE(28)
  287.    DO WHILE .T.
  288.       menu_id = 102          && Identifizierung für die Hilfedatenbank
  289.       mch = pop_menu(102, 8, 15, box_pop, mch)
  290.       DO CASE
  291.       CASE mch = 0
  292.          @ 10, 45 SAY str_pad('Fertig!',30)
  293.          EXIT
  294.       CASE mch = 1
  295.          @ 10, 45 SAY str_pad('Das war der 1. Menüpunkt...',30)
  296.       CASE mch = 2
  297.          @ 10, 45 SAY str_pad('... und das der 2. !',30)
  298.       CASE mch = 4
  299.          * Datei Drucken
  300.          IF .NOT. Isprinter()
  301.             show_msg(29, msg_color)
  302.             @ 10, 45 SAY str_pad('Druckversuch mißglückt!',30)
  303.          ELSE
  304.             @ 10, 45 SAY str_pad('Jetzt wird gedruckt...',30)
  305.          ENDIF
  306.       ENDCASE
  307.    ENDDO T
  308. CASE menusel = 1004
  309.    mstat = 'PopUp-Messages und vieles andere mehr!  Weiter...'
  310.    Savescr = STATUS(mstat, pop_color, box_pop, 10)
  311.    INKEY(0)
  312.    RESTORE SCREEN FROM Savescr
  313.    @  9, 18 SAY 'PopUp Messages,'
  314.    @ 10, 18 SAY 'Bestätigungen, '
  315.    @ 11, 18 SAY 'und anderes!!! '
  316. CASE menusel = 1005
  317.    pop_screen(105, 0, 0, 24, 79, box_pop, 'POP105')
  318. CASE menusel = 1007                              && Ende der Anwendung
  319.    IF pop_msg(quit_msg, pop_color, box_msg, frage)
  320.       mreturn = 0
  321.    ENDIF
  322. CASE menusel = 2001 .OR. menusel = 22
  323.    filelist(mdrive, mdir, '*', 1, box_pop, 4, 22)
  324.    @ 20, 0 SAY middle('Dateienhandling mit Clipper: Filelist()',80)
  325. CASE menusel = 2003
  326.    pop_screen(203, 6, 4, 18, 74, box_pop, 'POP203')
  327.    @ 16, 0 SAY middle('Zahlen umsetzen: '+num2word(10),80)
  328. CASE menusel = 2005
  329.    pop_screen(205, 6, 11, 19, 65, box_pop, 'POP205')
  330.    @ 18, 0 SAY middle('Datumsroutine: '+datum(6, CTOD('01.01.1992')),80)
  331.    mreturn = 2
  332. CASE menusel = 2007
  333.    SAVE SCREEN TO Savescr
  334.    mch = sel_one(1, 14, 13, win_color+','+ssys_color, 2, ;
  335.       'Autoexec.Bat', 'Config.Sys', 'Dummy', 'Auswahl 4', '5', '6', '7', '8')
  336.    RESTORE SCREEN FROM Savescr
  337.    DO CASE
  338.    CASE mch = 0
  339.       @ 14, 0 SAY middle('Auswahl abgebrochen!',80)
  340.    CASE mch = 1
  341.       filebrowse('C:\AUTOEXEC.BAT', 1)
  342.       @ 14, 0 SAY middle("Filebrowse('C:\AUTOEXEC.BAT')",80)
  343.    CASE mch = 2
  344.       filebrowse('C:\CONFIG.SYS')
  345.       @ 14, 0 SAY middle("Filebrowse('C:\CONFIG.SYS')",80)
  346.    CASE mch = 3
  347.       mret = filebrowse('dummy', 4)
  348.       IF mret > 0
  349.          pop_msg('Datei nicht vorhanden oder zu groß!')
  350.       ENDIF
  351.       @ 14, 0 SAY SPACE(80)
  352.    OTHERWISE
  353.       @ 14, 0 SAY middle('Auswahl Nr.'+Alltrim(STR(mch))+' ausgewählt!',80)
  354.    ENDCASE
  355.    mreturn = 2
  356. CASE menusel = 3001 .OR. menusel = 6
  357.    DO win_color WITH anw_id, anw_ver, anw_name
  358.    mreturn = 2
  359. CASE menusel = 300201
  360.    mjn1 = IF(EMPTY(mjn1),'√', ' ')
  361.    IF EMPTY(mjn1)
  362.       SET CONFIRM ON
  363.    ELSE
  364.       SET CONFIRM OFF
  365.    ENDIF
  366.    mreturn = 2
  367. CASE menusel = 300202
  368.    mjn2 = IF(EMPTY(mjn2),'√', ' ')
  369.    msgbeep = .NOT. EMPTY(mjn2)
  370.    mreturn = 2
  371. CASE menusel = 300203
  372.    mjn3 = IF(EMPTY(mjn3),'√', ' ')
  373.    shadows = .NOT. EMPTY(mjn3)
  374.    mreturn = 2
  375. CASE menusel = 300204
  376.    mjn4 = IF(EMPTY(mjn4),'√', ' ')
  377.    pdshadow = .NOT. EMPTY(mjn4)
  378.    mreturn = 2
  379. CASE menusel = 300205
  380.    mjn5 = IF(EMPTY(mjn5),'√', ' ')
  381.    ctrl_ret = EMPTY(mjn5)
  382.    mreturn = 2
  383. CASE menusel = 3004
  384.    mstat = 'Sicherung ist hier nicht möglich!  Weiter...'
  385.    Savescr = STATUS(mstat, msg_color, box_msg)
  386.    INKEY(0)
  387.    RESTORE SCREEN FROM Savescr
  388. CASE menusel = 4001
  389.    DO win_help WITH 'userhelp', 'CLPTEST'
  390.    mreturn = 2
  391. CASE menusel = 4002
  392.    DO win_help WITH 'userhelp', 'TASTEN'
  393.    mreturn = 2
  394. CASE menusel = 4004
  395.    DO win_help WITH 'userhelp', 'ABOUT'
  396.    mreturn = 2
  397. CASE menusel = 4006
  398.    DO win_help WITH 'userhelp', 'SHARE'
  399.    mreturn = 2
  400. OTHERWISE
  401.    mreturn = 2
  402. ENDCASE
  403. RETURN mreturn
  404.  
  405. *!*********************************************************************
  406. *!
  407. *!       Function: POP101()
  408. *!
  409. *!          Calls: VAL_STR()      (function  in CLPFUNC1.PRG)
  410. *!               : POP_MSG()      (function  in CLPWINDW.PRG)
  411. *!               : SHOW_MSG()     (function  in CLPFUNC1.PRG)
  412. *!               : POP_SCREEN()   (function  in CLPWINDW.PRG)
  413. *!               : POP_SETUP      (procedure in CLPTEST.PRG)
  414. *!
  415. *!*********************************************************************
  416. FUNCTION pop101
  417. PARAMETER maction, pbut
  418. PRIVATE mreturn              &&  1 = Zurück   2 = Weiter
  419. mreturn = 2
  420. IF maction = 'READ'
  421.    IF TYPE("mfeld1") = 'U'   && Feld 'mfeld1' noch nicht bekannt
  422.       PUBLIC mfeld1, mfeld2, mfeld3
  423.       mfeld1 = SPACE(20)
  424.       mfeld2 = SPACE(8)
  425.       mfeld3 = SPACE(8)
  426.    ENDIF
  427.    @  9, 14 SAY 'Eingabefeld1:'
  428.    @  9, 28 GET mfeld1
  429.    @ 11, 14 SAY 'Feld2:             Feld3:'
  430.    @ 11, 21 GET mfeld2
  431.    @ 11, 40 GET mfeld3
  432.    @ 13, 14 SAY 'Das ist ein Beispiel für einen'
  433.    @ 14, 14 SAY 'PopUp Screen mit Eingabefeldern!'
  434.    READ
  435. ELSEIF maction = 'PUSH'
  436.    DO CASE
  437.    CASE pbut = 1             && 1. Push-Button  (Sichern)
  438.       mret = val_str(mfeld1, 'ANUM')
  439.       DO CASE
  440.       CASE mret = 0          && Eingabe OK
  441.          pop_msg('Eingabe verarbeitet!', pop_color, box_pop)
  442.          mreturn = 1
  443.       CASE mret = 1          && Eingabefeld leer
  444.          show_msg(1, msg_color)
  445.       CASE mret = 2          && Eingabe falsch (nicht alphanumerisch)
  446.          show_msg(6, msg_color)
  447.       ENDCASE
  448.    CASE pbut = 2             && 2. Push-Button  (Abbrechen)
  449.       IF CONFIRM(canc_msg, msg_color, box_msg, 12)
  450.          mreturn = 1
  451.       ENDIF
  452.    CASE pbut = 3             && 3. Push-Button  (Pop-Up)
  453.       getloop = .F.
  454.       pop_screen(10103, 8, 17, 15, 45, box_pop, 'POP10103')
  455.       getloop = .T.
  456.       DO pop_setup WITH 101
  457.       pbut_activ = 3
  458.    ENDCASE
  459. ENDIF
  460. RETURN mreturn
  461.  
  462. *!*********************************************************************
  463. *!
  464. *!       Function: POP10103()
  465. *!
  466. *!*********************************************************************
  467. FUNCTION pop10103
  468. PARAMETER maction, pbut
  469. PRIVATE mreturn              &&  1 = Zurück   2 = Weiter
  470. PRIVATE dummy
  471. mreturn = 2
  472. IF maction = 'READ'
  473.    dummy = ' '
  474.    @ 11, 21 SAY "Das ist ein zweiter"
  475.    @ 12, 21 SAY "Pop-Up-Schirm" GET dummy
  476.    READ
  477. ELSEIF maction = 'PUSH'
  478.    DO CASE
  479.    CASE pbut = 1             && 1. Push-Button  (Sichern)
  480.       mreturn = 1
  481.    CASE pbut = 2             && 2. Push-Button  (Abbrechen)
  482.       IF CONFIRM(canc_msg, msg_color, box_msg, 12)
  483.          mreturn = 1
  484.       ENDIF
  485.    ENDCASE
  486. ENDIF
  487. RETURN mreturn
  488.  
  489. *!*********************************************************************
  490. *!
  491. *!       Function: POP105()
  492. *!
  493. *!*********************************************************************
  494. FUNCTION pop105
  495. PARAMETER maction, pbut
  496. PRIVATE mreturn              &&  1 = Zurück   2 = Weiter
  497. mreturn = 2
  498. IF maction = 'READ'
  499.    @  5, 18 SAY "Das ist ein großer leerer Bildschirm!"
  500.    @ 10, 18 SAY "Da gibt es sehr viel Platz für Eingaben"
  501.    @ 15, 18 SAY "und das ist doch gut so, oder nicht?"
  502.    INKEY(0)
  503. ELSEIF maction = 'PUSH'
  504.    mreturn = 1
  505. ENDIF
  506. RETURN mreturn
  507.  
  508. *!*********************************************************************
  509. *!
  510. *!       Function: POP203()
  511. *!
  512. *!          Calls: SHOW_MSG()     (function  in CLPFUNC1.PRG)
  513. *!               : VAL_STR()      (function  in CLPFUNC1.PRG)
  514. *!               : NUM2STR()      (function  in CLPNUMTO.PRG)
  515. *!               : NUM2WORD()     (function  in CLPNUMTO.PRG)
  516. *!
  517. *!*********************************************************************
  518. FUNCTION pop203
  519. PARAMETER maction, pbut
  520. PRIVATE mreturn              &&  1 = Zurück   2 = Weiter
  521. mreturn = 2
  522. IF maction = 'READ'
  523.    IF TYPE("mzahl1") = 'U'   && Feld 'mzahl1' noch nicht bekannt
  524.       PUBLIC mzahl1
  525.       mzahl1 = 0.00
  526.    ENDIF
  527.    @ 10,  8 SAY 'Zahl eingeben:'
  528.    @ 10, 24 GET mzahl1
  529.    @ 10, 42 SAY 'String:'
  530.    @ 12,  8 SAY 'Worte:'
  531.    READ
  532. ELSEIF maction = 'PUSH'
  533.    mok = .F.
  534.    IF pbut = 1 .OR. pbut = 2 .OR. pbut = 3
  535.       IF EMPTY(mzahl1)       && Eingabefeld leer
  536.          show_msg(1, msg_color)
  537.       ELSE
  538.          mret = val_str(Alltrim(STR(mzahl1)), 'STR', 'NUM.')
  539.          DO CASE
  540.          CASE mret = 0       && Eingabe OK
  541.             mok = .T.
  542.             @ 10, 50 SAY SPACE(18)
  543.             @ 12, 16 SAY SPACE(58)
  544.             @ 13, 16 SAY SPACE(58)
  545.             @ 14, 16 SAY SPACE(58)
  546.          CASE mret = 2       && Eingabe falsch (nicht numerisch)
  547.             show_msg(2, msg_color)
  548.          ENDCASE
  549.       ENDIF
  550.    ENDIF
  551.    DO CASE
  552.    CASE pbut = 1 .AND. mok   && 1. Push-Button  (Deutsche Form)
  553.       @ 10, 50 SAY num2str(mzahl1, 2, 0)
  554.    CASE pbut = 2 .AND. mok   && 2. Push-Button  (Amerikanisch)
  555.       @ 10, 50 SAY num2str(mzahl1, 2, 1)
  556.    CASE pbut = 3 .AND. mok   && 3. Push-Button  (In Worten)
  557.       mworte = num2word(mzahl1, ' ')
  558.       IF LEN(mworte) > 56
  559.          mcut1 = Rat(' ',mworte)
  560.          mworte1 = LEFT(mworte,mcut1-1)
  561.          IF LEN(mworte1) > 54
  562.             mcut2 = Rat(' ',mworte1)
  563.             mworte1 = LEFT(mworte1,mcut2-1)+' -'
  564.             mworte2 = SUBSTR(LEFT(mworte,mcut1-1),mcut2+1)+' -'
  565.             mworte3 = SUBSTR(mworte,mcut1+1)
  566.          ELSE
  567.             mworte1 = mworte1+' -'
  568.             mworte2 = SUBSTR(mworte,mcut1+1)
  569.             mworte3 = ' '
  570.          ENDIF
  571.       ELSE
  572.          mworte1 = mworte
  573.          mworte2 = ' '
  574.          mworte3 = ' '
  575.       ENDIF
  576.       @ 12, 16 SAY mworte1
  577.       @ 13, 16 SAY mworte2
  578.       @ 14, 16 SAY mworte3
  579.    CASE pbut = 4             && 4. Push-Button  (Abbrechen)
  580.       IF CONFIRM(canc_msg, msg_color, box_msg, 12)
  581.          mreturn = 1
  582.       ENDIF
  583.    ENDCASE
  584. ENDIF
  585. RETURN mreturn
  586.  
  587. *!*********************************************************************
  588. *!
  589. *!       Function: POP205()
  590. *!
  591. *!          Calls: MIDDLE()       (function  in CLPFUNC1.PRG)
  592. *!               : DATUM()        (function  in CLPFUNC1.PRG)
  593. *!
  594. *!*********************************************************************
  595. FUNCTION pop205
  596. PARAMETER maction, pbut
  597. PRIVATE mreturn              &&  1 = Zurück   2 = Weiter
  598. mreturn = 2
  599. IF maction = 'READ'
  600.    @  9, 13 SAY 'Datumsformat 0 : '+middle(datum(0),34)
  601.    @ 10, 13 SAY 'Datumsformat 1 : '+middle(datum(1),34)
  602.    @ 11, 13 SAY 'Datumsformat 2 : '+middle(datum(2),34)
  603.    @ 12, 13 SAY 'Datumsformat 3 : '+middle(datum(3),34)
  604.    @ 13, 13 SAY 'Datumsformat 4 : '+middle(datum(4),34)
  605.    @ 14, 13 SAY 'Datumsformat 5 : '+middle(datum(5),34)
  606.    @ 15, 13 SAY 'Datumsformat 6 : '+middle(datum(6),34)
  607.    INKEY(0)
  608. ELSEIF maction = 'PUSH'
  609.    mreturn = 1
  610. ENDIF
  611. RETURN mreturn
  612.  
  613. *!*********************************************************************
  614. *!
  615. *!      Procedure: USERHELP
  616. *!
  617. *!      Called by: WIN_HELP       (procedure in CLPWINDW.PRG)
  618. *!
  619. *!*********************************************************************
  620. PROCEDURE USERHELP
  621. PARAMETER helpid
  622. DO CASE
  623. CASE helpid = 'CLPTEST'
  624.    helptitel = 'Allgemeine Hilfe'
  625.    helpline2 = anw_id+' Version '+anw_ver+' ...'
  626.    helpline3 = "... demonstriert den Gebrauch und die Möglichkeiten"
  627.    helpline4 = "    mit den Clipper-Funktionen (CLPxxxxx)          "
  628.    helpline6 = "Es gelten die allgemeinen Regeln des SAA-Standards:"
  629.    helpline7 = "   F1=Hilfe,  F3=Zurück,  F10=Menü,  ...           "
  630. CASE helpid = 'TASTEN'
  631.    helptitel = 'Hilfe für Tasten'
  632.    helpline1 = "F1=Hilfe,  F3=Programm beenden,  F10=Menü          "
  633.    helpline3 = "Esc=Abbrechen  Eingabetaste=Ausführen              "
  634.    helpline5 = "'' und '' = Balken nach unten/oben bewegen       "
  635.    helpline7 = "Tabulator = nächsten Push-Button aktivieren        "
  636. CASE helpid = 'ABOUT'
  637.    helptitel = anw_name
  638.    helpline2 = anw_id+' Version '+anw_ver+' ...'
  639.    helpline3 = "... wurde mit 'Clipper', Version Sommer '87 ent-   "
  640.    helpline4 = "     wickelt und mit 'PLINK86' gelinkt.            "
  641.    helpline6 = "'Clipper' ist ein Warenzeichen der Nantucket Corp. "
  642.    helpline7 = "'PLINK86' ist ein Warenzeichen der Phoenix Tech Ltd"
  643. CASE helpid = 'SHARE'
  644.    helptitel = anw_name
  645.    helpline1 = "Die Ihnen hier vorliegende Version von "+anw_id+" ist die"
  646.    helpline2 = "Shareware-Version des Programms."
  647.    helpline3 = "Wenn Sie sich beim Autor registrieren lassen, dann"
  648.    helpline4 = "bekommen Sie zunächst einmal die neueste Version"
  649.    helpline5 = "des Programms. Außerdem fallen selbstverständlich"
  650.    helpline6 = "sämtliche (störenden) Hinweise auf Shareware weg."
  651.    helpline8 = anw_cr
  652. ENDCASE
  653. RETURN
  654.  
  655. *: EOF: CLPTEST.PRG
  656.