home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_6_93 / vbwin / addin / regi.cls < prev   
Text File  |  1993-11-10  |  4KB  |  108 lines
  1. Version 1.0 Class
  2. Attribute VB_Name = "AbisZRegister"
  3. Attribute VB_Creatable = True
  4. Attribute VB_Exposed = True
  5. '****************************************************************************************
  6. '** AZ-Register, Add-In von Michael Tischer, (c) 1994
  7. '****************************************************************************************
  8.  
  9. '-- Modulinterne Variablen, die fⁿr jede Instanz des Moduls einmal angelegt werden
  10. Private DieseVBInstanz As Object  'speichert die Instanz, in die sich das Addin einklinkt
  11. Private AbisZMenu As Object       'rerΣsentiert den Menⁿeintrag im Add-Ins-Menⁿ
  12. Private AufbauConnect As Long     'speichert Wert fⁿr die Verknⁿpfung zwischen Menⁿ und Programmcode
  13.  
  14. '-- wird von VB automatisch aufgerufen, nachdem der Anwender das Add-In geladen hat
  15. Sub ConnectAddIn(VBInstanz As Object)
  16.     Set DieseVBInstanz = VBInstanz  'Instanz merken
  17.     Set AbisZMenu = DieseVBInstanz.AddInMenu.MenuItems.Add("A bis Z-Register") 'Menⁿeintrag an Add-In Menⁿ anhΣngen
  18.     AufbauConnect = AbisZMenu.ConnectEvents(Me)  'Event-Procedure befindet sich in diesem Objekt
  19. End Sub
  20.  
  21. '-- wird von VB automatisch aufgerufen, wenn das Add-In wieder entfernt werden soll
  22. Sub DisconnectAddIn(Mode As Integer)
  23.     AbisZMenu.DisconnectEvents AufbauConnect
  24.     DieseVBInstanz.AddInMenu.MenuItems.Remove AbisZMenu
  25. End Sub
  26.  
  27. '-- wird nach Aufruf des A bis Z Register-Menⁿs durch den Anwender
  28. '-- zur Ausfⁿhrung gebracht
  29. Sub AfterClick()
  30.   Const BUT_BREITE = 180
  31.   Const BUT_HOEHE = 300
  32.   Const BUT_NAME = "AzRegister"
  33.   Const DAT_NAME = "addin1.~~~"
  34.   
  35.   Dim AktForm As Object
  36.   Dim CtrlSammlung As Object
  37.   Dim NeuesControl As Object
  38.   Dim Eigenschaften As Object
  39.   Dim i As Integer
  40.   Dim CodeDatei As String
  41.   Dim CtrlName As String
  42.   
  43.   Set AktForm = DieseVBInstanz.ActiveProject.ActiveForm
  44.   Set CtrlSammlung = AktForm.ControlTemplates
  45.   
  46.   CtrlName = BuildName(CtrlSammlung, BUT_NAME)
  47.   
  48.   '-- 26 Buttons mit den Beschriftungen von a bis Z anlegen
  49.   For i = 0 To 25
  50.     Set NeuesControl = CtrlSammlung.Add("CommandButton")
  51.     Set Eigenschaften = NeuesControl.Properties
  52.     Eigenschaften("Width").Value = BUT_BREITE
  53.     Eigenschaften("Height").Value = BUT_HOEHE
  54.     Eigenschaften("Left").Value = i * BUT_BREITE
  55.     Eigenschaften("Top").Value = 100
  56.     Eigenschaften("Caption").Value = Chr$(Asc("A") + i)
  57.     Eigenschaften("Name").Value = CtrlName
  58.     Eigenschaften("Index").Value = i + 1
  59.   Next
  60.   
  61.   '-- Programmcode fⁿr Event-Procedure erzeugen und einklinken ---
  62.   CodeDatei = App.Path + "\" + DAT_NAME
  63.   ErzeugeCodeDatei CodeDatei, CtrlName
  64.   AktForm.InsertFile (CodeDatei)
  65.   Kill CodeDatei
  66. End Sub
  67.  
  68. '-- schreibt den Programmcode fⁿr die Event-Procedure der Register --
  69. '-- Buttons in eine Datei
  70. Private Sub ErzeugeCodeDatei(ByVal DateiName As String, ByVal CtrlName As String)
  71.   Dim DatNr As Integer
  72.   
  73.   DatNr = FreeFile()
  74.   Open DateiName For Output As #DatNr
  75.   Print #DatNr, "private sub " + CtrlName + "_click( Index as integer )"
  76.   Print #DatNr, "  debug.print ""Register: ""+" + CtrlName + "(Index).caption"
  77.   Print #DatNr, "end sub"
  78.   Close #DatNr
  79. End Sub
  80.  
  81. '-- schaut nach, ob der gewⁿnschte Name fⁿr die Register-Buttons bereits --
  82. '-- an ein Control vergeben wurde und hΣngt dem Button eine Ziffer an,   --
  83. '-- wenn dies der Fall ist
  84. Private Function BuildName(CtrlSammlung As Object, ByVal CName As String)
  85.   Dim AnzCtrl As Long
  86.   Dim i As Variant
  87.   Dim digit As Variant
  88.   Dim NewName As String
  89.   
  90.   NewName = CName
  91.   AnzCtrl = CtrlSammlung.Count
  92.   If AnzCtrl > 0 Then 'gibt es ⁿberhaupt schon Controls?
  93.     i = 0 'Ja, alle durchlaufen und nach Namen suchen
  94.     digit = 0
  95.     Do
  96.       If CtrlSammlung(Int(i)).Properties("Name") = NewName Then
  97.         i = 0 'den Namen gibt es schon, wieder von vorn anfangen
  98.         digit = digit + 1 'Ziffer inkrementieren
  99.         NewName = CName + LTrim$(Str$(digit)) 'Ziffer an Namen anhΣngen
  100.       Else                    'keine Namensⁿbereinstimmung
  101.         i = i + 1             'weiter mit nΣchstem Control
  102.       End If
  103.     Loop While i < AnzCtrl
  104.   End If
  105.   BuildName = NewName 'diesen Namen weist kein existierendes Control auf
  106. End Function
  107.  
  108.