VB Source Code

Source Code & Tips

Inhalt

Wie lasse ich den Mauszeiger verschwinden und wieder Auftauchen?
Wie verschiebe ich eine Form ohne Tittelleiste?
Wie füge ich Inhalte aus der Zwischenablage in VB Objekte ein?
Wie schreibe ich Inhalte in die Zwischenablage?
Wie mache ich ein Kontextmenü beim Rechtsklicken?
Wie kann ich die typischen Farben bei einem Setup Programm machen?
Wie kann ich DragDrop aus einer anderen Anwendung abfangen?
Wie kann man sehen ob das Kompilierte Programm schon mal gestartet wurde, und wenn das Alte beenden?
Wie kann ich ein eigenes Kontextmenü bei einer Textbox machen?
Was ist der Name des gerade Angemeldeten Benutzers?
Was ist das Windows Verzeichnis?
Wie kann ich die Helligkeit des Monitors per Programmcode verändern?
Wie kann ich Informationen einer Datei herausbekommen?
Wie kann den "Ordner suchen" Dialog anzeigen?
Wie kann ich meine Programme Windows-XP fähig machen?
Warum funktionieren die Sheridan 3D Controls in der IDE nicht?
Wie kann ich längere Texte in Ressourcendateien einfügen und auslesen?

Wie lasse ich den Mauszeiger verschwinden und wieder auftauchen?

1. In der aktuellen Form unter "Declarations" Folgende Zeile Einfügen:
Private Declare Function ShowCursor Lib "User32" (ByVal bShow As Long) As Long

2. Um den Mauszeiger zu verstecken
MyVar = ShowCursor(False)
Einfügen, um ihn wieder anzuzeigen MyVar = ShowCursor(True)
Achtung: Für jedes Verstecken muss wieder gezeigt werden, also wenn Sie ihn 2 mal verstecken müsssen Sie ihn auch 2 mal wieder anzeigen.

Doppelklicken um zurück nach oben zu gehen.

Wie verschiebe ich eine Form ohne Tittelleiste?

1. In der aktuellen Form oder im aktuellen Modul
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
Einfügen.

2. In dem Objekt, das zum Verschieben der Form dienen soll, etwa ein Label unter "Mouse Down"
ReleaseCapture
SendMessage Me.hWnd, &HA1, 2, 0&
Einfügen.

Doppelklicken um zurück nach oben zu gehen.

Wie füge ich Inhalte aus der Zwischenablage in VB Objekte ein?

Texte: Am Beispiel von einem Textfeld namens Text1. "Text1.Text = Clipboard.GetText"
Bilder: Am Beispiel von einem Picture namens Picture1. "Picture1.Picture = Clipboard.GetData"

Doppelklicken um zurück nach oben zu gehen.

Wie schreibe ich Inhalte in die Zwischenablage?

Texte: Am beispiel eines Textfeldes Text1: Clipboard.SetText Text1.Text
(Tip: Will man nur den markierten Text kopieren, so muss man Clipboard.SetText Text1.SelText Schreiben.)
Aktueller Bildschirminhalt:(screenshot) In der aktuellen Form bzw. dem aktuellen Modul folgendes deklarieren:
Private Declare Sub keybd_event Lib "User32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long).
In dem Command, der es auslösen soll keybd_event &H2C, 1, 0, 0 Schreiben.

Doppelklicken um zurück nach oben zu gehen.

Wie mache ich ein Kontextmenü beim Rechtsklicken?

In dem Objekt, in dem es erscheinen soll unter "Mouse Down":
If Button = 2 Then PopupMenu Name_des_menüs

Doppelklicken um zurück nach oben zu gehen.

Wie kann ich die typischen Farben bei einem Setup Programm machen?

Schreiben sie im paint Ereignis der Form folgenden Code:
DrawStyle = 6
DrawMode = 13
DrawWidth = 2
ScaleMode = 3
ScaleHeight = 512
For i% = 0 To 511
Line (0, i%)-(Me.Width, i% + 1), RGB(0, 0, 511 - i%), B
Next i%

Doppelklicken um zurück nach oben zu gehen.

Wie kann ich DragDrop aus einer anderen Anwendung abfangen?

1. Beim Objekt OLEDropMode auf 1 - Manuell setzten

2. Im Programmcode des Objektes, unter OLEDragDrop:
Um Text abzufangen:
If Data.GetFormat(vbCFText) Then variableDieDenTextHabenSoll = Data.GetData(vbCFText)
Um den Pfad eines Symbols abzufangen:
If Data.GetFormat(vbCFFiles) Then VariableDieDenTextHabenSoll = Data.Files(1)
Doppelklicken um zurück nach oben zu gehen.

Wie kann man sehen ob das Compilierte Programm schon mal gestartet wurde, und wenn das alte Beenden?

1. In der Startform unter Form_Load
If App.PrevInstance = True Then
Dim wndhandle As Long
tempcaption = Me.Caption
Me.Caption = "#####" & me.caption 'Unsere Caption wird kurz verändert, damit wir nicht unser Prog beenden
wndhandle = FindWindow(vbNullString, tempcaption) 'Das alte Programm wird gesucht...
SendMessage wndhandle, WM_CLOSE, 0&, 0& '...und geschlossen
Me.Caption = tempcaption
End If
Doppelklicken um zurück nach oben zu gehen.

Wie kann ich ein Eigenes Kontextmenü machen, das kommt beim Rechtsklick einer Textbox?

Wir machen dies mit einem kleinen Trick. Wir schicken an eine Picturebox (hier Picture1) die Nachricht eines Rechtsklicks.

1. Im Betreffenden Textfeld unter MouseDown:
If Button = vbRightButton Then SendMessage Picture1.hWnd, &H204, 0&, 0&
In dex Picturebox(Hier Picture1) unter MouseDown: PopupMenu NameDesMenüs, vbPopupMenuRightButton
Picture1 darf visible = False sein.

Was ist der Name des gerade Angemeldeten Benutzers?

In den Deklarationen:
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _ (ByVal lpBuffer As String, nSize As Long) As Long
Dann ist "Benname" der gesuchte Name:
Dim strBuffer As String * 255, intlen As Long
Dim Benname As String
intlen = GetUserName(strBuffer, 255)
intlen = InStr(1, strBuffer, Chr(0))
If intlen > 0 Then Benname = Left(strBuffer, intlen - 1)

Was ist das Windows Verzeichnis?

In den Deklarationen der form:
Private Declare Function GetWindowsDirectory _
Lib "kernel32" Alias "GetWindowsDirectoryA" ( _
ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
Dan ist das Windowsverzeichenis:
Dim Temp As String * 256
X = GetWindowsDirectory(Temp, Len(Temp))
WinDir = Left$(Temp, X)

Wie kann ich die Helligkeit des Monitors per Programmcode verändern?

Die Helligkeit kann mit ein paar Zeilen geändert werden:
In den Deklarationen der Form:

Private Ramp1(0 To 255, 0 To 2) As Integer
Private Ramp2(0 To 255, 0 To 2) As Integer
Private Declare Function GetDeviceGammaRamp Lib "gdi32" (ByVal hdc As Long, lpv As Any) As Long
Private Declare Function SetDeviceGammaRamp Lib "gdi32" (ByVal hdc As Long, lpv As Any) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public Function Int2Lng(IntVal As Integer) As Long
   CopyMemory Int2Lng, IntVal, 2
End Function
Public Function Lng2Int(Value As Long) As Integer
   CopyMemory Lng2Int, Value, 2
End Function
Private Sub Form_Unload(Cancel As Integer)
   SetDeviceGammaRamp Me.hdc, Ramp1(0, 0)  'Beim Beenden wieder normale Helligkeit
End Sub

Dort, wo es dunkel werden soll:Dim iCtr As Integer Dim lVal As Long GetDeviceGammaRamp Me.hdc, Ramp1(0, 0) For iCtr = 0 To 255 lVal = Int2Lng(Ramp1(iCtr, 0)) Ramp2(iCtr, 0) = Lng2Int(Int2Lng(Ramp1(iCtr, 0)) / 2) Ramp2(iCtr, 1) = Lng2Int(Int2Lng(Ramp1(iCtr, 1)) / 2) Ramp2(iCtr, 2) = Lng2Int(Int2Lng(Ramp1(iCtr, 2)) / 2) Next iCtr SetDeviceGammaRamp Me.hdc, Ramp2(0, 0)
Sie können auch die Farbe verändern wenn sie die entsprechenden Zeilen auskommentieren.

Wie kann ich Informationen einer Datei herausbekommen?

Sie wollen über bestimmte Dateien Informationen, wie Größe oder Dateityp herausbekommen. Die Größe einer Datei ist einfach: a = FileLen(Dateiname)
Um Den Dateityp (Wie ihn Windows im Explorer zeigt) herauszubekommen benützen sie Folgenden Code in einem Modul z.B.: Private Const

'Deklarationen MAX_PATH = 260 Private Const SHGFI_TYPENAME = &H400 Private Type SHFILEINFO hIcon As Long iIcon As Long dwAttributes As Long szDisplayName As String * MAX_PATH szTypeName As String * 80 End Type Private Declare Function apiSHGetFileInfo Lib "shell32.dll" _ Alias "SHGetFileInfoA" (ByVal pszPath As String, _ ByVal dwFileAttributes As Long, psfi As SHFILEINFO, _ ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long 'Funktion Public Function GetFileType(FilePath As String) As String Dim psfi As SHFILEINFO Dim lngResult As Long 'API-Funktion aufrufen psfi.szTypeName = Space(80) lngResult = apiSHGetFileInfo(FilePath, 0&, psfi, _ LenB(psfi), SHGFI_TYPENAME) If lngResult = 0 Then GetFileType = "" Exit Function End If GetFileType = Mid(psfi.szTypeName, 1, InStr(psfi.szTypeName, Chr(0)) - 1) End Function

Und so wird es aufgerufen: a = GetFileType("c:\command.com")
In der Variable a würde nun "Anwendung für MS_DOS" stehen.

Wie kann den "Ordner suchen" Dialog anzeigen?

Es gibt ja den Commondialog Dateiauswahldialog. Um aber nur Verzeichnisse auszuwählen genügt ein API Aufruf:

Private Type BROWSEINFO
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "Shell32" _ (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" _ (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal hMem As Long)
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS = &H1&
Public Function BrowseForFolder(Optional Parent As Variant, _ Optional Title As Variant) As String
Dim tBI As BROWSEINFO
Dim lhWndParent As Long
Dim lngPIDL As Long
Dim strPath As String

If IsMissing(Title) Then Title = "Wählen Sie einen Ordner aus"
If IsMissing(Parent) = False Then lhWndParent = Parent.hWnd

With tBI
.hwndOwner = lhWndParent
.lpszTitle = Title
.ulFlags = BIF_RETURNONLYFSDIRS
End With

lngPIDL = SHBrowseForFolder(tBI)

If (lngPIDL <> 0) Then
strPath = Space$(MAX_PATH)
SHGetPathFromIDList lngPIDL, strPath
strPath = Left$(strPath, InStr(strPath, Chr$(0)) - 1)
CoTaskMemFree lngPIDL
End If

BrowseForFolder = strPath
End Function

Wie kann ich mein Programm Xp fähig machen?

Im Prinzip ist Ihr Porgramm schon unter Windows XP ohne Probleme lauffähig. Dabei verhalten sich die Api Funktionen wie in Windows NT. Allerdings werden die Controls nicht in den neuen XP-Styles angezeigt. Damit dies klappt müssen Sie im Verzeichnis Ihrer Exe eine Datei Exename.exe.manifest erstellen. Sie muss folgenden Inhalt haben:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?><assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity processorArchitecture="*" version="5.1.0.0" type="win32" name="Firma.Progname"/><description>Beschreibung</description><dependency> <dependentAssembly><assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" publicKeyToken="6595b64144ccf1df" language="*" processorArchitecture="*"/></dependentAssembly></dependency></assembly>
Außerdem muss im Initialize Ereignis der Form folgendes Stehen: InitCommonControls
Und in den Deklarationen: Private Declare Sub InitCommonControls Lib "comctl32.dll" ()

Warum funktionieren die Sheridan 3D Controls in der IDE nicht (threed32.ocx)?

Erhalten Sie, wenn Sie de Controls in der IDE hinzufügen wollen einen Lizenzfeher? Dann legen Sie die VB CD2 ein, und starten Sie unter \COMMON\TOOLS\VB\CONTROLS die Datei VBCTRLS.REG.
Diese trägt die Lizenzinformationen in die Registry ein.

Wie kann ich längere Texte in Ressourcendateien einfügen und auslesen?

Fügen Sie die .txt Dateien als benutzerdefinierte Ressource direkt ein. Das Auslesen fuktioniert nun mittels:
StrConv(LoadResData(ID, "CUSTOM"), vbUnicode)

Doppelklicken um zurück nach oben zu gehen.