home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
bp_6_93
/
vbwin
/
addin
/
regi.cls
< prev
Wrap
Text File
|
1993-11-10
|
4KB
|
108 lines
Version 1.0 Class
Attribute VB_Name = "AbisZRegister"
Attribute VB_Creatable = True
Attribute VB_Exposed = True
'****************************************************************************************
'** AZ-Register, Add-In von Michael Tischer, (c) 1994
'****************************************************************************************
'-- Modulinterne Variablen, die fⁿr jede Instanz des Moduls einmal angelegt werden
Private DieseVBInstanz As Object 'speichert die Instanz, in die sich das Addin einklinkt
Private AbisZMenu As Object 'rerΣsentiert den Menⁿeintrag im Add-Ins-Menⁿ
Private AufbauConnect As Long 'speichert Wert fⁿr die Verknⁿpfung zwischen Menⁿ und Programmcode
'-- wird von VB automatisch aufgerufen, nachdem der Anwender das Add-In geladen hat
Sub ConnectAddIn(VBInstanz As Object)
Set DieseVBInstanz = VBInstanz 'Instanz merken
Set AbisZMenu = DieseVBInstanz.AddInMenu.MenuItems.Add("A bis Z-Register") 'Menⁿeintrag an Add-In Menⁿ anhΣngen
AufbauConnect = AbisZMenu.ConnectEvents(Me) 'Event-Procedure befindet sich in diesem Objekt
End Sub
'-- wird von VB automatisch aufgerufen, wenn das Add-In wieder entfernt werden soll
Sub DisconnectAddIn(Mode As Integer)
AbisZMenu.DisconnectEvents AufbauConnect
DieseVBInstanz.AddInMenu.MenuItems.Remove AbisZMenu
End Sub
'-- wird nach Aufruf des A bis Z Register-Menⁿs durch den Anwender
'-- zur Ausfⁿhrung gebracht
Sub AfterClick()
Const BUT_BREITE = 180
Const BUT_HOEHE = 300
Const BUT_NAME = "AzRegister"
Const DAT_NAME = "addin1.~~~"
Dim AktForm As Object
Dim CtrlSammlung As Object
Dim NeuesControl As Object
Dim Eigenschaften As Object
Dim i As Integer
Dim CodeDatei As String
Dim CtrlName As String
Set AktForm = DieseVBInstanz.ActiveProject.ActiveForm
Set CtrlSammlung = AktForm.ControlTemplates
CtrlName = BuildName(CtrlSammlung, BUT_NAME)
'-- 26 Buttons mit den Beschriftungen von a bis Z anlegen
For i = 0 To 25
Set NeuesControl = CtrlSammlung.Add("CommandButton")
Set Eigenschaften = NeuesControl.Properties
Eigenschaften("Width").Value = BUT_BREITE
Eigenschaften("Height").Value = BUT_HOEHE
Eigenschaften("Left").Value = i * BUT_BREITE
Eigenschaften("Top").Value = 100
Eigenschaften("Caption").Value = Chr$(Asc("A") + i)
Eigenschaften("Name").Value = CtrlName
Eigenschaften("Index").Value = i + 1
Next
'-- Programmcode fⁿr Event-Procedure erzeugen und einklinken ---
CodeDatei = App.Path + "\" + DAT_NAME
ErzeugeCodeDatei CodeDatei, CtrlName
AktForm.InsertFile (CodeDatei)
Kill CodeDatei
End Sub
'-- schreibt den Programmcode fⁿr die Event-Procedure der Register --
'-- Buttons in eine Datei
Private Sub ErzeugeCodeDatei(ByVal DateiName As String, ByVal CtrlName As String)
Dim DatNr As Integer
DatNr = FreeFile()
Open DateiName For Output As #DatNr
Print #DatNr, "private sub " + CtrlName + "_click( Index as integer )"
Print #DatNr, " debug.print ""Register: ""+" + CtrlName + "(Index).caption"
Print #DatNr, "end sub"
Close #DatNr
End Sub
'-- schaut nach, ob der gewⁿnschte Name fⁿr die Register-Buttons bereits --
'-- an ein Control vergeben wurde und hΣngt dem Button eine Ziffer an, --
'-- wenn dies der Fall ist
Private Function BuildName(CtrlSammlung As Object, ByVal CName As String)
Dim AnzCtrl As Long
Dim i As Variant
Dim digit As Variant
Dim NewName As String
NewName = CName
AnzCtrl = CtrlSammlung.Count
If AnzCtrl > 0 Then 'gibt es ⁿberhaupt schon Controls?
i = 0 'Ja, alle durchlaufen und nach Namen suchen
digit = 0
Do
If CtrlSammlung(Int(i)).Properties("Name") = NewName Then
i = 0 'den Namen gibt es schon, wieder von vorn anfangen
digit = digit + 1 'Ziffer inkrementieren
NewName = CName + LTrim$(Str$(digit)) 'Ziffer an Namen anhΣngen
Else 'keine Namensⁿbereinstimmung
i = i + 1 'weiter mit nΣchstem Control
End If
Loop While i < AnzCtrl
End If
BuildName = NewName 'diesen Namen weist kein existierendes Control auf
End Function