Roombuster

‘add 9 labels and 1 text and 1 timer

Private Sub Command1_Click()
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
End Sub

Private Sub Form_Load()
Top = Screen.Height / 2 – Height / 2
Left = Screen.Width / 2 – Width / 2
StayOnTop Me
ErrorRsenD “•·• Lean Buster ¹·º •·•”
ErrorRsenD “•·• Now Loading •·•”

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
FormDrag Me
End Sub

Private Sub Form_Paint()
Etched3D Me
FormShade_BlueGreen Me
End Sub

Private Sub Form_Resize()
StayOnTop Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
ErrorRsenD “•·• Lean Buster ¹·º •·•”
ErrorRsenD “•·• Now UnLoading •·•”
Unload Me
End
End Sub

Private Sub Label2_Click()
Label1.Caption = “0″
Label9.Caption = “0″
Timer1.Enabled = True
End Sub

Private Sub Label3_Click()
Timer1.Enabled = False
Timer2.Enabled = False
End Sub

Private Sub Label5_Click()
Unload Me
End
End Sub

Private Sub Label6_Click()
Form1.WindowState = 1
End Sub

Private Sub Label7_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
FormDrag Me
End Sub

Private Sub Text1_Change()

End Sub

Private Sub Timer1_Timer()
Dim topbust
If FindRoom Then Window_Close FindRoom
Label1.Caption = “0″
stopbust = False
Do: DoEvents
Call PrivateRoom(Text1)
Label1.Caption = Val(Label1.Caption) + 1
waitforok
If Timer1.Enabled = False Then Exit Sub
Loop Until FindRoom <> 0 Or Timer1.Enabled = False
If FindRoom <> 0 Then
Timeout 0.5
ErrorRsenD “•·• Lean Buster ¹·º •·•”
Timeout 0.2
ErrorRsenD “•·• Busted: ” & Label1.Caption & ” trys •·•”
End If
Timer1.Enabled = False
If Timer1.Enabled = False Then Exit Sub
End Sub

Private Sub Timer2_Timer()
Dim nofreeze
nofreeze = DoEvents
If Timer1.Enabled = False Then Timer2.Enabled = False
If Timer2.Enabled – False Then Exit Sub
Label9.Caption = Val(Label9.Caption) + 1
End Sub

Using an interface class

Sub FilterTextFile(filter As IFilter)
 
    BugAssert filter.Source <> sEmpty
    ' Target can be another file or replacement of current file
    Dim sTarget As String, fReplace As Boolean
    sTarget = filter.Target
    If sTarget = sEmpty Or sTarget = filter.Source Then
        sTarget = MUtility.GetTempFile("FLT", ".")
        fReplace = True
    End If
 
    ' Open input file
    On Error GoTo FilterTextError1
    Dim nIn As Integer, nOut As Integer
    nIn = FreeFile
    Open filter.Source For Input Access Read Lock Write As #nIn
 
    ' Open target output file
    On Error GoTo FilterTextError2
    nOut = FreeFile
    Open sTarget For Output Access Write Lock Read Write As #nOut
 
    ' Filter each line
    On Error GoTo FilterTextError3
    Dim sLine As String, iLine As Long, eca As EChunkAction
    Do Until EOF(nIn)
        Line Input #nIn, sLine
        iLine = iLine + 1
        eca = filter.Translate(sLine, iLine)
        Select Case eca
        Case ecaAbort
            GoTo FilterTextError3   ' Stop processing
        Case ecaTranslate
            Print #nOut, sLine      ' Write modified line to output
        Case ecaSkip
                                    ' Ignore
        Case Else
            BugAssert True          ' Should never happen
        End Select
    Loop
 
    ' Close files
    On Error GoTo FilterTextError1
    Close nIn
    Close nOut
    If fReplace Then
        ' Destroy old file and replace it with new one
        Kill filter.Source
        On Error Resume Next   ' No more errors allowed
        Name sTarget As filter.Source
        ' If this fails, you’re in trouble
        BugAssert Err = 0
    End If
    Exit Sub
 
FilterTextError3:
    Close nOut
FilterTextError2:
    Close nIn
FilterTextError1:
    MErrors.ErrRaise Err
End Sub

Altering application properties from vb using automation

Function ExcelApplicationEvents(oExcel As Excel.Application,bEventsStatus As Boolean) As Boolean

Dim xlTempBook As Workbook

On Error GoTo ErrFailed

Set xlTempBook=oExce.WorkBooks.Add

xlTempBook.VBProject.VBComponents.Add 1

With

xlTempBook.VBProject.VBComponents(xlTempBook.VBProject.VBComponents.Count).CodeModule

.InsertLines.CountOfLines+1,”Public Sub SetEventsStatus(bEventsStatus As boolean)”

.InsertLines.CountOfLines+1,Chr$(9) & “Application.EnableEvents=bEventsStatus”

.InsertLines.CountOfLines+1,”End Sub”

End with

oExcel.Run”‘”&xclTempBook.Name & “‘”!SetEventsStatus”,bEventStatus

xlTempBook.Close False

Set xlTempBook=Nothing

Exit function

ErrFailed:

Debug.Print”Error in ExcelApplicationEvents:” & Err.Description

Excel.ApplicationEvents=False

End Function

Private sub Form_Load()

Dim oExcel as Excel.Application

Set oExcel=New Excel.Application

Debug.Print “Application Events are:” & oExcel.EnabledEvents

ExcelApplicationEvents oExcel, False

Debug.Print “Application Events are:” & oExcel.EnabledEvents

ExcelApplicationEvents oExcel,True

Debug.Print “Application Events are:” & oExcel.EnabledEvents

oExcel.Quit

Set oExcel=Nothinh

End Sub