Zdrojové kódy
PlánovačProgram
UDL souboryProgram
Informace o bitmapěProgram
SkinProgram
Kopie RecordsetuKód
Přehrávání souboru AVIKód
Je zapnuta funkce ActiveDesktop?Kód
Tisk dat z AccessuVBA

Plánovač
Plánovací kalendář, který ukazuje spoustu zajímavých programátorských technik.
24562 bajtůKopírovat

Zpět na obsah

UDL soubory
Chcete-li se připojit k databázi, např. pomocí objektů ADO, mužete pro definici připojení použít několik možností. Jedna z nich je UDL (Universal Data Link) soubor. Příklad ukazuje, jak takový soubor jednoduše vytvořit a použít.
2050 bajtůKopírovat

Zpět na obsah

Informace o bitmapě
Zobrazí některé informace o bitmapě, např. šířku a výšku, počet barev atd.
6758 bajtůKopírovat

Zpět na obsah

Skin
Příklad "skinovatelné" aplikace.
60315 bajtůKopírovat

Zpět na obsah

Kopie Recordsetu

Funkce GetRecordset vrátí objekt Recordset se stejnou strukturou sloupců jako má zadaný Recordset.

Public Function GetRecordset(rs As ADODB.Recordset) As ADODB.Recordset
  Dim fld As ADODB.Field, lRs As ADODB.Recordset

  Set lRs = New ADODB.Recordset

  For Each fld In rs.Fields
    With lRs
      .Fields.Append fld.name, fld.Type, fld.DefinedSize, fld.Attributes
      If fld.Type = adNumeric Or fld.Type = adDecimal Then
         .Fields(.Fields.Count - 1).Precision = fld.Precision
         .Fields(.Fields.Count - 1).NumericScale = fld.NumericScale
    End With
  Next fld
End Function

Zpět na obsah


Přehrávání souboru AVI

Funkce PlayAVI přehraje AVI soubor se zvukem nebo bez něj.

Private Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" _
  (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
  ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function mciGetErrorString Lib "winmm" Alias _
  "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, _
  ByVal uLength As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32" Alias _
  "GetShortPathNameA" (ByVal lpszLongPath As String, _
  ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Public Sub PlayAVI(ByVal strFile As String, Optional ByVal audio As Boolean = True)
  Dim ret As Long, mciCommand As String, shortFile As String * 255

  ret = GetShortPathName(strFile, shortFile, Len(shortFile))
  strFile = Left(shortFile, ret)
    
  ret = mciSendString("Open " & strFile & " type avivideo alias AVIFile", vbNullString, 0, 0&)
  If Not audio Then ret = mciSendString("Set AVIFile audio all off", vbNullString, 0, 0&)
  ret = mciSendString("Play AVIFile wait", vbNullString, 0, 0&)
  ret = mciSendString("Close AVIFile", vbNullString, 0, 0&)
End Sub

Zpět na obsah


Je zapnuta funkce ActiveDesktop

Co je to ActiveDesktop ví určitě každý z vás. Již od Windows 98 má tuto možnost každá nová verze Windows. Funkce ActiveDesktop vám řekne, zda ji má uživatel zapnutou či nikoliv.

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
  (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
  ByVal lpsz2 As String) As Long

Public Function ActiveDesktop() As Boolean
  Dim hWnd As Long
    
  hWnd = FindWindowEx(0, 0, "Progman", vbNullString)
  If hWnd Then
    hWnd = FindWindowEx(hWindow, 0, "SHELLDLL_DefView", vbNullString)
    If hWnd Then
      If FindWindowEx(hWindow, 0, "Internet Explorer_Server", vbNullString) Then
        ActiveDesktop = True
      End If
    End If
  End If
End Function

Zpět na obsah


Tisk dat z Accessu

Chcete-li vytisknout data nějakého objektu, např z dotazu, použijte objekt DoCmd. Nejdříve je potřeba daný objekt otevřít, vybrat (SelectObject) a nakonec jej vystisknete zavoláním metody PrintOut.

Dim mac As Access.Application

mac.OpenCurrentDatabase "C:\data.mdb"
With mac.DoCmd
  .OpenQuery "qryZamestnanci"
  .SelectObject acQuery, "qryZamestnanci"
  .PrintOut acPrintAll
End With

Zpět na obsah