' ------------------------------------------------------------------------------
' - 'Fliegende Dialoge' fr GFA-BASIC 3.x                                      -
' -                                                                            -
' - von Gregor Duchalski, Baueracker 15a, W-4690 Herne 1                       -
' - eMail-Kontakt: GREGOR DUCHALSKI @ DO im Mausnetz                           -
' -                                                                            -
' - Version 4.0                                                                -
' - Fenster-Dialoge, last change 24.03.93                                      -
' ------------------------------------------------------------------------------
' Bitte vor dem Starten den INLINE in rsc_walk_tree
' einlesen und den Pfad der RSC-Datei „ndern.
'
$m40960
RESERVE 40960
'
rsc_init
'
IF @rsc_laden("D:\GFA_FLY4\GFA_FLY4.RSC",2,1,2)
  main
ENDIF
'
rsc_exit
'
> PROCEDURE main
  LOCAL evnt&,t&
  '
  ~GRAF_MOUSE(0,0)                           ! Fr den Compiler
  ' Weil's im Interpreter sch”ner aussieht, fr den Compiler bitte entfernen!
  ~FORM_DIAL(3,deskx&,desky&,deskw&,deskh&,deskx&,desky&,deskw&,deskh&)
  '
  ~WIND_UPDATE(1)                            ! BEG_UPDATE
  ~MENU_BAR(rsc_adr%(menu|),1)               ! Men darstellen
  ~WIND_UPDATE(0)                            ! END_UPDATE
  '
  REPEAT
    evnt&=EVNT_MULTI(&X10011,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,mx&,my&,mb&,shift&,key&,mc&)
    '
    IF BTST(evnt&,4) AND MENU(1)=10          ! Message + MN_SELECTED
      '
      t&=MENU(4)                             ! Objektnummer des Mentitels
      '
      SELECT MENU(5)
        '
      CASE m_new|
        neues_fenster
        '
      CASE m_quit|
        evnt&=BSET(evnt&,0)
        '
      CASE m_dialog|
        test_dialog(FALSE)
        '
      CASE m_fenster|
        test_dialog(TRUE)
        '
      ENDSELECT
      '
      ~MENU_TNORMAL(rsc_adr%(rsc_menu&),t&,1)! Titel wieder normal
      '
    ELSE IF BTST(evnt&,4)                    ! Fenster-Message...
      message_auswerten
    ENDIF
    '
  UNTIL BTST(evnt&,0)                        ! Bis Taste gedrckt
  '
  ~WIND_UPDATE(1)                            ! BEG_UPDATE
  ~MENU_BAR(rsc_adr%(menu|),0)               ! Men weg
  ~WIND_UPDATE(0)                            ! END_UPDATE
  '
RETURN
'
> PROCEDURE test_dialog(window!)
  LOCAL rsc&,popup&
  '
  ' Durchfhrung des Beispieldialoges...
  '
  rsc_draw(flags|,window!)
  '
  REPEAT
    rsc&=@rsc_do(flags|,popup&)
    '
  UNTIL rsc&=ok| OR rsc&=abbruch|
  '
  OB_STATE(rsc_adr%(flags|),rsc&)=BCLR(OB_STATE(rsc_adr%(flags|),rsc&),0)
  rsc_back(flags|)
  '
RETURN
> PROCEDURE neues_fenster
  LOCAL handle&,a%
  '
  ' Zur Demonstration ein Fenster ”ffnen. Keine Titelzeile, um den Problemen
  ' mit der Garbage-Collection zumindest hier aus dem Weg zu gehen...
  '
  handle&=WIND_CREATE(&X101011,deskx&,desky&,deskw&,deskh&)
  IF handle&>0
    '
    a%=V:rsc_userblk%(0)                                ! Nullstring (unsauber)
    ~WIND_SET(handle&,2,INT(SWAP(a%)),INT(a%),0,0)      ! Titel setzen
    '
    ~WIND_OPEN(handle&,deskx&,desky&,deskw&/2,deskh&/2) ! ™ffnen
    '
  ENDIF
  '
RETURN
'
> PROCEDURE message_auswerten
  LOCAL x&,y&,w&,h&,handle&
  '
  ' Allgemeine Auswertung der Message-Events...
  '
  ~WIND_UPDATE(1)                               ! BEG_UPDATE
  '
  handle&=MENU(4)
  x&=MENU(5)
  y&=MENU(6)
  w&=MENU(7)
  h&=MENU(8)
  '
  SELECT MENU(1)
  CASE 20                                       ! WM_REDRAW
    redraw(handle&,x&,y&,w&,h&)
    '
  CASE 21                                       ! WM_TOPPED
    ~WIND_SET(handle&,10,0,0,0,0)
    '
  CASE 22                                       ! WM_CLOSED
    ~WIND_CLOSE(handle&)
    ~WIND_DELETE(handle&)
    '
  CASE 27,28                                    ! WM_MOVED/WM_SIZED
    ~WIND_SET(handle&,5,x&,y&,w&,h&)
    '
  ENDSELECT
  '
  ~WIND_UPDATE(0)                               ! END_UPDATE
  '
RETURN
> PROCEDURE redraw(handle&,x&,y&,w&,h&)
  LOCAL rx&,ry&,rb&,rh&
  '
  ' Redrawt ein Fenster...
  '
  DEFFILL 0
  '
  ~WIND_UPDATE(1)                         ! BEG_UPDATE
  ~GRAF_MOUSE(256,0)                      ! Hidem
  '
  ~WIND_GET(handle&,11,rx&,ry&,rb&,rh&)   ! 1. Rechteck
  '
  REPEAT
    '
    IF RC_INTERSECT(x&,y&,w&,h&,rx&,ry&,rb&,rh&)
      '
      PBOX rx&,ry&,ADD(rx&,PRED(rb&)),ADD(ry&,PRED(rh&))
      '
    ENDIF
    '
    ~WIND_GET(handle&,12,rx&,ry&,rb&,rh&) ! N„chstes Rechteck
  UNTIL rb&=0 AND rh&=0                   ! ...solange bis kein Redraw mehr n”tig
  '
  ~GRAF_MOUSE(257,0)                      ! Showm
  ~WIND_UPDATE(0)                         ! END_UPDATE
  '
RETURN
' ------------------------------------------------------------------------------
> PROCEDURE rsc_init
  '
  ' Initialisiert die von den RSC-Routinen ben”tigten Variablen...
  '
  ap_id&=APPL_INIT()                         ! Applikations-ID
  '                                          ! GLOBAL(1)=-1, AES >4.0 : MTOS
  mtos!=INT{ADD({ADD(GB,4)},2)}=-1 AND INT{ADD({ADD(GB,4)},0)}>=1024
  '
  CONTRL(6)=GRAF_HANDLE(wchar&,hchar&,a&,a&) ! AES-Handle, Zeichenbreite/H”he
  rsc_vh&=V_OPNVWK(1)                        ! Virt.Workst. fr Flydials ”ffnen
  IF rsc_vh&=0
    rsc_vh&=V~H                              ! ...Fehler, dann eben die alte
  ENDIF
  CONTRL(6)=V~H
  '
  INTIN(0)=1
  VDISYS 102,1,0
  planes&=INTOUT(4)                          ! Bitplanes
  '
  ~WIND_GET(0,7,deskx&,desky&,deskw&,deskh&) ! Hintergrundfenster
  '
RETURN
> PROCEDURE rsc_exit
  '
  ~RSRC_FREE()                               ! Resource entfernen
  IF popup_back%
    ~MFREE(popup_back%)                      ! Popup-Hintergrund freigeben
  ENDIF
  '
  CONTRL(6)=rsc_vh&
  VDISYS 38,0,0                              ! vqt_attributes
  IF ABS(INTOUT(0))<>1                       ! Anderer AES-Zeichensatz (MTOS)...
    ~VST_UNLOAD_FONTS(0)                     ! ...freigeben
  ENDIF
  '
  IF rsc_vh&<>V~H                            ! Flydial-Workstation freigeben...
    ~V_CLSVWK()
  ENDIF
  '
  GEMSYS 109                                 ! WIND_NEW
  EDIT
  '
RETURN
'
> FUNCTION rsc_laden(file$,trees&,popup&,menu&)
$F%
LOCAL tree&,obj&,font_h&,font_id&,a%,a$
'
' L„dt die Resource und initialisiert einige globale Variablen...
'
DIM rsc_adr%(trees&),rscx&(trees&),rscy&(trees&),rscw&(trees&),rsch&(trees&)
DIM rsc_handle%(trees&)
'
rsc_trees&=trees&                                      ! Anzahl Objektb„ume
rsc_popup&=popup&                                      ! Popup-Baum
rsc_menu&=menu&                                        ! Dropdown-Baum
' ------------------------------------------------------
' Berechnet den Speicherbedarf einer Bitmap-Grafik...
DEFFN getsize(w&,h&)=MUL(DIV(ADD(MUL(MUL(DIV(ADD(w&,15),8),h&),planes&),255),256),256)
'
' Gegenstck zur Prozedur rsc_text: Universelles Objekt-Text auslesen...
DEFFN rsc_text$(tree&,obj&)=CHAR{C:rsc_obspec%(L:rsc_adr%(tree&),obj&)}
'
' ------------------------------------------------------ RSC laden
' Wollen Sie das RSC-File direkt im Programmcode 'aufbewahren'?
' Dann entREMen Sie diese Zeilen und laden Sie die Funktion
' 'rsc_conv' aus EXTENDED.LST hinzu...
' INLINE rsc%,3160
' IF @rsrc_conv(rsc%)=0
IF RSRC_LOAD(file$)=0
  '
  ~FORM_ALERT(1,"[3][ | Fehler bei Laden | der RSC-Datei! | ][Abbruch]")
  RETURN FALSE
ENDIF
' ------------------------------------------------------ Adressen ermitteln
FOR tree&=0 TO trees&
  '
  ~RSRC_GADDR(0,tree&,a%)  ! Kompatibel zu den XRSRC-Routinen
  rsc_adr%(tree&)=a%
  IF tree&<>menu&
    ~FORM_CENTER(rsc_adr%(tree&),rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
  ENDIF
  '
NEXT tree&
' ------------------------------------------------------ Gr”žtes Popup
IF popup&>-1
  obj&=1
  '
  WHILE obj&>0
    popup_back%=MAX(popup_back%,@getsize(ADD(OB_W(rsc_adr%(popup&),obj&),21),OB_H(rsc_adr%(popup&),obj&)))
    obj&=OB_NEXT(rsc_adr%(popup&),obj&)
  WEND
  '
  popup_back%=MALLOC(popup_back%)                      ! Hintergrundpuffer...
  IF popup_back%=0
    RETURN FALSE                                       ! ...nicht geklappt
  ENDIF
  '
ENDIF
' ------------------------------------------------------ Anderer Zeichensatz
IF mtos!                                               ! MultiTOS...
  '
  GCONTRL(1)=1
  GCONTRL(2)=5
  GCONTRL(3)=0
  GCONTRL(4)=0
  GINTIN(0)=0
  '
  GEMSYS 130                                           ! APPL_GETINFO()
  '
  font_h&=GINTOUT(1)                                   ! AES-Font H”he
  font_id&=GINTOUT(2)                                  ! AES-Font ID
  '
  IF ABS(font_id&)<>1 AND GDOS?<>0                     ! Anderer AES-Font...
    V~H=rsc_vh&
    ~VST_LOAD_FONTS(0)                                 ! ...Fonts laden
    DEFTEXT ,,,,font_id&
    DEFTEXT ,,,font_h&                                 ! ...und einstellen
    V~H=-1
  ENDIF
ENDIF
' ------------------------------------------------------
rsc_walk_tree(trees&,popup&)
rsc_zuweisungen
'
RETURN TRUE                                            ! alles ok
ENDFUNC
> PROCEDURE rsc_walk_tree(trees&,popup&)
LOCAL a&,userblk&,tree&,obj&,a$
'
' Rsc-Baum durchgehen und userdefs installieren...
'
' ------------------------------------------------------ Inline vorbeiten
INLINE flydial%,2128
'
rsc_bitblt%=ADD(flydial%,INT{ADD(flydial%,16)})        ! BITBLT-Routine
rsc_obspec%=ADD(flydial%,INT{ADD(flydial%,18)})        ! OB_SPEC-Routine...
'
{ADD(flydial%,20)}=ADD(GB,24)                          ! VDI-Parameterblock
INT{ADD(flydial%,24)}=rsc_vh&                          ! Virt. Workstation
INT{ADD(flydial%,26)}=wchar&                           ! Zeichenzellenbreite
INT{ADD(flydial%,28)}=hchar&                           ! Zeichenzellenh”he
' ------------------------------------------------------ Userdefs ermitteln
FOR tree&=0 TO trees&
  '
  obj&=-1
  '
  REPEAT
    '
    INC obj&
    '
    a&=SHR&(OB_TYPE(rsc_adr%(tree&),obj&),8)
    '
    IF a&>=17 AND a&<=22                               ! Es ist ein userdef...
      INC userblk&
    ENDIF
    '
  UNTIL BTST(OB_FLAGS(rsc_adr%(tree&),obj&),5)         ! ...bis LAST_OBJ
  '
NEXT tree&
'
DIM rsc_userblk%(SHL(userblk&,1))                      ! Userblks (+1)
userblk&=1
' ------------------------------------------------------ Objektb„ume modifiz.
FOR tree&=0 TO trees&
  '
  obj&=-1
  REPEAT
    '
    INC obj&
    '
    SELECT SHR&(OB_TYPE(rsc_adr%(tree&),obj&),8)       ! OB_TYPE
      ' ------------------------------------------------ Flydial-Ecke...
    CASE 17
      rsc_instal_userdef(tree&,obj&,5,userblk&)
      ' ------------------------------------------------ Button...
    CASE 18
      '
      a$=CHAR{OB_SPEC(rsc_adr%(tree&),obj&)}           ! Text
      a&=OB_FLAGS(rsc_adr%(tree&),obj&)                ! OB_FLAGS
      '
      IF BTST(a&,4)                                    ! Radiobutton...
        rsc_instal_userdef(tree&,obj&,1,userblk&)
        '                                              ! SELECTABLE, nicht EXIT
      ELSE IF BTST(a&,0) AND (NOT BTST(a&,2))          ! Checkbutton...
        rsc_instal_userdef(tree&,obj&,2,userblk&)
        '
      ELSE                                             ! Normale EXIT-Buttons...
        rsc_instal_userdef(tree&,obj&,6,userblk&)
        '
        a&=SUCC(-BTST(a&,1)-BTST(a&,2))
        IF a&>1                                        ! EXIT / DEFAULT...
          OB_X(rsc_adr%(tree&),obj&)=SUB(OB_X(rsc_adr%(tree&),obj&),a&)
          OB_Y(rsc_adr%(tree&),obj&)=SUB(OB_Y(rsc_adr%(tree&),obj&),a&)
          OB_W(rsc_adr%(tree&),obj&)=ADD(OB_W(rsc_adr%(tree&),obj&),ADD(a&,a&))
          OB_H(rsc_adr%(tree&),obj&)=SUCC(ADD(OB_H(rsc_adr%(tree&),obj&),ADD(a&,a&)))
        ENDIF                                          ! ...fr Redraw gr”žer
        '
      ENDIF
      ' ------------------------------------------------ Unterstr. Text...
    CASE 19
      rsc_instal_userdef(tree&,obj&,4,userblk&)
      OB_FLAGS(rsc_adr%(tree&),obj&)=BSET(OB_FLAGS(rsc_adr%(tree&),obj&),13)
      ' ------------------------------------------------ Rahmen...
    CASE 20
      rsc_instal_userdef(tree&,obj&,3,userblk&)
      ' ------------------------------------------------ Niceline...
    CASE 21
      rsc_instal_userdef(tree&,obj&,8,userblk&)
      ' ------------------------------------------------ Circlebutton...
    CASE 22
      IF hchar&=8 OR hchar&=16                         ! ...nur wenn m”glich
        rsc_instal_userdef(tree&,obj&,7,userblk&)      ! ...als Bitmap
      ELSE
        OB_TYPE(rsc_adr%(tree&),obj&)=OR(SHL&(27,8),BYTE(OB_TYPE(rsc_adr%(tree&),obj&)))
      ENDIF                                            ! ...sonst Pfeil lassen
      '
    ENDSELECT
    '
  UNTIL BTST(OB_FLAGS(rsc_adr%(tree&),obj&),5)         ! Bis LAST_OB gesetzt
  '
NEXT tree&
'
RETURN
> PROCEDURE rsc_instal_userdef(tree&,obj&,nr&,VAR userblk&)
'
' Userdef-Objekt installieren...
'
' nr& bezeichnet eine der folgenden Ausgaberoutinen:
' 1  Radiobutton, rund
' 2  Check-Button
' 3  Rahmen
' 4  Unterstr. Text
' 5  Flydial
' 6  Button
' 7  Circlebutton
' 8  Niceline
'
rsc_userblk%(userblk&)=ADD(flydial%,INT{ADD(flydial%,SHL(PRED(nr&),1))})
rsc_userblk%(SUCC(userblk&))=OB_SPEC(rsc_adr%(tree&),obj&)
'
OB_SPEC(rsc_adr%(tree&),obj&)=V:rsc_userblk%(userblk&) ! userdef und alter Typ
OB_TYPE(rsc_adr%(tree&),obj&)=OR(SHL&(BYTE(OB_TYPE(rsc_adr%(tree&),obj&)),8),24)
'                                                      ! im oberen Byte
ADD userblk&,2
'
RETURN
'
> PROCEDURE rsc_draw(tree&,window!)
LOCAL fly&,title&,obj&,x&,y&,w&,h&,handle&,a%,rsc_adr%
'
' Stellt einen Dialog auf dem Bildschirm dar...
'
' tree&   : Index des Dialogbaumes
' window! : TRUE = Fenster-Dialog, FALSE = normaler Dialog
'
rsc_adr%=rsc_adr%(tree&)
' --------------------------------------------------- Titel & Flugecke suchen
DO WHILE NOT (fly&>0 AND title&>0)
  INC obj&
  IF BTST(OB_STATE(rsc_adr%,obj&),1)                ! Flugecke...
    fly&=obj&
  ELSE IF BTST(OB_FLAGS(rsc_adr%,obj&),13)          ! Dialogtitel...
    title&=obj&
  ENDIF
LOOP UNTIL BTST(OB_FLAGS(rsc_adr%,obj&),5)
' --------------------------------------------------- Als Fenster-Dialog
IF window!
  x&=SUCC(rscx&(tree&))
  y&=ADD(ADD(rscy&(tree&),hchar&*2),5)
  w&=SUB(rscw&(tree&),2)
  h&=SUB(SUB(rsch&(tree&),hchar&*2),5)
  '
  IF fly&                                           ! Flugecke hidden...
    OB_FLAGS(rsc_adr%,fly&)=BSET(OB_FLAGS(rsc_adr%,fly&),7)
  ENDIF
  '                                                 ! Rahmen: 1 Pixel aužen...
  OB_SPEC(rsc_adr%,0)=AND(OB_SPEC(rsc_adr%,0),&X11111111000000001111111111111111)
  '
  handle&=WIND_CREATE(&X1001,deskx&,desky&,deskw&,deskh&)
  IF handle&>0                                      ! Fenster vorhanden...
    '
    ~WIND_UPDATE(1)                                 ! BEG_UPDATE
    '
    INC rsc_window&                                 ! Anz. offene Fenster+1
    rsc_menu_ienable(FALSE)                         ! Mentitel disablen
    '
    IF title&                                       ! Dialogtitel existiert...
      a%=C:rsc_obspec%(L:rsc_adr%,title&)           ! ...Adresse des Titels
    ELSE
      a%=V:rsc_userblk%(0)                          ! ...sonst Nullstring
    ENDIF
    ~WIND_SET(handle&,2,INT(SWAP(a%)),INT(a%),0,0)  ! Fenstertitel setzen
    '
    ~WIND_CALC(0,&X1001,x&,y&,w&,h&,rx&,ry&,rb&,rh&)! WC_BORDER
    ~WIND_OPEN(handle&,rx&,ry&,rb&,rh&)
    '
    ~WIND_UPDATE(0)                                 ! END_UPDATE
    '
    rsc_handle%(tree&)=handle&
    '
  ENDIF
ENDIF
' --------------------------------------------------- Als normaler Dialog
IF rsc_handle%(tree&)=0
  a%=AND(OB_SPEC(rsc_adr%,0),&X11111111000000001111111111111111)
  OB_SPEC(rsc_adr%,0)=OR(a%,SHL(2,16))              ! Rahmen: 2 Pixel innen
  '
  w&=rscw&(tree&)
  h&=rsch&(tree&)
  '                                                 ! Aužerhalb des Screens...
  IF rscy&(tree&)<desky& OR ADD(rscx&(tree&),PRED(w&))>ADD(deskx&,PRED(deskw&)) OR ADD(rscy&(tree&),PRED(h&))>ADD(desky&,PRED(deskh&))
    ~FORM_CENTER(rsc_adr%(tree&),rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
  ENDIF                                             ! ...wieder in die Mitte
  '
  ~WIND_UPDATE(1)                                   ! BEG_UPDATE
  '
  rsc_handle%(tree&)=MALLOC(@getsize(w&,h&))
  IF rsc_handle%(tree&)                             ! Hintergrund retten...
    rsc_bitblt(0,0,0,rsc_handle%(tree&),w&,h&,rscx&(tree&),rscy&(tree&),w&,h&,0,0)
    '
  ENDIF
  '
  IF fly&>0 AND rsc_handle%(tree&)>0               ! Flugecke sichtbar...
    OB_FLAGS(rsc_adr%,fly&)=BCLR(OB_FLAGS(rsc_adr%,fly&),7)
  ELSE IF fly&                                     ! unsichtbar...
    OB_FLAGS(rsc_adr%,fly&)=BSET(OB_FLAGS(rsc_adr%,fly&),7)
  ENDIF
  '
  ~OBJC_DRAW(rsc_adr%,0,10,rscx&(tree&),rscy&(tree&),w&,h&)
  '
ENDIF
'
RETURN
> PROCEDURE rsc_menu_ienable(stat!)
LOCAL obj&,title&,rsc_adr%
'
' Disabled/enabled alle Men-Titel und den 'About...'-Men-Eintrag...
'                                ! Gibt es ein Men..
IF rsc_menu&>-1 AND rsc_window&=1! und ist es das 1. Fenster?
  '
  rsc_adr%=rsc_adr%(rsc_menu&)
  '                              ! Objektbreite ver„ndern...
  IF stat!                       ! Enablen...
    OB_W(rsc_adr%,2)=rscw&(rsc_menu&)
  ELSE                           ! Disablen...
    rscw&(rsc_menu&)=OB_W(rsc_adr%,2)
    OB_W(rsc_adr%,2)=OB_W(rsc_adr%,3)
  ENDIF
  '
  obj&=3                         ! Ersten Mentitel berspringen
  '
  REPEAT
    INC obj&
    '                            ! G_TITEL...
    IF BYTE(OB_TYPE(rsc_adr%,obj&))=32
      '
      ~MENU_IENABLE(rsc_adr%,obj&,stat!)
      '
      title&=obj&                ! Wird fr 'About...' gebraucht
    ENDIF
    '
  UNTIL BTST(OB_FLAGS(rsc_adr%,obj&),5)
  '                              ! 'About...' dis/enablen
  ~MENU_IENABLE(rsc_adr%,ADD(title&,3),stat!)
  '
  IF mtos!                       ! Unter MultiTOS...
    IF ap_id&=MENU_BAR(rsc_adr%,-1)
      ~MENU_BAR(rsc_adr%,1)      ! ...Menu nur neu anzeigen, wenn erlaubt
    ENDIF
  ELSE                           ! Unter SingleTOS...
    ~MENU_BAR(rsc_adr%,1)        ! ...Menu immer neu anzeigen
  ENDIF
  '
ENDIF
'
RETURN
'
> FUNCTION rsc_do(tree&,VAR popup&)
$F%
LOCAL edit_obj&,next_obj&,cont&,ob_tail&,obj&,a&,a$,rsc_adr%,idx&,flags&
LOCAL evnt&,mx&,my&,mb&,mc&,shift&,key&,ascii|,scan|
'
' Dialog auswerten...
'
IF rsc_handle%(tree&)>1000                             ! Normaler Dialog...
~WIND_UPDATE(1)                                      ! ...BEG_UPDATE
~WIND_UPDATE(3)                                      ! ...BEG_MCTRL
flags&=&X11                                          ! ...BUTTON/KEYBD-Events
'
ELSE                                                   ! Fenster-Dialog...
flags&=&X10011                                       ! ...zus. MESSAGE-Events
ENDIF
'
rsc_adr%=rsc_adr%(tree&)
cont&=TRUE
' ------------------------------------------------------ Editierbares Objekt
DO WHILE (NOT BTST(OB_FLAGS(rsc_adr%,next_obj&),3)) OR BTST(OB_STATE(rsc_adr%,next_obj&),3)
INC next_obj&
LOOP UNTIL BTST(OB_FLAGS(rsc_adr%,next_obj&),5)
IF BTST(OB_FLAGS(rsc_adr%,next_obj&),5)
next_obj&=0
ENDIF
' ------------------------------------------------------
WHILE cont&
'
IF next_obj&<>0 AND edit_obj&<>next_obj&             ! Ggf. Cursor setzen...
  edit_obj&=next_obj&
  next_obj&=0
  ~OBJC_EDIT(rsc_adr%,edit_obj&,0,idx&,1,idx&)       ! ...Cursor ein
ENDIF
'
evnt&=EVNT_MULTI(flags&,2,1,1,0,0,0,0,0,0,0,0,0,0,0,0,mx&,my&,mb&,shift&,key&,mc&)
' ---------------------------------------------------- Message-Ereignis
IF BTST(evnt&,4)
  handle&=MENU(4)                                    ! ...Fenster-Handle
  '
  FOR a&=rsc_trees& DOWNTO 0                         ! Ist es ein RSC?...
    EXIT IF handle&=rsc_handle%(a&)
  NEXT a&
  '
  IF a&>-1 AND NOT (MENU(1)=21 AND a&<>tree&)        ! Ein RSC-Fenster....
    rsc_message(a&,MENU(1),MENU(5),MENU(6),MENU(7),MENU(8),edit_obj&,idx&)
    '                                                ! Sonst ein anderes,
  ELSE IF MENU(1)<>21 AND MENU(1)<>22                ! nicht toppen/schliežen...
    message_auswerten
  ELSE                                               ! Nichts zu machen...
    OUT 2,7
  ENDIF
ENDIF
' ---------------------------------------------------- Tastaturereignis
IF BTST(evnt&,0)
  '
  cont&=FORM_KEYBD(rsc_adr%,edit_obj&,key&,0,next_obj&,key&)
  ' M”chten Sie erweiterte Tastaturkommandos? Dann entREMen Sie
  ' diese Zeile und ersetzen die Prozedur durch:
  ' cont&=@form_keybd(rsc_adr%,edit_obj&,key&,0,next_obj&,key&,idx&)
  '
  ascii|=BYTE(key&)                                  ! ASCII-Code
  scan|=BYTE(SHR(key&,8))                            ! SCAN-Code
  '
  IF ascii|=0                                        ! Kein ASCII-Code...
    '
    IF scan|=97 OR scan|=98                          ! UNDO/HELP...
      ascii|=ADD(SUB(scan|,97),14)
      obj&=0
      DO WHILE BTST(OB_FLAGS(rsc_adr%,obj&),5)=FALSE
        INC obj&
      LOOP UNTIL BTST(OB_FLAGS(rsc_adr%,obj&),ascii|)
      IF BTST(OB_FLAGS(rsc_adr%,obj&),ascii|)
        cont&=FORM_BUTTON(rsc_adr%,obj&,1,next_obj&)
      ENDIF
      '
    ELSE                                             ! ALT+Buchstabe...
      '
      IF scan|>=120 AND scan|<=129                   ! Zahlen...
        SUB scan|,118
        keytab%={XBIOS(16,L:-1,L:-1,L:-1)}           ! ...ohne Shift
      ELSE                                           ! Alles andere...
        keytab%={ADD(XBIOS(16,L:-1,L:-1,L:-1),4)}    ! ...mit Shift
      ENDIF
      '
      ascii|=BYTE{ADD(keytab%,scan|)}                ! ASCII-Code holen
      '
      IF ascii|                                      ! Tastaturbedienbar...
        CLR a&,obj&
        '
        DO WHILE NOT BTST(OB_FLAGS(rsc_adr%,obj&),5) ! Nicht LASTOBJ
          INC obj&
          '
          scan|=BYTE(SHR(OB_TYPE(rsc_adr%,obj&),8))
          IF scan|=26 OR scan|=28                    ! Ein Button/String...
            a$=@rsc_text$(tree&,obj&)                ! ...Text
            '
            a&=INSTR(a$,"[")
            IF a&                                    ! Tastaturbedienbar...
              a&=(BCLR(ASC(MID$(a$,SUCC(a&),1)),5)=BCLR(ascii|,5))
            ENDIF
            '                                        ! '[' vor Zeichen
          ENDIF
          '
        LOOP UNTIL a&                                ! ...gefunden
        '
        IF a&                                        ! Objekt gefunden...
          key&=0                                     ! ...keine Eingabe mehr
          '                                          ! +SHIFT Circle-Butt?
          IF BTST(shift&,1) AND BTST(OB_FLAGS(rsc_adr%,obj&),6) AND BTST(OB_STATE(rsc_adr%,SUCC(obj&)),5) AND SHR(OB_TYPE(rsc_adr%,obj&+2),8)=27
            evnt&=BSET(evnt&,1)
            mb&=1                                    ! ...Mausklick simulieren
            ~OBJC_OFFSET(rsc_adr%,obj&+2,mx&,my&)
            '                                        ! Ist es ein Popup...
          ELSE IF BTST(OB_FLAGS(rsc_adr%,obj&),6) AND BTST(OB_STATE(rsc_adr%,SUCC(obj&)),5)
            evnt&=BSET(evnt&,1)
            ~OBJC_OFFSET(rsc_adr%,obj&,mx&,my&)      ! ...Mausklick simul.
            '
          ELSE                                       ! ...Button bedienen
            cont&=FORM_BUTTON(rsc_adr%,obj&,1,next_obj&)
          ENDIF
        ENDIF
        '
      ENDIF
    ENDIF
    '
  ENDIF
  '
  IF key&
    ~OBJC_EDIT(rsc_adr%,edit_obj&,key&,idx&,2,idx&)  ! ...Eingabe
  ENDIF
  '
ENDIF
' ---------------------------------------------------- Mausereignis
IF BTST(evnt&,1) AND mb&=1
  '                                                  ! Objekt unter Maus..
  next_obj&=OBJC_FIND(rsc_adr%,0,100,mx&,my&)
  '                                                  ! String vor Popup...
  IF next_obj&>0
    IF BTST(OB_FLAGS(rsc_adr%,next_obj&),6) AND SHR(OB_TYPE(rsc_adr%,next_obj&),8)=28 AND BTST(OB_STATE(rsc_adr%,SUCC(next_obj&)),5)
      ' (TOUCHEXIT, STRING, SUCC: SHADOWED)
      INC next_obj&
    ENDIF
  ENDIF
  '
  IF next_obj&=-1                                    ! Neben die Box...
    OUT 2,7                                          ! ...PING!
    next_obj&=0
    '
  ELSE
    cont&=FORM_BUTTON(rsc_adr%,next_obj&,1,next_obj&)
    ' ------------------------------------------------ Flydial-Ecke
    IF BTST(OB_STATE(rsc_adr%,next_obj&),1)          ! (CROSSED)
      rsc_movedial(tree&)                            ! ...Dialog verschieben
      '
      next_obj&=0                                    ! Damit der Cursor..
      cont&=1                                        ! ..bleibt wo er ist
      ' ---------------------------------------------- Circle-Button...
    ELSE IF SHR(OB_TYPE(rsc_adr%,next_obj&),8)=27 AND BTST(OB_STATE(rsc_adr%,MAX(0,PRED(next_obj&))),5) AND (NOT BTST(OB_STATE(rsc_adr%,MAX(0,PRED(next_obj&))),3))
      ' (G_BOXCHAR, PRED: SHADOWED /NOT DISABLED)
      next_obj&=PRED(next_obj&)                      ! Objektnr. Button
      a$=@rsc_text$(tree&,next_obj&)                 ! Text des Buttons
      evnt&=SHR&(OB_TYPE(rsc_adr%,next_obj&),8)-30   ! Nr. des Popup-Baumes
      '
      obj&=1
      FOR ob_tail&=1 TO PRED(evnt&)
        obj&=OB_NEXT(rsc_adr%(rsc_popup&),obj&)      ! Objektnr. des Popups
      NEXT ob_tail&
      '
      evnt&=SUCC(obj&)
      DO WHILE a$<>@rsc_text$(rsc_popup&,evnt&)
        INC evnt&                                    ! Defaulteintrag
      LOOP
      '
      REPEAT
        INC evnt&                                    ! N„chster Eintrag...
        IF evnt&>OB_TAIL(rsc_adr%(rsc_popup&),obj&)  ! ...gibt es nicht
          evnt&=SUCC(obj&)                           ! ...dann wieder 1.
        ENDIF
        '                                            ! bis nicht DISABLED
      UNTIL NOT BTST(OB_STATE(rsc_adr%(rsc_popup&),evnt&),3)
      '                                              ! Button „ndern...
      rsc_text(tree&,next_obj&,@rsc_text$(rsc_popup&,evnt&))
      ~OBJC_DRAW(rsc_adr%,next_obj&,1,rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
      popup&=SUB(evnt&,obj&)
      ' ---------------------------------------------- Popup-Menue...
    ELSE IF BTST(OB_STATE(rsc_adr%,next_obj&),5) AND BTST(OB_FLAGS(rsc_adr%,next_obj&),6) AND (NOT BTST(OB_STATE(rsc_adr%,next_obj&),3))
      ' (SHADOWED, TOUCHEXIT, NOT DISABLED)
      evnt&=SHR&(OB_TYPE(rsc_adr%,next_obj&),8)-30   ! Nr. des Popup-Baumes
      obj&=1
      FOR ob_tail&=1 TO PRED(evnt&)
        obj&=OB_NEXT(rsc_adr%(rsc_popup&),obj&)      ! Objektnr. des Popups
      NEXT ob_tail&
      '
      ob_tail&=OB_TAIL(rsc_adr%(rsc_popup&),obj&)
      a$=@rsc_text$(tree&,next_obj&)                 ! Text des Buttons
      '
      evnt&=SUCC(obj&)
      DO WHILE a$<>@rsc_text$(rsc_popup&,evnt&)
        INC evnt&                                    ! Ausrichtung ermitteln
      LOOP UNTIL evnt&>ob_tail&
      '
      IF evnt&<=ob_tail&                             ! Defaulteintrag...
        popup&=@rsc_popup(tree&,next_obj&,obj&,SUB(evnt&,SUCC(obj&)),TRUE)
      ELSE                                           ! Sonst ohne...
        popup&=@rsc_popup(tree&,next_obj&,obj&,1,FALSE)
      ENDIF
      '
      ' ---------------------------------------------- Cursor positionieren
      ' M”chten Sie den Cursor mit der Maus zeichengenau positionieren?
      ' Dann entREMen Sie diese Zeilen und laden diese Prozedur nach:
      ' ELSE IF BTST(OB_FLAGS(rsc_adr%,next_obj&),3)
      ' rsc_set_cursor(rsc_adr%,mx&,my&,edit_obj&,next_obj&)
    ENDIF
    '
  ENDIF
ENDIF
'
IF cont&=0 OR (next_obj&<>0 AND next_obj&<>edit_obj&)
  ~OBJC_EDIT(rsc_adr%,edit_obj&,0,idx&,3,idx&)       ! Ggf. Cursor aus
ENDIF
'
WEND
'
IF rsc_handle%(tree&)>1000                             ! Normaler Dialog...
~WIND_UPDATE(0)                                      ! END_UPDATE
~WIND_UPDATE(2)                                      ! END_MCTRL
ENDIF
'
IF mc&=2 AND BTST(OB_FLAGS(rsc_adr%,next_obj&),6)      ! Doppelklick auf
next_obj&=WORD(BSET(next_obj&,15))                   ! TOUCHEXIT...
ENDIF                                                  ! ...15. Bit setzen
'
RETURN next_obj&
ENDFUNC
> FUNCTION rsc_popup(tree&,button&,popup&,default&,a!)
$F%
LOCAL evnt&,mx&,my&,mb&,mc&,shift&,key&,scan|,x&,y&,b&,h&,m!
LOCAL rsc&,rsc_adr%,obj&,old_obj&,first&,anz&
'
' Popup-Men darstellen und auswerten...
'
' tree&    : Index des Dialogbaumes
' button&  : Objektnr. des bet„tigten Buttons
' popup&   : Index des Popups
' default& : Default-Eintrag (1-x)
' a!       : TRUE: Button ver„ndern, FALSE: Nur Popup
'
~WIND_UPDATE(1)                                   ! BEG_UPDATE
~WIND_UPDATE(3)                                   ! BEG_MCTRL
'
rsc_adr%=rsc_adr%(rsc_popup&)
'
first&=OB_HEAD(rsc_adr%,popup&)                   ! erster Eintrag
anz&=SUB(OB_TAIL(rsc_adr%,popup&),first&)         ! Anzahl Eintr„ge-1
' ------------------------------------------------- Popup positionieren
~OBJC_OFFSET(rsc_adr%(tree&),button&,x&,y&)
OB_X(rsc_adr%,0)=SUB(x&,OB_X(rsc_adr%,popup&))
OB_Y(rsc_adr%,0)=MAX(ADD(hchar&,4),MIN(SUB(WORK_OUT(1),4)-OB_H(rsc_adr%,popup&),SUB(y&,MUL(default&,hchar&))))-OB_Y(rsc_adr%,popup&)
'
x&=ADD(OB_X(rsc_adr%,0),PRED(OB_X(rsc_adr%,popup&)))
y&=ADD(OB_Y(rsc_adr%,0),PRED(OB_Y(rsc_adr%,popup&)))
b&=ADD(OB_W(rsc_adr%,popup&),4)
h&=ADD(OB_H(rsc_adr%,popup&),4)
' -------------------------------------------------
rsc_bitblt(0,0,0,popup_back%,b&,h&,x&,y&,b&,h&,0,0)
'
~OBJC_DRAW(rsc_adr%,0,7,x&,y&,b&,h&)              ! Popup zeichnen
'
IF a!                                             ! Button ver„ndern...
'
~GRAF_MOUSE(256,0)                              ! Hidem
V~H=rsc_vh&                                     ! ...Default-Eintrag mit...
'
INTIN(0)=8                                      ! ...H„kchen versehen
PTSIN(0)=ADD(x&,DIV(wchar&,2))
PTSIN(1)=y&-DIV(hchar&,6)+MUL(SUCC(default&),hchar&)
VDISYS 8,1,1                                    ! ...v_gtext()
'
V~H=-1
~GRAF_MOUSE(257,0)                              ! Showm
'
ENDIF
'
~GRAF_MKSTATE(mx&,my&,mb&,shift&)
'
obj&=OBJC_FIND(rsc_adr%,popup&,anz&,mx&,my&)      ! Objekt unter der Maus...
'                                                 ! Nicht disabled...
IF obj&>0 AND (NOT BTST(OB_STATE(rsc_adr%,MAX(0,obj&)),3))
~OBJC_CHANGE(rsc_adr%,obj&,0,x&,y&,b&,h&,1,1)   ! ...selektieren
old_obj&=obj&
ELSE
old_obj&=ADD(first&,default&)
ENDIF
'
~EVNT_TIMER(200)
~GRAF_MKSTATE(mx&,my&,mb&,shift&)
IF mb&=1                                          ! Maus noch gedrckt...
m!=TRUE
evnt&=4
ENDIF
' -------------------------------------------------
DO
'
IF NOT m!
evnt&=EVNT_MULTI(&X111,1,1,1,1,mx&,my&,1,1,0,0,0,0,0,0,0,mx&,my&,mb&,shift&,key&,mc&)
ELSE
~GRAF_MKSTATE(mx&,my&,mb&,shift&)
ENDIF
'
IF BTST(evnt&,0)                                ! Tastaturereignis...
ascii|=BYTE(key&)
scan|=BYTE(SHR(key&,8))
'                                             ! Noch kein sel. Eintrag...
IF NOT (obj&>=first& AND obj&<=ADD(first&,anz&))
  obj&=first&
  '
ELSE IF scan|=80                              ! ...Cursor runter
  INC obj&
  IF obj&>ADD(first&,anz&)
    obj&=first&
  ENDIF
  '
ELSE IF scan|=72                              ! ...Cursor runter
  DEC obj&
  IF obj&<first&
    obj&=ADD(first&,anz&)
  ENDIF
  '
ENDIF
'
ENDIF
'
IF BTST(evnt&,2)                                ! Mausereignis...
obj&=OBJC_FIND(rsc_adr%,popup&,anz&,mx&,my&)
ENDIF
'                                               ! Alten Eintrag deselekt...
IF obj&<>old_obj&
~OBJC_CHANGE(rsc_adr%,old_obj&,0,x&,y&,b&,h&,BCLR(OB_STATE(rsc_adr%,old_obj&),0),1)
ENDIF
'                                               ! Im Men und nicht disabled...
IF (obj&>=first& AND obj&<=ADD(first&,anz&)) AND (NOT BTST(OB_STATE(rsc_adr%,MAX(0,obj&)),3))
~OBJC_CHANGE(rsc_adr%,obj&,0,x&,y&,b&,h&,1,1) ! ...neuen selektieren
'
old_obj&=obj&
rsc&=SUB(obj&,first&)                         ! Rckgabe
ENDIF
'
LOOP UNTIL BTST(evnt&,1) OR (mb&<>1 AND m!) OR ascii|=13 OR ascii|=27 OR scan|=97
' -------------------------------------------------
rsc_bitblt(popup_back%,b&,h&,0,0,0,0,0,b&,h&,x&,y&)   ! Hintergrund restaurieren
'
IF rsc&=SUB(obj&,first&) AND scan|<>97 AND ascii|<>27 ! Eintrag ausgew„hlt...
'
~OBJC_CHANGE(rsc_adr%,obj&,0,x&,y&,b&,h&,0,0)
'
IF a!                                           ! Button ver„ndern...
'                                             ! Neuen Text eintragen:
rsc_text(tree&,button&,@rsc_text$(rsc_popup&,obj&))
'
~OBJC_OFFSET(rsc_adr%(tree&),button&,x&,y&)   ! Button zeichnen
~OBJC_DRAW(rsc_adr%(tree&),button&,1,x&,y&,OB_W(rsc_adr%(tree&),button&),OB_H(rsc_adr%(tree&),button&))
'
ENDIF
'
ELSE                                              ! Daneben => Abbruch...
' IF NOT BTST(OB_STATE(rsc_adr%,obj&),3)
~OBJC_CHANGE(rsc_adr%,old_obj&,0,x&,y&,b&,h&,0,0)
' ENDIF
'
rsc&=default&
'
ENDIF
'
REPEAT
~GRAF_MKSTATE(mx&,my&,mb&,shift&)               ! Mausknopf 'entprellen'
UNTIL mb&=0
'
~WIND_UPDATE(0)                                   ! END_UPDATE
~WIND_UPDATE(2)                                   ! END_MCTRL
'
RETURN SUCC(rsc&)
ENDFUNC
'
> PROCEDURE rsc_movedial(tree&)
LOCAL x&,y&,a%
'
' Dialogbox bewegen...
' M”chten Sie SOLID-Flydials? Dann ersetzen Sie diese Prozedur
' durch die entsprechenden aus der EXTENDED.LST-Datei.
'
~GRAF_MOUSE(4,0)                                         ! Bewegen...
~GRAF_DRAGBOX(rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&),deskx&,desky&,deskw&,deskh&,x&,y&)
~GRAF_MOUSE(0,0)
'
IF x&<>rscx&(tree&) OR y&<>rscy&(tree&)                  ! šberhaupt bewegt...
'
a%=MALLOC(@getsize(rscw&(tree&),rsch&(tree&)))         ! Dialog getten
IF a%                                                  ! ...hat geklappt
rsc_bitblt(0,0,0,a%,rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&),0,0)
ENDIF
'                                                      ! Hintergr. restaur.
rsc_bitblt(rsc_handle%(tree&),rscw&(tree&),rsch&(tree&),0,0,0,0,0,rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&))
'
rscx&(tree&)=x&                                        ! Neue Position setzen...
rscy&(tree&)=y&
'
OB_X(rsc_adr%(tree&),0)=ADD(x&,3)
OB_Y(rsc_adr%(tree&),0)=ADD(y&,3)
'                                                      ! Neuen Hintergr. holen
rsc_bitblt(0,0,0,rsc_handle%(tree&),rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&),0,0)
'                                                      ! Dialog hinsetzen...
IF a%                                                  ! Hintergr. gerettet...
rsc_bitblt(a%,rscw&(tree&),rsch&(tree&),0,0,0,0,0,rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&))
~MFREE(a%)
ELSE                                                   ! Sonst wenigstens...
~OBJC_DRAW(rsc_adr%(tree&),0,10,rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
ENDIF
'
ENDIF
'
RETURN
> PROCEDURE rsc_message(tree&,message&,x&,y&,w&,h&,edit_obj&,idx&)
LOCAL ax&,ay&,ab&,ah&,handle&,obj&,rsc_adr%,a$
'
' Wertet ein innerhalb des 'rsc_do' eingetroffenes Message-Ereignis aus...
'
handle&=rsc_handle%(tree&)                         ! Fensterhandle des Dialogs
'
~WIND_UPDATE(1)                                    ! BEG_UPDATE
'
SELECT message&
' --------------------------------------------------------------------------
CASE 20,21                                         ! WM_REDRAW/WM_TOPPED
handle&=rsc_handle%(tree&)                       ! Fensterhandle des Dialogs
'
IF message&=20                                   ! WM_REDRAW...
~GRAF_MOUSE(256,0)                             ! Hidem
~WIND_GET(handle&,11,ax&,ay&,ab&,ah&)          ! 1. Rechteck
'
REPEAT
  '
  IF RC_INTERSECT(x&,y&,w&,h&,ax&,ay&,ab&,ah&) ! ...redrawen
    ~OBJC_DRAW(rsc_adr%(tree&),0,11,ax&,ay&,ab&,ah&)
  ENDIF
  '
  ~WIND_GET(handle&,12,ax&,ay&,ab&,ah&)        ! N„chstes Rechteck...
UNTIL ab&=0 AND ah&=0                          ! ...kein Redraw mehr n”tig
'
~GRAF_MOUSE(257,0)                             ! Showm
'
ELSE                                             ! WM_TOPPED...
~WIND_SET(handle&,10,0,0,0,0)                  ! ...toppen
ENDIF
'
~WIND_GET(0,10,ax&,ay&,ay&,ay&)                  ! Oberstes Fenster...
IF ax&=handle& AND edit_obj&>0                   ! Ist das unsrige...
' ---------------------------------------------- Cursor-Setz-Orgie...
rsc_adr%=rsc_adr%(tree&)
'
obj&=edit_obj&                                 ! Parent ermitteln...
'
REPEAT
  obj&=OB_NEXT(rsc_adr%,obj&)
UNTIL obj&<edit_obj&
'
~OBJC_OFFSET(rsc_adr%,edit_obj&,ax&,ay&)       ! Koordinaten des Objekts
'
a$=CHAR{{ADD(OB_SPEC(rsc_adr%,edit_obj&),4)}}  ! Maske: "Eingabe:______"
ah&=1
WHILE MID$(a$,ah&,1)<>"_"                      ! L„nge des Vortextes...
  INC ah&
WEND                                           ! ...ermitteln
'
ADD ax&,MUL(wchar&,ADD(PRED(ah&),idx&))        ! Cursor-Position im Pixeln
ah&=ADD(OB_H(rsc_adr%,edit_obj&),6)            ! Cursor ist gr”žer hchar&
'                                              ! Cursor l”schen...
~OBJC_DRAW(rsc_adr%,obj&,10,ax&,SUB(ay&,3),wchar&,ah&)
'
~OBJC_EDIT(rsc_adr%,edit_obj&,0,idx&,1,idx&)   ! Cursor ein
ENDIF
' --------------------------------------------------------------------------
CASE 28                                            ! WM_MOVED
~WIND_CALC(1,&X1001,x&,y&,w&,h&,ax&,ay&,ab&,ah&)
'
rscx&(tree&)=PRED(ax&)
rscy&(tree&)=SUB(SUB(ay&,5),MUL(hchar&,2))
OB_X(rsc_adr%(tree&),0)=ADD(rscx&(tree&),3)
OB_Y(rsc_adr%(tree&),0)=ADD(rscy&(tree&),3)
'
~WIND_SET(handle&,5,x&,y&,w&,h&)
'
ENDSELECT
'
~WIND_UPDATE(0)                                    ! END_UPDATE
'
RETURN
'
> PROCEDURE rsc_back(tree&)
'
' Entfernt den Dialog vom Bildschirm...
'
' ---------------------------------------------------- Als Fenster-Dialog
IF rsc_handle%(tree&)>0 AND rsc_handle%(tree&)<1000
'
~WIND_UPDATE(1)                                    ! BEG_UPDATE
~WIND_CLOSE(rsc_handle%(tree&))
~WIND_DELETE(rsc_handle%(tree&))
'
rsc_menu_ienable(TRUE)                             ! ...Men wieder w„hlbar
DEC rsc_window&                                    ! Anz. offene Fenster-1
' -------------------------------------------------- Als normaler Dialog
ELSE IF rsc_handle%(tree&)                           ! Hintergrund gerettet...
rsc_bitblt(rsc_handle%(tree&),rscw&(tree&),rsch&(tree&),0,0,0,0,0,rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&))
~MFREE(rsc_handle%(tree&))
'
ELSE                                                 ! Sonst wenigstens...
~FORM_DIAL(3,rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&),rscx&(tree&),rscy&(tree&),rscw&(tree&),rsch&(tree&))
ENDIF
'
rsc_handle%(tree&)=0
'
~WIND_UPDATE(0)                                      ! END_UPDATE
'
RETURN
'
> PROCEDURE rsc_text(tree&,obj&,a$)
'
' Universelle Objekt-Text Belegung...
'
CHAR{C:rsc_obspec%(L:rsc_adr%(tree&),obj&)}=a$
RETURN
> PROCEDURE rsc_bitblt(a%,w&,h&,b%,rb&,rh&,ax&,ay&,ab&,ah&,gx&,gy&)
'
' Universeller Raster-Kopierer (benutzt vro_cpyfm oder vrt_cpyfm)...
'
' a%,w&,h&        : Adresse, Breite, H”he Quellraster
' b%,rb&,rh&      : Adresse, Breite, H”he Zielraster
' ax&,ay&,ab&,ah& : Zu kopierender Ausschnitt
' gx&,gy&         : Zielposition
'
IF ab&>0 AND ah&>0                 ! Breite und H”he vorhanden...
'
~GRAF_MOUSE(256,0)               ! Hidem
~C:rsc_bitblt%(L:a%,w&,h&,0,planes&,L:b%,rb&,rh&,0,planes&,ax&,ay&,ab&,ah&,gx&,gy&)
~GRAF_MOUSE(257,0)               ! Showm
'
ENDIF
'
RETURN
' ------------------------------------------------------------------------------
> PROCEDURE rsc_zuweisungen
'
' Objektnummern des Beispieldialoges...
'
flags|=0
'
help|=25
abbruch|=26
ok|=27
'
popup|=1
'
menu|=2
m_about|=8
m_new|=17
m_open|=18
m_quit|=23
m_dialog|=25
m_fenster|=26
'
RETURN