الاخوة الكرام، أرجو أن يعجبكم هذا المثال لعمل إزاحة رأسية للأعلى ثم للأسفل بشكل تبادلى، و انتهزت الفرصة لشرح كيفية حفظ الصورة الموجودة كخاصية صورة لأحد الأدوات لملف على وحدة التخزين و أيضاً انتهزت الفرصة لشرح كيفية الاستعراض بحثاً عن مجلد بطريقة ويندوز الجديدة، و ليس عن طريق أدوات الملفات القديمة و المبنية داخل فيجوال بيزيك، و أيضاً فرصة لشرح كيفية اتاحة امكانية مقاطعة المستخدم لتنفيذ إجراء معين، أي كأن يضغط زر "ايقاف التنفيذ" مثلا، و عذرا لكتابة التعليقات باللغة الانجليزية، حتى أتمكن من تخطى بعض الصعاب البسيطة التى واجهتنى لدى كتابتها باللغة العربية.و لضيق الوقت، آثرت أن أكتبها بالانجليزية.
هذا المشروع موجة للمبتدئين و المتوسطين على السواء، توجد طرق أفضل باستخدام واجهة برمجة التطبيقات لتنفيذ المطلوب، صحيح أنها تتميز بالسرعة و التحكم و لكنها تتميز بالتعقيد، ربما تطرقت لها فى وقت لاحق.
و فرصة لطرح هذه النصائح حول كتابة المشاركات.
أخوكم، محمد فاروق.
Dim globalPause As Boolean
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Const BIF_RETURNONLYFSDIRS = 1
Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Sub cmdPause_Click()
If cmdPause.Tag = "Runing" Then
cmdPause.Tag = "Paused"
cmdPause.Caption = "??????? ???????"
globalPause = False
Else
cmdPause.Tag = "Runing"
cmdPause.Caption = "???? ????? ???? ?? ???? ??? ???????!"
globalPause = True
End If
End Sub
Private Sub Form_Load()
globalPause = True 'Intialize to True to enter the timer event
'sorry again for having to write in English.
End Sub
Private Sub tmrDown_Timer()
If globalPause = False Then Exit Sub
Dim dblEndTime As Double
If Image1.Top >= 0 Then
dblEndTime = Timer + 2#
Do While dblEndTime > Timer
DoEvents
Loop
tmrDown.Enabled = False
tmrUP.Enabled = True
Exit Sub
End If
Image1.Top = Image1.Top + 200
End Sub
Private Sub tmrUP_Timer()
If globalPause = False Then Exit Sub
Dim dblEndTime As Double
If Abs(Image1.Top) > (Image1.Height - Picture1.ScaleHeight) Then
dblEndTime = Timer + 5# '....I want to give more time for you to read about the authors
Do While dblEndTime > Timer 'of this article, which is in the bottom of the page.
DoEvents '................just to give the authors thier credit.
Loop '.......................I'm writting comments in English for technical reasons!.
tmrDown.Enabled = True
tmrUP.Enabled = False
Exit Sub
End If
Image1.Top = Image1.Top - 200
End Sub
Private Sub cmdSavePic_Click()
Dim iNull As Integer, lpIDList As Long, lResult As Long
Dim sPath As String, udtBI As BrowseInfo
With udtBI
'Set Owner Window
.hWndOwner = Me.hWnd
'lstrcat appends to strings and return a memory address
.lpszTitle = lstrcat("Where do you want to save the picture file?", "")
'Return only if the user selected a directory
.ulFlags = BIF_RETURNONLYFSDIRS
End With
'Show the dialog
lpIDList = SHBrowseForFolder(udtBI)
If lpIDList Then
sPath = String$(MAX_PATH, 0)
'Use IDList to get the path
SHGetPathFromIDList lpIDList, sPath
'Free memory
CoTaskMemFree lpIDList
iNull = InStr(sPath, vbNullChar)
If iNull Then
sPath = Left$(sPath, iNull - 1)
End If
End If
SavePicture Image1.Picture, sPath & "mageFile.bmp"
MsgBox "File have been saved to:" & vbCrLf & sPath & "mageFile.bmp"
End Sub