Dobrej pokec   Lišanská šlapka   MSDN   VB na Microsoft.cz   NCHAT Nový design
   Portál  O firmě  Profil  Reference  Produkty  Odkazy  Diskuse  Tisková verze 



  Novinky e-mailem
Pokud chcete být informováni o změnách ,přihlašte se k odběru novinek!
  
  
  Nejčtenější články
 Seznam všech českých hubů abecedně. (32160)
 Seznam hubů nad 100 uživatelů (20875)
 Konfigurovatelné rozbalovací menu (17499)
 Jak na makra (14371)
 Rozbalovací menu v JavaScriptu (2.) (12703)
  Nejstahovanější soubory
 Action Meter (1846)
 Slovní Fotbal (777)
 IE Boss Guard (484)
 zdroják slovní fotbal (383)
 Folder Watcher (370)
  Anketa

  Nabídka portálu

 Adobe Premiere
    Jak se dá udělat
 Alternativní prohlížeče
    FireFox
 ASP
    Tipy a triky
 Direct Connect
    Huby
    Scripty pro HUB
    Tipy a triky CZDC++
 Game Maker
    Tipy a triky
 Hry
    Akční
    Logické
 HTML
    Scripting (VBS,JS)
    Tipy a triky
 Internet
    Užitečné triky
 Microsoft Office
    Tipy, triky, návody
    Užitečná makra
    VBA Tipy a triky
 MS SQL Server
    Nastavení
    Seriály
    Tipy a triky
 Multimedia
    Návody
 Oracle
    PL/SQL
 PHP
    Jak na to
    Tipy a triky
 Užitečné odkazy
    Grafické programy
    Programátorské
 Visual Basic
    DirectX
    Formuláře
    Jak se dá udělat ...
    Užitečné funkce
    Win32Api
    Zdroje
 Visual Basic .NET
    Užitečné funkce
 Vtípky
    Vtipy a anekdnoty
 Vypalování
    DVD Shrink
    Tipy a triky
 Windows
    Jak se dá ...
    Tipy a triky pro XP
    Triky pro IE


Nabídka portálu se při zobrazení článku přesouvá na konec pravého sloupce nabídek.

 Vlastni parametry ke kontrolnímu prvku OCX ve VB

Autor: Kočí Marek
Zdroj: 
Vytvořeno: 11.11.2003
Publikováno: 11.11.2003
Čtenářů: 2583
Unikátních: 2532


Jak přidat libovolný počet parametrů k cizímu ovladacímu prvku?

Dost často se stává, že k již hotovému (cizímu) kontrolnímu prvku potřebujeme přidat náš parametr.Jak na to? Většina z Vás již určitě použila vlastnost Tag.Moje řešení ji využívá také, ale mohu vložit, vyzvednout a mazat vlastních parametrů libovolné množství.
Jak že to funguje? Do vlastnosti tag dám řetězec složený ze všech parametrů a hodnot oddělený oddělovačem.S hodnotami pak mohu pracovat pomocí dvou funkcí a jedné procedury.

Pro vložení/úpravu slouží:
Funkce GetUserParam(KontrolniPrvek,JmenoParametru) As Variant

Pro vyzvednutí
Funkce LetUserParam(KontrolniPrvek,JmenoParametru,Hodnota)

Pro výmaz parametru
Funkce DelUserParam(KontrolniPrvek,JmenoParametru)

KontrolniPrvek je reference na prvek, u kterého s parametry manipulujeme
JmenoParametru je náš název parametru
Hodnota je naše hodnota parametru.

Následuje plně komentovaný zdrojový kód funkcí a procedur.A nakonec ještě příklad použití.
Private Const COddelovac As String = "~|~"

Private Function GetUserParam( _
             ByRef cnt As Control, _
             ByVal ParamName As String _
             ) As Variant

  Dim arrParams
  Dim i As Long
  'Zjistime zda v tagu neco je
  If cnt.Tag <> "" Then
    'Pokud ano, zjistit zda parametr
    'existuje v poli
    If InStr(1, cnt.Tag, COddelovac & _
             UCase(ParamName), _
             vbBinaryCompare) > 0 Then
      'Vytvorime pole parametru
      arrParams = Split(cnt.Tag, COddelovac)
      'projdeme vsechny prvky pole
      For i = LBound(arrParams) To UBound(arrParams)
        'Nalezneme pozadovany parametr
        If Mid(arrParams(i), 1, Len(ParamName)) _
           = UCase(ParamName) Then
          'nalezen ukonci vyhledavani
          Exit For
        End If
      Next
      'Vratime hodnotu parametru
      GetUserParam = Mid(arrParams(i), Len(ParamName) + 1)
    'Existuje samostatne
    ElseIf Mid(cnt.Tag, 1, _
             Len(ParamName)) = UCase(ParamName) Then
      'Vratime hodnotu parametru
      GetUserParam = Mid(cnt.Tag, Len(ParamName) + 1)
    Else
      'Parametr neexistuje
      GetUserParam = ""
    End If

  Else'V tagu nic neni
    GetUserParam = ""
  End If

End Function


Private Function LetUserParam( _
             ByRef cnt As Control, _
             ByVal ParamName As String, _
             ByVal ParamVal As Variant _
             ) As Variant
  Dim arrParams
  Dim i As Long
  'Zjistime zda v tagu neco je
  If cnt.Tag <> "" Then
    'Pokud ano, zjistit zda parametr
    'existuje jinak pridat
    If InStr(1, cnt.Tag, COddelovac & _
             UCase(ParamName), _
             vbBinaryCompare) > 0 _
           Or _
             Mid(cnt.Tag, 1, _
             Len(ParamName)) = UCase(ParamName) _
           Then
      'existuje parametr
      'vytvorime pole parametru
      arrParams = Split(cnt.Tag, COddelovac)
      'projdeme vsechny prvky pole
      For i = LBound(arrParams) To UBound(arrParams)
        'Nalezneme pozadovany parametr
        If Mid(arrParams(i), 1, Len(ParamName)) _
           = UCase(ParamName) Then
          'nalezen ukonci vyhledavani
          Exit For
        End If
      Next
      'Upravime hodnotu parametru
      arrParams(i) = UCase(ParamName) & _
                   CStr(ParamVal)
      'Ulozime cele pole jako text do Tagu
      cnt.Tag = Join(arrParams, COddelovac)
    Else
      'neexistuje parametr
       cnt.Tag = cnt.Tag & COddelovac & _
                    UCase(ParamName) & _
                    ParamVal
    End If
  Else
    'Je prazdny tag
    cnt.Tag = UCase(ParamName) & _
              ParamVal
  End If
End Function

 
Private Function DelUserParam( _
             ByRef cnt As Control, _
             ByVal ParamName As String _
             ) As Boolean
   Dim arrParams
   Dim i As Long
   Dim preskoc As Long
   preskoc = -1
   'Je zadan parametr?
   If cnt.Tag <> "" Then
     'Pokud ano, zjistit zda parametr
    'existuje v poli
    If InStr(1, cnt.Tag, COddelovac & _
             UCase(ParamName), _
             vbBinaryCompare) > 0 Then
      'Vytvorime pole parametru
      arrParams = Split(cnt.Tag, COddelovac)
      'projdeme vsechny prvky pole
      For i = LBound(arrParams) To UBound(arrParams)
        'Nalezneme pozadovany parametr
        If Mid(arrParams(i), 1, Len(ParamName)) _
           = UCase(ParamName) Then
          'nalezen ukonci vyhledavani
          preskoc = i'uloz index pro vymaz
          Exit For
        End If
      Next
      'Vytvor text bez parametru
      cnt.Tag = ""
      For i = LBound(arrParams) To UBound(arrParams)
        'Zapis vse mimo mazaneho
        If i <> preskoc Then
          cnt.Tag = cnt.Tag & arrParams(i) & COddelovac
        End If
        'pokud je pouze jeden tak smaz oddelovac
        If Right(cnt.Tag, 3) = COddelovac And i = 1 Then
           cnt.Tag = Mid(cnt.Tag, 1, Len(cnt.Tag) - 3)
        End If
      Next
      DelUserParam = True
    'Existuje samostatne
    ElseIf Mid(cnt.Tag, 1, _
             Len(ParamName)) = UCase(ParamName) Then
      'Vratime hodnotu parametru
      cnt.Tag = ""
      DelUserParam = True
    Else
      'Parametr neexistuje
      DelUserParam = False
    End If
   Else
     'Parametr neexistuje
     DelUserParam = False
   End If

End Function

A takto se procedury a funkce používají:Na formuláři mám textove pole text1 a text2 a tři tlačítka v text1 mám Název mého parametru v text2 jeho hodnotu.Tlačítkem 1 přidávám(upravuji) hodnotu, tlačítkem2 jí vypisuji msgboxem a tlačítkem 3 jí mažu.
Private Sub Command1_Click()
  LetUserParam Label1, Text1.Text, Text2.Text
End Sub

 
Private Sub Command2_Click()
  MsgBox GetUserParam(Label1, Text1.Text)
End Sub

 
Private Sub Command3_Click()
  DelUserParam Label1, Text1.Text
End Sub



Příspěvky ke článku:



© Swit.cz, Marek Kočí 2003