ClassA.cls Public Event MyEvent() Public Sub RaiseMyEvent() RaiseEvent MyEvent End Sub -------------------------- ClassB.cls Public classA1 As New ClassA Public Sub Hoge() Call classA1.RaiseMyEvent End Sub ------------------------- Form1.frm Private WithEvents classA1 Private Sub classA1_MyEvent() Debug.Print "Hoge" End Sub Private Sub Form_Load() Dim classB1 As New ClassB Set classA1 = classB1.classA1 Call classB1.Hoge End Sub
ClassA.cls Public Property Set classC1(c As ClassC1) End Property ---------------- ClassB.cls Implements ClassA Dim classC1 As ClassC Public Sub Hoge() Call classC1.RaiseMyEvent End Sub Private Property Set ClassA_classC1(c As ClassC1) Set classC1 = c End Property ---------------- ClassC.cls Public Event MyEvent Public Sub RaiseMyEvent() RaiseEvent MyEvent End Sub ---------------- Form1.frm Private WithEvents classC1 as ClassC Private Sub classC1_MyEvent() Debug.Print "Hoge" End Sub Private Sub Form_Load() Dim classA1 As ClassA, classB1 As New ClassB Set classA1 = classB1: Set classC1 = New ClassC: Set classA1.classC1 = classC1 Call classB1.Hoge End Sub
ClassA.cls Public Property Set classC1(c As ClassC) End Property --------------- ClassB.cls Implements ClassA Dim classC1 As ClassC Public Sub Hoge() Call classC1.RaiseMyEvent End Sub Private Property Set ClassA_classC1(c As ClassC) Set classC1 = c End Property --------------- ClassC.cls Public Event QueryMyEvent() Public Sub RaiseMyEvent() RaiseEvent QueryMyEvent End Sub ---------------
423 名前：デフォルトの名無しさん [2010/03/10(水) 13:53:45 ]
ClassD.cls Public Event MyEvent() Private WithEvents classC1 As ClassC Dim mclassA1 As ClassA Public Property Set classA1(a As ClassA) If Not (mclassA Is Nothing) Then Set mclassA.classC1 = Nothing: Set mclassA = Nothing Set mclassA = a Set mclassA.classC1 = classC1 End Property Private Sub classC1_QueryMyEvent() RaiseEvent MyEvent End Sub Private Sub Class_Initialize() Set classC1 = New ClassC End SUb --------------- Form1.frm Private WithEvents classD1 As ClassD Private Sub classD1_MyEvent() Debug.Print "Hoge" End Sub Private Sub Form_Load() Set classD1 = New ClassD Dim classB1 As New ClassB Set classD1.classA1 = classB1 Call classB1.Hoge End Sub
424 名前：デフォルトの名無しさん [2010/03/10(水) 14:07:27 ]
ClassB.cls Implements ClassA Dim classC1 As ClassC Public Sub Hoge() If Not (classC1 Is Nothing) Then Call classC1.RaiseMyEvent End If End Sub Private Property Set ClassA_classC1(c As ClassC) Set classC1 = c End Property
425 名前：デフォルトの名無しさん [2010/03/10(水) 14:13:22 ]
ClassE.cls Implements ClassA Dim classC1 As ClassC Public Sub Hoge2() If Not (classC1 Is Nothing) Then Call classC1.RaiseMyEvent End If End Sub Private Property Set ClassA_classC1(c As ClassC) Set classC1 = c End Property --------------- Form1.frm Private WithEvents classD1 As ClassD Private Sub classD1_MyEvent() Debug.Print "Hoge" End Sub Private Sub Form_Load() Set classD1 = New ClassD Dim classB1 As New ClassB Set classD1.classA1 = classB1 Debug.Print "Test1": Call classB1.Hoge Dim classE1 As New ClassE Set classD1.classA1 = classE1 Debug.Print "Test2": Call classB1.Hoge Debug.Print "Test3": Call classE1.Hoge2 End Sub
ClassD.cls Public Event MyEvent() Private WithEvents classC1 As ClassC Dim mclassA1 As ClassA Public Property Set classA1(a As ClassA) If Not (mclassA1 Is Nothing) Then Set mclassA1.classC1 = Nothing: Set mclassA1 = Nothing Set mclassA1 = a If Not (mclassA1 Is Nothing) Then Set mclassA1.classC1 = classC1 End Property Private Sub classC1_QueryMyEvent() RaiseEvent MyEvent End Sub Private Sub Class_Initialize() Set classC1 = New ClassC End Sub
Form1.frm (CommandButton一つ配置) Private Sub Command1_Click() Dim f As New Form2 f.show End Sub ---------------------------- Form2.frm (BorderStyleを3に設定) Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Static dx, dy If Button > 0 Then Me.Left = Me.Left + X - dx Me.Top = Me.Top + Y - dy Else dx = X dy = Y End Sub
Module1.bas Private Const SWP_NOMOVE = 2, SWP_NOSIZE = 1, SWP_NOMOVE Or SWP_NOSIZE Private Const HWND_TOPMOST = -1, HWND_NOTOPMOST = -2 Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, _ ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Public Function SetTopMostWindow(hwnd As Long, Topmost As Boolean) As Long If Topmost = True Then 'Make the window topmost SetTopMostWindow = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS) Else SetTopMostWindow = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS) SetTopMostWindow = False End If End Function Form1.frm (CommandButton一つ配置) ----------------------- Private Sub Command1_Click() Dim f As New Form2 f.show: SetTopMostWindow f.hWnd, True End Sub Form2.frm (BorderStyleを0に設定) ----------------------- Private Sub Form_DblClick() Unload Me End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) SetTopMostWindow Me.hWnd, True End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Static dx, dy If Button > 0 Then Me.Left = Me.Left + X - dx: Me.Top = Me.Top + Y - dy Else dx = X: dy = Y End Sub
