Snake bloc-notes
Description
Un bloc-notes un peu mieux que celui de windows (note pad). La command d'impression n'a pas été tester donc si sa marche pas veuillez me le signaler: dedlza@hotmail.com. Pour coder faites nouveau EXE Standard, 2 form (une aide lautre fenetre principale. Pour l'aide je vous laisse faire se que vous voulez.
Mise a jours du code:
-Vérification qu'on a pas clicker sur annuler
-Plus de slider mais des combo
-Correction de quelques bugs
-Plus besoin de microsoft scripting runtime (ouf!=))
-Code simple et opensource
-Je vous ai fait une capture d'écran pour ne pas etre obliger de télécharger le zip=)
-Ajout des polices d'écriture
Source / Exemple :
Option Explicit
Private Sub Combo1_click()
If Combo1.Text = "Noir" Then
Text1.ForeColor = &H80000008
End If
If Combo1.Text = "Bleu" Then
Text1.ForeColor = &HFF0000
End If
If Combo1.Text = "Vert" Then
Text1.ForeColor = &HC000&
End If
If Combo1.Text = "Rouge" Then
Text1.ForeColor = &HFF&
End If
End Sub
Private Sub Combo3_Click()
If Combo3.Text = "10" Then
Text1.FontSize = 10
End If
If Combo3.Text = "12" Then
Text1.FontSize = 12
End If
If Combo3.Text = "14" Then
Text1.FontSize = 14
End If
If Combo3.Text = "8" Then
Text1.FontSize = 8
End If
End Sub
Private Sub Combo4_Click()
If Combo4.Text = "Time new roman" Then
Text1.Font = "Time new roman"
End If
If Combo4.Text = "Verdana" Then
Text1.Font = "Verdana"
End If
If Combo4.Text = "Tahoma" Then
Text1.Font = "Tahoma"
End If
If Combo4.Text = "Arial" Then
Text1.Font = "Arial"
End If
If Combo4.Text = "MS sans serif" Then
Text1.Font = "MS sans serif"
End If
If Combo4.Text = "System" Then
Text1.Font = "System"
End If
If Combo4.Text = "Trebuchet MS" Then
Text1.Font = "Trebuchet MS"
End If
If Combo4.Text = "MS Serif" Then
Text1.Font = "MS Serif"
End If
If Combo4.Text = "Lucida Console" Then
Text1.Font = "Lucida Console"
End If
End Sub
Private Sub Combo5_click()
If Combo5.Text = "Droite" Then
Text1.Alignment = 1
End If
If Combo5.Text = "Gauche" Then
Text1.Alignment = 0
End If
If Combo5.Text = "Centrer" Then
Text1.Alignment = 2
End If
End Sub
Private Sub Command1_Click() 'Pour ouvrir
CD.ShowOpen
Dim str As String, tmp As String
Open CD.FileName For Input As #1
While Not EOF(1)
Line Input #1, tmp
str = str + tmp + Chr$(13) + Chr$(10)
Text1.Text = str
Wend
Close (1)
End Sub
Private Sub command2_Click() 'Pour enregistrer
dlg.ShowSave
If dlg.FileName <> "" Then
If FileExist(dlg.FileName) = True Then Kill (dlg.FileName) 'si le fichier existe on le supprime
Open dlg.FileName For Append As #1 'on enregistre se qui est écrit dans text1.text
Print #1, Text1.Text
Close #1
Else
MsgBox "Impossible d'enregistrer" 'Erreure (on a clicker sur annuler)
End If
End Sub
Private Sub Command3_Click() 'Quitter
End
End Sub
Private Sub Command4_Click() 'Nouveau
Text1.Text = ""
End Sub
Private Sub Command5_Click() 'Aide
Form2.Show
End Sub
Private Sub Command6_Click() 'A propos...
MsgBox "Snake_Bloc-notes. Créer par snake (Damien et Thomas) pour windows. Copyright 2004", vbInformation, "A propos..."
End Sub
Private Sub Command7_Click() 'imprimer
Printer.CurrentX = 2
Printer.CurrentY = 2
Printer.FontSize = 12
Printer.Print Text1.Text; ""
Printer.EndDoc
End Sub
Private Sub combo2_Click()
If Combo2.Text = "Rouge" Then
Text1.BackColor = &HFF&
End If
If Combo2.Text = "Vert" Then
Text1.BackColor = &HC000&
End If
If Combo2.Text = "Bleu" Then
Text1.BackColor = &HFF0000
End If
If Combo2.Text = "Blanc" Then
Text1.BackColor = &HFFFFFF
End If
End Sub
Private Sub Form_Load()
Label5.FontSize = 14
Label5.FontBold = True
Label6.FontSize = 14
Label6.FontItalic = True
Label7.FontSize = 14
Label7.FontUnderline = True
End Sub
Private Sub Label5_Click()
Text1.FontBold = True
Text1.FontItalic = False
Text1.FontUnderline = False
End Sub
Private Sub Label6_Click()
Text1.FontBold = False
Text1.FontItalic = True
Text1.FontUnderline = False
End Sub
Private Sub Label7_Click()
Text1.FontBold = False
Text1.FontItalic = False
Text1.FontUnderline = True
End Sub
Private Sub Label8_Click()
Text1.FontBold = False
Text1.FontItalic = False
Text1.FontUnderline = False
End Sub
Public Function FileExist(Dir1) As Boolean
On Error GoTo Erreur
If FileLen(Dir1) <> vbNull Then
FileExist = True
End If
Exit Function
Erreur:
End Function
Conclusion :
Mise a jours du code:
-Vérification qu'on a pas clicker sur annuler
-Plus de slider mais des combo
-Correction de quelques bugs
-Plus besoin de microsoft scripting runtime (ouf!=))
-Code simple et opensource
-Je vous ai fait une capture d'écran pour ne pas etre obliger de télécharger le zip=)
-Ajout des polices d'écriture
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.