home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AMOS PD CD
/
amospdcd.iso
/
sourcecode
/
procedures
/
dialog_procs.amos
/
dialog_procs.amosSourceCode
< prev
next >
Wrap
AMOS Source Code
|
1991-06-22
|
16KB
|
960 lines
' ***********************************
' *** AMOS Dialog Procedures V2.1 ***
' ***********************************
'
Gosub INIT
'
' ***********************
' *** EXAMPLE PROGRAM ***
' ***********************
'
'
' **********************
' *** END OF PROGRAM ***
' **********************
'
End
'
' *** Open Dialog Screen Procedure.
'
Procedure _OPENDIALOGSCREEN[N,H,Y]
'
Screen Open N,640,H,4,Hires
Screen Display N,130,Y,,
Curs Off
Flash Off
Cls 0
'
Palette $999,$0,$FFF,$58A
'
Pen 1
Paper 0
Ink 1,0
'
_BACK=0
_SHADOW=1
_LIGHT=2
_COLOUR=3
_TEXT=1
'
End Proc
'
' *** Draw 3D Box Procedure.
'
Procedure _DRAW3DBOX[X1,Y1,X2,Y2,T$,IN,FC,BC]
'
I=0
IO=0
B=0
While I<Len(T$)
I=Instr(T$,"|",I+1)
If I=0
I=Len(T$)+1
End If
IO=I
Inc B
Wend
'
If IN=0
C1=_SHADOW
C2=_LIGHT
Else
C1=_LIGHT
C2=_SHADOW
End If
'
If IN<>2
Cls BC,X1,Y1 To X2+1,Y2+1
Ink C1
Box X1,Y1 To X2,Y2
Box X1+1,Y1 To X2-1,Y2
Ink C2
Polyline X1+1,Y2 To X2,Y2 To X2,Y1
Polyline X1+1,Y2 To X2-1,Y2 To X2-1,Y1+1
Else
Cls BC,X1+2,Y1+1 To X2-1,Y2
End If
'
If Upper$(Left$(T$,3))="(S)"
CHK$=Upper$(Mid$(T$,4))
_DRAWUSEROBJECT[X1,Y1,X2,Y2,CHK$]
Goto FIN
End If
'
H#=((Y2-Y1)-(B*Text Base))/(B+1)
Y#=Y1+H#+Text Base
'
Ink FC,BC
Gr Writing 0
'
I=0
IO=0
LOP=0
While LOP<B
I=Instr(T$,"|",I+1)
If I=0
I=Len(T$)+1
End If
A$=Mid$(T$,IO+1,I-IO-1)
'
If Left$(A$,1)="'"
A$=Mid$(A$,2)
X7=X1+4
Goto NXT
End If
'
If Left$(A$,1)="^"
A$=Mid$(A$,2)
X7=(X2-Text Length(A$))-4
Goto NXT
End If
'
WID=Text Length(A$)
X7=(((X2-X1)/2)+X1)-(WID/2)+1
'
NXT:
Text X7,Y#,A$
'
Y#=Y#+Text Base+H#
'
IO=I
Inc LOP
Wend
'
Gr Writing 1
'
FIN:
'
End Proc
'
' *** Check Zone Procedure.
'
Procedure _CHECKZONE[X1,Y1,X2,Y2,WT]
'
X=X Screen(X Mouse)
Y=Y Screen(Y Mouse)
M=Mouse Key
AN=0
'
If X<X1 or X>X2 or Y<Y1 or Y>Y2 or M=0
Goto FIN2
End If
'
AN=M
'
If WT=0
Goto FIN2
End If
'
Gr Writing 2
Bar X1,Y1 To X2,Y2
'
While X>=X1 and X<=X2 and Y>=Y1 and Y<=Y2
X=X Screen(X Mouse)
Y=Y Screen(Y Mouse)
If Mouse Key=0
Goto FIN
End If
Wend
'
AN=0
'
FIN:
Bar X1,Y1 To X2,Y2
Gr Writing 1
'
FIN2:
'
End Proc[AN]
'
' *** Set Font Procedure.
'
Procedure _SETFONT[FT$,FS]
'
FT$=Upper$(FT$)
'
OK=0
POS=1
'
While Font$(POS)<>""
'
If Upper$(Left$(Font$(POS),Len(FT$)+5))=(FT$+".FONT")
If Val(Mid$(Font$(POS),30,3))=FS
Set Font POS
OK=1
_FONTNAME$=FT$
_FONTSIZE=FS
End If
End If
'
Inc POS
Wend
'
End Proc[OK]
'
' *** Add Dialog Button Procedure.
'
Procedure _ADDBUTTON[X1,Y1,X2,Y2,T$,BZ]
'
_DRAW3DBOX[X1,Y1,X2,Y2,T$,1,_TEXT,0]
'
If BZ<>0
'
L$=String$(" ",19)+";"
'
Mid$(L$,1,3)=Str$(X1)-" "
Mid$(L$,5,3)=Str$(Y1)-" "
Mid$(L$,9,3)=Str$(X2)-" "
Mid$(L$,13,3)=Str$(Y2)-" "
Mid$(L$,17,4)=Str$(BZ)-" "
'
_DIALOGBUTTON$=_DIALOGBUTTON$+L$
'
End If
'
End Proc
'
' *** Check Dialog Buttons Procedure.
'
Procedure _CHECKBUTTONS
'
ZN=0
I1=1
I2=1
'
While I2<Len(_DIALOGBUTTON$)
'
I2=Instr(_DIALOGBUTTON$,";",I1)
L$=Mid$(_DIALOGBUTTON$,I1,I2-I1)
'
X1=Val(Mid$(L$,1,3))
Y1=Val(Mid$(L$,5,3))
X2=Val(Mid$(L$,9,3))
Y2=Val(Mid$(L$,13,3))
BZ=Val(Mid$(L$,17,4))
'
WT=1
If BZ<0
BZ=-BZ
WT=0
End If
'
_CHECKZONE[X1,Y1,X2,Y2,WT]
If Param
ZN=BZ
Goto FIN
End If
'
I1=I2+1
'
Wend
'
FIN:
'
End Proc[ZN]
'
' *** Delete Dialog Button Procedure.
'
Procedure _DELETEBUTTON[NO,BC]
'
I1=1
I2=1
'
While I2<Len(_DIALOGBUTTON$)
'
I2=Instr(_DIALOGBUTTON$,";",I1)
L$=Mid$(_DIALOGBUTTON$,I1,I2-I1)
'
BZ=Val(Mid$(L$,17,3))
'
If BZ=NO
'
X1=Val(Mid$(L$,1,3))
Y1=Val(Mid$(L$,5,3))
X2=Val(Mid$(L$,9,3))
Y2=Val(Mid$(L$,13,3))
'
_DIALOGBUTTON$=Left$(_DIALOGBUTTON$,I1-1)+Mid$(_DIALOGBUTTON$,I2+1)
'
If BC>-1
Ink BC
Bar X1,Y1 To X2,Y2
End If
'
End If
'
I1=I2+1
'
Wend
'
End Proc
'
' *** Add Dialog Tick-Box Procedure.
'
Procedure _ADDTICKBOX[X1,Y1,PO,BZ]
'
_ADDBUTTON[X1,Y1,X1+26,Y1+11,"",BZ]
'
If BZ=0
PO=1-PO
End If
'
If PO=1
Ink _SHADOW
X1=X1+7
Y1=Y1+2
Draw X1,Y1+3 To X1+3,Y1+6
Draw X1+1,Y1+3 To X1+4,Y1+6
Draw X1+2,Y1+3 To X1+5,Y1+6
Draw X1+10,Y1 To X1+12,Y1
Draw X1+10,Y1+1 To X1+6,Y1+5
Draw X1+9,Y1+1 To X1+5,Y1+5
End If
'
End Proc[PO]
'
' *** Add Cycle Button Procedure.
'
Procedure _ADDCYCLEBUTTON[X1,Y1,X2,Y2,T$,PO,BZ]
'
T$=T$+"|"
I1=1
I2=1
P=1
'
I=0
IO=0
B=0
While I<Len(T$)
I=Instr(T$,"|",I+1)
If I=0
I=Len(T$)+1
End If
IO=I
Inc B
Wend
'
If BZ=0
Add PO,1,1 To B
End If
'
While I2<Len(T$)
I2=Instr(T$,"|",I1)
If P=PO
L$=Mid$(T$,I1,I2-I1)
Exit
End If
I1=I2+1
Inc P
Wend
'
_ADDBUTTON[X1,Y1,X2,Y2,"",BZ]
'
Ink _SHADOW
X1=X1+6
Y1=Y1+2
Y2=Y2-3
Draw X1+1,Y1 To X1+7,Y1
Draw X1,Y1+1 To X1,Y2-1
Draw X1+1,Y1+1 To X1+1,Y2-1
Draw X1+1,Y2 To X1+7,Y2
Draw X1+7,Y2-1 To X1+8,Y2-1
Draw X1+7,Y1+1 To X1+7,Y1+5
Draw X1+8,Y1+1 To X1+8,Y1+5
Draw X1+5,Y1+3 To X1+10,Y1+3
Draw X1+6,Y1+4 To X1+9,Y1+4
Draw X1+14,Y1 To X1+14,Y2+1
Ink _LIGHT
Draw X1+15,Y1 To X1+15,Y2+1
'
_DRAW3DBOX[X1+16,Y1-2,X2,Y2+3,L$,2,_TEXT,0]
'
End Proc[PO]
'
' *** Add Text Input Button Procedure.
'
Procedure _ADDINPUTBUTTON[X,Y,TXT$,L,ML,BZ]
'
XX=X
YY=Y
ED$=TXT$
SX=L
'
Pen _TEXT
'
If BZ<>0
_ADDBUTTON[(X*8)-4,(Y*8)-3,(X*8)+(L*8)+4,(Y*8)+8+2,"",BZ]
_DRAW3DBOX[(X*8)-2,(Y*8)-2,(X*8)+(L*8)+2,(Y*8)+8+1,"",0,1,0]
Locate XX,YY
Print Mid$(TXT$,1,L)
Goto _END
End If
'
X1=(X*8)-4
Y1=(Y*8)-3
X2=(X*8)+(L*8)+4
Y2=(Y*8)+8+2
'
Locate XX,YY
Print Space$(SX);
'
XC=Len(ED$)
MN=0
PX=0
'
L=Len(ED$)
If L>=SX
PX=L-SX
End If
'
Clear Key
'
Do
Gosub _DED
'
If Mouse Key=1
X=(X Screen(X Mouse))/8-XX
If X>=0 and X<=L
XC=X
Gosub _DED
End If
End If
'
Gr Writing 2
GRX=X Curs*8
GRY=YY*8
Bar GRX,GRY To GRX+7,GRY+7
If Mouse Key
Repeat
Until Mouse Key=0
End If
'
Repeat
A$=Inkey$
S=Scancode
K=Key Shift
Until A$<>"" or Mouse Key or(A$<>"" and K)
'
XM=X Screen(X Mouse)
YM=Y Screen(Y Mouse)
If Mouse Key and(XM<X1 or XM>X2 or YM<Y1 or YM>Y2)
A$=Chr$(13)
End If
'
Bar GRX,GRY To GRX+7,GRY+7
Gr Writing 1
'
F=1
'
If A$=Chr$(13)
Exit
End If
'
If A$=Chr$(27)
ED$=TXT$
TXT$=""
Locate XX,YY
Print Space$(SX);
Gosub _DED
Exit
End If
'
If S=65 and K=0 and XC+PX>MN
ED$=Left$(ED$,XC+PX-1)+Mid$(ED$,PX+XC+1)
E=1
Dec L
S=79
End If
'
If S=65 and K>0 and K<4
ED$=Mid$(ED$,PX+XC+1)
L=Len(ED$)
PX=0
XC=0
End If
'
If S=70 and K=0 and XC+PX<L
ED$=Left$(ED$,XC+PX)+Mid$(ED$,PX+XC+2)
E=1
Dec L
End If
'
If S=70 and K>0 and K<4
ED$=Left$(ED$,XC+PX)
L=Len(ED$)
F=0
End If
'
If S=79 and PX+XC>MN
F=0
If XC=0
Dec PX
Else
Dec XC
End If
End If
'
If S=79 and K>0 and K<4
F=0
PX=0
XC=0
End If
'
If S=78 and PX+XC<L
F=0
If XC=SX
Inc PX
Else
Inc XC
End If
End If
'
If S=78 and K>0 and K<4
F=0
XC=L
If XC>SX
XC=SX
End If
PX=L-SX
If PX<0
PX=0
End If
End If
'
If F
If A$>=" " and L<ML
ED$=Left$(ED$,PX+XC)+A$+Mid$(ED$,PX+XC+1)
Inc L
If L>SX
If XC>=SX
Inc PX
Else
Inc XC
End If
Else
Inc XC
End If
End If
End If
'
Loop
'
Goto _END
'
_DED:
'
Print At(XX,YY)+Space$(SX);
Print At(XX,YY)+Mid$(ED$,PX+1,SX);
Locate Min(XX+XC,XX+SX-1),YY
Return
'
_END:
'
End Proc[ED$]
'
' *** Draw User Object Procedure.
'
Procedure _DRAWUSEROBJECT[X1,Y1,X2,Y2,T$]
'
If Mid$(T$,1,3)="ICO"
Paste Icon X1+X2,Y1+Y2,Val(Right$(T$,3))
End If
'
If Mid$(T$,1,3)="BOB"
Paste Bob X1+X2,Y1+Y2,Val(Right$(T$,3))
End If
'
' ********************
' *** USER OBJECTS ***
' ********************
'
' *** Up Arrow.
'
If T$="UAR"
Ink _SHADOW
X=X1+(X2-X1)/2
Y=Y1+(Y2-Y1)/2
Polygon X,Y1+2 To X1+4,Y2-2 To X,Y To X2-4,Y2-2 To X,Y1+2
End If
'
' *** Down Arrow.
'
If T$="DAR"
Ink _SHADOW
X=X1+(X2-X1)/2
Y=Y1+(Y2-Y1)/2
Polygon X,Y2-2 To X1+4,Y1+2 To X,Y To X2-4,Y1+2 To X,Y2-2
End If
'
' *** Left Arrow.
'
If T$="LAR"
Ink _SHADOW
X=X1+(X2-X1)/2
Y=Y1+(Y2-Y1)/2
Polygon X1+4,Y To X2-4,Y1+2 To X,Y To X2-4,Y2-2 To X1+4,Y
End If
'
' *** Right Arrow.
'
If T$="RAR"
Ink _SHADOW
X=X1+(X2-X1)/2
Y=Y1+(Y2-Y1)/2
Polygon X2-4,Y To X1+4,Y1+2 To X,Y To X1+4,Y2-2 To X2-4,Y
End If
'
End Proc
'
' *** Add Radio Button Procedure.
'
Procedure _ADDRADIOBUTTON[X,Y,GP,BN,PO,BZ]
'
X1=X
Y1=Y
'
If PO=0
C1=_LIGHT
C2=_SHADOW
C3=_COLOUR
Else
C1=_SHADOW
C2=_LIGHT
C3=_BACK
End If
'
Ink C1
Draw X1+14,Y1 To X1+14,Y1+1
Draw X1+15,Y1+1 To X1+15,Y1+7
Draw X1+16,Y1+2 To X1+16,Y1+6
Draw X1+14,Y1+7 To X1+15,Y1+7
Draw X1+14,Y1+8 To X1+3,Y1+8
Ink C2
Draw X1+13,Y1 To X1+2,Y1
Draw X1+2,Y1+1 To X1+1,Y1+1
Draw X1,Y1+2 To X1,Y1+6
Draw X1+1,Y1+2 To X1+1,Y1+7
Draw X1+2,Y1+7 To X1+2,Y1+8
Ink C3
Draw X1+4,Y1+3 To X1+4,Y1+5
Draw X1+12,Y1+3 To X1+12,Y1+5
Bar X1+5,Y1+2 To X1+11,Y1+6
'
If BZ>0
'
L$=String$(" ",21)+";"
'
Mid$(L$,1,3)=Str$(X)-" "
Mid$(L$,5,3)=Str$(Y)-" "
Mid$(L$,9,3)=Str$(GP)-" "
Mid$(L$,13,3)=Str$(BN)-" "
Mid$(L$,17,3)=Str$(PO)-" "
Mid$(L$,21,3)=Str$(BZ)-" "
'
_RADIOBUTTON$=_RADIOBUTTON$+L$
'
End If
'
End Proc
'
' *** Check Radio Buttons Procedure.
'
Procedure _CHECKRADIOBUTTONS
'
RZN=0
I1=1
I2=1
'
While I2<Len(_RADIOBUTTON$)
'
I2=Instr(_RADIOBUTTON$,";",I1)
L$=Mid$(_RADIOBUTTON$,I1,I2-I1)
'
X1=Val(Mid$(L$,1,3))
Y1=Val(Mid$(L$,5,3))
'
_CHECKZONE[X1,Y1,X1+16,Y1+8,0]
If Param
RZN=Val(Mid$(L$,21,3))
Goto FIN
End If
'
I1=I2+1
'
Wend
'
FIN:
'
End Proc[RZN]
'
' *** Set Radio Buttons Procedure.
'
Procedure _SETRADIO[GN,BA]
'
I1=1
I2=1
'
While I2<Len(_RADIOBUTTON$)
'
I2=Instr(_RADIOBUTTON$,";",I1)
L$=Mid$(_RADIOBUTTON$,I1,I2-I1)
'
GP=Val(Mid$(L$,9,3))
'
If GP=GN
'
X1=Val(Mid$(L$,1,3))
Y1=Val(Mid$(L$,5,3))
BN=Val(Mid$(L$,13,3))
'
If BN=BA
_ADDRADIOBUTTON[X1,Y1,BN,GP,0,0]
Else
_ADDRADIOBUTTON[X1,Y1,BN,GP,1,0]
End If
End If
'
I1=I2+1
'
Wend
'
End Proc
'
' *** Horizontal Slider Procedure.
'
Procedure _HORIZONTALSLIDER[X1,Y1,X2,Y2,NO,PO,T$]
'
If PO<1 or PO>NO
Goto FIN
End If
'
Dec PO
'
WID=6
'
SL#=(X2-X1)-WID
SS#=Max(SL#/NO,WID)
If SS#>SL#/NO
SL#=(X2-X1)-4-WID
End If
SW#=(SL#/NO)*PO
'
_DRAW3DBOX[X1,Y1,X2,Y2,"",1,1,0]
Ink _SHADOW
Bar X1+2+SW#,Y1+2 To X1+2+SW#+SS#,Y2-2
'
If T$<>""
SLIDP=PO+1
_SLIDERROUTINE[T$,SLIDP]
End If
'
FIN:
'
End Proc
'
' *** Vertical Slider Procedure.
'
Procedure _VERTICALSLIDER[X1,Y1,X2,Y2,NO,PO,T$]
'
If PO<1 or PO>NO
Goto FIN
End If
'
Dec PO
'
HIG=3
'
SL#=(Y2-Y1)-HIG
SS#=Max(SL#/NO,HIG)
If SS#>SL#/NO
SL#=(Y2-Y1)-2-HIG
End If
SH#=(SL#/NO)*PO
'
_DRAW3DBOX[X1,Y1,X2,Y2,"",1,1,0]
Ink _SHADOW
Bar X1+4,Y1+1+SH# To X2-4,Y1+1+SH#+SS#
'
If T$<>""
SLIDP=PO+1
_SLIDERROUTINE[T$,SLIDP]
End If
'
FIN:
'
End Proc
'
' *** Grab Horizontal Slider Procedure.
'
Procedure _GRABHORIZONTALSLIDER[X1,Y1,X2,Y2,NO,PO,T$]
'
Dec PO
'
WID=6
'
SL#=(X2-X1)-WID
SS#=Max(SL#/NO,WID)
If SS#>SL#/NO
SL#=(X2-X1)-4-WID
End If
SW#=(SL#/NO)*PO
'
_CHECKZONE[X1+1+SW#,Y1+1,X1+1+SW#+SS#,Y2-1,0]
If Param
'
OK=0
P=PO
'
MX=X Screen(X Mouse)
DX=MX-(X1+SW#)
'
Repeat
MX=X Screen(X Mouse)
MY=Y Screen(Y Mouse)
MK=Mouse Key
'
X=MX-X1-DX
'
P=(X*(NO+1))/SL#
'
If P<1
P=1
End If
If P>NO
P=NO
End If
If P<>PO
PO=P
SP=PO
OK=1
_HORIZONTALSLIDER[X1,Y1,X2,Y2,NO,PO,T$]
End If
'
Until MK=0
End If
'
If OK=0
PO=0
End If
'
End Proc[PO]
'
' *** Grab Vertical Slider Procedure.
'
Procedure _GRABVERTICALSLIDER[X1,Y1,X2,Y2,NO,PO,T$]
'
Dec PO
'
HIG=3
'
SL#=(Y2-Y1)-HIG
SS#=Max(SL#/NO,HIG)
If SS#>SL#/NO
SL#=(Y2-Y1)-2-HIG
End If
SH#=(SL#/NO)*PO
'
_CHECKZONE[X1+1,Y1+1+SH#,X2-1,Y1+1+SH#+SS#,0]
If Param
'
OK=0
P=PO
'
MY=Y Screen(Y Mouse)
DY=MY-(Y1+SH#)
'
Repeat
MX=X Screen(X Mouse)
MY=Y Screen(Y Mouse)
MK=Mouse Key
'
Y=MY-Y1-DY
'
P=(Y*(NO+1))/SL#
'
If P<1
P=1
End If
If P>NO
P=NO
End If
If P<>PO
PO=P
SP=PO
OK=1
_VERTICALSLIDER[X1,Y1,X2,Y2,NO,PO,T$]
End If
'
Until MK=0
End If
'
If OK=0
PO=0
End If
'
End Proc[PO]
'
' *** Slider Routines Procedure.
'
Procedure _SLIDERROUTINE[T$,P]
'
Goto T$
'
HSLIDE:
_DRAW3DBOX[140,25,170,35,Str$(P)-" ",1,_TEXT,_COLOUR]
Goto FIN
'
VSLIDE:
_DRAW3DBOX[35,25,65,35,Str$(P)-" ",1,_TEXT,_COLOUR]
Goto FIN
'
FIN:
'
End Proc
'
' *** Title Bar Procedure.
'
Procedure _DRAWTITLEBAR[T$]
'
B_FT$=_FONTNAME$
B_FS=_FONTSIZE
'
_SETFONT["Topaz",8]
'
If T$=""
T$=""
T$=T$+"'Amiga Workbench "+Str$(Chip Free)-" "+" graphics mem "+Str$(Fast Free)-" "+" other mem"
End If
'
_DRAW3DBOX[-1,0,640,10,T$,1,_SHADOW,_LIGHT]
'
_SETFONT[B_FT$,B_FS]
'
End Proc
'
' *** Initialise Dialog Stuff.
'
INIT:
'
' *** SET VARIABLES & STRINGS.
'
_DIALOGBUTTON$=""
_RADIOBUTTON$=""
'
' *** SET GLOBAL VARIABLES & STRINGS.
'
Global _DIALOGBUTTON$,_RADIOBUTTON$
Global _BACK,_SHADOW,_LIGHT,_COLOUR,_TEXT
Global _FONTNAME$,_FONTSIZE
'
' *** Open Default Screen.
'
_OPENDIALOGSCREEN[0,200,50]
'
' *** Set Font.
'
Get Rom Fonts
_SETFONT["Topaz",8]
'
Return