|
'
------------------------------------------------------------------------
' Jeu d'outils Souris de Visual Basic pour MS-DOS
'
' Le jeu d'outils Souris (MOUSE.BAS) assure la gestion de la
souris
' pour les programmes en mode texte et graphiques, en l'absence
de feuilles
' Visual Basic visibles. Ce jeu d'outils offre les
' procédures suivantes :
' MouseBorder - fixe les limites de déplacement de la souris
' MouseDriver - vérifie qu'une souris est présente et
' donne accès aux fonctions de la souris.
' MouseHide - cache le pointeur de la souris.
' MouseInit - initialise le gestionnaire de souris.
' MousePoll - obtient l'emplacement du pointeur et
' l'état des boutons de la souris.
' MouseShow - indique la position de la souris.
' SetHigh - établit le mode vidéo offrant la plus haute
résolution.
' ScrSettings - obtient le mode affichage Basic et la largeur
d'écran
' en cours.
'
' Pour des informations complètes sur la programmation de la
souris en
' Basic et en autres langages, voir le Microsoft Mouse
Programmer's Guide
' (Microsoft Press).
'
' Pour employer les routines du jeu d'outils Souris dans un de
vos programmes,
' incorporez MOUSE.BAS au programme ou servez-vous de la
' bibliothèque (MOUSE.LIB, MOUSEA.LIB) et de la bibliothèque
Quick (MOUSE.QLB)
' fournies, en appelant les procédures voulues. MOUSE.COM
' ou MOUSE.SYS doit aussi être chargé.
'
' Remarque : si vous incorporez MOUSE.BAS à votre
' programme, vous devez également utiliser VBDOS.LIB et
' VBDOS.QLB.
'
------------------------------------------------------------------------
DEFINT A-Z
' Inclut les fichiers contenant les déclarations relatives aux
procédures appelées.
'$INCLUDE: 'MOUSE.BI'
'$INCLUDE: 'VBDOS.BI'
CONST FALSE = 0
CONST TRUE = NOT FALSE
DEFINT A-Z
' Procédure MouseBorder.
'
' Fixe les limites verticales et horizontales de
' déplacement du pointeur de la souris.
'
' Paramètres :
' ligne1, ligne2 - limites verticales de début
' et fin.
' col1, col2 - limites horizontales de début
' et fin.
'
' Les coordonnées de ligne et colonne sont déterminées par
' le mode affichage et la largeur en cours (renvoyés par
' la procédure ScrSettings.)
'
STATIC SUB MouseBorder (row1, col1, row2, col2)
ScrSettings sMode, sWidth ' Obtient le mode affichage en cours
' pour déterminer les coordonnées.
SELECT CASE sMode
CASE 0 ' Coordonnées en mode texte
row1 = row1 - 1 * 8
col1 = col1 - 1 * 8
row2 = row2 - 1 * 8
col2 = col2 - 1 * 8
CASE 1, 7, 13 ' Coordonnées en mode graphique
col1 = col1 * 2
col2 = col2 * 2
CASE 2, 3, 4, 8, 9, 10, 11, 12
' Pas de correction nécessaire
END SELECT
MouseDriver 7, 0, col1, col2
MouseDriver 8, 0, row1, row2
END SUB
DEFINT A-Z
' Procédure MouseDriver.
'
' Fournit une interface en langage Basic pour les
' routines de souris de MOUSE.COM ou MOUSE.SYS.
'
' Paramètres :
' m0 - tâche de souris à effectuer :
' 0 - initialise les routines de souris.
' 1 - affiche le pointeur de la souris.
' 2 - cache le pointeur de la souris.
' 3 - obtient la position du pointeur et
' l'état des boutons.
' 7 - fixe les limites horizontales de
' déplacement de la souris.
' 8 - fixe les limites verticales de
' déplacement de la souris.
' m1, m2, - varient selon les tâches de souris.
' and m3 Voir les procédures MouseInit, MouseShow,
' MouseHide, MousePoll et MouseBorder
' pour les valeurs correctes.
'
' Le jeu d'outils Souris donne accès aux routines de souris
' précitées. Pour des informations sur les autres routines de
souris
' et les autres valeurs admissibles de m0, m1, m2 et m3, voir le
' "Microsoft Mouse Programmer's Guide" (Microsoft Press).
'
STATIC SUB MouseDriver (m0, m1, m2, m3)
DIM regs AS RegType
IF MouseChecked = FALSE THEN
DEF SEG = 0
MouseSegment& = 256& * PEEK(207) + PEEK(206)
MouseOffset& = 256& * PEEK(205) + PEEK(204)
DEF SEG = MouseSegment&
IF (MouseSegment& = 0 AND MouseOffset& = 0) OR PEEK(MouseOffset&)
= 207 THEN
MousePresent = FALSE
MouseChecked = TRUE
DEF SEG
END IF
END IF
IF MousePresent = FALSE AND MouseChecked = TRUE THEN
EXIT SUB
END IF
' Appelle l'interruption 51 pour invoquer les fonctions de
souris du gestionnaire de souris MS.
regs.ax = m0
regs.bx = m1
regs.cx = m2
regs.dx = m3
INTERRUPT 51, regs, regs
m0 = regs.ax
m1 = regs.bx
m2 = regs.cx
m3 = regs.dx
IF MouseChecked THEN EXIT SUB
' Vérifie que l'initialisation de la souris s'est bien
effectuée.
IF m0 AND NOT MouseChecked THEN
MousePresent = TRUE
DEF SEG
END IF
MouseChecked = TRUE
END SUB
DEFINT A-Z
' Procédure MouseHide.
'
' Cache le pointeur de la souris.
'
SUB MouseHide ()
MouseDriver 2, 0, 0, 0
END SUB
DEFINT A-Z
' Procédure MouseInit.
'
' Initialise le gestionnaire de souris.
'
SUB MouseInit ()
MouseDriver MousePresent%, 0, 0, 0
'IF MousePresent% = FALSE THEN
' Action = MSGBOX("Souris pas présente ou gestionnaire non
installé. Fin du programme ?", 4, "Erreur")
' IF Action = 6 THEN STOP
'END IF
END SUB
DEFINT A-Z
' Procédure MousePoll.
'
' Obtient la position du pointeur de la souris
' et l'état des boutons.
'
' Paramètres :
' ligne - coordonnée verticale du pointeur de la souris.
' col - coordonnée horizontale du pointeur de la souris.
' BoutonG - état du bouton gauche de la souris :
' 0 - non pressé.
' 1 - pressé.
' BoutonD - état du bouton droit de la souris :
' 0 - non pressé.
' 1 - pressé.
'
' Les plages valides de lignes et colonnes sont déterminées
' par le mode affichage et la largeur en cours renvoyés
' par la procédure ScrSettings.
'
STATIC SUB MousePoll (row, col, lButton, rButton)
MouseDriver 3, button, col, row
ScrSettings sMode, sWidth ' Obtient le mode affichage en cours
pour déterminer
'les coordonnées.
SELECT CASE sMode
CASE 0 ' Coordonnées en mode texte
row = row / 8 + 1
col = col / 8 + 1
CASE 1, 7, 13 ' Coordonnées en mode graphique
col = col / 2
CASE 2, 3, 4, 8, 9, 10, 11, 12
' Pas de correction nécessaire.
END SELECT
IF button AND 1 THEN
lButton = TRUE
ELSE
lButton = FALSE
END IF
IF button AND 2 THEN
rButton = TRUE
ELSE
rButton = FALSE
END IF
END SUB
DEFINT A-Z
' Affiche le pointeur de la souris.
SUB MouseShow ()
MouseDriver 1, 0, 0, 0
END SUB
DEFINT A-Z
' Procédure ScrSettings.
'
' Obtient le mode affichage Basic et la largeur en cours.
'
' Paramètres :
' sMode - mode affichage Basic en cours. Pour les valeurs
' de retour admissibles, voir l'instruction SCREEN.
' (0-13).
' sLargeur - largeur en cours de l'affichage (en
' caractères).
'
SUB ScrSettings (sMode AS INTEGER, sWidth AS INTEGER)
'
=======================================================================
' Obtient le mode affichage Basic et la largeur en cours.
'
=======================================================================
DIM regs AS RegType
regs.ax = &HF00
INTERRUPT &H10, regs, regs ' &H10 renvoie informations
' sur vidéo.
sWidth = (regs.ax AND &HFF00) \ 256 ' Octet fort de AX (AH).
sMode = regs.ax AND &HFF ' Octet faible de AX (AL).
SELECT CASE sMode ' Fait correspondre numéros
CASE 3 ' de mode vidéo MS-DOS et
sMode = 0 ' modes affichage Basic.
CASE 4
sMode = 1
CASE 6
sMode = 2
CASE 13
sMode = 7
CASE 14
sMode = 8
CASE 15
sMode = 10
CASE 16
sMode = 9
CASE 17
sMode = 11
CASE 18
sMode = 12
CASE 19
sMode = 13
CASE ELSE
sMode = 3
END SELECT
END SUB
DEFINT A-Z
' Procédure SetHigh.
'
' Etablit le mode affichage graphique donnant la plus haute
' résolution possible pour le matériel en cours.
'
SUB SetHigh ()
ON LOCAL ERROR RESUME NEXT
' Suit la liste des modes vidéo (12-0) jusqu'à
' en trouver un qui convienne.
FOR Mode = 12 TO 0 STEP -1
SCREEN Mode
IF ERR = 0 THEN EXIT SUB
NEXT Mode
END SUB
|
