السلام عليكم ورحمه الله وبركاته .
-----------------------------------------------
انا عملت فورم لعرض الصور من المسار محدد بالكود .
وضعت الادوات التالية :
image , combobox , filelistbox ,dirlistbox ,timer ,وزر للتالى وأخر للسابق :
-------------------------------------- وها هو الكود :
---------------------------------------------------------------------------
Dim X As Integer
------------------------------------------------------------
Private Sub Combo2_Change()
If Combo2.Text <> "" Then
If Combo2.ListIndex <> -1 Then
shfile = File1.Path & "\" & Combo2.Text
Image1.Picture = LoadPicture(shfile)
Else
Combo2.ListIndex = Val(Combo2.ListIndex) + 1
End If
ElseIf Combo2.ListIndex = Combo2.ListCount - 1 Then
Combo2.ListIndex = 0
Else
Combo2.ListIndex = Val(Combo2.ListIndex) + 1
End If
End Sub
-----------------------------------------------------------
Private Sub Combo2_Click()
Combo2_Change
End Sub
--------------------------------------------
Private Sub ctrl_SkinableButton1_Click()
If Combo2.Text <> "" Then
If Combo2.ListIndex = X Then
Combo2.ListIndex = 0
Combo2_Click
Else
Combo2.ListIndex = Val(Combo2.ListIndex) + 1
Combo2_Click
End If
ElseIf Combo2.ListCount = 1 Or Combo2.ListCount = 0 Then
MsgBox "This folder don't have a image , please select another folder", vbExclamation, "Error"
Else
Combo2.ListIndex = Val(Combo2.ListIndex) + 1
End If
End Sub
---------------------------------------------------------
Private Sub ctrl_SkinableButton2_Click()
If Combo2.Text <> "" Then
If Combo2.ListIndex = -1 Or Combo2.ListIndex = 0 Then
Combo2.ListIndex = X
Combo2_Click
Else
Combo2.ListIndex = Val(Combo2.ListIndex) - 1
Combo2_Click
End If
ElseIf Combo2.ListCount = 1 Or Combo2.ListCount = 0 Then
MsgBox "This folder don't have a image , please select another folder", vbExclamation, "Error"
Else
Combo2.ListIndex = Val(Combo2.ListIndex) + 1
End If
End Sub
----------------------------------------------
Private Sub Dir1_Change()
File1.Path = Dir1.Path
S = File1.ListCount
Combo2.Clear
For i = 1 To S
Combo2.AddItem (File1.List(i))
Next
End Sub
--------------------------------------------------
Private Sub Drive1_Change()
On Error GoTo DriveErrs
Dir1.Path = Drive1.Drive
Exit Sub
DriveErrs:
mb1 = MsgBox("Drive not ready. Please insert disk in drive.", vbOKOnly)
Drive1.Drive = Dir1.Path
End Sub
--------------------------------------------
Private Sub File1_Click()
If Mid$(File1.Path, Len(File1.Path)) = "\" Then
shfile = File1.Path & File1.FileName
maya.Caption = shfile
Else
shfile = File1.Path & "\" & File1.FileName
End If
Image1.Picture = LoadPicture(shfile)
End Sub
---------------------------------------------------
Private Sub Form_Load()
Image1.Picture = LoadPicture(App.Path & "\dd.bmp")
Dir1.Path = App.Path & "\piclib"
End Sub
--------------------------------------------
Private Sub Timer1_Timer()
X = Val(Combo2.ListCount) - 1
End Sub
--------------
المشكلة يا أخوانى فى الصور التى بيتم عرضها فيوجد صور بالطول واخرى بالعرض فاريد عرض كل صورة على وضعها اى عند أختيار الفولدر من الليست وعرض الصور لو الواحدة بالطول يتغير مربع الصورة لمقياس الصورة ولو بالعرض يتغير للعرض .
--------
واسف جداً على الأطالة والله يوفقكم فى عملكم وعمل الخير ... أمين