Resim Gösterici Program

 
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

Yorum Yapabilmek İçin Üye Girişi Yapmanız Gerekmektedir.

resim gösterici program