home *** CD-ROM | disk | FTP | other *** search
/ M.u.C.S. Disc 2000 / MUCS2000.iso / anwend / fontshow / fontshow.lst < prev    next >
File List  |  1995-04-30  |  16KB  |  588 lines
  1. '
  2. @prg_init
  3. @prg_defvar
  4. @prg_defconst
  5. @prg_rsc
  6. @prg_main
  7. @prg_exit
  8. '
  9. EDIT
  10. '
  11. '
  12. ' Liste der Procedures
  13. '
  14. > PROCEDURE font_get(fg_dev&,fg_ptr%)
  15.   SWAP *fg_ptr%,fg_ptr$()
  16.   LOCAL i&,a&,a$,fg_count&
  17.   V~H=fg_dev&
  18.   fg_count&=VST_LOAD_FONTS(0)+1
  19.   '
  20.   IF fg_count&=0
  21.     ~FORM_ALERT(1,"[1][Es stehen keine|Zeichensätze zur Verfügung|für dieses Gerät!][Abbruch]")
  22.   ELSE
  23.     FOR i&=1 TO fg_count&
  24.       a&=@vqt_name(fg_dev&,i&,a$)
  25.       fg_ptr$(i&-1)=STR$(a&,5)+"  "+LEFT$(a$,16)
  26.     NEXT i&
  27.   ENDIF
  28.   '
  29.   SWAP *fg_ptr%,fg_ptr$()
  30. RETURN
  31. > PROCEDURE font_size(d&,ptr%)
  32.   LOCAL a&,b&,c&,dummy&
  33.   SWAP *ptr%,ptr$()
  34.   a&=32767
  35.   CLR c&
  36.   CLR b&
  37.   DO
  38.     b&=@vst_point(d&,a&,dummy&,dummy&,dummy&,dummy&) ! Fontgrö₧e
  39.     ptr$(c&)=STR$(b&,5) ! Wir zählen von oben nach unten,
  40.     EXIT IF b&>a&       ! da wir immer die nächst kleinere
  41.     INC c&              ! Grö₧e zurückgeliefert bekommen!!!
  42.     a&=b&
  43.     DEC a&
  44.   LOOP UNTIL c&=255
  45.   '
  46.   QSORT ptr$(),c&
  47.   FOR a&=c& TO PRED(DIM?(ptr$()))
  48.     ptr$(a&)=""
  49.   NEXT a&
  50.   '
  51.   SWAP *ptr%,ptr$()
  52. RETURN
  53. '
  54. > PROCEDURE prg_defconst
  55.   '
  56.   ' Für FORM_DIAL()
  57.   '
  58.   fo_dbeg&=0
  59.   fo_dgrw&=1
  60.   fo_dshr&=2
  61.   fo_dend&=3
  62.   '
  63.   LET tree1%=0  !RSC_TREE!
  64.   LET tree2%=1  !RSC_TREE!
  65.   LET tree3%=2  !RSC_TREE!
  66.   LET tree4%=3  !RSC_TREE!
  67.   LET t1_chrbx&=2  !Obj in #0
  68.   LET t1_exit&=3  !Obj in #0
  69.   LET t1_sty_a&=7  !Obj in #0
  70.   LET t1_sty_f&=12  !Obj in #0
  71.   LET t1_styl0&=14  !Obj in #0
  72.   LET t1_styl5&=19  !Obj in #0
  73.   LET t1_nameb&=23  !Obj in #0
  74.   LET t1_names&=24  !Obj in #0
  75.   LET t1_namet&=25  !Obj in #0
  76.   LET t1_sizeb&=26  !Obj in #0
  77.   LET t1_sizes&=27  !Obj in #0
  78.   LET t1_sizet&=28  !Obj in #0
  79.   LET t1_charb&=30  !Obj in #0
  80.   LET t1_chart&=31  !Obj in #0
  81.   LET t1_chars&=32  !Obj in #0
  82.   LET t1_about&=34  !Obj in #0
  83.   LET t2_txtbx&=1  !Obj in #1
  84. RETURN
  85. > PROCEDURE prg_defvar
  86.   prg_path$=CHR$(GEMDOS(25)+65)+":"+DIR$(0)+"\"
  87.   rsc_name$=prg_path$+"FONTSHOW.RSC"
  88.   DIM font_name$(255),font_size$(255),extend&(7),font_char$(256)
  89.   '
  90.   draw!=TRUE
  91.   font_size&=10
  92.   font_style&=0
  93.   pos_font&=0
  94.   pos_size&=0
  95.   '
  96.   FOR i&=0 TO 222
  97.     font_char$(i&)=CHR$(i&+1)+" "+CHR$(i&+33)
  98.   NEXT i&
  99. RETURN
  100. > PROCEDURE prg_exit
  101.   ~VST_UNLOAD_FONTS(0)
  102.   ~RSRC_FREE()
  103.   RESERVE
  104. RETURN
  105. > PROCEDURE prg_init
  106.   IF GDOS?=FALSE
  107.     ~FORM_ALERT(1,"[3][FONTSHOW |benötigt|GDOS!][ABBRUCH]")
  108.     EDIT
  109.   ENDIF
  110.   RESERVE 40960
  111.   handle_s&=V~H
  112. RETURN
  113. > PROCEDURE prg_main
  114.   LOCAL pos&,back&,x&,y&,a&
  115.   '
  116.   ~FORM_DIAL(fo_dbeg&,0,0,0,0,t1_x&,t1_y&,t1_w&,t1_h&)
  117.   ~FORM_DIAL(fo_dgrw&,0,0,0,0,t1_x&,t1_y&,t1_w&,t1_h&)
  118.   ~OBJC_DRAW(tree4%,0,5,t4_x&,t4_y&,t4_w&,t4_h&)
  119.   @font_get(handle_s&,*font_name$())
  120.   font_name$=font_name$(0)
  121.   pos_char&=65
  122.   font_char$="Endlich GDOS!"
  123.   '
  124.   ~OBJC_DRAW(tree1%,0,5,t1_x&,t1_y&,t1_w&,t1_h&)
  125.   ~GRAF_MOUSE(0,0)
  126.   '
  127.   DO
  128.     '
  129.     IF draw!
  130.       @redraw(handle_s&)
  131.       @font_size(handle_s&,*font_size$())
  132.       draw!=FALSE
  133.     ENDIF
  134.     '
  135.     back&=WORD(FORM_DO(tree1%,0))
  136.     SELECT back&
  137.     CASE t1_exit&
  138.       prg_exit!=TRUE
  139.       '
  140.     CASE t1_names&
  141.       ' Wenn man will, da₧ das Popupmenue immer bei Position 0 beginnt,
  142.       ' mu₧ man für pos_font& immer 0 übergeben!!
  143.       @popup(tree2%,*font_name$(),pos_font&,font_name$,pos_font&)
  144.       draw!=TRUE
  145.       pos_size&=0 ! Mu₧ zurückgesetzt werden, da Listenlänge anders sein kann
  146.       '
  147.     CASE t1_sizes&
  148.       ~OBJC_OFFSET(tree1%,t1_sizeb&,x&,y&)
  149.       OB_X(tree3%,0)=x&+OB_W(tree1%,t1_sizeb&)-OB_W(tree3%,0)
  150.       OB_Y(tree3%,0)=y&+OB_H(tree1%,t1_sizeb&)+1
  151.       '
  152.       ' Wenn man will, da₧ das Popupmenue immer bei Position 0 beginnt,
  153.       ' mu₧ man für pos_size& immer 0 übergeben!!
  154.       @popup(tree3%,*font_size$(),pos_size&,font_size$,pos_size&)
  155.       draw!=TRUE
  156.       '
  157.     CASE t1_chars&
  158.       ~OBJC_OFFSET(tree1%,t1_charb&,x&,y&)
  159.       OB_X(tree3%,0)=x&+OB_W(tree1%,t1_charb&)-OB_W(tree3%,0)
  160.       OB_Y(tree3%,0)=y&+OB_H(tree1%,t1_charb&)+1
  161.       '
  162.       @popup(tree3%,*font_char$(),pos_char&,font_char$,pos_char&)
  163.       draw!=TRUE
  164.       '
  165.     CASE t1_styl0& TO t1_styl5&
  166.       CLR font_style&
  167.       OB_STATE(tree1%,back&-t1_styl0&+t1_sty_a&)=BCHG(OB_STATE(tree1%,back&-t1_styl0&+t1_sty_a&),1)
  168.       ~OBJC_DRAW(tree1%,back&-t1_styl0&+t1_sty_a&,0,0,0,0,0)
  169.       FOR a&=0 TO t1_sty_f&-t1_sty_a&
  170.         IF BTST(OB_STATE(tree1%,a&+t1_sty_a&),1)=TRUE
  171.           font_style&=BSET(font_style&,a&)
  172.         ENDIF
  173.       NEXT a&
  174.       draw!=TRUE
  175.       '
  176.       ~EVNT_BUTTON(1,1,0)
  177.       '
  178.     CASE t1_sizet&,t1_chart&
  179.       OB_FLAGS(tree1%,t1_exit&)=BCLR(OB_FLAGS(tree1%,t1_exit&),1)
  180.       OB_FLAGS(tree1%,back&)=OB_FLAGS(tree1%,back&) XOR &X110
  181.       ~FORM_DO(tree1%,back&)
  182.       OB_STATE(tree1%,back&)=0
  183.       IF back&=t1_sizet&
  184.         font_size$=CHAR{{OB_SPEC(tree1%,back&)}}
  185.       ELSE
  186.         font_char$=CHAR{{OB_SPEC(tree1%,back&)}}
  187.       ENDIF
  188.       OB_FLAGS(tree1%,back&)=OB_FLAGS(tree1%,back&) XOR &X110
  189.       OB_FLAGS(tree1%,t1_exit&)=BSET(OB_FLAGS(tree1%,t1_exit&),1)
  190.       draw!=TRUE
  191.       '
  192.     CASE t1_about&
  193.       GET t4_x&,t4_y&,t4_x&+t4_w&,t4_y&+t4_h&,get$
  194.       ~OBJC_DRAW(tree4%,0,5,t4_x&,t4_y&,t4_w&,t4_h&)
  195.       ~FORM_DO(tree4%,0)
  196.       PUT t4_x&,t4_y&,get$
  197.       '
  198.     ENDSELECT
  199.     '
  200.   LOOP UNTIL prg_exit!=TRUE
  201.   ~FORM_DIAL(fo_dshr&,0,0,0,0,t1_x&,t1_y&,t1_w&,t1_h&)
  202.   ~FORM_DIAL(fo_dend&,0,0,0,0,t1_x&,t1_y&,t1_w&,t1_h&)
  203. RETURN
  204. > PROCEDURE prg_rsc
  205.   LOCAL x&,y&
  206.   IF RSRC_LOAD(rsc_name$)=0
  207.     ~FORM_ALERT(1,"[3][Konnte |"+RIGHT$(rsc_name$,30)+"|nicht finden!][ABBRUCH]")
  208.     RESERVE
  209.     EDIT
  210.   ENDIF
  211.   '
  212.   ~RSRC_GADDR(0,tree1%,tree1%)
  213.   ~RSRC_GADDR(0,tree2%,tree2%)
  214.   ~RSRC_GADDR(0,tree3%,tree3%)
  215.   ~RSRC_GADDR(0,tree4%,tree4%)
  216.   '
  217.   ~FORM_CENTER(tree1%,t1_x&,t1_y&,t1_w&,t1_h&)
  218.   SUB t1_x&,2    ! Ist notwendig, da Mutterobjekt schattiert ist!!
  219.   SUB t1_y&,2
  220.   ADD t1_w&,4
  221.   ADD t1_h&,4
  222.   '
  223.   ~FORM_CENTER(tree4%,t4_x&,t4_y&,t4_w&,t4_h&)
  224.   SUB t4_x&,2    ! Ist notwendig, da Mutterobjekt schattiert ist!!
  225.   SUB t4_y&,2
  226.   ADD t4_w&,4
  227.   ADD t4_h&,4
  228.   '
  229.   ~OBJC_OFFSET(tree1%,t1_nameb&,x&,y&)
  230.   OB_X(tree2%,0)=x&
  231.   OB_Y(tree2%,0)=y&+OB_H(tree1%,t1_nameb&)+1
  232.   '
  233. RETURN
  234. '
  235. PROCEDURE popup(pp_tree%,pp_field%,pp_posin&,VAR pp_string$,pp_posout&)
  236.   '
  237.   ' Adresse des Objektbaums                                     pp_tree%
  238.   ' Objekt, mit dem nach oben gescrollt werden soll             pp_up&
  239.   ' Objekt, mit dem nach unten gescrollt werden soll            pp_dn&
  240.   ' Slider-Objekt                                               pp_ib&
  241.   ' Mutterobjekt der Textobjekte                                pp_txtbx&
  242.   ' Erstes Textobjekt des Scroll-Menues                         pp_txt0&
  243.   ' Letztes Textobjekt des Scroll-Menues                        pp_txt9&
  244.   ' Zeiger auf Stringfeld, das angezeigt werden soll            pp_field%
  245.   ' Anzahl der tatsächlichen Einträge                           pp_count&
  246.   ' Maximale Anzahl der Einträge                                pp_max&
  247.   ' Elter-Objekt, das alle Texcteinträge enthält                pp_txtbx&
  248.   ' Elter-Objekt, das die Slider & Pfeile enthält               pp_scrbx&
  249.   ' Textinhalt des String-Objektes, das ausgewählt wurde        pp_string$
  250.   ' Anzahl der Texteinträge                                     pp_txt&
  251.   '
  252.   '
  253.   LOCAL a$,a&,b&,c&,d&,pp_tx&,pp_ty&,pp_tw&,pp_th&,exit!,back&
  254.   LOCAL pp_a&,pp_pos&,pp_sel!,pp_up&,pp_dn&,pp_txt0&,pp_txt9&
  255.   LOCAL pp_scrbx&,pp_txtbx&,pp_count&,pp_max&,pp_txt&,pp_ib&,pp_ob&
  256.   '
  257.   '
  258.   pp_txtbx&=OB_HEAD(pp_tree%,0)         ! Textbox im Objektbaum ermitteln
  259.   pp_scrbx&=OB_TAIL(pp_tree%,0)         ! Scrollbox   -""-
  260.   pp_up&=OB_HEAD(pp_tree%,pp_scrbx&)    ! Erstes Textobjekt
  261.   pp_ob&=pp_up&+1
  262.   pp_ib&=OB_HEAD(pp_tree%,pp_ob&)
  263.   pp_dn&=OB_TAIL(pp_tree%,pp_scrbx&)    ! Letztes Textobjekt
  264.   pp_txt0&=OB_HEAD(pp_tree%,pp_txtbx&)  ! Pfeil hoch
  265.   pp_txt9&=OB_TAIL(pp_tree%,pp_txtbx&)  ! Pfeil runter
  266.   pp_txt&=pp_txt9&-pp_txt0&+1
  267.   '
  268.   SWAP *pp_field%,pp_field$()   ! Feld zuweisen
  269.   pp_max&=DIM?(pp_field$())
  270.   '
  271.   DO UNTIL pp_field$(pp_count&)=""
  272.     INC pp_count&
  273.   LOOP WHILE pp_count&<pp_max&
  274.   '
  275.   a&=MAX(pp_count&,pp_txt&)
  276.   a&=OB_H(pp_tree%,pp_ob&)*(pp_txt&)/a&
  277.   a&=MAX(OB_W(pp_tree%,pp_ib&),a&)
  278.   OB_H(pp_tree%,pp_ib&)=a&
  279.   '
  280.   pp_tx&=OB_X(pp_tree%,0)   ! Ausma₧e ermitteln...
  281.   pp_ty&=OB_Y(pp_tree%,0)
  282.   pp_tw&=OB_W(pp_tree%,0)
  283.   pp_th&=OB_H(pp_tree%,0)
  284.   '
  285.   SUB pp_tx&,2      ! Ist notwendig, da Mutterobjekt schattiert ist!!
  286.   SUB pp_ty&,2      ! dto.
  287.   ADD pp_tw&,6      ! dto.
  288.   ADD pp_th&,6      ! dto.
  289.   '
  290.   pp_pos&=pp_posin&
  291.   '
  292.   FOR a&=0 TO MIN(pp_txt&-1,pp_count&-1) ! Wir weisen Strings zu
  293.     OB_FLAGS(pp_tree%,a&+pp_txt0&)=BSET(OB_FLAGS(pp_tree%,a&+pp_txt0&),6) !Touchexit
  294.     CHAR{OB_SPEC(pp_tree%,a&+pp_txt0&)}=pp_field$(a&+pp_pos&)
  295.   NEXT a&
  296.   '
  297.   IF pp_count&<=pp_txt&
  298.     '
  299.     FOR a&=pp_count& TO pp_txt&-1
  300.       OB_FLAGS(pp_tree%,a&+pp_txt0&)=BCLR(OB_FLAGS(pp_tree%,a&+pp_txt0&),6)
  301.       CHAR{OB_SPEC(pp_tree%,a&+pp_txt0&)}="" ! Da wo nix ist, wird auch nix
  302.     NEXT a&                                  ! reingeschrieben
  303.     '
  304.   ENDIF
  305.   '
  306.   GET pp_tx&,pp_ty&,pp_tx&+pp_tw&,pp_ty&+pp_th&,a$      ! Wir merken uns den Hintergrund!
  307.   pp_sel!=TRUE
  308.   '
  309.   ~OBJC_DRAW(pp_tree%,0,0,pp_tx&,pp_ty&,pp_tw&,pp_th&)
  310.   ~OBJC_DRAW(pp_tree%,pp_up&,0,0,0,0,0)
  311.   ~OBJC_DRAW(pp_tree%,pp_dn&,0,0,0,0,0)
  312.   DO
  313.     '
  314.     IF pp_sel!=TRUE ! Wenn neu gezeichnet werden soll...
  315.       '
  316.       IF pp_pos&=0
  317.         OB_FLAGS(pp_tree%,pp_up&)=BCLR(OB_FLAGS(pp_tree%,pp_up&),6)
  318.       ELSE
  319.         OB_FLAGS(pp_tree%,pp_up&)=BSET(OB_FLAGS(pp_tree%,pp_up&),6)
  320.       ENDIF
  321.       '
  322.       IF pp_pos&=pp_count&-pp_txt& OR pp_count&<pp_txt&
  323.         OB_FLAGS(pp_tree%,pp_dn&)=BCLR(OB_FLAGS(pp_tree%,pp_dn&),6)
  324.       ELSE
  325.         OB_FLAGS(pp_tree%,pp_dn&)=BSET(OB_FLAGS(pp_tree%,pp_dn&),6)
  326.       ENDIF
  327.       '
  328.       IF pp_count&>pp_txt&               ! Ist notwendig, da sonst
  329.         '                                ! Division durch Null stattfinden
  330.         '                                ! könnte!
  331.         OB_Y(pp_tree%,pp_ib&)=(OB_H(pp_tree%,pp_ob&)-OB_H(pp_tree%,pp_ib&))*pp_pos&/(pp_count&-pp_txt&)
  332.       ELSE
  333.         OB_Y(pp_tree%,pp_ib&)=0
  334.       ENDIF
  335.       '
  336.       FOR a&=pp_txt0& TO pp_txt9&
  337.         CHAR{OB_SPEC(pp_tree%,a&)}=pp_field$(pp_pos&+a&-pp_txt0&)
  338.       NEXT a&
  339.       ~OBJC_DRAW(pp_tree%,pp_txtbx&,1,0,0,0,0)
  340.       ~OBJC_DRAW(pp_tree%,pp_ob&,1,0,0,0,0)
  341.       pp_sel!=FALSE
  342.       '
  343.     ENDIF
  344.     '
  345.     back&=BYTE(FORM_DO(pp_tree%,0))
  346.     '
  347.     SELECT back&
  348.     CASE pp_up&         ! Einen Eintrag zurückblättern
  349.       pp_sel!=TRUE      ! Befehl zum Neuzeichnen
  350.       DEC pp_pos&
  351.       '
  352.     CASE pp_dn&         ! Einen Eintrag vorblättern
  353.       pp_sel!=TRUE      ! Befehl zum Neuzeichnen
  354.       INC pp_pos&
  355.       '
  356.     CASE pp_ib&
  357.       '
  358.       IF pp_count&>pp_txt& ! Relativ Positionieren...
  359.         a&=GRAF_SLIDEBOX(pp_tree%,pp_ob&,pp_ib&,1)      ! Slidebox aktivieren
  360.         a&=a&/1000*(pp_count&-pp_txt&) ! und auswerten
  361.         IF NOT a&=pp_pos&
  362.           pp_sel!=TRUE
  363.           pp_pos&=a&
  364.         ENDIF
  365.       ENDIF
  366.       '
  367.     CASE pp_txt0& TO pp_txt9&
  368.       exit!=TRUE                ! Wenn angewählt, nix wie raus aus dem Dialog
  369.       pp_string$=CHAR{OB_SPEC(pp_tree%,back&)}
  370.       '
  371.     CASE pp_ob&
  372.       ~OBJC_OFFSET(pp_tree%,pp_ib&,a&,b&)
  373.       ~OBJC_OFFSET(pp_tree%,pp_ob&,c&,d&)
  374.       w&=OB_W(pp_tree%,pp_ob&)
  375.       h&=OB_H(pp_tree%,pp_ob&)
  376.       ~EVNT_BUTTON(0,0,0,x&,y&,k&,s&)
  377.       IF y&<b&
  378.         IF pp_pos&>pp_txt&+1
  379.           SUB pp_pos&,pp_txt&-1
  380.         ELSE
  381.           pp_pos&=0
  382.         ENDIF
  383.       ELSE
  384.         IF pp_pos&>pp_count&-2*pp_txt&
  385.           pp_pos&=pp_count&-pp_txt&
  386.         ELSE
  387.           ADD pp_pos&,pp_txt&-1
  388.         ENDIF
  389.       ENDIF
  390.       pp_sel!=TRUE
  391.       '
  392.     ENDSELECT
  393.     '
  394.   LOOP UNTIL exit!=TRUE         ! Wollen wir den Dialog beenden?
  395.   PUT pp_tx&,pp_ty&,a$          ! Bildschirm wieder hinzeichnen
  396.   SWAP *pp_field%,pp_field$()   ! Feld mit Feldzeiger wieder zurücktauschen
  397.   '                             ! darf nicht vergessen werden
  398.   pp_posout&=pp_pos&            ! Neue Position übergeben
  399. RETURN
  400. '
  401. > PROCEDURE redraw(r_handle&)
  402.   LOCAL width&,height&,x&,y&,tx&,ty&,tw&,th&
  403.   '
  404.   font_id&=VAL(LEFT$(font_name$,5))
  405.   ~@vst_font(r_handle&,font_id&)
  406.   font_size&=MIN(VAL(font_size$),32767)  ! Wir haben nur Wortgrö₧e!!!!
  407.   font_size&=@vst_point(r_handle&,font_size&,dummy&,dummy&,dummy&,dummy&) ! Fontgrö₧e
  408.   ~@vst_rotation(r_handle&,0)                                   ! Fontlage
  409.   ~@vst_effects(r_handle&,font_style&)                          ! Fontstil
  410.   @vqt_extend(r_handle&,font_char$,*extend&())                  ! Zeichenma₧e
  411.   width&=MAX(extend&(2),extend&(4))-MIN(extend&(6),extend&(0))  ! Zeichenbreite
  412.   height&=MAX(extend&(3),extend&(5))-MIN(extend&(7),extend&(1)) ! Zeichenhoehe
  413.   '
  414.   ~OBJC_OFFSET(tree1%,t1_chrbx&,x&,y&)
  415.   w&=OB_W(tree1%,t1_chrbx&)
  416.   h&=OB_H(tree1%,t1_chrbx&)
  417.   ~OBJC_DRAW(tree1%,t1_chrbx&,0,0,0,0,0)
  418.   '
  419.   CHAR{{OB_SPEC(tree1%,t1_namet&)}}=font_name$  ! Fontname
  420.   CHAR{{OB_SPEC(tree1%,t1_sizet&)}}=STR$(font_size&,5)
  421.   CHAR{{OB_SPEC(tree1%,t1_chart&)}}=font_char$
  422.   ~OBJC_DRAW(tree1%,t1_namet&,0,0,0,0,0)
  423.   ~OBJC_DRAW(tree1%,t1_sizet&,0,0,0,0,0)
  424.   ~OBJC_DRAW(tree1%,t1_chart&,0,0,0,0,0)
  425.   '
  426.   @vst_alignment(r_handle&,1,3,dummy&,dummy&)
  427.   ~@vswr_mode(r_handle&,0)
  428.   '
  429.   '
  430.   CLIP x&+4,y&+4,w&-8,h&-8
  431.   '
  432.   ADD x&,(OB_W(tree1%,t1_chrbx&)/2)
  433.   ADD y&,(OB_H(tree1%,t1_chrbx&)/2)
  434.   ADD y&,(height&/2)
  435.   '
  436.   @v_justified(r_handle&,x&,y&,font_char$,width&,0,0)
  437.   '
  438. RETURN
  439. '
  440. '
  441. ' ====== VDI-Prozeduren & -Funktionen ======================================
  442. '
  443. > PROCEDURE v_justified(handle&,x&,y&,string$,length&,word_space&,char_space&)
  444.   LOCAL n&,string%,i&
  445.   '
  446.   INTIN(0)=word_space&
  447.   INTIN(1)=char_space&
  448.   '
  449.   n&=LEN(string$)
  450.   string%=V:string$
  451.   '
  452.   FOR i&=0 TO n&
  453.     INTIN(i&+2)=BYTE{string%+i&}
  454.   NEXT i&
  455.   '
  456.   CONTRL(1)=2
  457.   CONTRL(2)=0
  458.   CONTRL(3)=n&+2
  459.   CONTRL(4)=0
  460.   CONTRL(5)=10
  461.   CONTRL(6)=handle&
  462.   '
  463.   PTSIN(0)=x&
  464.   PTSIN(1)=y&
  465.   PTSIN(2)=length&
  466.   PTSIN(3)=0
  467.   '
  468.   VDISYS 11
  469. RETURN
  470. '
  471. FUNCTION vswr_mode(handle&,mode&)  ! SET WRITING MODE
  472.   INTIN(0)=mode&    ! 0=Replace, 1=Transparent, 3=XOR, 4=reverse Transparent
  473.   CONTRL(1)=0
  474.   CONTRL(2)=0
  475.   CONTRL(3)=1
  476.   CONTRL(6)=handle&
  477.   VDISYS 32
  478.   RETURN INTOUT(0)
  479. ENDFUNC
  480. '
  481. FUNCTION vst_point(handle&,point&,VAR char_width&,char_height&,cell_width&,cell_height&)
  482.   PTSIN(0)=0
  483.   PTSIN(1)=point&
  484.   CONTRL(1)=0
  485.   CONTRL(2)=2
  486.   CONTRL(3)=1
  487.   CONTRL(4)=1
  488.   CONTRL(6)=handle&
  489.   '
  490.   INTIN(0)=point&
  491.   '
  492.   VDISYS 107
  493.   '
  494.   char_width&=PTSOUT(0)
  495.   char_height&=PTSOUT(1)
  496.   cell_width&=PTSOUT(2)
  497.   cell_height&=PTSOUT(3)
  498.   RETURN INTOUT(0)
  499. ENDFUNC
  500. '
  501. FUNCTION vst_effects(handle&,effect&)
  502.   INTIN(0)=effect&
  503.   CONTRL(1)=0
  504.   CONTRL(3)=1
  505.   CONTRL(6)=handle&
  506.   VDISYS 106
  507.   RETURN INTOUT(0)
  508. ENDFUNC
  509. '
  510. FUNCTION vst_font(handle&,font&)
  511.   INTIN(0)=font&
  512.   CONTRL(1)=0
  513.   CONTRL(3)=1
  514.   CONTRL(6)=handle&
  515.   VDISYS 21
  516.   RETURN INTOUT(0)
  517. ENDFUNC
  518. '
  519. FUNCTION vst_rotation(handle&,angle&)
  520.   INTIN(0)=angle&
  521.   CONTRL(1)=0
  522.   CONTRL(3)=1
  523.   CONTRL(6)=handle&
  524.   VDISYS 13
  525.   RETURN INTOUT(0)
  526. ENDFUNC
  527. '
  528. > PROCEDURE vst_alignment(handle&,hor_in&,vert_in&,VAR hor_out&,vert_out&)
  529.   INTIN(0)=hor_in&
  530.   INTIN(1)=vert_in&
  531.   CONTRL(1)=0
  532.   CONTRL(2)=0
  533.   CONTRL(3)=2
  534.   CONTRL(4)=2
  535.   CONTRL(6)=handle&
  536.   VDISYS 39
  537.   hor_out&=INTOUT(0)
  538.   vert_out&=INTOUT(1)
  539. RETURN
  540. > PROCEDURE vqt_extend(handle&,string$,extend%)
  541.   LOCAL a&,string%,n&
  542.   n&=LEN(string$)
  543.   string%=V:string$
  544.   SWAP *extend%,a&()
  545.   '
  546.   CONTRL(1)=0
  547.   CONTRL(2)=4
  548.   CONTRL(3)=LEN(string$)
  549.   CONTRL(4)=0
  550.   CONTRL(6)=handle&
  551.   '
  552.   '
  553.   FOR i&=0 TO n&
  554.     INTIN(i&+2)=BYTE{string%+i&}
  555.   NEXT i&
  556.   '
  557.   VDISYS 116
  558.   '
  559.   FOR a&=0 TO 7
  560.     a&(a&)=PTSOUT(a&)
  561.   NEXT a&
  562.   SWAP *extend%,a&()
  563.   '
  564. RETURN
  565. '
  566. FUNCTION vqt_name(handle&,element_num&,VAR n.ame$)
  567.   LOCAL i&
  568.   '
  569.   INTIN(0)=element_num&
  570.   CONTRL(1)=0
  571.   CONTRL(3)=1
  572.   CONTRL(6)=handle&
  573.   VDISYS 130
  574.   '
  575.   n.ame$=""
  576.   i&=1
  577.   DO UNTIL INTOUT(i&)=0
  578.     n.ame$=n.ame$+CHR$(INTOUT(i&))
  579.     INC i&
  580.   LOOP
  581.   RETURN INTOUT(0)
  582. ENDFUNC
  583. '
  584. > PROCEDURE prog
  585.   CHDRIVE "f:"
  586.   CHDIR "\prog\gfa\fontshow"
  587. RETURN
  588.