Visual Basic


Data objektProgram
DataReport a DataEnvironmentProgram
DataReportProgram
ZjiÜt∞nφ v∞ku z data narozenφK≤d
Vlastnφk objektu v databßziK≤d
V²maz schrßnky pomocφ APIK≤d
èφ°ka a v²Üka kurzoruK≤d
Binßrnφ vyhledßvßnφ v poli hodnotK≤d
Rozklad RGB barvy na jednotlivΘ slo₧kyK≤d
Zobrazenφ formulß°e podle jmΘnaK≤d

Data objekt
P°φklad t°φdy fungujφcφ jako zdroj dat.
11795 bajt∙Kopφrovat

Zp∞t na obsah


DataReport a DataEnvironment
Jednoduch² p°φklad pro zaΦßteΦnφky, kter² ukazuje pou₧itφ DataReportu. Jako zdroj dat je zde pou₧ito DataEnvironment.
63251 bajt∙Kopφrovat

Zp∞t na obsah


DataReport
P°φklad pou₧itφ DataReportu bez DataEnvironment.
26111 bajt∙Kopφrovat

Zp∞t na obsah


ZjiÜt∞nφ v∞ku z data narozenφ

Funkce GetAge vrßtφ v∞k v poΦtu let podle zadanΘho data narozenφ.

Public Function GetAge(BirthDate As Date) As Byte
  GetAge = Year(Now) - Year(BirthDate) + _
    (DateSerial(Year(Now), Month(BirthDate), Day(BirthDate)) > Now)
End Function

Zp∞t na obsah


Vlastnφk objektu v databßzi

P°φklad ukazuje, jak zjistit jmΘno vlastnφka objektu v databßzi. KonkrΘtn∞ jde o zjiÜt∞nφ vlastnφka tabulky, pro ostatnφ objekty jsou zapoznßmkovanΘ Φßsti k≤du.

Dim db As DAO.Database, cont As DAO.Container

Set db = OpenDatabase("C:\databaze.mdb")
Set cont = db.Containers("Tables")
'Set cont = db.Containers("Forms")
'Set cont = db.Containers("Reports")
'Set cont = db.Containers("Scripts")
'Set cont = db.Containers("Modules")

MsgBox cont.Documents("nazev_tabulky").Owner

db.Close

Zp∞t na obsah


V²maz schrßnky pomocφ API

Schrßnku m∙₧ete vymazat bu∩ pomocφ metody Clear objektu Clipboard nebo pomocφ funkce API EmptyClipboard.

Private Declare Function EmptyClipboard Lib "USER32" () As Long
Private Declare Function OpenClipboard Lib "USER32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "USER32" () As Long

If OpenClipboard(0) <> 0 Then
  EmptyClipboard
  CloseClipboard
End If

Zp∞t na obsah


èφ°ka a v²Üka kurzoru

P°φklad ukazuje zjiÜt∞nφ Üφ°ky a v²Üky kurzoru myÜi. Hodnoty zobrazuje v pixelech.

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const SM_CXCURSOR = 13
Private Const SM_CYCURSOR = 14

MsgBox "èφ°ka: " & GetSystemMetrics(SM_CXCURSOR) & vbCrLf & _
       "V²Üka: " & GetSystemMetrics(SM_CYCURSOR)

Zp∞t na obsah


Binßrnφ vyhledßvßnφ v poli hodnot

Funkce BinarySearch vyhledßvß hodnotu v zadanΘm poli. Pokud hodnota nenφ nalezena, vrßtφ Φφslo -1, jinak index nalezenΘ hodnoty.

Public Function BinarySearch(varArray() As Variant, ByVal varItem As Variant) As Long
  Dim Found As Boolean
  Dim LowNumber As Long, HighNumber As Long, MidNumber As Long
  Dim lngIndex As Long
  
  lngIndex = -1
  
  Found = False
  LowNumber = 0
  HighNumber = UBound(varArray) - LBound(varArray)
  
  Do
    MidNumber = (LowNumber + HighNumber) \ 2
    If varItem < varArray(MidNumber) Then
      HighNumber = MidNumber - 1
    ElseIf varItem > varArray(MidNumber) Then
      LowNumber = MidNumber + 1
    Else
      Found = True
      lngIndex = MidNumber
    End If
  Loop Until Found Or (HighNumber < LowNumber)
  
  BinarySearch = lngIndex
End Function

Zp∞t na obsah


Rozklad RGB barvy na jednotlivΘ slo₧ky

P°φklad ukazuje, jak zjistit hodnoty jednotliv²ch barevn²ch slo₧ek z hodnoty RGB.

Dim barva As Long

barva = RGB(120, 100, 80)
MsgBox "Eervenß: " & (barva And &HFF) & vbCrLf & _
       "Zelenß: " & ((barva \ &H100) And &HFF) & vbCrLf & _
       "Modrß: " & ((barva \ &H10000) And &HFF)

Zp∞t na obsah


Zobrazenφ formulß°e podle jmΘna

Chcete-li nahrßt do pam∞ti a zobrazit formulß°, jeho₧ jmΘno nenφ p°edem znßmo, m∙₧ete pou₧φt jednoduch² trik. StaΦφ jej pouze p°idat do kolekce Forms.

Dim frm As Form
Set frm = Forms.Add("Form2")
frm.Visible = True

Zp∞t na obsah