Zdrojové kódy

RegisterOCX Program
Krychle pomocí OpenGL Program
Batnball Program
QuadBall Program
AutoComplete Program
Asociace Program
Komáři Program
Piškvorky Program
3D kreslení Program
3D bludiště Program
3D terén Program
IP utility Modul
N-tý řádek z TextBoxu Kód
Operace Undo (návrat zpět) Kód
Jak rychleji naplnit prvek daty z databáze Kód
Detekce spuštění některých programů Microsoftu Kód

RegisterOCX

Archív obsahuje dva projekty. Oba dva dělají stejnou akci, každý pouze trochu jinak (princip je stejný). Umí zaregistrovat i odregistrovat ActiveX prvek a knihovny DLL. Ne však pomocí externího programu (regsvr32 apod.), ale pomocí API funkcí.
9783 bytů Kopírovat

Zpět na obsah


Krychle pomocí OpenGL

Barevná pohybující se krychle, vytvořená pomocí OpenGL. Krychlí je možno otáčet v horizontálním i vertikálním směru pomocí posuvníků. Barvy na povrchu krychle mění svůj odstín podle natočení krychle.
209488 bytů Kopírovat

Zpět na obsah


Batnball

Variace na, kdysi velmi populární, hru Arkanoid. Pohybujícím se odrazovým můstkem řídíte kuličku, jejíž pomocí musíte zbořit zeď.
23090 bytů Kopírovat

Zpět na obsah


QuadBall

Ještě jedna variace na hru Arkanoid. Tentokrát nejde o to zbořit zeď, ale udržet meteorit na obrazovce pomocí čtyř odrazových ploch (každá na jedné straně obrazovky) po určitou dobu a zachránit tím nějakou planetu.
665500 bytů Kopírovat

Zpět na obsah


AutoComplete

ActiveX prvek, včetně příkladu, který dokončuje napsaný text podobně jako Internet Explorer, když zadáváte stránku do adresního řádku.
48667 bytů Kopírovat

Zpět na obsah


Asociace

Příklad na vytváření asociací ve Windows. K zadané příponě můžete přidat program, který bude spouštět soubory s touto příponou.
16839 bytů Kopírovat

Zpět na obsah


Komáři

Hra, ve které je účelem postřílet co nejvíce komárů, kteří vám létají na obrazovce (přesněji pouze na formuláři).
95014 bytů Kopírovat

Zpět na obsah


Piškvorky

Variace na hru piškvorky. Účelem hry je na ploše 3 krát 3 pole vytvořit řadu tří koleček nebo křížků stejným způsobem jako v piškvorkách. Program ukazuje i hru přes síť pomocí protokolu TCP/IP.
1154162 bytů Kopírovat

Zpět na obsah


3D kreslení

Jednoduchý příklad ukazující 3D kreslení bez pomocí API funkcí.
1595 bytů Kopírovat

Zpět na obsah


3D bludiště

Poněkud složitější program, který umožňuje vytvořit (maker.vbp) bludiště a potom v něm procházet (maze.vbp). Procházení je řešeno stejně jako ve hrách typu DOOM, DUKE NUKEM 3D atp. (samozřejmně v poněkud horší grafice).
19400 bytů Kopírovat

Zpět na obsah


3D terén

Program vytváří jednoduchý 3D terén (hory, údolí) pomocí drátového modelu. Vytváření je řízeno zadáním několika parametrů, výsledný obrázek můžete uložit.
18787 bytů Kopírovat

Zpět na obsah


IP utility

Modul obsahuje několik funkcí pro komunikaci pomocí TCP/IP protokolu pomocí knihovny WSOCK32.DLL, např. zjištění IP adresy, PING na IP adresu apod.
12888 bytů Kopírovat

Zpět na obsah


N-tý řádek z TextBoxu

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

Zpět na obsah


Operace Undo (návrat zpět)

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

Zpět na obsah


Jak rychleji naplnit prvek daty z databáze

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

Zpět na obsah


Detekce spuštění některých programů Microsoftu

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

Zpět na obsah