منتديات الطرف

منتديات الطرف (www.altaraf.com/vb/index.php)
-   واحة الكمبيوتر والبرامج والإنترنت والجوال (www.altaraf.com/vb/forumdisplay.php?f=15)
-   -   للمبتدئين : التعامل مع App.path (www.altaraf.com/vb/showthread.php?t=5831)

دمعة فرح 14-04-2003 02:10 AM

للمبتدئين : التعامل مع App.path
 
App.path تعني مسار البرنامج ، وهي تستخدم للحصول على مسار المجلد الذي يوجد فيه البرنامج .
فمثلاً إذا كان لدينا برنامج في C:New فهذا هو مسار البرنامج والذي يمكننا الحصول عليه باستخدام App.path
وللتجربة يمكنك الحصول على مسار برنامجك بواسطة أمر هكذا :


code:Msgbox App.path




وسترى أنه يعطيك مسار المجلد الذي تحفظ فيه المشروع .

الفائدة من ذلك هو تلافي مشكلة تغير المسارات من جهاز لآخر ، فمثلاً في برنامج للصور ضع جميع الصور في نفس مجلد البرنامج ، ولتحميل صورة مثلاً اسمها PP1 وامتدادها Bmp اكتب :

code:Picture1.Picture = Loadpicture(App.path & "PP1.Bmp")





ويمكنك أيضاً إنشاء مجلد جديد في نفس مجلد البرنامج وتسميه مثلاً Image وتضع فيه الصور ، وبذلك يصبح أمر تحميل الصور بالشكل التالي :

code:Picture1.Picture = Loadpicture(App.path & "ImagePP1.Bmp")





وليست الصور هي كل ما نستخدم فيها App.path بل كل شيء ، فمثلاً لتشغيل ملف مفكرة ملحق بالبرنامج نضعه في مجلد البرنامج ونكتب :


code:****l "notepad.exe" & " " & App.path & "RedMe.txt", vbNormalFocus





ولنسخ نفس البرنامج نستخدم الأمر التالي :

code:Filecopy App.path & App.EXEName , "C:Ahmed"





وهكذا ، وتوجد لـ App العديد من الفوائد التي لا يتسع المجال لذكرها ، ومنها مثلاً إنهاء البرنامج إذا لم يكن يعمل من القرص المدمج ، واستخدامها في أوامر حفظ البيانات واسترجاعها ، ومنع تشغيل أكثر من نسخة .... الخ

لكن ينبغي التنبه إلى أن App.path قد تعطينا C:Ahmed أو C:Ahmed ولتلافي هذه المشكلة نقوم بالتالي :

code:Dim Folder
Folder = App.path
If Right(Folder,1) <> "" then Folder = Folder & ""




هنا قمنا بتعريف متغير وخزنا فيه مسار البرنامج ، واختبرناه ، فإذا كان آخر حرف من اليمين لا يساوي فإننا نقوم باضافتها إليه .

وهكذا نتعامل مع الناتج والمخزن في المتغير Folder كأنه يحتوي على مباشرة ، ولذا لا حاجة لكتابتها قبل كتابة اسم الملف .

أخيراً هنا طريقة أخرى قرأتها للأخ المشرف طارق العبيد وقمت بتخزينها لكني لا أتذكر مكانها تحديداً ، ولذلك أوردها هنا ، وهي غير طريقة App.path


quote:
--------------------------------------------------------------------------------
2) استخدام
- Registry
* reading values from Registry by using GetSetting(conAppTitle, conRegistrySection, conRegistryKey)
* writing values to Registry by using SaveSetting conAppTitle, conRegistrySection, conRegistryKey, TqGPath
- Dialog Box , to be able to browse the dirctory to locate your database


1)
Set MyDb = OpenDatabase( App.Path & "Tareq.mdb")

2)
' Create a Module.bas then add the code showing next

Global TqGPath As String ' تعريف لتعميم اسم و مسار قاعدة البيانات
' تعريفات المشروع لوضعها في الريجستري
Public Const conAppTitle As String = "Tareq Al-Obaid Applications"
Public Const conRegistrySection As String = "Database********"
Public Const conRegistryKey As String = "Quality Control"

Sub Main()
Dim i As Integer

On Error GoTo NopathErr

FirstPath:
TqGPath = GetSetting(conAppTitle, conRegistrySection, conRegistryKey)
If TqGPath <> "" Then
Set MYDB = OpenDatabase(TqGPath)
frmLogin.Show
Exit Sub
ElseIf TqGPath = "" Then
MsgBox "This the first time to run this application , Please Specify data path", vbOKOnly, "Welcome to Complain Control application"
GoTo NopathErr
End If
Exit Sub
NopathErr:
' MsgBox "Error : " + Err.Name '+ " " + Trim(Str(Err.Number)) + " " + Err.De******ion
TqGPath = FindData
SaveSetting conAppTitle, conRegistrySection, conRegistryKey, TqGPath
GoTo FirstPath
End Sub

Function FindData() As String
On Error GoTo ErrHandler

' Configure cmdDialog in case the QC.mdb can't be found.
With frmPath.CmDlg
.DialogTitle = "Can't Find QC.mdb"
.Filter = "(*.MDB)|*.mdb"
End With

'Causes an error if user clicks on cancel
frmPath.CmDlg.CancelError = True
frmPath.CmDlg.ShowOpen
'Make sure user select your aa.mdb Database
Do While UCase(Right(Trim(frmPath.CmDlg.FileName), 6)) <> "QC.MDB"
MsgBox "File Name is not equal to QC.mdb"
frmPath.CmDlg.ShowOpen
Loop

FindData = frmPath.CmDlg.FileName
Exit Function
ErrHandler:
If Err = 32755 Then
End
End If
End Function


تحياتي للجميع


الساعة الآن 08:52 PM

Powered by vBulletin® Copyright ©2000 - 2026, Jelsoft Enterprises Ltd. TranZ By Almuhajir

ما ينشر في منتديات الطرف لا يمثل الرأي الرسمي للمنتدى ومالكها المادي
بل هي آراء للأعضاء ويتحملون آرائهم وتقع عليهم وحدهم مسؤولية الدفاع عن أفكارهم وكلماتهم
رحم الله من قرأ الفاتحة إلى روح أبي جواد