Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0305: ToolBar-Demo

VB 5/6-Tipp 0305: ToolBar-Demo

 von Daniel Noll

Schwierigkeitsgrad:

Verwendete API-Aufrufe: SendMessageA (SendMessage)

Download: Download des Beispielprojektes [4,47 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
' Die Komponente 'Microsoft Windows Common Controls 6.0 (SP6) (MSCOMCTL.OCX)' wird benötigt.
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (COMDLG32.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Standarddialog-Steuerelement "DLG1"
' Steuerelement: Textfeld "Text1"
' Steuerelement: Bilderlistenelement "ImageList1"
' Steuerelement: Toolbar "Toolbar1"
' Steuerelement: Menü "mnudatei"
' Steuerelement: Menü "mnuNeu" auf mnudatei
' Steuerelement: Menü "mnuladen" auf mnudatei
' Steuerelement: Menü "mnuspeichern" auf mnudatei
' Steuerelement: Menü "mnuline1" auf mnudatei
' Steuerelement: Menü "mnuEnde" auf mnudatei
' Steuerelement: Menü "mnubearbeiten"
' Steuerelement: Menü "mnuback" auf mnubearbeiten
' Steuerelement: Menü "mnuline2" auf mnubearbeiten
' Steuerelement: Menü "mnucut" auf mnubearbeiten
' Steuerelement: Menü "mnucopy" auf mnubearbeiten
' Steuerelement: Menü "mnupaste" auf mnubearbeiten

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 Const WM_UNDO = &H304

Private DorT As Integer

Private Sub Form_Load()
  DorT = 1
End Sub

Private Sub Form_Resize()
  Text1.Move 10, 450, Me.Width - 200, Me.Height - 1250
End Sub

Private Sub mnuback_Click()
  Call SendMessage(Text1.hwnd, WM_UNDO, 0&, 0)
End Sub

Private Sub mnucopy_Click()
  Clipboard.SetText Text1.SelText
End Sub

Private Sub mnucut_Click()
  Clipboard.SetText Text1.SelText
  Text1.SelText = ""
End Sub

Private Sub mnuEnde_Click()
  Unload Me
End Sub

Private Sub mnuladen_Click()
  Dim temp As String
  On Error Goto error_load
  
    With DLG1
      .Filter = "Text-Dateien (*.txt)|*.txt|Alles (*.*)|*.*"
      .ShowOpen
      Open .filename For Input As #1
      
        Do Until EOF(1)
          Line Input #1, temp
          Text1.Text = Text1.Text & temp
          DoEvents
        Loop
      Close #1
      
      Me.Caption = "Editor         [" & .filename & "]"
    End With
    Exit Sub

error_load:

End Sub

Private Sub mnuNeu_Click()
  Text1.Text = ""
  Me.Caption = "Editor"
End Sub

Private Sub mnupaste_Click()
  Text1.SelText = Clipboard.GetText
End Sub

Private Sub mnuspeichern_Click()
  Dim temp As String
  On Error Goto error_save
  
    With DLG1
      .Filter = "Text-Dateien (*.txt)|*.txt"
      .ShowSave
      
      Open .filename For Output As #1
        Print #1, Text1.Text
      Close #1
      Me.Caption = "Editor         [" & .filename & "]"
    End With
    Exit Sub
    
error_save:

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As _
                                 MSComctlLib.Button)
  Select Case Button.Key 'Welcher Button wurde gedrückt?
                         'Man kann den Button auch am Tolltip ...
                         'erkennen
                         
    Case "new":   Text1.Text = ""
                  Me.Caption = "Editor"
                  
    Case "open":  Call mnuladen_Click
    
    Case "save":  Call mnuspeichern_Click
    
    Case "cut":   Clipboard.SetText Text1.SelText
                  Text1.SelText = ""
                  
    Case "copy":  Clipboard.SetText Text1.SelText
    
    Case "paste": Text1.SelText = Clipboard.GetText
    
    Case "dt"
                  If DorT = 1 Then
                    Text1.SelText = Date
                  ElseIf DorT = 2 Then
                    Text1.SelText = Time
                  End If
   End Select
End Sub

Private Sub Toolbar1_ButtonMenuClick(ByVal ButtonMenu As _
                                     MSComctlLib.ButtonMenu)
  Select Case ButtonMenu.Key 'Welcher Button in einen
                             'ButtonMenu wurde gedrückt
                             
    Case "date": Text1.SelText = Date
                 DorT = 1
                 
    Case "time": Text1.SelText = Time
                 DorT = 2
  End Select
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 3 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.