home *** CD-ROM | disk | FTP | other *** search
/ ST-Computer Leser 2002 January / STC_CD_01_2002.iso / GAMES / DR_WHO / SOURCE / USERWORK.LST < prev   
File List  |  2002-01-16  |  20KB  |  708 lines
  1. > FUNCTION zeilenzaehler(dat$)
  2. IF EXIST(dat$)
  3.   ERASE dummy$()
  4.   DIM dummy$(50)
  5.   OPEN "I",#1,dat$
  6.   anz_zeilen%=0
  7.   RECALL #1,dummy$(),-1,z%
  8.   WHILE z%
  9.     ADD anz_zeilen%,z%
  10.     RECALL #1,dummy$(),-1,z%
  11.   WEND
  12.   CLOSE #1
  13.   RETURN anz_zeilen%
  14. ELSE
  15.   RETURN 0
  16. ENDIF
  17. ENDFUNC
  18. > PROCEDURE questions
  19. fragen:
  20. '  num_q%=67
  21. '  dat_q%=@zeilenzaehler$(program_path$)
  22. DIM temp$(200)
  23. OPEN "I",#1,program_path$+"QUESTION.WHO"
  24. RECALL #1,temp$(),200,len%
  25. CLOSE #1
  26. num_q%=len%
  27. DIM p$(num_q%),typ$(num_q%),t$(num_q%),answ$(num_q%),r$(num_q%),h%(num_q%),d$(num_q%)
  28. FOR i%=1 TO num_q%
  29. a$=temp$(i%)
  30. p$(i%)=@teil$(CHR$(9),a$)
  31. typ$(i%)=@teil$(CHR$(9),a$)
  32. t$(i%)=@teil$(CHR$(9),a$)
  33. answ$(i%)=@teil$(CHR$(9),a$)
  34. r$(i%)=@teil$(CHR$(9),a$)
  35. d$(i%)=@teil$(CHR$(9),a$)
  36. NEXT i%
  37. ERASE temp$()
  38. RETURN
  39. > FUNCTION teil$(sep$,VAR a$)
  40. LOCAL b$,a&
  41. a&=INSTR(a$,sep$)
  42. IF a&
  43. b$=LEFT$(a$,PRED(a&))
  44. a$=MID$(a$,SUCC(a&))
  45. ELSE
  46. b$=a$
  47. a$=""
  48. ENDIF
  49. RETURN b$
  50. ENDFUNC
  51. > PROCEDURE dialog_aufbauen
  52. INC frage%
  53. IF frage%=12
  54. @finish
  55. ENDIF
  56. @additional
  57. @zufall
  58. ausgang!=FALSE
  59. c$=answ$(auswahl%)
  60. FOR i&=whoansw1& TO whoansw3&
  61. @rsc_ob_hide(multiple&,i&,FALSE)
  62. d$=@teil$("|",c$)
  63. @rsc_set_text2(multiple&,i&,d$)
  64. NEXT i&
  65. c$=t$(auswahl%)
  66. FOR i&=textl1& TO textl4&
  67. @rsc_set_text2(multiple&,i&,@teil$("|",c$))
  68. NEXT i&
  69. @rsc_set_text2(multiple&,right&,STR$(richtig%))
  70. @rsc_set_text2(multiple&,wrong&,STR$(falsch%))
  71. p$=p$(auswahl%)
  72. IF p$(auswahl%)="RND"
  73. i%=INT(RND(1)*8)+1
  74. p$=STR$(i%)
  75. ENDIF
  76. SELECT p$
  77. CASE "COY","1"
  78. icon&=icon2&
  79. CASE "ACE","2"
  80. icon&=icon1&
  81. CASE "DR1","3"
  82. icon&=icon3&
  83. CASE "DR3","4"
  84. icon&=icon4&
  85. CASE "DR4","5"
  86. icon&=icon5&
  87. CASE "PLA","6"
  88. icon&=world&
  89. CASE "BRI","7"
  90. icon&=brigadier&
  91. CASE "TAR","8"
  92. icon&=tardis&
  93. CASE "DAL","9"
  94. icon&=dalek&
  95. DEFAULT
  96. icon&=icon_who&
  97. ENDSELECT
  98. tree%=@xrsrc_gaddr(0,multiple&)
  99. tree2%=@xrsrc_gaddr(0,whoicons&)
  100. OB_TYPE(tree%,picbox&)=OB_TYPE(tree2%,icon&)
  101. OB_SPEC(tree%,picbox&)=OB_SPEC(tree2%,icon&)
  102. RETURN
  103. > PROCEDURE zufall
  104. auswahl%=INT(RND(1)*num_q%)+1
  105. IF h%(auswahl%)>klein%
  106. FOR i%=1 TO 10
  107. auswahl%=INT(RND(1)*num_q%)+1
  108. EXIT IF h%(auswahl%)=klein%
  109. NEXT i%
  110. IF i%=10
  111. FOR i%=1 TO num_q%
  112. EXIT IF h%(i%)=klein%
  113. NEXT i%
  114. IF i%=num_q% AND h%(num_q%)>klein%
  115. INC klein%
  116. ELSE
  117. auswahl%=i%
  118. ENDIF
  119. ENDIF
  120. ENDIF
  121. ADD h%(auswahl%),1
  122. RETURN
  123. > PROCEDURE finish
  124. @win_close(multiple_dialog&)
  125. @rsc_set_text(whofinish&,ranswer&,STR$(richtig%))
  126. @rsc_set_text(whofinish&,wanswer&,STR$(falsch%))
  127. finish_dialog&=@win_open_dialog(2,whofinish&,icfyicon&)
  128. RETURN
  129. > PROCEDURE additional
  130. IF LEFT$(d$(auswahl%),1)="#"
  131. e$=RIGHT$(d$(auswahl%),LEN(d$(auswahl%))-1)
  132. IF ausgang!=FALSE
  133. CLR e$
  134. ENDIF
  135. ELSE
  136. e$=d$(auswahl%)
  137. ENDIF
  138. f$=@teil$("|",e$)
  139. @rsc_set_text(multiple&,addinfo1&,f$)
  140. @rsc_ob_reset(multiple&,addinfo1&)
  141. @rsc_set_text(multiple&,addinfo2&,e$)
  142. @rsc_ob_reset(multiple&,addinfo2&)
  143. RETURN
  144. > PROCEDURE cab_show(a$)
  145. cabid&=APPL_FIND("CAB     ")
  146. IF cabid&>-1
  147. ' LOCAL b$
  148. adr%=@mxalloc_global(255)
  149. CHAR{adr%}=a$+CHR$(0)
  150. DIM msg&(7)
  151. msg&(0)=WORD(&HCAB3)
  152. msg&(1)=ap_id&
  153. msg&(2)=0
  154. msg&(3)=WORD(SWAP(adr%))
  155. msg&(4)=WORD(adr%)
  156. msg&(5)=0
  157. msg&(6)=0
  158. msg&(7)=0
  159. ~APPL_WRITE(cabid&,16,msg&(0))
  160. ~EVNT_TIMER(50)
  161. ~MFREE(adr%)
  162. ERASE msg&()
  163. ELSE
  164. cabid&=APPL_FIND("ADAMAS  ")
  165. adr%=@mxalloc_global(255)
  166. CHAR{adr%}=a$+CHR$(0)
  167. DIM msg&(7)
  168. msg&(0)=&H4711
  169. msg&(1)=ap_id&
  170. msg&(2)=0
  171. msg&(3)=WORD(SWAP(adr%))
  172. msg&(4)=WORD(adr%)
  173. msg&(5)=0
  174. msg&(6)=0
  175. msg&(7)=0
  176. ~APPL_WRITE(cabid&,16,msg&(0))
  177. ~EVNT_TIMER(50)
  178. ~MFREE(adr%)
  179. ERASE msg&()
  180. ENDIF
  181. RETURN
  182. > PROCEDURE mouse(VAR mx&,my&,mk&)
  183. LOCAL void&
  184. '
  185. ~WIND_UPDATE(3)
  186. ~GRAF_MKSTATE(mx&,my&,mk&,void&)
  187. ~WIND_UPDATE(2)
  188. '
  189. SUB mx&,WORD{WINDTAB+64}
  190. SUB my&,WORD{WINDTAB+66}
  191. RETURN
  192. > FUNCTION lang$(a&)
  193. RETURN @rsc_get_text$(language&,a&)
  194. ENDFUNC
  195. > FUNCTION bitplanes
  196. $F%
  197. '
  198. RETURN INT{{GB+4}+20}
  199. ENDFUNC
  200. > FUNCTION environment$(such$)
  201. a=SHEL_ENVRN(a%,UPPER$(such$))
  202. IF a%>0
  203. a$=CHAR{a%}
  204. IF INSTR(a$,"=")>0
  205. a=INSTR(a$,"=")
  206. env$=RIGHT$(a$,LEN(a$)-a)
  207. ELSE
  208. env$=a$
  209. ENDIF
  210. RETURN env$
  211. ELSE
  212. RETURN ""
  213. ENDIF
  214. ENDFUNC
  215. > FUNCTION name$(file$)
  216. LOCAL backslash&,punkt&,a$
  217. '
  218. LET backslash&=RINSTR(file$,"\")
  219. IF backslash&
  220. LET file$=MID$(file$,SUCC(backslash&))
  221. ELSE
  222. LET doppelpunkt&=INSTR(file$,":")
  223. LET file$=MID$(file$,SUCC(doppelpunkt&))
  224. ENDIF
  225. '
  226. LET punkt&=INSTR(file$,".")
  227. IF punkt&
  228. a$=LEFT$(file$,PRED(punkt&))
  229. ELSE
  230. a$=file$
  231. ENDIF
  232. IF LEN(a$)<8
  233. n$=UPPER$(a$)+STRING$(8-LEN(a$)," ")
  234. ELSE
  235. n$=UPPER$(a$)
  236. ENDIF
  237. RETURN n$
  238. '
  239. ENDFUNC
  240. > PROCEDURE rsc_set_text2(tree&,object&,string$)
  241. @rsc_set_text(tree&,object&,string$)
  242. @rsc_ob_reset(tree&,object&)
  243. RETURN
  244. > FUNCTION rsc_get_text$(tree&,object&)                                   !call
  245. LOCAL tree%,obspec%
  246. tree%=@xrsrc_gaddr(0,tree&)
  247. obspec%=ADD(faceval_sys%,INT{ADD(faceval_sys%,18)})
  248. RETURN CHAR{C:obspec%(L:tree%,object&)}
  249. ENDFUNC
  250. '
  251. ' ------------------------------------------------------------------------
  252. ' USER PROCEDURES AND FUNCTIONS: These are for you to fill in...
  253. '
  254. > PROCEDURE user_var_index
  255. '
  256. ' ---------------------------------------------------------------------------
  257. ' Objektbaum-Namen:
  258. ' system&                             : Dialog
  259. ' whointro&                           : Dialog
  260. ' fvt_alst&                           : Dialog
  261. ' fvt_alic&                           : Dialog
  262. ' fvt_altr&                           : Dialog
  263. ' icfyicon&                           : Dialog
  264. ' menu&                               : Menü
  265. ' multiple&                           : Dialog
  266. ' whofinish&                          : Dialog
  267. ' fvt_asci&                           : Dialog
  268. ' language&                           : Dialog
  269. ' whoicons&                           : Dialog
  270. ' ---------------------------------------------------------------------------
  271. ' Objekt-Namen:
  272. ' whostart&                           : Objekt im Baum whointro&
  273. ' about&                              : Objekt im Baum menu&
  274. ' quizstart&                          : Objekt im Baum menu&
  275. ' quizquit&                           : Objekt im Baum menu&
  276. ' help&                               : Objekt im Baum menu&
  277. ' netwho&                             : Objekt im Baum menu&
  278. ' picbox&                             : Objekt im Baum multiple&
  279. ' whoibox2&                           : Objekt im Baum multiple&
  280. ' whoansw1&                           : Objekt im Baum multiple&
  281. ' whoansw2&                           : Objekt im Baum multiple&
  282. ' whoansw3&                           : Objekt im Baum multiple&
  283. ' whoibox1&                           : Objekt im Baum multiple&
  284. ' textl1&                             : Objekt im Baum multiple&
  285. ' textl2&                             : Objekt im Baum multiple&
  286. ' textl3&                             : Objekt im Baum multiple&
  287. ' textl4&                             : Objekt im Baum multiple&
  288. ' whohelp&                            : Objekt im Baum multiple&
  289. ' right&                              : Objekt im Baum multiple&
  290. ' wrong&                              : Objekt im Baum multiple&
  291. ' addinfo1&                           : Objekt im Baum multiple&
  292. ' addinfo2&                           : Objekt im Baum multiple&
  293. ' ranswer&                            : Objekt im Baum whofinish&
  294. ' wanswer&                            : Objekt im Baum whofinish&
  295. ' finok&                              : Objekt im Baum whofinish&
  296. ' brigadier&                          : Objekt im Baum whoicons&
  297. ' tardis&                             : Objekt im Baum whoicons&
  298. ' dalek&                              : Objekt im Baum whoicons&
  299. ' icon_who&                           : Objekt im Baum whoicons&
  300. ' world&                              : Objekt im Baum whoicons&
  301. ' icon5&                              : Objekt im Baum whoicons&
  302. ' icon4&                              : Objekt im Baum whoicons&
  303. ' icon3&                              : Objekt im Baum whoicons&
  304. ' icon2&                              : Objekt im Baum whoicons&
  305. ' icon1&                              : Objekt im Baum whoicons&
  306. '
  307. ' ---------------------------------------------------------------------------
  308. ' Status-Variablen: (Details in der Prozedur user_rsc_var_init)
  309. '
  310. '
  311. '
  312. ' ---------------------------------------------------------------------------
  313. '
  314. ' ΩΩwsnippetΩΩ  - Wrinkle-Code: (dieses Flag nicht löschen oder verändern)
  315. ' gemscriptcmd_par_%        : internal (GEMScriptCMD-wrinkle)             !ΩΩFVW:GEMScriptCMDΩΩ
  316. ' gemscriptcmd_senders_$    : internal (GEMScriptCMD-wrinkle)             !ΩΩFVW:GEMScriptCMDΩΩ
  317. ' ΩΩwsnippetΩΩ  - Ende des Wrinkle-Codes: (dieses Flag nicht löschen oder verändern)
  318. '
  319. RETURN
  320. > PROCEDURE user_rsc_var_init
  321. '
  322. '  You MUST set these variables (and DIMension any listbox arrays here).
  323. '  This is read ONCE, at startup, and the corresponding dialog objects
  324. '  will be set accordingly.
  325. '
  326. current_menubar&=menu&      !set this to the menu bar tree index
  327. '
  328. ' snap_windows!=TRUE
  329. '
  330. LET whoanswer_var$=""                     ! Max lenght: 0 - tree: multiple&
  331. '
  332. @questions
  333. RETURN
  334. PROCEDURE user_rsc_interact(index&,tree&,object&,mc&,sub_me&)
  335. '
  336. '  <index&> is the index of this window in window_array&(index&,x)
  337. '           If the object tree is the normal menu bar, <index&>=-1
  338. '   <tree&> is the object tree number
  339. ' <object&> is the object that was selected (clicked on OR shortcut)
  340. '     <mc&> is the number of clicks (1=normal/2=double clicked/1 if shortcut)
  341. ' <sub_me&> is the chosen menuitem in a popup menu
  342. '
  343. SELECT tree&
  344. '
  345. ' ------------------------------------------------------------------------
  346. '
  347. CASE whointro&
  348. SELECT object&
  349. CASE whostart&
  350. @win_close(intro_dialog&)
  351. ENDSELECT
  352. '
  353. ' ------------------------------------------------------------------------
  354. '
  355. CASE menu&
  356. SELECT object&
  357. CASE about&
  358. intro_dialog&=@win_open_dialog(2,whointro&,icfyicon&)
  359. CASE quizstart&
  360. CLR frage%,klein%,richtig%,falsch%
  361. @dialog_aufbauen
  362. multiple_dialog&=@win_open_dialog(2,multiple&,icfyicon&)
  363. CASE quizquit&
  364. exit_program!=TRUE
  365. CASE netwho&
  366. @cab_show("http://www.mypenguin.de/prg/")
  367. CASE help&
  368. @user_rsc_context_help(tree&)
  369. ENDSELECT
  370. '
  371. ' ------------------------------------------------------------------------
  372. '
  373. CASE multiple&
  374. SELECT object&
  375. CASE whoansw1&
  376. IF r$(auswahl%)="1"
  377. INC richtig%
  378. ausgang!=TRUE
  379. ELSE
  380. INC falsch%
  381. ENDIF
  382. dialog_aufbauen
  383. CASE whoansw2&
  384. IF r$(auswahl%)="2"
  385. INC richtig%
  386. ausgang!=TRUE
  387. ELSE
  388. INC falsch%
  389. ENDIF
  390. dialog_aufbauen
  391. CASE whoansw3&
  392. IF r$(auswahl%)="3"
  393. INC richtig%
  394. ausgang!=TRUE
  395. ELSE
  396. INC falsch%
  397. ENDIF
  398. @dialog_aufbauen
  399. CASE whohelp&
  400. @user_rsc_context_help(tree&)
  401. '
  402. CASE whoquit&
  403. IF typ$(auswahl%)="S"
  404. c$=answ$(auswahl%)
  405. ausgang!=FALSE
  406. DO
  407. e$=@teil$("|",c$)
  408. IF UPPER$(@rsc_get_text$(multiple&,whoanswer&))=UPPER$(e$) AND e$<>""
  409. INC richtig%
  410. ausgang!=TRUE
  411. ENDIF
  412. LOOP UNTIL e$="" OR ausgang!=TRUE
  413. IF ausgang!=FALSE
  414. INC falsch%
  415. ENDIF
  416. dialog_aufbauen
  417. ENDIF
  418. '
  419. ENDSELECT
  420. '
  421. ' ------------------------------------------------------------------------
  422. '
  423. CASE whofinish&
  424. SELECT object&
  425. CASE finok&
  426. @win_close(finish_dialog&)
  427. ENDSELECT
  428. '
  429. ' ------------------------------------------------------------------------
  430. '
  431. CASE fvt_altr&
  432. alert_result&=SUB(object&,7)
  433. @win_close(@find_handle_from_tree(fvt_altr&))
  434. exit_alert_loop!=TRUE
  435. '
  436. ' ------------------------------------------------------------------------
  437. '
  438. ENDSELECT
  439. RETURN
  440. > PROCEDURE user_rsc_draw_extra(userhandle&,index&,tree&,tree%,cx&,cy&,cw&,ch&)
  441. LOCAL x&,y&,w&,h&
  442. ~GRAF_MOUSE(256,0) !hidem - to avoid "mousedroppings"
  443. '
  444. ' This procedure is here if you need to draw anything in the dialog that
  445. ' cannot be in the RSC-file. The clipping rectangle is already set
  446. ' for this procedure (walking the rectangle tree) MUST NOT BE ALTERED!!!
  447. ' Else you may find yourself drawing over other objects, or even windows!
  448. '
  449. ' <userhandle&> is the userhandle you gave when opening the window
  450. '               or -1 if it is a dialog window
  451. ' <index&> is the index of this window in window_array&(index&,x)
  452. ' <tree&> is the object tree number of the dialog or toolstrip/bar
  453. ' <tree%> is the object tree adress of the dialog or toolstrip/bar
  454. ' <cx&>,<cy&>,<cw&>,<ch&> is the clipping rectangle set
  455. '
  456. ' You should limit your drawing/blitting commands to the size and
  457. ' location of an IBOX/BOX object. The BOX will give you a backround,
  458. ' the IBOX will not. The location and width/height of the IBOX/BOX
  459. ' are found by calling:
  460. '
  461. ' @rsc_ob_xywh(tree%,object&,x&,y&,w&,h&)
  462. '
  463. ' <tree%> is the object tree adress
  464. ' <object&> is the object number
  465. ' <x&> is the x-coordinate
  466. ' <y&> is the y-coordinate
  467. ' <w&> is the width
  468. ' <h&> is the height
  469. '
  470. ' So you might set up a SELECT/CASE structure that looks
  471. ' something like this example:
  472. '
  473. SELECT tree&
  474. CASE multiple&
  475. @rsc_ob_xywh(tree%,whoibox2&,x&,y&,w&,h&)
  476. minus%=0
  477. FOR i%=50 TO 55
  478. COLOR i%
  479. BOX x&+minus%,y&+minus%,PRED(ADD(x&,w&))-minus%,PRED(ADD(y&,h&))-minus%
  480. INC minus%
  481. NEXT i%
  482. @rsc_ob_xywh(tree%,whoibox1&,x&,y&,w&,h&)
  483. minus%=0
  484. FOR i%=100 TO 110
  485. COLOR i%
  486. BOX x&+minus%,y&+minus%,PRED(ADD(x&,w&))-minus%,PRED(ADD(y&,h&))-minus%
  487. INC minus%
  488. NEXT i%
  489. ENDSELECT
  490. '
  491. ~GRAF_MOUSE(257,0) !showm - display pointer again
  492. RETURN
  493. > PROCEDURE user_on_open
  494. '
  495. ' This procedure is called when the program is run, after the RSC is
  496. ' loaded and just before the main loop. You can open program windows,
  497. ' toolboxes etc. here, or  init things for your program like
  498. ' loading an *.INF or .DAT file.
  499. '
  500. ' If run as an accessory, this procedure is called EVERY TIME
  501. ' THE ACCESSORY IS OPENED. If you need to do anything just ONCE,
  502. ' like disable menu-entries spesific to PROGRAM execution, set a global
  503. ' flag here to avoid doing things EVERY time the accessory is opened.
  504. '
  505. RETURN
  506. > PROCEDURE user_on_exit
  507. '
  508. ' This procedure is called when you exit the program. If you need to
  509. ' release memory, restore the original desktop or do other
  510. ' "cleaning up" tasks, do it here.
  511. '
  512. ' If run as an accessory, this procedure is called EVERY TIME
  513. ' THE ACCESSORY IS CLOSED. (Remember: An accessory is NEVER exited)
  514. '
  515. RETURN
  516. > FUNCTION user_quit_ok
  517. $F%
  518. exit_program!=FALSE
  519. IF acc&
  520. RETURN TRUE
  521. ELSE
  522. '
  523. ' User wants to quit
  524. ' Return value: TRUE  to quit
  525. '               FALSE to ignore
  526. '
  527. ' The following SELECT-CASE-ENDSELECT structure is just an example.
  528. ' If you want to use an alert,  you may (should?:-) want to use
  529. ' a windowed alert...
  530. '
  531. ' The rest of the code in this function should *NOT* be altered!
  532. '
  533. SELECT @alert_wind(1,4,"")
  534. CASE 1
  535. RETURN TRUE
  536. CASE 2
  537. RETURN FALSE
  538. ENDSELECT
  539. '
  540. ENDIF
  541. ENDFUNC
  542. > FUNCTION user_systemcheck
  543. $F%
  544. '
  545. ' This function is called immediately when the program is started,
  546. ' and only if the requirements in the system procedure 'SYSTEMCHECK'
  547. ' is met. Remember: The RSC is NOT YET LOADED! If you need to check
  548. ' anything special (like a cookie) before allowing the program to load
  549. ' and run, do it here.
  550. '
  551. ' To continue, return TRUE
  552. ' To abort the program, return FALSE
  553. '
  554. ' If you abort the program, use an alert to tell the user WHY the program
  555. ' is aborted.
  556. '
  557. ' If you have no need to check anything, just leave this function empty,
  558. ' except of course for the 'RETURN TRUE' line below.
  559. '
  560. RETURN TRUE
  561. ENDFUNC
  562. > PROCEDURE user_gem_messages(mx&,my&,ks&,m0&,m1&,m2&,m3&,m4&,m5&,m6&,m7&)
  563. '
  564. ' Any message the Face Value engine do not understand, goes to this proc.
  565. ' Here, you are free to implement your own communication protocols, or
  566. ' to ignore unknown messages completly and leave it empty.
  567. '
  568. ' <mx&> and <my&> are the mouse coordinates at the time of the message
  569. ' <ks&> is the keyboard state at the time of the message
  570. ' <m0&> to <m7&> are the actual words in the message
  571. '
  572. IF m0&=&H4711
  573. @user_rsc_interact(-1,menu&,quizstart&,1,-1)
  574. ENDIF
  575. RETURN
  576. > PROCEDURE user_win_close_all
  577. '
  578. ' This procedure is called when the WIN_CLOSE_ALL procedure of the FV engine
  579. ' is called, and before the windows are closed and the window arrays erased.
  580. '
  581. ' If you have any resources attatched to each window, you can clean them
  582. ' up here. (releasing memory etc.)
  583. '
  584. RETURN
  585. '
  586. > FUNCTION user_rsc_bubble_help$(tree&,object&)
  587. LOCAL help_str$
  588. help_str$=""
  589. '
  590. ' Hier können die Texte für die BubbleGEM-Hilfen eingetragen werden:
  591. ' help_str$="Mein Hilfetext"
  592. '
  593. ' Beispiel:
  594. ' SELECT tree&
  595. ' CASE my_dialog&
  596. '   SELECT object&
  597. '   CASE my_object&
  598. '     help_str$="Hier ist mein Beispiel-Hilfetext...!"
  599. '   ENDSELECT
  600. ' ENDSELECT
  601. '
  602. ' faceVALUE kann Unterscheiden, ob die Hilfeblase geöffnet wird, weil
  603. ' mit der Maus geklicked wurde, oder weil die Maus eine gewisse Zeit
  604. ' über dem Objekt verweilt hat (sog. Dämon-Hilfe).
  605. '
  606. ' Soll eine Blase bei der Dämon-Hilfe nicht erscheinen, so kann dem Text
  607. ' ein "#" vorangestellt werden:
  608. '
  609. '     help_str$="#Dieser Text wird nur bei Mausklick gezeigt!"
  610. '
  611. '
  612. SELECT tree&
  613. ' ----------------------------------------------------------------------------
  614. CASE multiple&
  615. SELECT object&
  616. CASE picbox&
  617. help_str$=""
  618. CASE whoibox2&
  619. help_str$=""
  620. CASE whoansw1&,whoansw2&,whoansw3&
  621. help_str$=@lang$(2)
  622. CASE 3 TO 12
  623. a$=@lang$(INT(RND(1)*3)+4)
  624. CASE whohelp&
  625. help_str$=""
  626. ENDSELECT
  627. '
  628. ' ----------------------------------------------------------------------------
  629. CASE whofinish&
  630. SELECT object&
  631. CASE ranswer&
  632. help_str$=""
  633. CASE wanswer&
  634. help_str$=""
  635. CASE finok&
  636. help_str$=""
  637. ENDSELECT
  638. '
  639. ' ----------------------------------------------------------------------------
  640. '
  641. ' ΩΩwsnippetΩΩ  - Wrinkle-Code: (dieses Flag nicht löschen oder verändern)
  642. ' ΩΩwsnippetΩΩ  - Ende des Wrinkle-Codes: (dieses Flag nicht löschen oder verändern)
  643. '
  644. ' ----------------------------------------------------------------------------
  645. ENDSELECT
  646. IF help_str$=""
  647. help_str$="#Für dieses Objekt ist keine Kontext-Hilfe verfügbar." !***if no bubble help
  648. ENDIF
  649. RETURN help_str$
  650. ENDFUNC
  651. > FUNCTION user_gemscriptcmd_command(cmd$)
  652. $F%
  653. ' -----------------------------------------------------------------------------
  654. ' GEMScript  Command-Receive V1.0   ╜1998 by Holger Herzog
  655. '
  656. '
  657. ' This procedure is called, when a gemscript-command
  658. ' is received. The command is stored in cmd$ (Upper-Case!).
  659. '
  660. ' You can get the first parameter by using:
  661. '
  662. '  par_exist!=@gemscriptcmd_par(par$)
  663. '
  664. ' If there's no parameter, par_exist! will be FALSE.
  665. ' The value of the parameter will be stored in par$.
  666. ' Get the next par using the same call, untill the
  667. ' function returns FALSE.
  668. '
  669. ' For some commands, the sender should additionaly return
  670. ' a string-value. You can set this value by calling
  671. ' the procedure @gemscriptcmd_return(string$).
  672. '
  673. ' Set the return-value!
  674. ' RETURN 0   Command ok (executed)
  675. ' RETURN 2   Command failed (an error occuderd)
  676. ' RETURN 3   Command unknown
  677. '
  678. ' Example:
  679. '
  680. IF cmd$="APPGETLONGNAME"
  681. @gemscriptcmd_return(CHAR{faceval_sys%+2854})    ! get long AppName
  682. RETURN 0
  683. ELSE IF cmd$="QUIT"
  684. LET exit_program!=TRUE
  685. RETURN 0
  686. '
  687. ENDIF
  688. '
  689. ' ΩΩwsnippetΩΩ  - Wrinkle-Code: (dieses Flag nicht löschen oder verändern)
  690. ' ΩΩwsnippetΩΩ  - Ende des Wrinkle-Codes: (dieses Flag nicht löschen oder verändern)
  691. '
  692. RETURN 1      ! command unknown
  693. ENDFUNC
  694. > PROCEDURE user_rsc_context_help(tree&)
  695. '
  696. ' Von hier aus wird der ST-Guide aufgerufen. Bitte die Namen
  697. ' der entsprechenden Hilfeseiten eintragen:
  698. '
  699. SELECT tree&
  700. CASE multiple&
  701. @call_st_guide("DR_WHO.hyp","The Dr.Who-Quiz!")
  702. ' ΩΩwsnippetΩΩ  - Wrinkle-Code: (dieses Flag nicht löschen oder verändern)
  703. ' ΩΩwsnippetΩΩ  - Ende des Wrinkle-Codes: (dieses Flag nicht löschen oder verändern)
  704. DEFAULT
  705. @call_st_guide("DR_WHO.hyp","")
  706. ENDSELECT
  707. RETURN
  708.