RUN Flagazine: Run 16/unpacked-run16.zip/PBVOORB.BAS

BASIC Source File | 1995-01-01 | 10KB | 341 lines

'┌─────────────────────────────────────────────────────────────────────────┐
'│ Voorbeeld programma bij MC. Dit programma is geschreven in Power Basic. │
'└─────────────────────────────────────────────────────────────────────────┘

''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Het volgende stukje data wordt gegenereerd door MC '
' wanneer u kiest voor opslag als Power Basic.       '
' Het bevat alle informatie van zowel de screenmap   '
' als de cursormap. De laatste twee DATA statements  '
' zijn de coordinaten van de Hot-Spot.               '
'                                                    '
''''''''''''''''''''''''''''''''''''''''''''''''''''''

DATA  16383,  8191,  4095,  2047,  1023,   511,   255,   127
DATA  65535, 40129, 34945, 32769, 32799, 32769, 34945, 35009
DATA      0, 16384, 24576, 28672, 30720, 31744, 32256,     0
DATA      0,     0,  8764, 13888, 10816,  8768,  8764,     0
DATA      0,     0

'''''''''''''''''''''''''''''
' Dimensioneer de muistabel '
'                           '
'''''''''''''''''''''''''''''
DIM CurTab(32) as Shared Word

'''''''''''''''''''''''''''''''''''''''''''''
' Bepaal segment en offset van de muistabel '
'                                           '
'''''''''''''''''''''''''''''''''''''''''''''
DIM Dxa as Shared Word           : Dxa=VarPtr(CurTab(1))
DIM Esa as Shared Word           : Esa=VarSeg(CurTab(1))

''''''''''''''''''''''''''''
' Dimensioneer de Hot-Spot '
'                          '
''''''''''''''''''''''''''''
DIM HsVer as Shared Word         : HsVer=0
DIM HsHor as Shared Word         : HsHor=0

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Kijk of de gebruiker met de muis een vlak aanklikt.  '
' Als dat zo is, wachten tot de knop wordt losgelaten  '
' en controleren of de muis zich nog steeds binnen     '
' het vlak bevindt.                                    '
'                                                      '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function SquareClicked(x1, y1, x2, y2)
  Ant=-1
  Mx=MouseX
  My=MouseY
  If ((MX>=x1) and (MX<=x2) and (MY>=y1) and (MY<=y2)) then
     If ((LeftButtonPressed) or (RightButtonPressed)) then
       If LeftButtonPressed Then While LeftButtonPressed:Wend
       If RightButtonPressed Then While RightButtonPressed:Wend
       Mx=MouseX
       My=MouseY
       If ((MX>=x1) and (MX<=x2) and (MY>=y1) and (MY<=y2)) then Ant=1
     End If
  End If
  SquareClicked=Ant
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Kijk of de gebruiker met de muis een vlak aanklikt.  '
' Deze functie reageert direkt in tegenstelling tot    '
' de vorige.                                           '
'                                                      '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function SquareClickedNoWait(x1, y1, x2, y2)
  Ant=-1
  Mx=MouseX
  My=MouseY
  If ((MX>=x1) and (MX<=x2) and (MY>=y1) and (MY<=y2)) then
     If ((LeftButtonPressed) or (RightButtonPressed)) then Ant=1
  End If
  SquareClickedNoWait=Ant
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Initialiseer de muis. Geeft een 1 terug als de initialisatie '
' succesvol is verlopen.                                       '
'                                                              '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function InitMouse!
  ! push ds
  ! mov  ax,0
  ! int  &H33
  ! mov  state,ax
  ! pop  ds
  If (state=-1) then
    InitMouse=0
    Else
      InitMouse=1
  End if
End Function

''''''''''''''''''''''
' Toon de muiscursor '
'                    '
''''''''''''''''''''''
Sub ShowMouse
  ! push ds
  ! mov  ax, 1
  ! int  &H33
  ! pop  ds
End Sub

'''''''''''''''''''''''''
' Verberg de muiscursor '
'                       '
'''''''''''''''''''''''''
Sub HideMouse
  ! push ds
  ! mov  ax,2
  ! int  &H33
  ! pop  ds
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retourneert 1 als de linker muistoets werd gedrukt '
'                                                    '
''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function LeftButtonPressed!
Dim LeftButStat As Local Word
  ! push ds
  ! mov  ax,3
  ! mov  bx,0
  ! int  &H33
  ! mov  LeftButStat,bx
  ! pop  ds
  Select Case LeftButStat
    Case 1,3,5,7
      LeftButtonPressed=1
    Case Else
      LeftButtonPressed=0
  End Select
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retourneert 1 als de middelste muistoets werd gedrukt '
'                                                       '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function MidButtonPressed!
Dim MidButStat as Local Word
  ! push ds
  ! mov  ax,3
  ! mov  bx,2
  ! int  &H33
  ! mov  MidButStat,bx
  ! pop  ds
  Select Case MidButStat
    Case 4,5,6,7
      MidButtonPressed=1
    Case Else
      MidButtonPressed=0
  End Select
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Retourneert 1 als de rechter muistoets werd gedrukt '
'                                                     '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function RightButtonPressed!
Dim RightButStat as Local Word
  ! push ds
  ! mov  ax,3
  ! mov  bx,1
  ! int  &H33
  ! mov  RightButStat,bx
  ! pop  ds
  Select Case RightButStat
    Case 2,3,6,7
      RightButtonPressed=1
    Case Else
      RightButtonPressed=0
  End Select
End Function

'''''''''''''''''''''''''''''''''''''''''''''''
' Geef de huidige x-positie van de muis terug '
'                                             '
'''''''''''''''''''''''''''''''''''''''''''''''
Function MouseX!
Dim x as Local Integer
   ! push ds
   ! mov  ax, 3
   ! mov  bx, 0
   ! int  &H33
   ! mov  x, cx
   ! pop  ds
  MouseX=x
End Function

'''''''''''''''''''''''''''''''''''''''''''''''
' Geef de huidige y-positie van de muis terug '
'                                             '
'''''''''''''''''''''''''''''''''''''''''''''''
Function MouseY!
Dim y as Local Integer
   ! push ds
   ! mov  ax, 3
   ! mov  bx, 0
   ! int  &H33
   ! mov  y, dx
   ! pop  ds
  MouseY=y
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Bepaal horizontaal interval waarbinnen de muis mag bewegen '
'                                                            '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MouseSetX(x1,x2 as word)
  Dim Xmin as Word
  Dim Xmax as Word
  Xmin=x1
  Xmax=x2
  ! push ds
  ! mov  ax,7
  ! mov  cx,Xmin
  ! mov  dx,Xmax
  ! int  &H33
  ! pop  ds
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Bepaal vertikaal interval waarbinnen de muis mag bewegen '
'                                                          '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MouseSetY(y1,y2 as word)
  Dim Ymin as Word
  Dim Ymax as Word
  Ymin=y1
  Ymax=y2
  ! push ds
  ! mov  ax,8
  ! mov  cx,Ymin
  ! mov  dx,Ymax
  ! int  &H33
  ! pop  ds
End Sub

'''''''''''''''''''''''''''''''
' Plaats de muiscursor op x,y '
'                             '
'''''''''''''''''''''''''''''''
Sub MouseXy(x,y as Word)
  Dim Mx as Word
  Dim My as Word
  ! push ds
  ! mov  ax,4
  ! mov  cx,Mx
  ! mov  dx,My
  ! int  &H33
  ! pop  ds
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Definieer een venster waarbinnen de muis mag opereren '
'                                                       '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MouseWindow(x1, y1, x2, y2)
  ! push ds
  ! mov  ax, &H7
  ! mov  cx, x1
  ! mov  dx, x2
  ! int  &h33
  ! mov  ax, &H8
  ! mov  cx, y1
  ! mov  dx, y2
  ! int  &h33
  ! pop  ds
End Sub

''''''''''''''''''''''''''''''''
' Laad de grafische muiscursor '
'                              '
''''''''''''''''''''''''''''''''
Sub MouseLoadCursor
  ! push ds
  ! mov  bx, HsVer
  ! mov  cx, HsHor
  ! mov  ax, ESa
  ! mov  es, ax
  ! mov  ax, DXa
  ! mov  dx, ax
  ! mov  ax, 9
  ! int  &H33
  ! pop ds
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''
' Lees de grafische muiscursor en de hot-spot in '
'                                                '
''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ReadMouseCursor
  Restore
  For Teller=1 To 32
    Read CurTab(Teller)
  Next Teller
  Read HsHor
  Read HsVer
End Sub

'''''''''''''''''''''''''''''''''''
'   H O O F D P R O G R A M M A   '
'                                 '
'''''''''''''''''''''''''''''''''''
Cls
If InitMouse=1 Then
  Screen 9,,0,0                                 ' EGA 640*350 kleurenmodus
  Kleur=1                                       ' Teken een kleurig
  For Teller=1 to 640 Step 40                   ' scherm
    Line(Teller,1)-(Teller+39,350),Kleur,BF
    Kleur=Kleur+1
  Next Teller
  Color 15                                      ' Tekenkleur is 15
  Locate 10,25
  Print "Rechter muisknop = Einde"
  Call ReadMouseCursor                          ' Inlezen DATA
  Call MouseLoadCursor                          ' Laad de muiscursor
  ShowMouse                                     ' Toon de muiscursor
  Do
    If LeftButtonPressed=1 Then                 ' Linker muistoets?
      HideMouse                                 ' Verberg de muis
      While LeftButtonPressed=1
        x=MouseX                                ' Lees x en y van de muis
        y=MouseY
        Kleur=Int(14*Rnd)+1
        Gr=Int(10*Rnd)+1
        Line(x-Gr,y-Gr)-(x+Gr,y+Gr),Kleur,BF    ' Teken een blok
        Line(x+Gr,y-Gr)-(x-Gr,y+Gr),1,B
      Wend
      ShowMouse                                 ' Toon de muis
    End If
  Loop Until RightButtonPressed=1               ' Einde
  HideMouse
Else
  Print "Geen muis gevonden!"
End If
End