Scource Codes

Hieronder vind je een aantal gebruikersvolle codes van Visual Basic.
Om deze codes te kunnen gebruiken, moet je simpelweg de tekst op je web-bwrowser kopiëren, en in een formulier of een module zetten.

Hier is een code om je form te centreren (zet het in de form_load of declareer het in een module)

Dim x, y
x = (Screen.Width - aForm.Width) / 2
y = (Screen.Height - aForm.Height) / 2
aForm.Move x, y

Een module om een Random getal te maken

Function MaakGetal(ByVal MHoogste As Long, ByVal MLaagste As Long) As Long
Randomize
MaakGetal = Int((MHoogste - MLaagste + 1) * Rnd + MLaagste)
Exit Function
MaakGetalErr:
x = MsgBox("Error - Verkeerde nummeriek invoer" & Chr(10) & "Modulenaam MaakGetal", vbCritical, Title:="Error nr. 1")
Exit Function
End Function

'gebruik: (lbuitkgetal is een label die de uitkomst toont)
'lbuitkgetal = MaakGetal(12, 58)
'je komt dan minimaal 12 uit, maximaal 58!!??


Een module om een UserName van de persoon vast te krijgen

Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

'functie:
'dit moet ook nog in de form!
'Private Function UserName() As String
'Const UNLEN = 256 ' Max user name length.
'Dim user_name As String
'Dim name_len As Long
'
' user_name = Space$(UNLEN + 1)
' name_len = Len(user_name)
' If GetUserName(user_name, name_len) = 0 Then
' UserName = ""
' Else
' UserName = Left$(user_name, name_len - 1)
' End If
'End Function
'
'en gebruik:
'[label].Caption = UserName()


Module om te kijken of een Dir wel bestaat...

Public Function DirExists(ByVal sDirName As String) As Boolean
Dim sDir As String
On Error Resume Next
DirExists = False
sDir = Dir$(sDirName, vbDirectory)
If (Len(sDir) > 0) And (Err = 0) Then
DirExists = True
End If

'gebruik: (lbJa is een label die alleen True of False ziet)
'lbJa = DirExists("c:\")

End Function

Een zelfgemaakte module om wisselkoersen te berekenen. Wel eenvoudig, maar dat geeft toch niet, hé?

Global Const MODULENAAM = "GelbBereken"
'Land = string, hoeveelheid = long
'Invoergeld = "A" of "B"

'---------------------------------------------------------------
' Gemaakt door Wouter Groeneveld op 10/05/1999 -
' Deze module (GeldBereken) kan de wisselkoersen -
' Van verschillende landen maken -
' (c) Copyright 1999-1999 [WGP] Software (versie 1.0.1) -
'---------------------------------------------------------------
Function GeldBereken(ByVal Hoeveelheid As Long, ByVal Land As String, ByVal InvoerGeld As String) As Long
On Error GoTo GeldBerekenErr
Dim ErrorNr As Byte
If InvoerGeld = "A" Then GoTo AnderLand
If InvoerGeld = "B" Then GoTo BelgLand
If InvoerGeld <> "A" And "B" Then
ErrorNr = 1
GoTo GeldBerekenErr
End If
Exit Function
BelgLand:
Select Case Land
Case "Amerika"
GeldBereken = Hoeveelheid * 38
Case "Euro"
GeldBereken = Hoeveelheid * 40.3399
Case "Spanje"
GeldBereken = Hoeveelheid * 0.2425
Case Else
ErrorNr = 2
GoTo GeldBerekenErr
End Select
Exit Function
AnderLand:
Select Case Land
Case "Amerika"
GeldBereken = Hoeveelheid / 38
Case "Euro"
GeldBereken = Hoeveelheid / 40.3399
Case "Spanje"
GeldBereken = Hoeveelheid / 0.2425
Case Else
ErrorNr = 2
GoTo GeldBerekenErr
End Select
Exit Function
GeldBerekenErr:
If ErrorNr = 1 Then
x = MsgBox("Error - Verkeerde invoer INVOERGELD" & Chr(10) & "Modulenaam " & MODULENAAM, vbCritical, Title:="Error nr. 1")
Exit Function
End If
If ErrorNr = 2 Then
x = MsgBox("Error - Verkeerde invoer LAND" & Chr(10) & "Modulenaam " & MODULENAAM, vbCritical, Title:="Error nr. 2")
Exit Function
End If
x = MsgBox("Error!", vbCritical, Title:=MODULENAAM & "error")
End Function

'gebruik: (txt... zijn textboxen!)

'Private Sub Command1_Click()
'Dim uitkomst As Long
'uitkomst = GeldBereken(txtHoeveelheid, txtLand, txtInvoer)
'lbuitk = uitkomst
'End Sub

Dat is het voorlopig...


[WGP] software (c) copyright 1999 - 1999