DLL pour Visual Basic 4 ( version 16 bits ) et Visual Basic 3
Cette librairie dynamique ( DLL ) va vous permettre de pouvoir piloter votre port // à l 'aide d 'instructions contenues dans la DLL.
Vous devez déclarer dans un module cette librairie avec la syntaxe suivante :
Declare Function INP Lib "INOUT.DLL" (ByVal address&) As Integer
Declare Sub out Lib "INOUT.DLL" (ByVal address&, ByVal value%)
Utilisation :
En sortie :
out 378,255 'met tous les bits du port // à 1
En entrée :
a%=inp(379) 'lit l 'état des lignes du port //
DLL 32 bits pour Visual Basic 5 et Visual Basic 6
Cette librairie dynamique ( DLL ) va vous permettre de pouvoir piloter votre port // et les broches du port série à l 'aide d 'instructions contenues dans la DLL.
Avec VB vous devez déclarer dans un module cette librairie avec la syntaxe suivante :
Declare Sub SORTIE Lib "SORTIE3.DLL" (ByVal d As Byte, ByVal a%)
Declare Function ENTREE Lib "SORTIE3.DLL" (ByVal adresse%) As Integer
Declare Function CTS Lib "SORTIE3.DLL" (ByVal adresse%) As Byte
Declare Function DSR Lib "SORTIE3.DLL" (ByVal adresse%) As Byte
Declare Function RI Lib "SORTIE3.DLL" (ByVal adresse%) As Byte
Declare Function DCD Lib "SORTIE3.DLL" (ByVal adresse%) As Byte
Si vous utilisez DELPHI :
Déclarations de la DLL au niveau de DELPHI III :
procedure SORTIE(donnee: byte ;adressse:word);stdcall;external 'sortie3.dll' ;
function ENTREE(adresse:word):byte;stdcall;external 'sortie3.dll' ;
function CTS(adresse:word):byte;stdcall;external 'sortie3.dll' ;
function DSR(adresse:word):byte;stdcall;external 'sortie3.dll' ;
function RI(adresse:word):byte; stdcall;external 'sortie3.dll' ;
function DCD(adresse:word):byte; stdcall;external 'sortie3.dll' ;
Utilisation sous VB :
En sortie :
Private Sub Command1_Click()
z% = InputBox("Valeur à envoyer", 0)
SORTIE z%, 888 '888 correspond à l'adresse sur laquelle on envoie les données ici c'est lpt1
End Sub
En entrée :
Private Sub Command2_Click()
z% = InputBox("Adresse à scruter", 0)
r = ENTREE(z%)
Label1.Caption = Hex(r)
End Sub
exemple sous DELPHI3
procedure TForm1.Button1Click(Sender: TObject);
begin
SORTIE(255,888);
end;
Pilotage des lignes du port série (attention sous VB il faut ouvrir le port série avec la fonction MSComm) :
Etat du bit CTS :
Private Sub Command3_Click()
if MSComm1.PortOpen = False then
MSComm1.PortOpen = True
end if
r =CTS(766)
Label1.Caption = r
End Sub
· - DSR : idem que la fonction CTS mais pour la broche DSR du port com spécifié
· - RI : idem que la fonction CTS mais pour la broche RI du port com spécifié
· - DCD : idem que la fonction CTS mais pour la broche DCD du port com spécifié
**************************************************************************************************
Quelques astuces en VB ..( si vous avez des propositions ou des questions contactez moi ).
* Choix d'une Couleur
* Opération sur une Date
* lecture et écriture dans un Fichier
* Inputbox
* Changement de la Police de caractère
* Touches de fonction
* Création de nouveaux objets dans un projet en cours d'éxécution
****************** Choix d'une couleur pour un objet Couleur *********************************************
'exemple
dialogue1.Flags = &H3&
dialogue1.Action = 3
Picture1.BackColor = dialogue1.Color
**************************************** format de la Date ***************************************************
label6.Caption = Format$(Now, "dd-mm-yy")
**************************************** test sur une Date ***************************************************
If DateValue(Date) > DateValue("17/09/2007") Then
MsgBox "Erreur : 50 " & Chr$(13) & Chr$(10) & "Date dépassée!!!", 64, "Message"
End If
********************************* fichier ******************************************************
' - Déclaration dans *.bas
' WritePrivateProfileString
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
Declare Function GetPrivateProfileint Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Integer, ByVal lpFileName As String) As Integer
Declare Function GetprivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
Declare Function GetProfileString Lib "Kernel" (ByVal a As String, ByVal b As Any, ByVal c As Any, ByVal d As String, ByVal e As Integer) As Integer
' - Ecriture dans un fichier type "ini"
-----------------------------------
dialogue1.Filename = "essai.ini"
dialogue1.Flags = &H2006&
dialogue1.Action = 2
fiche$ = dialogue1.Filename
ecr% = WritePrivateProfileString("police", "valeur", FontName, fiche$)
' - Lecture dans un fichier type "ini"
----------------------------------
Const cbuffersize = 100
ReDim cbuffer(1) As String * 50
fiche$ = app.path & "\essai.ini"
enr% = GetprivateProfileString("police", "valeur", "", cbuffer(1), 25, fiche$)
a$ = cbuffer(1)
FontName = a$
' - Ouverture d'un fichier
----------------------
dialogue1.CancelError = 1
dialogue1.Filename = "*.txt"
dialogue1.Flags = &H2006&
dialogue1.Action = 1
fiche2$ = dialogue1.Filename
Open fiche2$ For Binary As #1
Text2.Text = Input$(LOF(1), #1)
Close #1
' - Sauvegarde d'un fichier
----------------------
dialogue1.Filename = "texte1.txt"
dialogue1.Flags = &H2006&
dialogue1.Action = 2
If cancel Then GoTo fin3_1
On Error GoTo fin3_1
If dialogue1.Filename = "" Then GoTo fin3_1
fiche$ = dialogue1.Filename
Open fiche$ For Output As #1
Print #1, Text2.Text;
Close #1
*********************************** Inputbox ****************************************************
defaut = 1
b = InputBox("Multiplication du coeff analogique", "Changement de coeff ", defaut)
If b = cancel Then Exit Sub
coeff_analog = b * 1.8
*********************************** Polices *****************************************************
dialogue1.FontName = FontName
dialogue1.FontSize = FontSize
dialogue1.Flags = &H3&
dialogue1.Action = 4
If dialogue1.FontName = "" Then Exit Sub
text1.FontName = dialogue1.FontName
text1.FontSize = dialogue1.FontSize
*********************************** Touches de fonction *******************************************
'touches de fonction
Global Const KEY_F1 = &H70
Global Const KEY_RETURN = &HD
******************************** Création de nouveaux objets **************************************
' avant de pouvoir créer un nouvel objet il est obligatoire de faire une copie (copier coller) de l'objet
' à reproduire et cela en utilisant les index (vb le propose lors de la copie d'un objet). Ci dessous un
' exemple pour obtenir 10 bouton de commande en mode dynamique (les boutons sont créés dans
' l'éxécutable).
Private Sub cmdAdd_Click()
If MaxId > 10 Then Exit Sub ' Seuls 10 boutons sont autorisés.
MaxId = MaxId + 1 ' Incrémente le compteur de bouton.
Load Command1(MaxId) ' Créer un bouton.
Command1(MaxId).Top = Command1(MaxId - 1).Top + 400 ' positionne le nouveau bouton
Command1(MaxId).Visible = True ' Affiche le nouveau bouton.
Command1(MaxId).Caption = "Commande" & MaxId + 1 ' caption du nouveau bouton
End Sub
******************************************************************************************