Zdrojové kódy pro vývojáře.
Přeskočit odkazy pro navigaci Top 10 přispěvatelů
UživatelČlánky
codeshare45
sochor1
stoupa1
tomas.oplt15
Článek: Používané funkce v jazyku Visual Basic 6.0
Špatný Super
Autor:
Vytvořeno:
Popularita:

Option Explicit

Private Const CB_ERR = -1
Private Const CB_FINDSTRING = &H14C
Public Const CB_SETCURSEL = &H14E
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal sBuffer As String, lSize As Long) As Long
Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long
 
'Get days for month
Public Function DaysInMonth(dteInput As Date) As Integer
   DaysInMonth = DateAdd("m", 1, dteInput) - dteInput
End Function

'Convertor for binary timestamp data to string
Public Function TimestampToString(TimeStamp As Variant) As String
Dim Buffer As String
     Dim i As Integer
    
     Buffer = "0x"
     For i = 1 To 8
         Buffer = Buffer & Right("00" & Hex(AscB(MidB(TimeStamp, i, 1))), 2)
     Next i
     TimestampToString = Buffer
End Function

'returns current username
Public Function Get_User_Name() As String
    ' Dimension variables
    Dim lpBuff As String * 25
    Dim ret As Long, UserName As String
    ' Get the user name minus any trailing spaces found in the name.
    ret = GetUserName(lpBuff, 25)
    Get_User_Name = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1)
End Function

'returns true if year is leap
Public Function IsLeapYear(yr As Variant) As Boolean
    If (yr Mod 4 = 0 And yr Mod 100 <> 0) Or yr Mod 400 = 0 Then
        IsLeapYear = True
    Else
        IsLeapYear = False
    End If
    
End Function

'searching inside combobox
'this method should be called in combobox keypress event
Public Sub cboFindItem(cbo As ComboBox, KeyAscii As Integer)
 Dim sBuffer As String
 Dim lRetVal As Long
    sBuffer = Left(cbo.Text, cbo.SelStart) & Chr(KeyAscii)
    lRetVal = SendMessage((cbo.hwnd), CB_FINDSTRING, -1, ByVal sBuffer)
    If lRetVal <> CB_ERR Then
        cbo.ListIndex = lRetVal
        cbo.Text = cbo.List(lRetVal)
        cbo.SelStart = Len(sBuffer)
        cbo.SelLength = Len(cbo.Text)
        KeyAscii = 0
    End If
End Sub

'returns current computer name
Function GetComputerNameCurrent() As String
 Dim s1 As String
    s1 = Space(512)
    GetComputerName s1, Len(s1)
    GetComputerNameCurrent = Trim$(s1)
    GetComputerNameCurrent = Left(GetComputerNameCurrent, Len(GetComputerNameCurrent) - 1)
End Function
 

Public Sub cboSetValue(cbo_ As ComboBox, val_ As Long)
   Dim iFor As Long
   Dim bFound As Boolean

   bFound = False
   For iFor = 0 To cbo_.ListCount - 1
      If cbo_.ItemData(iFor) = val_ Then
        bFound = True
        cbo_.ListIndex = iFor
        Exit For
      End If
   Next iFor
   If bFound = False Then
      cbo_.ListIndex = -1
   End If
End Sub


Public Function cboGetValue(cbo_ As ComboBox, valIfNull_ As Long) As Long
   Dim iFor As Long
   Dim bFound As Boolean

   If cbo_.ListIndex = -1 Then
     cboGetValue = valIfNull_
   End If
   
   cboGetValue = cbo_.ItemData(cbo_.ListIndex)
    
End Function
  Na stránku 
screen  Nový příspěvek
Název  Uživatel  Datum 
Poslední návštěva: 14:38:50, 21. listopadu 2017 První  Předchozí  0 Záznamů  Další  Poslední  

Autor článku
Jméno
Pracovní pozice
Informace
Foto

   

Počet návštěvníků:44
 
  Kontakt