Swit : Hlavní stránka

Dobrej pokec Lišanská šlapka MSDN VB na Microsoft.cz NCHAT Nový design

Portál O firmě Profil Reference Produkty Odkazy Diskuse

Tisková verze

reklama: www.billboard.cz

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ě. (32122)

Seznam hubů nad 100 uživatelů (20834)

Konfigurovatelné rozbalovací menu (17450)

Jak na makra (14331)

Rozbalovací menu v JavaScriptu (2.) (12655)

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ářů: 2565	Unikátních: 2514

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: