Edition de page html (simple) crée en vb3

Soyez le premier à donner votre avis sur cette source.

Vue 3 097 fois - Téléchargée 264 fois

Télécharger le projet
Commenter

Description

-Ouvertue et Enregistrement de fichiers
-Drag & drop
-fonction pset()
-Ocx qui n'en est pas un (La palette de couleure)

Source / Exemple : 


Sub Check1_Click ()
If check1.Value = 1 Then
windowstate = 2 'Plein écran
Else
windowstate = 0 'normal
End If
End Sub

Sub codecoul_Click ()
codecoul.Tag = codecoul.Caption 'tag sert pour le drag & drop
codecoul.Drag (1) 'on commence le drag
End Sub

Sub Combo1_Click (index As Integer)
combo1(index).Tag = combo1(index).Text
combo1(index).Drag (1)
End Sub

Sub Command1_Click ()
combo1(1).AddItem combo1(1).Text 
End Sub

Sub Command2_Click ()
combo1(1).Clear
End Sub

Sub coul_Scroll (index As Integer)
extrait.BackColor = RGB(coul(0).Value, coul(1).Value, coul(2).Value) 'vous connaissez ?
codecoul.Caption = Hex$(extrait.BackColor) 'ça aussi
End Sub

Sub Dir1_Change ()
file1.Path = dir1.Path ' c'est clair ?
End Sub

Sub Drive1_Change ()
dir1.Path = drive1.Drive ' ça aussi !
End Sub

Sub Exporter_Click ()
FileName$ = InputBox("Entrez le nom du fichier à creer : ", "nom du fichier")
Open file1.Path + "\" + FileName$ For Output As #1 'ouverture pour l'écriture
Print #1, text1.Text
Close #1
End Sub

Sub Form_Resize () 'pour que tou se mette bien !
text1.Width = Form1.ScaleWidth - 2 * text1.Left
tabs.Width = Form1.ScaleWidth - 2 * tabs.Left
text1.Height = Form1.ScaleHeight - text1.Top - text1.Left
label1(0).Enabled = True 'ya un bug alors j'ai rajouté ces 3 lignes (donc plus de bug !!)
label1(1).Enabled = True
label1(2).Enabled = True
End Sub

Sub HScroll1_Scroll ()
text1.FontSize = hscroll1.Value ' ne dittent pas que vous ne savez pas !
End Sub

Sub importer_Click ()
On Error GoTo erreure 'prévien les erreures
text1 = ""
Open file1.Path + "\" + file1.FileName For Input As #1 'ouverture pour écriture
Do Until EOF(1) 'sortir si on attein la fin du fichier
Input #1, b$
text1 = text1 + b$
b$ = ""
Loop
Close #1
exitsub:
Exit Sub
erreure:
MsgBox "Veuillez indiquer un fichier à importer", 48
Resume exitsub
End Sub

Sub Label1_Click (index As Integer)
label1(index).Drag (1) ' déjà di !
End Sub

Sub List1_Click (index As Integer)
list1(index).Tag = list1(index).Text ' le tag est utilisé car c'est le point commun entre tous les objets
list1(index).Drag (1)
End Sub

Sub Picture1_MouseUp (button As Integer, Shift As Integer, X As Single, Y As Single)
If button = 1 Then
text1.ForeColor = picture1.Point(X, Y) ' faites un effort
Else
text1.BackColor = picture1.Point(X, Y)
End If
picture2.BackColor = text1.ForeColor
picture3.BackColor = text1.BackColor
End Sub

Sub tabs_TabActivate (TabToActivate As Integer)
If TabToActivate = 5 Then
If MsgBox("Attention vous êtes prêt à quiter l'application" + Chr(13) + "Voulez vous quiter ?", 36, "Attention") = 6 Then
End
End If
End If
End Sub

Sub Text1_DragDrop (Source As Control, X As Single, Y As Single)
text1.SelText = Source.Tag
End Sub

Conclusion :


Voilà, le code est mis !
Mais je vous conseil vivement de télécharger le ZIP
En effet, vous serrez plus à votre aise et vous comprendrez mieux.
Vous remarquerez que le code est très peux commenté mais je ne vai pas commenter pour rien !!!
Bonne prog :-)
Télécharger le projet

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

Signaler
devsurf
Messages postés
148
Date d'inscription
dimanche 13 octobre 2002
Statut
Membre
Dernière intervention
13 novembre 2008
bonne intention , mais ou est le code?
Signaler
krissssss
Messages postés
88
Date d'inscription
jeudi 26 décembre 2002
Statut
Membre
Dernière intervention
2 janvier 2007
voilà il est là !
S'inscrire maintenant

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.

Du même auteur (krissssss)