Visual Basic

Je formulß° v pam∞ti?	K≤d
Je ComboBox rozbalen²?	K≤d
P°evody teplot	K≤d
P°estupn² rok	K≤d
Mß p°ipojenß myÜ koleΦko?	K≤d
PoΦet p°eskoΦen²ch °ßdk∙ p°i pohybu koleΦkem	K≤d
Operace Drag and drop se soubory	K≤d

Je formulß° v pam∞ti?

Funkce vrßtφ hodnotu True, pokud je formulß° zadan² sv²m jmΘnem ji₧ nahrßn do pam∞ti, tzn. pokud je nalezen v kolekci Forms.

Function FrmIsLoaded(ByVal FormName As String) As Boolean
  Dim frm As Form
  
  FrmIsLoaded = False
  For Each frm In Forms
    If UCase(frm.Name) = UCase(FormName) Then
      FrmIsLoaded = True
      Exit For
    End If
  Next frm
End Function

Zp∞t na obsah

Je CombBox rozbalen²?

Chcete-li zjistit, zda je rozbalovacφ Φßst ComboBoxu rozbalena, pou₧ijte funkci IsComboDrop. K zjiÜt∞nφ tΘto informace vyu₧φvß funkci API SendMessage.

Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const CB_GETDROPPEDSTATE = &H157


Function IsComboDrop(cbo As ComboBox) As Boolean
  Dim res As Long
  
  res = SendMessage(cbo.hwnd, CB_GETDROPPEDSTATE, 0&, ByVal 0&)
  IsComboDrop = (res <> 0)
End Function

Zp∞t na obsah

P°evody teplot

Nφ₧e uvedenΘ dv∞ funkce C2F a F2C p°evßdφ teplotu ve stupnφch Celsia na teplotu ve stupnφch Fahrenheita a opaΦn∞.

Function C2F(ByVal Celsius As Double) As Double
  C2F = 32 + Celsius * 9 / 5
End Function

Function F2C(Fahrenheit As Double) As Double
  F2C = (Fahrenheit - 32) * 5 / 9
End Function

Zp∞t na obsah

P°estupn² rok

Chcete-li v∞d∞t, zda je p°estupn² rok, m∙₧ete si to bu∩ spoΦφtat sami podle znßmΘho algoritmu (co₧ je pon∞kud pracn∞jÜφ) nebo m∙₧ete v∞°it Visual Basicu, ₧e to umφ sprßvn∞. Oba p°φklady vßm ukß₧eme.

Function LeapYear(ByVal Year As Long) As Boolean
  LeapYear = Month(DateSerial(Year, 2, 29)) = 2
End Function

'Jestlize je rok delitelny beze zbytku 4, je prestupny, ale pokud je zaroven
'delitelny i 100, neni prestupny, ale pokud je delitelny i 400, prestupny je
Function LeapYear2(ByVal Year As Long) As Boolean
  LeapYear2 = False
  If Year Mod 4 = 0 Then
    If Year Mod 100 = 0 Then
      If Year Mod 400 Then
        LeapYear2 = True
      End If
    Else
      LeapYear2 = True
    End If
  End If
End Function

Zp∞t na obsah

Mß p°ipojenß myÜ koleΦko?

Zjistit, zda-li mß myÜ koleΦko pro jednoduÜÜφ ovlßdßnφ, nenφ ₧ßdn² problΘm. StaΦφ zavolat funkci API GetSystemMetrics s parametrem SM_MOUSEWHEELPRESENT.

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

Const SM_MOUSEWHEELPRESENT = 75

Function IsWheel() As Boolean
  IsWheel = GetSystemMetrics(SM_MOUSEWHEELPRESENT)
End Function

Pokud myÜ koleΦko mß, vrßtφ funkce hodnotu True.

Zp∞t na obsah

PoΦet p°eskoΦen²ch °ßdk∙ p°i pohybu koleΦkem

OtoΦφte-li koleΦkem, pohybujete se v dokumentu, v internetovΘm prohlφ₧e, prost∞ kdekoliv, kde je koleΦko podporovßno, posunete se o urΦit² poΦet °ßdku nahoru nebo dolu. Chcete-li v∞d∞t o kolik, nebo dokonce nastavovat tuto hodnotu, zkuste tento p°φklad.

Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" _
  (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Long, _
   ByVal fuWinIni As Long) As Long

Const SPI_GETWHEELSCROLLLINES = 104
Const SPI_SETWHEELSCROLLLINES = 105
Const SPIF_SENDWININICHANGE = &H2


'Vrßtφ poΦet °ßdk∙
Function GetWheelLines() As Long
  Dim ret As Long 
  SystemParametersInfo SPI_GETWHEELSCROLLLINES, 0, ret, 0
  GetWheelLines = ret
End Function

'Nastavφ poΦet °ßdk∙
Sub SetWheelLines(ByVal newValue As Long)
  SystemParametersInfo SPI_SETWHEELSCROLLLINES, newValue, 0, SPIF_SENDWININICHANGE
End Sub

Zp∞t na obsah

Opearace Drag and drop se soubory

Vytvß°φte-li nap°. textov² editor, musφte u₧ivateli umo₧nit n∞jak²m zp∙sobem otevφrat soubory. Jedna mo₧nost je zvolit klasickΘ menu Soubor/Otev°φt atd. Co takhle umo₧nit otev°φt soubor pouh²m p°eta₧enφm na vßÜ spuÜt∞n² editor? Nenφ to nic slo₧itΘho. Textbox, kter² mß hlavnφ funkci editoru, musφ mφt vlastnost OLEDropMode nastavenu na hodnotu 1, tj. Manual. Pak ji₧ staΦφ vlo₧it do formulß°e tento k≤d:

Private Sub DropFile(ByVal txt As TextBox, ByVal strFN As String)
  Dim iFile As Integer
  Dim sFile As String
  
  iFile = FreeFile
  Open strFN For Binary Access Read As #iFile
  sFile = Space(LOF(iFile))
  Get #iFile, , sFile
  Close #iFile

  With txt
    .SelStart = Len(txt)
    .SelLength = 0
    .SelText = sFile
  End With
End Sub

Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, _
Button As Integer, Shift As Integer, X As Single, Y As Single)
  Dim f
  If Data.GetFormat(vbCFFiles) Then
    For Each f In Data.Files
      DropFile Text1, f
    Next f
  End If
End Sub

Private Sub Text1_OLEDragOver(Data As DataObject, Effect As Long, _
Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
  If Data.GetFormat(vbCFFiles) Then
    Effect = vbDropEffectCopy And Effect
  Else
    Effect = vbDropEffectNone
  End If
End Sub

Pokud oznaΦφte jeden nebo vφce soubor∙ a "p°etßhnete" je myÜφ nad textbox, vlo₧φ se do n∞j jejich obsah. Samoz°ejm∞ je asi mnohem lepÜφ pro ka₧d² soubor otev°φt novΘ okno, ale to u₧ urΦit∞ zvlßdnete sami.

Zp∞t na obsah