Votre prog vb dans une belle console classique (très simple)
Soyez le premier à donner votre avis sur cette source.
Vue 7 206 fois - Téléchargée 510 fois
Description
Bon. C'est simple. Ça permet de faire afficher votre prog dans une console (comme avec MS DOS) EN VB6!!!. On peut lire, écrite, changer la couleur du texte, du titre, changer la couleur d'arrière plan du texte et ce, simplement. Cela utilise les APIS. Pour utliser cet exemple, créer un projet EXE standard, créer un module (supprimer le form), mettez "Sub Main" comme objet de démarrage et mettez ce code dans le module.
Dites-moi si vous avez des suggestions. Je pense que je vais en créer une classe.
Source / Exemple :
Option Explicit
'Les apis
Private Declare Function AllocConsole _
Lib "kernel32" () _
As Long
Private Declare Function FreeConsole _
Lib "kernel32" () _
As Long
Private Declare Function GetStdHandle _
Lib "kernel32" ( _
ByVal nStdHandle As Long) _
As Long
Private Declare Function ReadConsole _
Lib "kernel32" Alias "ReadConsoleA" ( _
ByVal hConsoleInput As Long, _
ByVal lpBuffer As String, _
ByVal nNumberOfCharsToRead As Long, _
lpNumberOfCharsRead As Long, _
lpReserved As Any) _
As Long
Private Declare Function SetConsoleMode _
Lib "kernel32" ( _
ByVal hConsoleOutput As Long, _
dwMode As Long) _
As Long
Private Declare Function SetConsoleTextAttribute _
Lib "kernel32" ( _
ByVal hConsoleOutput As Long, _
ByVal wAttributes As Long) _
As Long
Private Declare Function SetConsoleTitle _
Lib "kernel32" Alias "SetConsoleTitleA" ( _
ByVal lpConsoleTitle As String) _
As Long
Private Declare Function WriteConsole _
Lib "kernel32" Alias "WriteConsoleA" ( _
ByVal hConsoleOutput As Long, _
ByVal lpBuffer As Any, _
ByVal nNumberOfCharsToWrite As Long, _
lpNumberOfCharsWritten As Long, _
lpReserved As Any) _
As Long
'\'API pour attendre
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
'\'Types de handle qu'on peut avoir pour la console
Private Const STD_INPUT_HANDLE = -10&
Private Const STD_OUTPUT_HANDLE = -11&
Private Const STD_ERROR_HANDLE = -12&
'\
'Couleurs possibles pour SetConsoleTextAttribute
Private Const FOREGROUND_BLUE = &H1
Private Const FOREGROUND_GREEN = &H2
Private Const FOREGROUND_RED = &H4
Private Const FOREGROUND_INTENSITY = &H8
Private Const BACKGROUND_BLUE = &H10
Private Const BACKGROUND_GREEN = &H20
Private Const BACKGROUND_RED = &H40
Private Const BACKGROUND_INTENSITY = &H80
'\
'Options pour SetConsoleMode (input)
Private Const ENABLE_LINE_INPUT = &H2
Private Const ENABLE_ECHO_INPUT = &H4
Private Const ENABLE_MOUSE_INPUT = &H10
Private Const ENABLE_PROCESSED_INPUT = &H1
Private Const ENABLE_WINDOW_INPUT = &H8
'\
'Options pour SetConsoleMode (output)
Private Const ENABLE_PROCESSED_OUTPUT = &H1
Private Const ENABLE_WRAP_AT_EOL_OUTPUT = &H2
'\'Variables Globales
Private hIn As Long ' Input
Private hOut As Long ' Output
'\
Public Sub EcrireConsole(Str As String) 'Pour écrire sans ce casser la tête
WriteConsole hOut, Str, Len(Str), vbNull, vbNull
End Sub
Public Function LireConsole() 'Pour lire simplement
Dim Str As String * 256
ReadConsole hIn, Str, Len(Str), 0, vbNullString
LireConsole = Left$(Str, InStr(Str, Chr$(0)) - 1)
End Function
Private Sub main()
On Error Resume Next
Dim Buffer As String
AllocConsole 'Créer la console
SetConsoleTitle "Je suis un programme dans une console!!!!" 'Placer le titre
'Obtenir le handle pour LIRE et ÉCRIRE sur la console
hIn = GetStdHandle(STD_INPUT_HANDLE)
hOut = GetStdHandle(STD_OUTPUT_HANDLE)
'\
'Placer des options pour le texte
SetConsoleTextAttribute hOut, FOREGROUND_GREEN
'\
'Comment écrire du texte ... (on peut en changer les couleurs comme on veut) (C'est l'en-tête pour présenter le programme)
EcrireConsole String$(50, "*") & vbCrLf & "Lanceur de fichiers en console Version 1.0" & vbCrLf & "Par DeadlyPredator" & vbCrLf & String$(50, "*") & vbCrLf
SetConsoleTextAttribute hOut, FOREGROUND_RED
EcrireConsole "Inscivez Bye et appuyez sur Enter pour quitter" & vbCrLf
SetConsoleTextAttribute hOut, FOREGROUND_RED + FOREGROUND_GREEN + FOREGROUND_INTENSITY
EcrireConsole ">"
'\
'Traitement des données
Do 'Bon, là c simple. C'est une boucle sans fin (on doit l'intérompre avec Exit Do) qui permet d'obtenir du texte écrit
Do 'Attendre le Enter
Buffer = LireConsole 'Il faut lire la ligne
If InStr(1, Buffer, Chr(13) + Chr(10)) <> 0 Then Exit Do 'SI C'EST L'UTILISATEUR À APPUYÉ ENTER, SORTIR DE CETTE BOUCLE
Sleep 500 'Pour ne pas surcharger le CPU
DoEvents '...
Loop '\
Buffer = Replace(Buffer, Chr(13) + Chr(10), "") 'Dans mon cas, enlever le CRLF à la fin de la ligne
'Rendu ici, vous traitez le message :)
If LCase$(Buffer) = "?bye" Then Exit Do 'Bon, si c'est marqué ?bye on sort
Shell Buffer
If Err.Number <> 0 Then 'ERREUR AVEC LE PROGRAMME!!
SetConsoleTextAttribute hOut, FOREGROUND_RED 'Rouge
EcrireConsole "Erreur! Impossible d'ouvrir le fichier """ & Buffer & """" & vbCrLf 'Description
SetConsoleTextAttribute hOut, FOREGROUND_RED + FOREGROUND_GREEN + FOREGROUND_INTENSITY 'On remet la couleur jaune
End If '\
'On remet le petit signe >
EcrireConsole ">"
'\
DoEvents
Loop
'\FreeConsole 'Libérer la console
End Sub
Conclusion :
Dites-moi si vous avez des suggestions. Je pense que je vais en créer une classe.
Merci de réponses...
JM
- Messages postés
-
516
- Date d'inscription
- samedi 3 février 2001
- Statut
- Modérateur
- Dernière intervention
- 24 octobre 2006
1W@rning
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.