Scroller, images dans un richtextbox

Commenter

Contenu du snippet

Voilà, on peut scroller (ici un) ou plusieurs richtextbox ensemble. Il peut être vachement optimisé !! Ce n' est qu' un exemple

Il faut:
Un richtextbox (richtextbox1)
Une boite de dialogue (commondialog1)
2 boutons (command1 et command2)
Un scrollbar (vscroll1)
Une picturebox (picture1)

Mettes tout ca dans le désordre, copiez le code en dessous et voilà !!!

Source / Exemple : 


Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Sub Command1_Click()
End
End Sub
Private Sub Command2_Click()
CommonDialog1.CancelError = True
On Error GoTo Fin
CommonDialog1.Filter = "Fichiers images bmp|*.bmp|Fichiers windows media files|*.wmf|Fichiers jpg|*.jpg|Tous les fichiers|*.*"
CommonDialog1.Flags = &H1000 + &H4 + &H800
CommonDialog1.ShowOpen
Picture1.Picture = LoadPicture(CommonDialog1.filename)
Clipboard.Clear
Clipboard.SetData Picture1.Picture
SendMessage RichTextBox1.hwnd, &H302, 0, 0
Fin:
End Sub
Private Sub Form_Load()
RichTextBox1.Height = 3495
RichTextBox1.Left = 120
RichTextBox1.Top = 120
RichTextBox1.Width = 3495
RichTextBox1.Text = ""
VScroll1.Height = 3495
VScroll1.Left = 3720
VScroll1.Top = 120
VScroll1.Width = 255
VScroll1.Min = 1
VScroll1.Max = 1
Me.Height = 4575
Me.Left = 0
Me.Top = 0
Me.Width = 4140
Me.Caption = "Exemple fait par Rodolf de vbfrance"
Command1.Height = 375
Command1.Left = 120
Command1.Top = 3720
Command1.Width = 1215
Command1.Cancel = True
Command1.Caption = "&Quitter"
Command2.Caption = "&Insérer une image"
Command2.Height = 375
Command2.Left = 1440
Command2.Top = 3720
Command2.Width = 1575
Picture1.Visible = False
MsgBox "Démonstration d' utilisation de scroll avec un richtextbox et l' insertion d' une image." & vbCrLf & "Cette exemple vous est fourni par rodolf dans le seul but d' améliorer vos connaissances en visual basic. Cet exemple est freeware, vous avez le droit de le distribuer à condition que cela soit gratuit et que vous ne changer pas le nom de l' auteur." & vbCrLf & "Merci de me tenir informer des améliorations que vous ferez et si vous l' utilisez dans vos programmes.", vbInformation, "Fait par Rodolf"
End Sub
Private Sub RichTextBox1_Change()
Dim Début As Integer
Dim Lignes As Integer
For Début = 1 To Len(RichTextBox1.Text)
    If Mid$(RichTextBox1.Text, Début, 2) = vbCrLf Then
        Lignes = Lignes + 1
    End If
Next Début
VScroll1.Max = Lignes + 1
End Sub
Private Sub VScroll1_Change()
Dim Début As Integer
Dim Ligne As Integer
Dim Atrouver As Integer
Atrouver = VScroll1
For Début = 1 To Len(RichTextBox1.Text)
    If Mid$(RichTextBox1.Text, Début, 1) = Chr$(13) Then
        Ligne = Ligne + 1
        If Ligne = Atrouver Then
            Exit For
        End If
    End If
Next Début
RichTextBox1.SetFocus
If Atrouver = 1 Then
    RichTextBox1.SelStart = 1
Else
    RichTextBox1.SelStart = Début
End If
RichTextBox1.SelLength = 1
End Sub

Conclusion :


Simple non ?
La le scrollbar c 1 ligne mais si la hauteur total est par ex de 17 lignes on peut facilement le modifier. (code très simple même sans commentaires)

A voir également

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 (cs_Rodolf)