Archiv nach Kategorien: VB6

Ein einfacher Logger

Veröffentlicht von am 21. Februar 2012 Keine Kommentare

Ein einfacher Logger, dem man den zu loggenden String übergibt. Alles andere macht er selbst (Datum, Uhrzeit anhängen).
Alternativ kann dem Logger auch der Dateiname übergeben werden, in welche Datei er das loggen soll.

' Ein Verweis auf "Microsoft Scripting Runtime" muss gesetzt werden!

Private Sub Log2(ByVal iMeldung As String, Optional ByVal iDateiname As String = "log.log")
Dim FSO As FileSystemObject
Dim TS As TextStream
 
Set FSO = New FileSystemObject
If Not FSO.FileExists(iDateiname) Then FSO.CreateTextFile iDateiname, False
Set TS = FSO.OpenTextFile(iDateiname, ForAppending)
TS.WriteLine CStr(Now) & ": " & iMeldung
TS.Close
Set FSO = Nothing
 
End Sub
' Ein Verweis auf "Microsoft Scripting Runtime" muss gesetzt werden!

Private Sub Log2(ByVal iMeldung As String, Optional ByVal iDateiname As String = "log.log")
Dim FSO As FileSystemObject
Dim TS As TextStream

Set FSO = New FileSystemObject
If Not FSO.FileExists(iDateiname) Then FSO.CreateTextFile iDateiname, False
Set TS = FSO.OpenTextFile(iDateiname, ForAppending)
TS.WriteLine CStr(Now) & ": " & iMeldung
TS.Close
Set FSO = Nothing

End Sub

 

Formel in VB 6 evaluieren

Veröffentlicht von am 12. Februar 2012 Keine Kommentare

Manchmal kommt man in die Not, einen frei eingebbaren mathematischen Ausdruck auswerten zu müssen.
Besonders bei der berühmten Taschenrechner-Applikation, die jeder einmal irgendwann in seinem Leben schreiben muss, lohnt es nicht, einen eigenen Parser dafür zu schreiben.
Visual Basic bietet eine einfache Möglichkeit, das zu bewerkstelligen. Das “Script Control” erledigt alles.
Hier ein Taschenrechner in seiner simpelsten Form:

Public Function Eval(ByVal iFormel As String) As Double
Dim sc As ScriptControl
 
On Error GoTo MyFehler
 
Set sc = New ScriptControl
sc.Language = "vbscript"
Eval = sc.Eval(iFormel)
Exit Function
 
MyFehler:
MsgBox "Formel '" & iFormel & "' kann nicht evaluiert werden!" & vbCrLf & "Fehler: " & Err.Description
Exit Function
 
End Function
Public Function Eval(ByVal iFormel As String) As Double
Dim sc As ScriptControl

On Error GoTo MyFehler

Set sc = New ScriptControl
sc.Language = "vbscript"
Eval = sc.Eval(iFormel)
Exit Function

MyFehler:
MsgBox "Formel '" & iFormel & "' kann nicht evaluiert werden!" & vbCrLf & "Fehler: " & Err.Description
Exit Function

End Function

Der Aufruf ist ebenso simpel:

Ergebnis = Eval(3*4+20/5) ' Ergebnis = 16
Ergebnis = Eval(3*4+20/5) ' Ergebnis = 16

Wie man erkennen kann, werden selbstverständlich mathematische Rechenregeln beachtet.

Wichtig: Unter Verweise muss im zugrundeliegenden Visual Basic Projekt ein Verweis auf “Microsoft Script Control x.x” gesetzt werden!

Natürlich steht es jedem frei, auch einen umfangreichen Parser zu schreiben, der den Ausdruck zerlegt und dann auswertet. Aber die oben gezeigte Möglichkeit finde ich wesentlich effektiver.

Zahlen ins 35er System wandeln

Veröffentlicht von am 10. Februar 2012 Keine Kommentare

Recht sinnfrei, aber wer’s mal haben möchte: Zahlen wandeln in ein beliebiges Zahlensystem unter VB6.
Naja, beliebig ist relativ. Die hier aufgeführte Version macht’s bis zum 35er-System (und bedient sich dabei der restlichen Buchstaben bis “Z” nach dem 16er-System mit “F”).

Private Function lfWandler(ByVal iZahl As Long, ByVal iBasis As Long) As String
Dim lvZahlen As String
Dim lvErgebnis As String
Dim lvRest As Long
 
If iZahl = 0 Then lfWandler = "0": Exit Function
If iBasis = 1 Then lfWandler = iZahl: Exit Function
 
lvZahlen = "0123456789ABCDEFGHIJKLMNOPQRSTUVXYZ"
 
lvRest = iZahl
While Not (lvRest = 0)
lvErgebnis = Mid(lvZahlen, lvRest Mod iBasis + 1, 1) & lvErgebnis
lvRest = iZahl \ iBasis
iZahl = lvRest
Wend
 
lfWandler = lvErgebnis
 
End Function
Private Function lfWandler(ByVal iZahl As Long, ByVal iBasis As Long) As String
Dim lvZahlen As String
Dim lvErgebnis As String
Dim lvRest As Long

If iZahl = 0 Then lfWandler = "0": Exit Function
If iBasis = 1 Then lfWandler = iZahl: Exit Function

lvZahlen = "0123456789ABCDEFGHIJKLMNOPQRSTUVXYZ"

lvRest = iZahl
While Not (lvRest = 0)
lvErgebnis = Mid(lvZahlen, lvRest Mod iBasis + 1, 1) & lvErgebnis
lvRest = iZahl \ iBasis
iZahl = lvRest
Wend

lfWandler = lvErgebnis

End Function

Ich glaube, das war eine der ersten Routinen, die ich je geschrieben habe. Damals noch im BASIC des VC-20 :)

Natürlich kann man den lvZahlen-String noch beliebig erweitern. Wenigstens solange man unterschiedliche ASCII-Zeichen zur Vverfügung hat…
Eine tolle Erweiterung wäre die Bearbeitung von negativen Zahlen und “krummen” Basen. Viel Erfolg :)

Listview unter VB6

Veröffentlicht von am 19. Januar 2012 Keine Kommentare

Weil ich immer wieder gerne vergesse, wie es mit diesem Listview unter VB6 funktioniert…
Hier eine kleine Demo, die ein Listview aufbaut. Durch Klick auf einen Spaltenkopf wird nach der Spalte sortiert.
Das war schon alles.

' Im Projekt müssen die "Microsoft Windows Common Controls 6.0" hinzugefügt werden.
' Es muss Version 6 sein! Version 5 erkennt "MSComctlLib.ColumnHeader" nicht.

' Ein ListView1 muss der Form hinzugefügt werden.

Private Sub Form_Load()
Dim lvI As Long
Dim lvListitem As ListItem
 
ListView1.View = lvwReport
ListView1.HideColumnHeaders = False
ListView1.ColumnHeaders.Add , "E1", "Sp1"
ListView1.ColumnHeaders.Add , "E2", "Test"
ListView1.ColumnHeaders.Add , "E3", "Drei"
 
For lvI = 1 To 10
Set lvListitem = ListView1.ListItems.Add(, "E" & lvI, lvI)
lvListitem.SubItems(1) = CStr(Int(Rnd * 100))
lvListitem.SubItems(2) = "Test"
Next lvI
 
End Sub
' Im Projekt müssen die "Microsoft Windows Common Controls 6.0" hinzugefügt werden.
' Es muss Version 6 sein! Version 5 erkennt "MSComctlLib.ColumnHeader" nicht.

' Ein ListView1 muss der Form hinzugefügt werden.

Private Sub Form_Load()
Dim lvI As Long
Dim lvListitem As ListItem

ListView1.View = lvwReport
ListView1.HideColumnHeaders = False
ListView1.ColumnHeaders.Add , "E1", "Sp1"
ListView1.ColumnHeaders.Add , "E2", "Test"
ListView1.ColumnHeaders.Add , "E3", "Drei"

For lvI = 1 To 10
Set lvListitem = ListView1.ListItems.Add(, "E" & lvI, lvI)
lvListitem.SubItems(1) = CStr(Int(Rnd * 100))
lvListitem.SubItems(2) = "Test"
Next lvI

End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
 
ListView1.SortKey = ColumnHeader.SubItemIndex
ListView1.Sorted = True
 
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)

ListView1.SortKey = ColumnHeader.SubItemIndex
ListView1.Sorted = True

End Sub

Schalt ja oder nein?

Veröffentlicht von am 15. Januar 2012 Keine Kommentare

(Kleiner Kalauer…)

Um herauszufinden, ob ein Jahr ein Schaltjahr ist, genügt es, vom 1. März des Jahres einen Tag abzuziehen. Wenn das Ergebnis “29″ ist, ist das Jahr ein Schaltjahr.

Public Function gfSchaltjahr(Optional ByVal iJahr As Long = -1) As Boolean
 
If iJahr = -1 Then iJahr = Year(Date)
If Day((CDate("1.3." & iJahr) - 1)) = 29 Then gfSchaltjahr = True
 
End Function
Public Function gfSchaltjahr(Optional ByVal iJahr As Long = -1) As Boolean

If iJahr = -1 Then iJahr = Year(Date)
If Day((CDate("1.3." & iJahr) - 1)) = 29 Then gfSchaltjahr = True

End Function

Unter .NET geht das natürlich einfacher ;)