'************************************************************************ '* * '* Requester rutiner som bruker req.library * '* laget av Torsten Gabrielsen for EXEC * '* 8/11 1990 * '* * '* til bruk i AmigaBasic * '* * '************************************************************************ '* * '* req.bmap må ligge i LIBS: eller naavaerende directory. * '* req.library må ligge i LIBS: eller naavaerende directory. * '* * '* For aa bruke rutinene, saa maa disse linjene vaere kj0rt: * '* * '* DECLARE FUNCTION TextRequest& LIBRARY * '* DECLARE FUNCTION FileRequester& LIBRARY * '* DECLARE FUNCTION ExtendedColorRequester& LIBRARY * '* DECLARE FUNCTION GetLong& LIBRARY * '* DECLARE FUNCTION GetString& LIBRARY * '* LIBRARY "req.library" * '* * '* Denne filen inneholder foelgende rutiner: * '* * '* ReqTextRequest, ReqSimpleRequest, ReqTwoGadget, ReqThreeGadget * '* ReqColorRequester, ReqFileRequester, ReqGetLong, ReqGetString * '* * '* Alle rutinene er AmigaBasic SUB-rutiner med egne varibler, * '* så du trenger ikke bekymre deg for kollisjoner med egne * '* variabelnavn. * '* * '* (Bruk MERGE for aa sette denne filen sammen med ditt program) * '* * '************************************************************************ '************************************************************************ '* ReqTextRequest * '************************************************************************ '* * '* Setter opp en "requester" med en tekst og 3 gadgets, venter til * '* bruker trykker en av disse gadgets. * '* * '* INPUTS : * '* title$ - requestervinduets tittel * '* txt$ - Tekst som skal stå i requesteren. Teksten kan være * '* på flere linjer. (Bruk chr$(10)) * '* ptxt$ - Venstre gadgets text * '* mtxt$ - Midtre gadgets text * '* ntxt$ - Høyre gadgets text * '* TPen& - Tekst farge (anbefalt verdi: 1) * '* APen& - Forgrunnsfarge (anbefalt verdi: 0) * '* BPen - Bakgrunnsfarge (anbefalt verdi: 1) * '* OUTPUT: * '* Answer&- 1 : Venstre Gadget ble valgt * '* Answer&- 2 : Midtre Gadget ble valgt * '* Answer&- 0 : Høyre Gadget ble valgt * '* * '* Hvis en tekst er tom (="") så blir ikke dennes boksen brukt. Hvis * '* alle gadgettekstene er tomme, så vil requesteren få en close-gadget * '* til å avslutte requesten med. * '* * '************************************************************************ SUB ReqTextRequest (title$,txt$,Ptxt$,Mtxt$,NTxt$,TPen&,APen&,BPen&,Answer&) STATIC txt$=txt$+CHR$(0) ' Tekstene med vaere 'Null-terminated' title$=title$+CHR$(0) Mtxt$=Mtxt$+chr$(0) PTxt$=Ptxt$+chr$(0) NTxt$=NTxt$+chr$(0) Txstruct$=string$(47,0) OddAddress&=SADD(Txstruct$) - INT(SADD(Txstruct$)/2)*2 MID$(Txstruct$,1+ OddAddress&,4) =MKL$(SADD(Txt$)) '*text MID$(Txstruct$,5+ OddAddress&,4) =MKL$(0) '*Controls MID$(Txstruct$,9+ OddAddress&,4) =MKL$(WINDOW(7)) '*Window if Mtxt$<>chr$(0) THEN MID$(Txstruct$,13+OddAddress&,4)=MKL$(SADD(MTxt$)) '*MiddleText END IF IF PTxt$<>CHR$(0) THEN MID$(Txstruct$,17+OddAddress&,4)=MKL$(SADD(PTxt$)) '*PositiveText END IF IF NTxt$<>CHR$(0) THEN MID$(Txstruct$,21+OddAddress&,4)=MKL$(SADD(NTxt$)) '*NegativeText END IF MID$(Txstruct$,25+OddAddress&,4) =MKL$(SADD(Title$)) '*Title MID$(Txstruct$,29+OddAddress&,2) =MKI$(-1) 'KeyMask MID$(Txstruct$,31+OddAddress&,2) =MKI$(TPen&) 'textcolor MID$(Txstruct$,33+OddAddress&,2) =MKI$(APen&) 'detailcolor MID$(Txstruct$,35+OddAddress&,2) =MKI$(BPen&) 'blockcolor answer&=TextRequest&(SADD(Txstruct$)+OddAddress&) txt$=LEFT$(txt$,len(txt$)-1) 'fjerne chr$(0) så tekstene title$=LEFT$(title$,len(title$)-1) 'forblir uforandret i Mtxt$=LEFT$(Mtxt$,len(Mtxt$)-1) 'oppkallingsvariablene PTxt$=LEFT$(Ptxt$,len(Ptxt$)-1) NTxt$=LEFT$(Ntxt$,len(Ntxt$)-1) END SUB '************************************************************************ '* ReqSimpleRequest * '************************************************************************ '* * '* Setter opp en "requester" med en tekst og en gadget, venter til * '* bruker trykker gadgeten. * '* * '* INPUTS : * '* txt$ - Tekst som skal stå i requesteren. Teksten kan være * '* på flere linjer. (Bruk chr$(10)) * '* Gadtxt$- gadgets text * '* * '* OUTPUT: * '* ingen * '* * '************************************************************************ SUB ReqSimpleRequest (txt$,Gadtxt$) STATIC CALL ReqTextRequest("",txt$,"","",Gadtxt$,1&,0&,1&,ans&) END SUB '************************************************************************ '* ReqTwoGadget * '************************************************************************ '* * '* Setter opp en "requester" med en tekst og to gadgets og venter til * '* bruker trykker en av gadgetene * '* * '* INPUTS : * '* txt$ - Tekst som skal stå i requesteren. Teksten * '* kan vaere på flere linjer. (Bruk chr$(10)) * '* firsttxt$ - venstre gadgets tekst * '* secondtxt$- hoeyre gadgets tekst * '* * '* OUTPUT: * '* answer& = 1 : venstre gadget ble trykket * '* = 0 : hoeyre gadget ble trykket * '* * '************************************************************************ SUB ReqTwoGadget(txt$,firsttxt$,secondtxt$,answer&) STATIC CALL ReqTextRequest("",txt$,firsttxt$,"",secondtxt$,1&,0&,1&,answer&) END SUB '************************************************************************ '* ReqThreeGadget * '************************************************************************ '* * '* Setter opp en "requester" med en tekst og tre gadgets og venter til * '* bruker trykker en av gadgetene * '* * '* INPUTS : * '* txt$ - Tekst som skal stå i requesteren. Teksten * '* kan vaere på flere linjer. (Bruk chr$(10)) * '* firsttxt$ - venstre gadgets tekst * '* secondtxt$- midtre gadgets tekst * '* thirdtxt$ - hoeyre gadgets tekst * '* * '* OUTPUT: * '* answer& = 1 : venstre gadget ble trykket * '* = 2 : midtre gadget ble trykket * '* = 0 : hoeyre gadget ble trykket * '* * '************************************************************************ SUB ReqThreeGadget(txt$,firsttxt$,secondtxt$,thirdtxt$,answer&) STATIC CALL ReqTextRequest("",txt$,firsttxt$,secondtxt$,thirdtxt$,1&,0&,1&,answer&) END SUB '************************************************************************ '* ReqColorRequester * '************************************************************************ '* * '* Setter opp en Colorrequester. Requesteren dukker opp på samme skjerm * '* som ditt aktive basic-vindu. Den har automatisk riktig antall farger * '* * '* INPUTS : * '* Col& - Hvilken farge som skal vaere valgt naar * '* requesteren dukker opp * '* OUTPUT : * '* Col& - Sist valgte farge, eventuelt 65535 hvis bruker * '* valgte eller close gadget. * '************************************************************************ SUB ReqColorRequester (Col&) STATIC XCstruct$=string$(29,0) OddAddress&=SADD(XCstruct$) - INT(SADD(XCstruct$)/2)*2 MID$(XCstruct$,1+OddAddress&,4) =MKL$(Col&) MID$(XCstruct$,5+OddAddress&,4) =MKL$(WINDOW(7)) Col&=ExtendedColorRequester&(SADD(XCstruct$)+OddAddress&) END SUB '************************************************************************ '* ReqFileRequester * '************************************************************************ '* * '* Setter opp en avansert fil-requester, lar bruker velge en fil, * '* og returnerer filnavnet, samt om bruker valgte en fil. * '* * '* INPUTS : * '* title$ - requestervinduets tittel * '* * '* OUTPUT: * '* PathName$ - Det komplette filnavnet. * '* Success& = 1 : Bruker valgte en fil * '* = 0 : Bruker trykket eller close-gadget * '* * '************************************************************************ SUB ReqFileRequester (title$,pathname$,Success&) STATIC title$ = title$ + CHR$(0) + CHR$(0) pathname$=STRING$(162,0) 'DSIZE+FCHARS+2=162 struct$ = STRING$(356,0) 'sizeof(FileReqStruct)=356 OddAddress%=0 IF SADD(struct$)/2 <> INT(SADD(struct$)/2) THEN OddAddress%=1 MID$(struct$,3+OddAddress%,4) = MKL$(SADD(title$)) MID$(struct$,15+OddAddress%,4) = MKL$(SADD(pathname$)) MID$(struct$,19+OddAddress%,4) = MKL$(WINDOW(7)) Success& = FileRequester& (SADD(struct$)+OddAddress%) pathname$=LEFT$(pathname$,INSTR(pathname$,CHR$(0))-1) title$=LEFT$(title$,len(title$)-1) END SUB '************************************************************************ '* ReqGetLong * '************************************************************************ '* * '* Setter opp en requester som ber om et tall (Long integer) * '* Popper opp med en defaultverdi, og avslutter ikke foer bruker * '* velger en verdi >= minlimit og <=maxlimit. * '* (Hvis ikke bruker velger eller close-gadget) * '* * '* INPUTS : * '* title$ - requestervinduets tittel * '* defval& - Defaultverdi * '* minlimit& - Minimumsverdi som godtas * '* maxlimit& - Maximumsverdi som godtas * '* * '* OUTPUT: * '* result& - Valgt verdi * '* Success& = 1 : Bruker valgte en verdi * '* = 0 : Bruker trykket eller close-gadget * '* * '************************************************************************ SUB ReqGetLong (title$,defval&,minlimit&,maxlimit&,Result&,success&) STATIC title$=title$+CHR$(0) glstruct$=string$(35,0) tb&=SADD(title$) OddAddress&=SADD(glstruct$) - INT(SADD(glstruct$)/2)*2 MID$(glstruct$,1+ OddAddress&,4) =MKL$(tb&) '*titlebar MID$(glstruct$,5+ OddAddress&,4) =MKL$(defval&) 'defaultval MID$(glstruct$,9+ OddAddress&,4) =MKL$(minlimit&) 'minlimit MID$(glstruct$,13+OddAddress&,4) =MKL$(maxlimit&) 'maxlimit MID$(glstruct$,17+OddAddress&,4) =MKL$(0) 'result MID$(glstruct$,21+OddAddress&,4) =MKL$(WINDOW(7)) '*window MID$(glstruct$,25+OddAddress&,2) =MKI$(0) 'versionnumber MID$(glstruct$,27+OddAddress&,4) =MKL$(0) 'flags MID$(glstruct$,31+OddAddress&,4) =MKL$(0) 'rfu2 success&=GetLong&(SADD(glstruct$)+OddAddress&) Result&=CVL(MID$(glstruct$,17+OddAddress&,4)) Title$=LEFT$(title$,len(Title$)-1) END SUB '************************************************************************ '* ReqGetString * '************************************************************************ '* * '* Setter opp en requester som ber om en streng. * '* Popper opp med en defaultstreng, og lar ikke brukeren taste en * '* streng lengre enn maxlength&. Lengden paa tekstvinduet bestemmes av * '* vislength&. * '* * '* INPUTS : * '* text$ - Strengen startverdi, defaultverdi * '* title$ - requestervinduets tittel * '* vislength& - tekstvinduets bredde i antall tegn * '* maxlength& - Maximumslengde på strengen * '* * '* OUTPUT: * '* text$ - Resulterende streng * '* Success& = 1 : Bruker valgte en verdi * '* = 0 : Bruker trykket eller close-gadget * '* * '************************************************************************ SUB ReqGetString (text$,title$,vislength&,maxlength&,success&) STATIC text$=text$+CHR$(0) title$=title$+CHR$(0) IF maxlength& > LEN (text$) - 1 THEN text$=text$+STRING$(maxlength&-LEN(text$)+1,0) END IF success& = GetString&(SADD(text$),SADD(Title$),WINDOW(7),vislength&,maxlength&+1&) text$=LEFT$(text$,INSTR(text$,CHR$(0))-1) title$=LEFT$(title$,INSTR(title$,CHR$(0))-1) END SUB