اضافة صوره داخل قاعدة البيانات
هذا كود لادخال صورة داخل قاعدة بيانات …
صورة البرنامج
الكود :
Dim Db As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim PiC As New ADODB.Stream
Private Sub CmdBrows_Click()
MyCom.DialogTitle = “Open Picture”
MyCom.Filter = “JPG Files | *.jpg”
MyCom.ShowOpen
If Not MyCom.FileName = “” Then
ImgPic.Picture = LoadPicture(MyCom.FileName)
End If
End Sub
Private Sub CmdFST_Click()
Rs.MoveFirst
Call ShowPic
End Sub
Private Sub CmdLST_Click()
Rs.MoveLast
Call ShowPic
End Sub
Private Sub CmdNXT_Click()
Rs.MoveNext
If Rs.EOF = True Then Rs.MoveLast
Call ShowPic
End Sub
Private Sub CmdPVS_Click()
Rs.MovePrevious
If Rs.BOF = True Then Rs.MoveFirst
Call ShowPic
End Sub
Private Sub CmdSave_Click()
Dim X As String
If Text1.Text = “” Then
MsgBox “ÇÏÎá ÇÓã ÇáÕæÑå”
Exit Sub
End If
If MyCom.FileName = “” Then
MsgBox “There Is No Picture Loaded!”, vbExclamation, “Error”
Else
X = MsgBox(“Are You Sure To Save The Picture ” & MyCom.FileTitle, vbQuestion + vbYesNo, “Save..”)
If X = vbNo Then Exit Sub
If PiC.State = adStateOpen Then PiC.Close
PiC.Open
PiC.Type = adTypeBinary
PiC.LoadFromFile MyCom.FileName
Rs.AddNew
Rs.Fields!picnem = Text1.Text
Rs.Fields!PiC = PiC.Read
Rs.Update
MsgBox “The Picture : ” & MyCom.FileTitle & ” Has Saved Successfully Mr:Lo2i”, vbInformation, “Save”
End If
End Sub
Private Sub Command1_Click()
If Text1.Text = “” Then
MsgBox “áã íÊã ÊÍÏíÏ ÇÓã ááÈÍË Úäå”
Exit Sub
End If
If Rs.State = 1 Then Rs.Close
Rs.Open “Select * From TPic Where picnem Like ‘%” & Text1.Text & “%’”
If Rs.EOF = True Then
MsgBox “áã íÊã ÇáÚËæÑ Úáì ÇÓã ãÔÇÈå áåÐÇ ÇáÇÓã”, vbMsgBoxRight + vbExclamation, “ÎØÔ
Exit Sub
End If
ShowPic
Db.Close
If Rs.State = 1 Then Rs.Close
Call Form_Load
End Sub
Private Sub Form_Load()
Me.Caption = “Save Picture”
CmdBrows.Caption = “Browse”
CmdSave.Caption = “Save Picture Now”
ImgPic.Stretch = True
Db.Provider = “Microsoft.Jet.Oledb.4.0;”
Db.Open App.Path & “\PicDb.mdb”
Rs.Open “TPic”, Db, adOpenDynamic, adLockOptimistic
CmdFST.Caption = “ÇÓÊÚÑÖ Çæá ÕæÑÉ”
CmdPVS.Caption = “ÇÓÊÚÑÖ ÇáÕæÑÉ ÇáÓÇÈÞÉ”
CmdNXT.Caption = “ÇÓÊÚÑÖ ÇáÕæÑÉ ÇáÊÇáíÉ”
CmdLST.Caption = “ÇÓÊÚÑÖ ÇÎÑ ÕæÑÉ”
Command1.Caption = “ÈÍË”
End Sub
Public Sub ShowPic()
Dim Chunk() As Byte
Dim lngLengh As Long
Dim intChunks As Integer
Dim intFragment As Integer
Const ChunkSize = 1000
Const lngDataFile = 1
Open “pictemp” For Binary Access Write As lngDataFile
lngLengh = Rs.Fields!PiC.ActualSize
intChunks = lngLengh \ ChunkSize
intFragment = lngLengh Mod ChunkSize
ReDim Chunk(intFragment)
Chunk() = Rs.Fields!PiC.GetChunk(intFragment)
Put lngDataFile, , Chunk()
For I = 1 To intChunks
ReDim Buffer(ChunkSize)
Chunk() = Rs.Fields!PiC.GetChunk(ChunkSize)
Put lngDataFile, , Chunk()
Next I
Close lngDataFile
FileName = “pictemp”
Text1.Text = Rs.Fields!picnem
ImgPic.Picture = LoadPicture(FileName)
End Sub
