Is it possible to write a code which generates a set of MS Access 97's ready-to-run modules?
Yes, it is possible. Here is one of the solutions plus Withevents feature samples. See instructions inline.
Option Compare Database
Option Explicit
'*+
'
' Copyright (c) 1998 by Shamil Salakhetdinov, e-mail: shamil@marta.darts.spb.ru
' by Marek Kepinski, e-mail: MKepinski@impaq.com.pl
'
' Sample code for an upcoming article temporary titled as:
'
' "Dynamic/dockable External Event Procedures/properties/methods (DEEP-objects)
' in MS Access 97 (AKA sink-objects)" or
' "How deep are DEEPs"?
'
' Preface: This sample code/article are the results of authors' investigations
' of MS Access 97's advanced features: custom class modules, early and late
' methods binding, WithEvents objects and VBA code manipulation/generation.
' It seems (was intentionally written) a little bit tricky way to activate
' readers' own investigations of the subject.
' Some of the points of the main subject of this code/article was announced/
' discussed by authors on ACCESS-L discussion list. URL links for this discussion
' are the following:
'
' http://peach.ease.lsoft.com/scripts/wa.exe?A2=ind9807C&L=access-l&P=R21471
' http://peach.ease.lsoft.com/scripts/wa.exe?A2=ind9807C&L=access-l&P=R21833
' http://peach.ease.lsoft.com/scripts/wa.exe?A2=ind9807C&L=access-l&P=R26661
' http://peach.ease.lsoft.com/scripts/wa.exe?A2=ind9807D&L=access-l&P=R831
' http://peach.ease.lsoft.com/scripts/wa.exe?A2=ind9807D&L=access-l&P=R3124
'
' Instructions for sample code "activation":
'
' 1. Unzip sample code from DEEPs.zip archive into _Unpack_.txt VBA module.
' 2. Start MS Access 97
' 3. Create new .mdb file, say DEEPTest.mdb
' 4. Open New module
' 5. Delete options code lines from module
' 6. Insert _Unpack_.txt into this module
' 7. Save module as, e.g., _Unpack_
' 8. Close module
' 9. Open immediate window ( <Ctrl>+<G> )
' 10. Type Unpack<Enter> in it - you should get the sample's form and modules as a result
' 11. Type Test1<Enter> to run Test#1
' 12. Type Test2<Enter> to run Test#2
' 13. Type Test3<Enter> to run Test#3
' 14. Quit MS Access 97
'
' Notes:
'
' - Test#1 shows how single form instance can be opened usual way using DoCmd.OpenForm but
' with all the code (including event processing one) placed into an external custom
' class module...
' - Test#2 shows how multiple form instances can be opened object way...
' - Test#3 is a just a combination of Test#1 and Test#2...
' - If you look through the class module code of frmDEEPTest form you'll find that it has
' property get function. This function isn't necessary to use DEEPs - it is placed in
' form's module to show one of the possible ways to get reference to form's DEEP-object.
' To be DEEP-active form *should* have class module but it can be empty (to get empty
' form's class module open form in design view, open its module, delete all lines from it
' and save it).
' - You can test also codeless front-end form using this sample code - to get such form do the
' following:
'
' 1. Create an front-end .mdb file, say, MyFe.mdb
' 2. Import frmDEEPTest into it
' 3. Open frmDEEPTest in design mode and delete all the code from it
' 4. Go Tools -> References -> Browse to set reference to DEEPTest.MDB
' 5. Save and close frmDEEPTest
' 6. Open frmDEEPTest in normal mode.
' 7. You can also run Test1,2,3 from front-end .MDB to test "back-end"/library forms activation.
'
' to be continued...
'
'*+
Public Sub Unpack()
DEEPTestUnPack True
End Sub
Private Sub DEEPTestUnPack(Optional ByVal vblnGen As Boolean = False)
Dim dbs As Database
Dim mdl As Module
Dim strUnpackMdlName As String
Dim colModules As New Collection
Dim colLines As Collection
Dim lngLinesCnt As Long
Dim strLine As String
Dim strMdlName As String
Dim blnGen As Boolean
blnGen = vblnGen
If blnGen Then DoCmd.Hourglass True
If blnGen Then DoCmd.Echo False, "Generating test objects..."
Set dbs = CodeDb()
If vblnGen Then
DoCmd.OpenModule dbs.Containers("Modules").Documents(0).Name
End If
Set mdl = Modules(0)
strUnpackMdlName = mdl.Name
strMdlName = ""
For lngLinesCnt = 1 To mdl.CountOfLines
strLine = mdl.Lines(lngLinesCnt, 1)
If Len(strLine) >= 6 Then
If Left(strLine, 6) = "'//SOM" Then
Set colLines = New Collection
strMdlName = Trim(Mid(strLine, 7))
colLines.Add "'" & Mid(strLine, 8), Mid(strLine, 2, 5)
ElseIf Left(strLine, 6) = "'//EOM" Then
colModules.Add colLines, strMdlName
Else
If strMdlName <> "" Then
colLines.Add Mid(strLine, 8), Mid(strLine, 2, 5)
End If
End If
End If
Next
DoCmd.Close acModule, mdl.Name
For Each colLines In colModules
strMdlName = Mid(colLines(1), 2)
If blnGen Then smsModuleCreate colLines, strMdlName
Next
If blnGen Then smsFormCreate
CleanUp strUnpackMdlName
'If blnGen Then DoCmd.RunCommand acCmdCompileAllModules
If blnGen Then DoCmd.Echo True
If blnGen Then DoCmd.Hourglass False
End Sub
Private Function CleanUp(ByVal vstrMdlname As String)
Dim frm As Form
Dim mdl As Module
Set frm = CreateForm()
DoCmd.RunCommand acCmdViewCode
Set mdl = Modules("Form_" & frm.Name)
mdl.DeleteLines 1, mdl.CountOfLines
mdl.InsertText "Private Sub Form_Timer()"
mdl.InsertText " on error resume next"
mdl.InsertText " DoCmd.DeleteObject acModule, """ & vstrMdlname & """"
mdl.InsertText " docmd.Close acForm ,Me.name,acSaveNo"
mdl.InsertText "End sub"
DoCmd.Close acModule, mdl.Name
frm.OnTimer = "[Event Procedure]"
frm.TimerInterval = 1000
DoCmd.OpenForm frm.Name, acNormal, , , , acHidden
End Function
Private Function smsFormCreate()
Dim frm As Form
Dim strAutoFrmName As String
Dim ctl As Control
Dim mdl As Module
Set frm = CreateForm()
Set ctl = CreateControl(frm.Name, acCommandButton)
ctl.Name = "cmdOk"
Set ctl = CreateControl(frm.Name, acLabel)
ctl.Name = "lblMsg"
Set ctl = CreateControl(frm.Name, acRectangle)
ctl.Name = "shpFrame"
DoCmd.Restore
smsFormPrpsSet frm
DoCmd.RunCommand acCmdViewCode
Set mdl = Modules("Form_" & frm.Name)
mdl.DeleteLines 1, mdl.CountOfLines
mdl.InsertText "Public Property Get DEEP() As Object 'clsFormDEEP"
mdl.InsertText " Set DEEP = FormDEEP(Me)"
mdl.InsertText "End Property"
frm.OnOpen = "=smsFormAndDEEPsCheckIn([Form])"
frm.OnClose = "=smsFormAndDEEPsCheckOut([Form])"
strAutoFrmName = frm.Name
DoCmd.SetWarnings False
DoCmd.Close acForm, strAutoFrmName, acSaveYes
DoCmd.Rename "frmDEEPTest", acForm, strAutoFrmName
DoCmd.SetWarnings True
End Function
Private Function smsFormPrpsSet(ByRef rfrm As Form)
Dim ctl As Control
With rfrm
.DefaultView = 0 'Single Form
.ViewsAllowed = 1 ' Form
.ScrollBars = 0 ' neither
.RecordSelectors = False
.NavigationButtons = False
.DividingLines = False
.AutoResize = True
.AutoCenter = True
.BorderStyle = 1 ' Thin
.ControlBox = False
.MinMaxButtons = 0 ' None
.CloseButton = False
.Cycle = 1 ' Current record
.GridX = 5
.GridY = 5
.PopUp = True
.InsideWidth = 4530
.InsideHeight = 3045
.Width = 4530
.Section(0).Height = 3105
.Caption = "DEEPs test form"
End With
Set ctl = rfrm![cmdOk]
With ctl
.Name = "cmdOK"
.Caption = "OK"
.Left = 1815
.Top = 2310
.Width = 1140
.Height = 510
End With
Set ctl = rfrm![lblMsg]
With ctl
.Name = "lblMsg"
.Caption = "1 second left to start test..."
.Left = 390
.Top = 375
.Width = 3675
.Height = 1605
.FontName = "MS Sans Serif"
.FontSize = 9
.FontBold = True
.TextAlign = 2 ' Center
End With
Set ctl = rfrm![shpFrame]
With ctl
.Name = "shpFrame"
.Left = 330
.Top = 315
.Width = 3900
.Height = 1740
.SpecialEffect = 3
End With
End Function
Public Function smsModuleCreate(ByRef rcolModuleLines As Collection, ByVal vstrModuleName As String)
Dim mdl As Module
Dim strCode As String
Dim strAutoMdlName As String
Dim varLine As Variant
Select Case Left(vstrModuleName, 3)
Case "bas":
DoCmd.RunCommand acCmdNewObjectModule
Case "cls":
DoCmd.RunCommand acCmdNewObjectClassModule
End Select
Set mdl = Modules(Modules.Count - 1)
mdl.DeleteLines 1, mdl.CountOfLines
For Each varLine In rcolModuleLines
mdl.InsertText varLine
Next
strAutoMdlName = mdl.Name
DoCmd.SetWarnings False
DoCmd.Close acModule, strAutoMdlName, acSaveYes
DoCmd.Rename vstrModuleName, acModule, strAutoMdlName
DoCmd.SetWarnings True
End Function
'//SOP
'//SOM bas_Description
'00001 '*+
'00002 '
'00003 ' Copyright (c) 1998 by Shamil Salakhetdinov, e-mail: shamil@marta.darts.spb.ru
'00004 ' by Marek Kepinski, e-mail: MKepinski@impaq.com.pl
'00005 '
'00006 ' Sample code for an upcoming article temporary titled as:
'00007 '
'00008 ' "Dynamic/dockable External Event Procedures/properties/methods (DEEP-objects)
'00009 ' in MS Access 97 (AKA sink-objects)" or
'00010 ' "How deep are DEEPs"?
'00011 '
'00012 ' Preface: This sample code/article are the results of authors' investigations
'00013 ' of MS Access 97's advanced features: custom class modules, early and late
'00014 ' methods binding, WithEvents objects and VBA code manipulation/generation.
'00015 ' It seems (was intentionally written) a little bit tricky way to activate
'00016 ' readers' own investigations of the subject.
'00017 ' Some of the points of the main subject of this code/article was announced/
'00018 ' discussed by authors on ACCESS-L discussion list. URL links for this discussion
'00019 ' are the following:
'00020 '
'00021 ' http://peach.ease.lsoft.com/scripts/wa.exe?A2=ind9807C&L=access-l&P=R21471
'00022 ' http://peach.ease.lsoft.com/scripts/wa.exe?A2=ind9807C&L=access-l&P=R21833
'00023 ' http://peach.ease.lsoft.com/scripts/wa.exe?A2=ind9807C&L=access-l&P=R26661
'00024 ' http://peach.ease.lsoft.com/scripts/wa.exe?A2=ind9807D&L=access-l&P=R831
'00025 ' http://peach.ease.lsoft.com/scripts/wa.exe?A2=ind9807D&L=access-l&P=R3124
'00026 '
'00027 ' Instructions for sample code "activation":
'00028 '
'00029 ' 1. Unzip sample code from DEEPs.zip archive into _Unpack_.txt VBA module.
'00030 ' 2. Start MS Access 97
'00031 ' 3. Create new .mdb file, say DEEPTest.mdb
'00032 ' 4. Open New module
'00033 ' 5. Delete options code lines from module
'00034 ' 6. Insert _Unpack_.txt into this module
'00035 ' 7. Save module as, e.g., _Unpack_
'00036 ' 8. Close module
'00037 ' 9. Open immediate window ( <Ctrl>+<G> )
'00038 ' 10. Type Unpack<Enter> in it - you should get the sample's form and modules as a result
'00039 ' 11. Type Test1<Enter> to run Test#1
'00040 ' 12. Type Test2<Enter> to run Test#2
'00041 ' 13. Type Test3<Enter> to run Test#3
'00042 ' 14. Quit MS Access 97
'00043 '
'00044 ' Notes:
'00045 '
'00046 ' - Test#1 shows how single form instance can be opened usual way using DoCmd.OpenForm but
'00047 ' with all the code (including event processing one) placed into an external custom
'00048 ' class module...
'00049 ' - Test#2 shows how multiple form instances can be opened object way...
'00050 ' - Test#3 is a just a combination of Test#1 and Test#2...
'00051 ' - If you look through the class module code of frmDEEPTest form you'll find that it has
'00052 ' property get function. This function isn't necessary to use DEEPs - it is placed in
'00053 ' form's module to show one of the possible ways to get reference to form's DEEP-object.
'00054 ' To be DEEP-active form *should* have class module but it can be empty (to get empty
'00055 ' form's class module open form in design view, open its module, delete all lines from it
'00056 ' and save it).
'00057 ' - You can test also codeless front-end form using this sample code - to get such form do the
'00058 ' following:
'00059 '
'00060 ' 1. Create an front-end .mdb file, say, MyFe.mdb
'00061 ' 2. Import frmDEEPTest into it
'00062 ' 3. Open frmDEEPTest in design mode and delete all the code from it
'00063 ' 4. Go Tools -> References -> Browse to set reference to DEEPTest.MDB
'00064 ' 5. Save and close frmDEEPTest
'00065 ' 6. Open frmDEEPTest in normal mode.
'00066 ' 7. You can also run Test1,2,3 from front-end .MDB to test "back-end"/library forms activation.
'00067 '
'00068 ' to be continued...
'00069 '
'00070 '*+
'//EOM bas_Description
'//SOM bas_Tests
'00001 Option Compare Database
'00002 Option Explicit
'00003
'00004 Public Sub Test1()
'00005 DoCmd.OpenForm "frmDeepTest", acNormal
'00006 End Sub
'00007
'00008 Public Sub Test2()
'00009 Dim frm1 As New Form_frmDEEPTest
'00010 Dim frm2 As New Form_frmDEEPTest
'00011 Dim frm3 As New Form_frmDEEPTest
'00012
'00013 FormDEEP(frm1).mtdTestDurationReset 10
'00014 frm1.Visible = True
'00015 If frm1.PopUp = False Then
'00016 DoCmd.MoveSize 200, 200
'00017 Else
'00018 DoCmd.MoveSize 200, 1100
'00019 End If
'00020
'00021 frm2.DEEP.mtdTestDurationReset 7
'00022 frm2.Visible = True
'00023 If frm2.PopUp = False Then
'00024 DoCmd.MoveSize 500, 500
'00025 Else
'00026 DoCmd.MoveSize 500, 1400
'00027 End If
'00028
'00029 FormDEEP(frm3).mtdTestDurationReset 14
'00030 frm3.Visible = True
'00031 If frm3.PopUp = False Then
'00032 DoCmd.MoveSize 800, 800
'00033 Else
'00034 DoCmd.MoveSize 800, 1700
'00035 End If
'00036 End Sub
'00037
'00038 Public Sub Test3()
'00039 Test1
'00040 Test2
'00041 End Sub
'//EOM bas_Tests
'//SOM basHelpers
'00001 Option Compare Database
'00002 Option Explicit
'00003
'00004 Public pobjFormsRegistry As New clsFormsRegistry
'00005 Public pobjDEEPsRegistry As New clsDEEPsRegistry
'00006
'00007 Public Function smsFormAndDEEPsCheckIn(ByRef rfrm As Form)
'00008 pobjFormsRegistry.CheckIn rfrm, FormId(rfrm)
'00009
'00010 ObjDeepDock rfrm, New clsFormDEEP
'00011 ObjDeepDock rfrm![cmdOk], New clsCmdCtlDEEP
'00012 ObjDeepDock rfrm![lblMsg], New clsLblCtlDEEP
'00013 ObjDeepDock rfrm![lblMsg], New clsLastLblCtlInQueue, 1
'00014 ObjDeepDock rfrm![shpFrame], New clsShpCtlDEEP
'00015 End Function
'00016
'00017 Public Function smsFormAndDEEPsCheckOut(ByRef rfrm As Form)
'00018 ObjDeepUnDock rfrm![shpFrame]
'00019 ObjDeepUnDock rfrm![lblMsg], 1
'00020 ObjDeepUnDock rfrm![lblMsg]
'00021 ObjDeepUnDock rfrm![cmdOk]
'00022 ObjDeepUnDock rfrm
'00023
'00024 pobjFormsRegistry.CheckOut rfrm, FormId(rfrm)
'00025 End Function
'00026
'00027 Public Property Get FormId(ByRef rfrm As Object, Optional ByVal vintDEEPIdx As Integer = 0) As String
'00028 FormId = CStr(rfrm.Hwnd) & "." & CStr(vintDEEPIdx)
'00029 End Property
'00030
'00031 Public Property Get FormDEEP(ByRef rfrm As Form) As clsFormDEEP
'00032 Set FormDEEP = pobjDEEPsRegistry.Item(FormId(rfrm))
'00033 End Property
'00034
'00035 Public Property Get CtlId(ByRef rctl As Object, Optional ByVal vintDEEPIdx As Integer = 0) As String
'00036 Dim frm As Object
'00037 Dim ctl As Object
'00038
'00039 Set ctl = rctl
'00040 While Not TypeOf ctl.Parent Is Form
'00041 Set ctl = ctl.Parent
'00042 Wend
'00043 Set frm = ctl.Parent
'00044 CtlId = ctl.Name & CStr(frm.Hwnd) & "." & CStr(vintDEEPIdx)
'00045 End Property
'00046
'00047 Public Property Get CmdCtlDEEP(ByRef rcmd As CommandButton) As clsCmdCtlDEEP
'00048 Set CmdCtlDEEP = pobjDEEPsRegistry.Item(CtlId(rcmd))
'00049 End Property
'00050
'00051 Public Property Get LblCtlDEEP(ByRef rlbl As Label) As clsLblCtlDEEP
'00052 Set LblCtlDEEP = pobjDEEPsRegistry.Item(CtlId(rlbl))
'00053 End Property
'00054
'00055 Public Property Get ShpCtlDEEP(ByRef rshp As Rectangle) As clsShpCtlDEEP
'00056 Set ShpCtlDEEP = pobjDEEPsRegistry.Item(CtlId(rshp))
'00057 End Property
'00058
'00059 Public Property Get ControlDEEP(ByRef rctl As Control) As Object
'00060 Set ControlDEEP = pobjDEEPsRegistry.Item(CtlId(rctl))
'00061 End Property
'00062
'00063 Public Property Get ObjId(ByRef robj As Object, Optional ByVal vintDEEPIdx As Integer = 0) As String
'00064 If TypeOf robj Is Form Then
'00065 ObjId = FormId(robj, vintDEEPIdx)
'00066 Else
'00067 ObjId = CtlId(robj, vintDEEPIdx)
'00068 End If
'00069 End Property
'00070
'00071 Private Function ObjDeepDock(ByRef robj As Object, ByRef robjDeep As Object, Optional ByVal vintDEEPIdx As Integer = 0)
'00072 robjDeep.Dock robj
'00073 pobjDEEPsRegistry.CheckIn robjDeep, ObjId(robj, vintDEEPIdx)
'00074 End Function
'00075
'00076 Private Function ObjDeepUnDock(ByRef robj As Object, Optional ByVal vintDEEPIdx As Integer = 0)
'00077 Dim objDeep As Object
'00078
'00079 Set objDeep = pobjDEEPsRegistry.Item(ObjId(robj, vintDEEPIdx))
'00080 objDeep.UnDock
'00081 pobjDEEPsRegistry.CheckOut objDeep, ObjId(robj, vintDEEPIdx)
'00082 End Function
'00083
'00084
'//EOM basHelpers
'//SOM clsCmdCtlDEEP
'00001 Option Compare Database
'00002 Option Explicit
'00003
'00004 Private WithEvents mcmd As CommandButton
'00005
'00006 Public Function Dock(ByRef rcmd As CommandButton)
'00007 Set mcmd = rcmd
'00008 rcmd.OnClick = "[Event procedure]"
'00009 End Function
'00010
'00011 Public Function UnDock()
'00012 mcmd.OnClick = ""
'00013 Set mcmd = Nothing
'00014 End Function
'00015
'00016 Private Sub mcmd_Click()
'00017 mcmd.Parent.TimerInterval = 0
'00018 MsgBox "Button [" & mcmd.Caption & "] clicked.@ @", vbInformation + vbOKOnly
'00019 FormDEEP(mcmd.Parent).mtdClose
'00020 End Sub
'00021
'//EOM clsCmdCtlDEEP
'//SOM clsDEEPsRegistry
'00001 Option Compare Database
'00002 Option Explicit
'00003
'00004 Private mobjDEEPsRegistry As New clsObjectRegistry
'00005
'00006 Private Sub Class_Terminate()
'00007 Set mobjDEEPsRegistry = Nothing
'00008 End Sub
'00009
'00010 Public Function CheckIn(ByRef robjDeep As Object, ByVal vvarDEEPId As Variant)
'00011 mobjDEEPsRegistry.CheckIn robjDeep, vvarDEEPId
'00012 End Function
'00013
'00014 Public Function CheckOut(ByRef robjDeep As Object, ByVal vvarDEEPId As Variant)
'00015 mobjDEEPsRegistry.CheckOut robjDeep, vvarDEEPId
'00016 End Function
'00017
'00018 Public Property Get Item(ByVal vvarDEEPId As Variant) As Variant
'00019 Set Item = mobjDEEPsRegistry.Item(vvarDEEPId)
'00020 End Property
'//EOM clsDEEPsRegistry
'//SOM clsFormDEEP
'00001 Option Compare Database
'00002 Option Explicit
'00003
'00004 Private Const mclngTimerInterval As Long = 1000
'00005 Private Const mcintTestDuration As Integer = 15
'00006
'00007 Private WithEvents mfrm As Form
'00008 Private mintTestDuration As Integer
'00009
'00010 Public Function Dock(ByRef rfrm As Form)
'00011 Dim frm As Form
'00012 Dim intIdx As Integer
'00013 Dim strCaption As String
'00014
'00015 Set mfrm = rfrm
'00016 mfrm.OnTimer = "[Event procedure]"
'00017 mfrm.TimerInterval = mclngTimerInterval
'00018 mintTestDuration = mcintTestDuration
'00019 strCaption = "(Hwnd = " & mfrm.Hwnd & ") " & mfrm.Caption
'00020 For intIdx = 0 To Forms.Count - 1
'00021 Set frm = Forms(intIdx)
'00022 If frm Is rfrm Then
'00023 strCaption = CStr(intIdx + 1) & ". " & strCaption
'00024 End If
'00025 Next intIdx
'00026 mfrm.Caption = strCaption
'00027 End Function
'00028
'00029 Public Function UnDock()
'00030 mfrm.TimerInterval = 0
'00031 mfrm.OnTimer = ""
'00032 Set mfrm = Nothing
'00033 End Function
'00034
'00035 Public Sub mtdClose()
'00036 mfrm.SetFocus
'00037 DoCmd.Close
'00038 End Sub
'00039
'00040 Public Sub mtdTestDurationReset(ByVal vintTestDuration As Integer)
'00041 mintTestDuration = vintTestDuration
'00042 End Sub
'00043
'00044 Private Sub mfrm_Timer()
'00045 Dim strMsg As String
'00046 mintTestDuration = mintTestDuration - 1
'00047 strMsg = ""
'00048 strMsg = strMsg & "Form closes inself in " & mintTestDuration & " seconds," & vbCrLf
'00049 strMsg = strMsg & "meantime you can click on label or rectangle " & vbCrLf
'00050 strMsg = strMsg & "border to see their DEEPs in effect or" & vbCrLf
'00051 strMsg = strMsg & "click [OK]" & vbCrLf & "to close test form..."
'00052 mfrm![lblMsg].Caption = strMsg
'00053 If mintTestDuration = 0 Then mtdClose
'00054 End Sub
'00055
'00056
'//EOM clsFormDEEP
'//SOM clsFormsRegistry
'00001 Option Compare Database
'00002 Option Explicit
'00003
'00004 Private mobjFormsRegistry As New clsObjectRegistry
'00005
'00006 Private Sub Class_Terminate()
'00007 Set mobjFormsRegistry = Nothing
'00008 End Sub
'00009
'00010 Public Function CheckIn(ByRef rfrm As Form, ByVal vvarFormId As Variant)
'00011 mobjFormsRegistry.CheckIn rfrm, vvarFormId
'00012 End Function
'00013
'00014 Public Function CheckOut(ByRef rfrm As Form, ByVal vvarFormId As Variant)
'00015 mobjFormsRegistry.CheckOut rfrm, vvarFormId
'00016 End Function
'00017
'00018 Public Property Get Item(ByVal vvarFormId As Variant) As Variant
'00019 Set Item = mobjFormsRegistry.Item(vvarFormId)
'00020 End Property
'00021
'//EOM clsFormsRegistry
'//SOM clsLastLblCtlInQueue
'00001 Option Compare Database
'00002 Option Explicit
'00003
'00004 Private WithEvents mctl As Label
'00005
'00006 Public Function Dock(ByRef rctl As Control)
'00007 Set mctl = rctl
'00008 mctl.Properties("OnClick") = "[Event procedure]"
'00009 End Function
'00010
'00011 Public Function UnDock()
'00012 mctl.Properties("OnClick") = ""
'00013 Set mctl = Nothing
'00014 End Function
'00015
'00016 Private Sub mctl_Click()
'00017 mctl.FontSize = 9
'00018 mctl.FontUnderline = Not (mctl.FontUnderline)
'00019 End Sub
'00020
'//EOM clsLastLblCtlInQueue
'//SOM clsLblCtlDEEP
'00001 Option Compare Database
'00002 Option Explicit
'00003
'00004 Private WithEvents mlbl As Label
'00005
'00006 Public Function Dock(ByRef rlbl As Label)
'00007 Set mlbl = rlbl
'00008 rlbl.OnClick = "[Event procedure]"
'00009 End Function
'00010
'00011 Public Function UnDock()
'00012 mlbl.OnClick = ""
'00013 Set mlbl = Nothing
'00014 End Function
'00015
'00016 Private Sub mlbl_Click()
'00017 mlbl.FontItalic = Not (mlbl.FontItalic)
'00018 End Sub
'00019
'//EOM clsLblCtlDEEP
'//SOM clsObjectRegistry
'00001 Option Compare Database
'00002 Option Explicit
'00003
'00004 Private mcolObjectRegistry As New Collection
'00005
'00006 Private Sub Class_Terminate()
'00007 Set mcolObjectRegistry = Nothing
'00008 End Sub
'00009
'00010 Public Function CheckIn(ByRef robj As Object, ByVal vvarObjId As Variant)
'00011 mcolObjectRegistry.Add robj, CStr(vvarObjId)
'00012 End Function
'00013
'00014 Public Function CheckOut(ByRef robj As Object, ByVal vvarObjId As Variant)
'00015 mcolObjectRegistry.Remove CStr(vvarObjId)
'00016 End Function
'00017
'00018 Public Property Get Item(ByVal vvarObjId As Variant) As Variant
'00019 Set Item = mcolObjectRegistry.Item(vvarObjId)
'00020 End Property
'00021
'//EOM clsObjectRegistry
'//SOM clsShpCtlDEEP
'00001 Option Compare Database
'00002 Option Explicit
'00003
'00004 Private WithEvents mshp As Rectangle
'00005
'00006 Public Function Dock(ByRef rshp As Rectangle)
'00007 Set mshp = rshp
'00008 rshp.OnClick = "[Event procedure]"
'00009 End Function
'00010
'00011 Public Function UnDock()
'00012 mshp.OnClick = ""
'00013 Set mshp = Nothing
'00014 End Function
'00015
'00016 Private Sub mshp_Click()
'00017 mshp.SpecialEffect = 5 - mshp.SpecialEffect
'00018 End Sub
'00019
'//EOM clsShpCtlDEEP
'//EOP
| HOME TOPICS |
Copyright © 1998–1999 by Shamil Salakhetdinov.
|
| Last updated: June 7, 1999
Published also here at 4TOPS: Self-extracting VBA code and WithEvents tricks |
|