سؤالين عن حفظ إعدادات البرنامج

بسم الله الرحمن الرحيم

أولا حياك اخي الكريم معانا ,,,,

بالنسبة للسؤال الأول وهو لحفظ المتغيرات التي تحدث في البرنامج فيمكن استخدام الدالة SaveSetting . واسترحاع البيانات من خلال الدالة GetSetting .

مثال عليها افتح مشروع جديد وإضف عليه تكست بوكس Text1 انسخ الكود التالي وضعة في المشروع . ثم اكتب اي شي في التكست بوكس واغلق المشروع ثم افتحة سترى إنه يقوم بسترجاع البيانات بعد اغلاق المشروع .

الكود /

Private Sub Form_Load()
'
 Text1.Text = GetSetting(App.Title, "LocalText", "GetText", "Visitor_OM")
'
End Sub

Private Sub Form_Unload(Cancel As Integer)
'
 SaveSetting App.Title, "LocalText", "GetText", Text1.Text
'
End Sub

اتمنى إن يكون الكود السابق يفي بالغرض . اما بخصوص السؤال الثاني ما فهمته !! .

تحياتي وحياك معانا مرة أخرى واتمنى لك الإسفادة من الأخوان الأفاضل .

اخى العزيز Visitor_OM

شكرا لك على هذه المعلومات

اما بالنسبة للسؤالى الثانى فهو

كيف يمكن حفظ بيانات موجودة فى اربع قوائم اى (المقصود بالقائمة هى اداه Listbox)

فى ملف واحد ثم استرجاع هذه البيانات مرة اخرى كل بيان فى

القائمة التى كان فيها

مع مراعاة ان مستخدم البرنامج وهو الذى يحدد اسم هذا الملف ومكانه

على الهارد اما امتداد الملف فلا يستطيع التحكم فيه

اتمنى ان تكون فهمت ما اقصده وشكرا لك

ملحوظة:---

اسف على عدم الرد عليك بسرعة لاسباب خاصة

الأخ الكريم futureSun

تحية طيبة و بعد

أرجو أن أكون فهمت سؤالك الثانى جيدا، و أرجو أن يفيدك الكود التالى

Dim WithEvents ctlList As VB.ListBox

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 Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long

Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Private Sub cmdBrowse_Click()

   Dim iNull As Integer, lpIDList As Long, lResult As Long

   Dim sPath As String, udtBI As BrowseInfo

   With udtBI

       '????? ??????? ??????? ?????? ???????

       .hWndOwner = Me.hWnd

       '???? ?????? ??????? ? ???? ????? ???????? lstrcat

       .lpszTitle = lstrcat("??? ?????? ???? ??? ??? ????? ??", "")

       '????? ?? ?? ????? ???? ???? ??? ?? ????? ???????? ????

       .ulFlags = BIF_RETURNONLYFSDIRS

   End With

   '"??? ?????? ??????? "??????? ??????

   lpIDList = SHBrowseForFolder(udtBI)

   If lpIDList Then

       sPath = String$(MAX_PATH, 0)

       'IDList ?????? ??? ?????? ??

       SHGetPathFromIDList lpIDList, sPath

       '????? ????? ??????? ?????????

       CoTaskMemFree lpIDList

       iNull = InStr(sPath, vbNullChar)

       If iNull Then

           sPath = Left$(sPath, iNull - 1)

       End If

   End If

   txtFileName = sPath

End Sub

Private Sub cmdClear_Click()

'???? ??? ??????? ???? ?????? ?? ????? ???????

'??? ???? ????? ??????? ??? ??????? ?? ?? ????? ?????

'??? ????? ?? ????? ???????

'????? ????? ??? ??????? ? ?????? ????????

'????? ?? ?????

'???? ????? ????? ????

Dim lstCtl As Control

For Each lstCtl In Controls

   If TypeOf lstCtl Is ListBox Then lstCtl.Clear

Next lstCtl

End Sub

Private Sub cmdRead_Click()

'API ?? ???? GetPrivateProfileSection ????? ??????? ?? ????? ??????? ???????? ??????

Dim szBuf As String * 255, strKeys() As String, Xlooper As Long

Dim tmpArray() As String

'/////////////////////////////////////////////////////////////////////////////

'???? ??????? ??????

Call GetPrivateProfileSection("List1", szBuf, 255, App.Path & "istContents.ini")

strKeys = Split(szBuf, Chr(0))

List1.Clear

For Xlooper = LBound(strKeys) To UBound(strKeys)

   If Len(strKeys(Xlooper)) < 1 Then Exit For

   tmpArray = Split(strKeys(Xlooper), "=")

   List1.AddItem tmpArray(1)

Next

'/////////////////////////////////////////////////////////////////////////////

'???? ??????? ???????

Call GetPrivateProfileSection("List2", szBuf, 255, App.Path & "istContents.ini")

strKeys = Split(szBuf, Chr(0))

List2.Clear

For Xlooper = LBound(strKeys) To UBound(strKeys)

   If Len(strKeys(Xlooper)) < 1 Then Exit For

   tmpArray = Split(strKeys(Xlooper), "=")

   List2.AddItem tmpArray(1)

Next

'/////////////////////////////////////////////////////////////////////////////

'???? ??????? ???????

Call GetPrivateProfileSection("List3", szBuf, 255, App.Path & "istContents.ini")

strKeys = Split(szBuf, Chr(0))

List3.Clear

For Xlooper = LBound(strKeys) To UBound(strKeys)

   If Len(strKeys(Xlooper)) < 1 Then Exit For

   tmpArray = Split(strKeys(Xlooper), "=")

   List3.AddItem tmpArray(1)

Next

'/////////////////////////////////////////////////////////////////////////////

'???? ??????? ???????

Call GetPrivateProfileSection("ctlList", szBuf, 255, App.Path & "istContents.ini")

strKeys = Split(szBuf, Chr(0))

ctlList.Clear

For Xlooper = LBound(strKeys) To UBound(strKeys)

   If Len(strKeys(Xlooper)) < 1 Then Exit For

   tmpArray = Split(strKeys(Xlooper), "=")

   ctlList.AddItem tmpArray(1)

Next

End Sub

Private Sub cmdSave_Click()

'????? ??????? ?????? ??????? ???????? ????? ??????? ?? ???????

Dim lstCtl As Control, lstCnt As Long, Xlooper As Long

'?? ?????? ??????? ??????? ???????? ??? ???? ?????? ?????????

'ListBox ? ???? ?????? ?? ????? ??? ???? ???????

'Root Directory ?????? ????? ????? ?????? ???? ????? ??? ??? ?????? ?????? ?? ?????? ???????

'C:??? ??? ????? ????? ?????? ??????? ????? ????

'????? ????? ??????

'If Right(App.Path, 1) = " Then

'    MyPathVar=...

'Else

'    MyPathVar=...

'End If

'? ??? ?? ??? ??????? ????? ?????? ??? ? ????? ???? ?? ???? ????? ?????

Open txtFileName & "istContents.ini" For Output Access Write Lock Write As #1

   For Each lstCtl In Controls

       If TypeOf lstCtl Is ListBox Then

           Print #1, "[" & lstCtl.Name & "]"

           lstCnt = lstCtl.ListCount '????? ??????? ?? ????? ???? ??? ?? ????? ?????? ?? ???????

           For Xlooper = 0 To lstCnt - 1

               Print #1, "item" & Xlooper & "=" & lstCtl.List(Xlooper) 'Strings ??? ??????

           Next Xlooper

       End If

   Next lstCtl

Close #1

'??? ??? ?? ???? ???? ?????? ?? ????? ??????? ?? ???????

'FileSystemObject ????????

'? ??? ???? ???? ????? ??? ????

End Sub

Private Sub Form_Load()

Dim Xlooper As Long

'????? ???? ????? ?? ???? ??????

'.Text ???? ??? ????? ???????

'? ??? ????? ??????? ??????????: ??????? ???? ????? ??????

txtFileName = App.Path

'??? ??? ?????? ?? ???????

With List1

   .AddItem "??? ??? ???? ??????? ??????"

   .AddItem "? ??? ????? ???? ???? ??????? ??????"

   .AddItem "? ??? ??? ????? ???? ??????? ??????"

   .AddItem "? ????? ??? ????? ??? ???????? ??????"

   .AddItem "????? ???? ?? ??? ????? ???????? ??????"

   .AddItem "??? ???????? ??????"

   .AddItem "??? ???? ??????? ??????"

End With

For Xlooper = 1 To 7

   List2.AddItem "??? ??? ??? " & Xlooper & " ???????? ???????"

Next Xlooper

List3.AddItem "??? ??? ???? ??????? ???????"

List3.AddItem "? ??? ????? ???? ???? ??????? ???????"

List3.AddItem "? ??? ??? ????? ???? ??????? ???????"

List3.AddItem "? ????? ??? ????? ??? ???????? ???????"

List3.AddItem "????? ???? ?? ??? ????? ???????? ???????"

List3.AddItem "??? ???????? ???????"

List3.AddItem "??? ???? ??????? ???????"

Set ctlList = Controls.Add("VB.ListBox", "ctllist1", Form1)

'????? ????? ? ???? ??????

ctlList.Move 120, 2040, 2535, 1815

'??? ?????? ????? ??? [/COLOR

contribute.zip

عذرا لظهور التعليقات مشفرة، و سبب هذا مشكلة بسيطة فى تنسيق المشاركة، و الله أعلم

تأكدت من أن الملف المرفق سليم، حيث قمت بتحميله و فكه، و تحياتي.

شكرا لك على ردك على بهذه السرعة

الطريقة نجحت ولكن لا تظهر البيانات فى القائمة الرابعة

لماذا ذلك......

كما اريد ان يقوم مستخدم البرنامج بتحديد اسم الملف ومكانة دون

ان يتحكم فى امتداد الملف

والغرض من ذلك هو حفظ اكثر من بيان فى اكثر من ملف

وأتمن منك ان تجيب علي وأسف على كثره السؤال

ولك الشكر مرة ثانية

الأخ الكريم، بعد التحية.

هل القائمة الرابعة لا تعمل فى البرنامج الذى أرسلته لك، أم فى برنامجك بعد إقتباس الطريقة فى برنامجك؟ لاحظ أن القائمة الرابعة منشأة وقت التنفيذ و إسمها يختلف عن بقية الأدوات، و لذا إذا كنت أنت أضفت قائمة رابعة فى مشروعك و أخذت الاسم الافتراضى List4 فمن الطبيعى ألا يعمل الكود، أرجو قراءة و تفحص الكود مليا ثم موافاتى بالرد، و المشروع الذى توجد به المشكلة، و شكرا

أخوك

شكرا لك على الرد

ولكن لاتظهر القائمة الرابعة عند الضغط على مفتلح فتح

وايضا لا تضهر محتويات القوائم الاخرى كاملة

ارجو الإفادة فى ذلك ولك الشكر

أخى العزيز سوف اعمل على طريقتك

وان شاء الله سوف ارد عليك قريبا

وجزاك الله خيرا

[B]بسم الله الرحمن الرحيم[/B]

اريد مساعدتك فى عمل هذا الكود الرائع

عن طريق استخدام الاداه CommonDialog

حيث ارفق لك برنامج يتكون من :-

الفورم الاولى تحتوى على الكود الذى صممته

انت مع بعض التغير حسب طلبى

اما الفورم الثانية بها بعض الكود الذى ارجو من الله عز وجل

ان يعينك فى مساعدتى لإستكمال ما بدأته

savelist.zip

بسم الله الرحمن الرحيم

الأخوه الأعزاء رواد وأعضاء هذا المنتدى الرائع

هذه الصورة اسفل كلامى هى لبرنامج تشغيل ملفات الصوت والفيديو

من المساعدة التى تلقيتها منكم ومن أخ فاضل من

المملكة العربية السعودية الأخ (عبدالله) الذى

افادنى الكود الذى يقوم بتشغيل الملفات السابق ذكرها

وقد قمت بتحويل هذا الكود الى برنامج يطلق عليه

البعض برنامج (دى جى) وانى اعمل على زيادة امكانياته

ارجو منكم ان تساعدونى فى حفظ اعدادات هذا البرنامج

سوف اقوم بشرح نوع الاداه المراد حفظ اعدادها

وهى التى تم ترقيمها من رقم 1 الى رقم 6

اداتين اختيار لغة واجهة التطبيق رقم 1

اداتين صندوق نص لبداية ونهاية تشغيل الملف رقم 2

ادوات اختيار الصوت والسماعات رقم 3

ادوات المنزلق لتحديد درجة الصوت والسرعة رقم 4

ادوات اختيار لتكرار وتتالى الملفات وغيرهم رقم 5

اداه صندوق نص لتحديد زمن تكرار او تتالى الملف رقم 6

وفى النهاية اوجه شكرى لكل من ساعدنى فى هذا البرنامج

الذى عملت فيه كثيرا من شهر اغسطس 2002 حتى كتابة

هذه الكلمات وما زلت اعمل فيه

ارجو المساعدة منكم

ملحوظة :- الادوات من رقم 2 الى رقم 6 مضروبه فى اربعة

اى كل اداة يوجد منها اربع ادوات اخرى كما هو واضح

فى الصورة

والسلام عليكم ورحمه الله وبركاته