IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası

PHP- Kodu:
   Dim AppName As String, RecordsDeleted As Boolean, MyDB As Database
Dim MyRS As Recordset, MyPic As Picture

Public Sub CleanUpDatabase()
    'Records that are deleted from the database are only
    'marked for delete and not removed from the database
    'This Procedure shows how to remove the deletes
    Dim Srcfile As String, DestFile As String
    Form1.MousePointer = 11
    'Store the database name
    Srcfile = Data1.Database.Name
    'Close the database
    Data1.Database.Close
    'Create a path and name to hold the records
    DestFile = App.Path & "Olddb.Cat"
    'make a copy of the database
    FileCopy Srcfile, DestFile
    'delete the old file
    Kill Srcfile
    'Removes the deletes from database
    DBEngine.CompactDatabase DestFile, Srcfile
    'Remove the old database
    Kill DestFile
    RecordsDeleted = False
    Form1.MousePointer = 0
End Sub
Public Sub SizeScrolls()
    With VScroll1
        .Left = Picture2.Left + Picture2.Width
        .Top = Picture2.Top
        .Max = Picture1.Height - Picture2.ScaleHeight '32,767
        .Min = 0
        .Value = .Min
        .Height = Picture2.Height
        .SmallChange = Picture2.ScaleHeight / 5
        .LargeChange = Picture2.ScaleHeight
    End With
    If Picture1.ScaleHeight > Picture2.ScaleHeight Then
        VScroll1.Visible = True
    Else
        VScroll1.Visible = False
    End If
    With HScroll1
        .Left = Picture2.Left
        .Top = Picture2.Top + Picture2.Height
        .Min = 0
        .Width = Picture2.Width
        .Value = .Min
        .Max = Picture1.Width - Picture2.ScaleWidth
        .SmallChange = Picture2.ScaleWidth / 5
        .LargeChange = Picture2.Width
    End With
    If Picture1.ScaleWidth > Picture2.ScaleWidth Then
        HScroll1.Visible = True
    Else
        HScroll1.Visible = False
    End If
End Sub

Private Sub Command1_Click(index As Integer)
    On Error GoTo Command1_Click_Errors
    Dim GraphicPath As String
    MousePointer = 11
        With Data1.Recordset
            Select Case index
                Case 0 'Paste
                    For i = 2 To 7
                        If Clipboard.GetFormat(i) Then Exit For
                        If i = 7 Then
                            MsgBox "No Graphic Available"
                            MousePointer = 0
                            Exit Sub
                        End If
                    Next
                    Data1.Recordset.AddNew
                    Picture1 = Clipboard.GetData()
                    GraphicPath = InputBox("Input Graphic Name - ", "Paste Graphic")
                    If Len(GraphicPath) = 0 Then
                        MousePointer = 0
                        Data1.Recordset.CancelUpdate
                        Exit Sub
                    End If
                    Data1.Recordset.Fields(0) = GraphicPath
                    Data1.Recordset.Update
                    Data1.Recordset.Bookmark = Data1.Recordset.LastModified
                    lblName = .Fields(0)
                Case 1 'Copy
                    Clipboard.Clear
                    Clipboard.SetData Picture1.Picture
                Case 2 'Add
                    With CommonDialog1
                        .Action = 1
                        If .FileName <> "" Then
                            Data1.Recordset.AddNew
                            Picture1.Picture = LoadPicture(.FileName)
                            Data1.Recordset.Fields(0) = .FileName
                            Data1.Recordset.Update
                            Data1.Recordset.MoveLast
                        End If
                    End With
                Case 3 'Delete
                    DI% = MsgBox("Delete " & .Fields(0) & " From the database?", vbYesNoCancel, "DELETE GRAPHIC!")
                    If DI = 6 Then
                        .Delete
                        If Not BOF Then .MovePrevious Else .MoveNext
                        RecordsDeleted = True
                    End If
                Case 4 'Move First
                    .MoveFirst
                    lblName = .Fields(0)
                Case 5 'Move Previous
                    If Not .BOF() Then .MovePrevious Else .MoveFirst
                    If .BOF() Then .MoveFirst
                    lblName = .Fields(0)
                Case 6 'Move Next
                    If Not .EOF() Then .MoveNext Else .MoveLast
                    If .EOF() Then .MoveLast
                    lblName = .Fields(0)
                Case 7 'Move Last
                    .MoveLast
                    lblName = .Fields(0)
                Case 8 'Exit
                    If RecordsDeleted Then CleanUpDatabase
                    End
            End Select
        End With
        lblName.Left = Picture2.Left + ((Picture2.Width / 2) - (lblName.Width / 2))
        SizeScrolls
        MousePointer = 0
Exit Sub

Command1_Click_Errors:
Select Case Err
    Case 3022
        Data1.Recordset.CancelUpdate
        MsgBox GraphicPath & " is a duplicate name."
    Case Else
        MsgBox "Error " & Error & "  " & Err
End Select

Resume Next
    
End Sub

Private Sub Form_Activate()
    lblName = Data1.Recordset.Fields(0)
    lblName.Left = Picture2.Left + ((Picture2.Width / 2) - (lblName.Width / 2))
End Sub

Private Sub Form_Load()
    Dim DBPath As String
    If Right(App.Path, 1) = "\" Then
        DBPath = App.Path & "Graphics.mdb"
    Else
        DBPath = App.Path & "\Graphics.mdb"
    End If
    Data1.DatabaseName = DBPath
    AppName = Form1.Caption
End Sub

Private Sub HScroll1_Change()
    Picture1.Left = -HScroll1.Value
End Sub

Private Sub HScroll1_Scroll()
    HScroll1_Change
End Sub

Private Sub VScroll1_Change()
    Picture1.Top = -VScroll1.Value
End Sub

Private Sub VScroll1_Scroll()
    VScroll1_Change
End Sub
Alıntıdır..