Zdrojové kódy
Funkce TextBoxLine vrátí zadaný řádek textu z TextBoxu.
Private Const EM_GETLINE = &HC4 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 Function TextBoxLine(TB As TextBox, ByVal LineNO As Integer) As String Const BUFLEN = 1028 Dim buffer As String * BUFLEN, ret As Long Mid(buffer, 1, 1) = Chr(BUFLEN And &HFF) Mid(buffer, 2, 1) = Chr(BUFLEN \ &H100) If Not TB.MultiLine Then TextBoxLine = TB.Text Else ret = SendMessage(TB.hwnd, EM_GETLINE, LineNO - 1, ByVal buffer) If ret Then TextBoxLine = Left$(buffer, ret&) Else TextBoxLine = "" End If End If End Function Většina dnešních programů (hlavně editorů - ať už grafických, textových nebo tabulkových atd.), umožňuje zrušit naposledy vykonanou akci. Jak na to ve Visual Basicu? Možností existuje více, ukážeme si tuto operaci pomocí funkce SendMessage.
Private Const EM_UNDO = &HC7 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 Sub UndoTextBox(TB As TextBox) SendMessage TB.hwnd, EM_UNDO, 0, 0 End Sub
Chcete-li naplnit např. ListBox daty z databáze, většinou použijete tento kód:
Do While Not myRecordset.EOF List1.AddItem myRecordset!prijmeni myRecordset.Movenext Loop Tento kód však nní příliš výhodný, protože při každém průchodu cyklem je třeba zkontrolovat (poměrně náročnou operací), zda není Recordset na konci (EOF). Mnohem rychlejší bude tento kód:
myRecordset.MoveLast intPocet=myRecordset.RecordCount myRecordset.MoveFirst For i = 1 To intPocet List1.AddItem myRecordset!prijmeni myRecordset.MoveNext Next i
Již několik čtenářů se nás ptalo, jak zdetekovat zda běží ten či onen program. Níže uvedená funkce IsAppRunning detekuje některé programy od Microsoftu podle třídy a ostatní programy podle textu v titulkovém pruhu.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Function IsAppRunning(ByVal strAppName As String) As Boolean Dim lngH As Long, strClassName As String IsAppRunning = False Select Case LCase(strAppName) Case "excel": strClassName = "XLMain" Case "word": strClassName = "OpusApp" Case "access": strClassName = "OMain" Case "powerpoint95": strClassName = "PP7FrameClass" Case "powerpoint97": strClassName = "PP97FrameClass" Case "notepad": strClassName = "NOTEPAD" Case "paintbrush": strClassName = "pbParent" Case "wordpad": strClassName = "WordPadClass" Case Else: strClassName = "" End Select If strClassName = "" Then lngH = FindWindow(vbNullString, strAppName) Else lngH = FindWindow(strClassName, vbNullString) End If If lngH <> 0 Then IsAppRunning = True End Function
|