الفريق العربي للبرمجةأرشيف المنتديات · 2000 – 2023
نسخة أرشيفية للقراءة فقط — التسجيل والمشاركة مغلقان، والمحتوى محفوظ كما كان.

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

بدأه جمال الدين الحسيني في 27 فبراير 2009 · 2 رد · 454 مشاهدة · في لغة Ms Visual Basic 6 وما قبلها من إصدارات
مشاركة: واتساب X فيسبوك تيليجرام
#1 صاحب الموضوع

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

هل من الممكن أن تساعدون في تحويل الكود التالي إلى ما يقابله من أزرار و قوائم في form

Option Explicit

'Public LoginSucceeded As Boolean

Dim Login_UserCon As New ADODB.Connection, Login_UserRes As New ADODB.Recordset

Private Sub cmdCancel_Click()

Me.Hide

FrmMDIMain.MDIForm_Unload (-1)

End

End Sub

Private Sub cmdOK_Click()

On Error GoTo Err_Mes

Login_UserCon.Open dbConnectString

Login_UserCon.CursorLocation = adUseClient

Login_UserRes.Open "Select * from UserAccess where USER_ID = '" & UCase(Trim(txtUserName.Text)) & "'", Login_UserCon, adOpenDynamic, adLockReadOnly

If Login_UserRes.BOF And Login_UserRes.EOF Then

MsgBox "Incorrect Login Name", vbOKOnly, "Login"

cmdOK.Enabled = False

txtUserName.Text = ""

txtUserName.SetFocus

Login_UserCon.Close

Exit Sub

End If

Set Login_UserRes.ActiveConnection = Nothing

Set Login_UserCon = Nothing

If UCase(Trim(txtPassword.Text)) = Login_UserRes("PASSWORD") Then

If Login_UserRes("ACTIVE") = "Y" Then

LoginSucceeded = True

Global_User = Login_UserRes("USER_NAME")

Global_User_Code = Login_UserRes("User_Code")

Global_User_Group = Login_UserRes("User_Group")

Global_User_Admin = Login_UserRes("ADMINISTRATOR")

Global_User_Password = Login_UserRes("PASSWORD")

Global_User_Approver = IIf(Login_UserRes("USER_APPROVER") = "Y", True, False)

Global_User_Doctor = IIf(Login_UserRes("USER_DOCTOR_CODE") <> "", Login_UserRes("USER_DOCTOR_CODE"), "")

DTPicker1.Format = dtpShortDate

ProcessDate = DTPicker1.Value

Me.Hide

FrmMDIMain.Toolbar1.Buttons(26).Enabled = True

FrmMainScreen.Show

Call Initializer

Call Enabler_Main

Login_UserRes.Close

Login_UserCon.Open dbConnectString

Login_UserRes.Open "Select * From USER_SCHEDULE Where (ACTION_STATUS = 'P' And (SUBMITTED_BY = '" & Global_User_Code & "' Or SUBMIT_TO_USER = '" & Global_User_Code & "')) OR (SUBMIT_DATE = '" & Format(ProcessDate, "dd-mmm-yyyy") & "' And (SUBMITTED_BY = '" & Global_User_Code & "' Or SUBMIT_TO_USER = '" & Global_User_Code & "'))", Login_UserCon, adOpenDynamic, adLockReadOnly

If Not (Login_UserRes.BOF And Login_UserRes.EOF) Then

Frm_Alerter.Show vbModal

End If

Set Login_UserRes = Nothing

Set Login_UserCon = Nothing

Else

MsgBox "Unauthorized access: Not an active user", vbOKOnly, "Login"

Set Login_UserRes = Nothing

Set Login_UserCon = Nothing

Me.Hide

FrmMDIMain.MDIForm_Unload (-1)

End

End If

Else

Login_UserRes.Close

MsgBox "Invalid Password, try again!", , "Login"

txtPassword.Text = ""

cmdOK.Enabled = False

txtPassword.SetFocus

SendKeys "{Home}+{End}"

End If

Err_Mes:

If Err.Number > 0 Then

MsgBox (Err.Number & ": " & Err.Description), vbOKOnly, "Error"

End If

End Sub

Private Sub Form_Load()

FrmMDIMain.Toolbar1.Buttons(26).Enabled = False

frmLogin.Left = Screen.Width - Screen.Width + ((1 / 2) * (Screen.Width - frmLogin.Width))

frmLogin.Top = Screen.height - Screen.height + ((1 / 2) * (Screen.height - frmLogin.height))

Div_Name = GetFromINI("Division", "DivisionType", "", "C:\Program Files\HealPlus\Bin\HealPlus.ini")

If Div_Name = "Reception" Or Div_Name = "Pharmacy" Then

Div_Name = Div_Name & "-" & GetFromINI("Division", "DivisionID", "", "C:\Program Files\HealPlus\Bin\HealPlus.ini")

Div_ID = Left(Div_Name, 3) & "-" & GetFromINI("Division", "DivisionID", "", "C:\Program Files\HealPlus\Bin\HealPlus.ini")

End If

txtDiv.Text = Div_Name

cmdOK.Enabled = False

DTPicker1.CustomFormat = "ddd - MMM dd, yyyy"

DTPicker1.Format = dtpCustom

DTPicker1.ToolTipText = "Pick current working date"

DTPicker1.Value = Now

End Sub

Private Sub Form_Unload(Cancel As Integer)

FrmMDIMain.MDIForm_Unload (-1)

End

End Sub

Private Sub txtPassword_Change()

If txtUserName.Text <> "" And txtPassword.Text <> "" Then

cmdOK.Enabled = True

End If

End Sub

Private Sub txtPassword_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

Call cmdOK_Click

End If

End Sub

Private Sub txtUserName_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then

txtPassword.SetFocus

End If

End Sub

Function Initializer()

FrmMDIMain.StatusBar1.Panels(2).Text = Global_User

FrmMDIMain.StatusBar1.Panels(4).Text = Format(ProcessDate, "dd mmm, yyyy")

End Function

Function Enabler_Main()

Dim i As Integer, GrupRes As New ADODB.Recordset, GrupCon As New ADODB.Connection

Global_User_Modules = ""

GrupCon.Open dbConnectString

GrupRes.Open "Select * from USERGRUP where GROUP_CODE = '" & Global_User_Group & "'", GrupCon, adOpenForwardOnly, adLockReadOnly

If GrupRes.BOF And GrupRes.EOF Then

MsgBox "Can't identify User Group, Please inform your System Manager", vbOKOnly, "Error"

Else

FrmMDIMain.MnuFile.Enabled = True

FrmMDIMain.MnuModules.Enabled = True

If GrupRes("MODULES") = "ALL" Then

Global_User_Modules = "ALL"

FrmMDIMain.MnuDefa.Enabled = True

For i = 1 To FrmMDIMain.Toolbar1.Buttons.Count

FrmMDIMain.Toolbar1.Buttons(i).Enabled = True

FrmMDIMain.SubMnuModules(i).Enabled = True

Next i

Else

For i = 1 To FrmMDIMain.Toolbar1.Buttons.Count

If InStr(1, GrupRes("MODULES"), UCase(Trim(FrmMDIMain.Toolbar1.Buttons(i).Tag)), vbTextCompare) Then

FrmMDIMain.Toolbar1.Buttons(i).Enabled = True

FrmMDIMain.SubMnuModules(i).Enabled = True

Global_User_Modules = Global_User_Modules + UCase(Trim(FrmMDIMain.Toolbar1.Buttons(i).Key)) & ","

End If

Next i

End If

End If

GrupRes.Close

GrupCon.Close

BtnCloseEnabled = True

EnableCloseButton FrmMDIMain.hWnd, BtnCloseEnabled

FrmMDIMain.SetFocus

Set GrupRes = Nothing

Set GrupCon = Nothing

End Function

Function Disabler_Main()

Dim i As Integer

For i = 1 To FrmMDIMain.Toolbar1.Buttons.Count - 1

If FrmMDIMain.Toolbar1.Buttons(i).Enabled = True Then

FrmMDIMain.Toolbar1.Buttons(i).Enabled = False

End If

If FrmMDIMain.SubMnuModules(i).Enabled = True Then

If FrmMDIMain.SubMnuModules(i).Caption <> "-" Then

FrmMDIMain.SubMnuModules(i).Enabled = False

End If

End If

Next i

FrmMDIMain.MnuFile.Enabled = False

FrmMDIMain.MnuModules.Enabled = False

FrmMDIMain.MnuDefa.Enabled = False

BtnCloseEnabled = False

EnableCloseButton FrmMDIMain.hWnd, BtnCloseEnabled

End Function

#2

السلام عليكم...

رغم أن عنوان الموضوع مخالف - و ربما يتم إغلاقه! - لكن على أية حال تحتوي الـ Form المأخوذ منها هذا الكود - على الأقل - على المكونات التالية:

* زر (Command) باسم cmdOK (أي الخاصية cmdOK = Name).

* زر (Command) باسم cmdCancel.

* مربع نص (TextBox) باسم txtUserName.

* مربع نص (TextBox) باسم txtPassword.

فقط ضع تلك المكونات على الـ Form و أعطها الأسماء المذكورة أعلاه، و ستقوم Visual Basic تلقائياً بربط كل مكون بإجرائه (أو إجراءاته)، طبعاً مع نسخ الكود إلى الـ Form.

** ملاحظة: من الواضح أن الكود يستعمل أسماء نوافذ و مكونات و متغيرات موجودة في Forms و / أو Modules أخرى، و يجب أن تكون لديك حتى يعمل الكود.

ها هنا إعادة للكود بعد تنظيمه - دون أن أغير في نصه أي شيء:

  1. Option Explicit
  2.  
  3. 'Public LoginSucceeded As Boolean
  4. Dim Login_UserCon As New ADODB.Connection, Login_UserRes As New ADODB.Recordset
  5.  
  6. Function Initializer()
  7.     FrmMDIMain.StatusBar1.Panels(2).Text = Global_User
  8.     FrmMDIMain.StatusBar1.Panels(4).Text = Format(ProcessDate, "dd mmm, yyyy")
  9. End Function
  10.  
  11. Function Enabler_Main()
  12.     Dim i As Integer, GrupRes As New ADODB.Recordset, GrupCon As New ADODB.Connection
  13.  
  14.     Global_User_Modules = ""
  15.     GrupCon.Open dbConnectString
  16.     GrupRes.Open "Select * from USERGRUP where GROUP_CODE = '" & Global_User_Group & "'", GrupC
    on, adOpenForwardOnly, adLockReadOnly
  17.     If GrupRes.BOF And GrupRes.EOF Then
  18.         MsgBox "Can't identify User Group, Please inform your System Manager", vbOKOnly, "Error
    "
  19.     Else
  20.         FrmMDIMain.MnuFile.Enabled = True
  21.         FrmMDIMain.MnuModules.Enabled = True
  22.         If GrupRes("MODULES") = "ALL" Then
  23.             Global_User_Modules = "ALL"
  24.             FrmMDIMain.MnuDefa.Enabled = True
  25.             For i = 1 To FrmMDIMain.Toolbar1.Buttons.Count
  26.                 FrmMDIMain.Toolbar1.Buttons(i).Enabled = True
  27.                 FrmMDIMain.SubMnuModules(i).Enabled = True
  28.             Next i
  29.         Else
  30.             For i = 1 To FrmMDIMain.Toolbar1.Buttons.Count
  31.                 If InStr(1, GrupRes("MODULES"), UCase(Trim(FrmMDIMain.Toolbar1.Buttons(i).Tag))
    , vbTextCompare) Then
  32.                     FrmMDIMain.Toolbar1.Buttons(i).Enabled = True
  33.                     FrmMDIMain.SubMnuModules(i).Enabled = True
  34.                     Global_User_Modules = Global_User_Modules + UCase(Trim(FrmMDIMain.Toolbar1.
    Buttons(i).Key)) & ","
  35.                 End If
  36.             Next i
  37.         End If
  38.     End If
  39.     GrupRes.Close
  40.     GrupCon.Close
  41.     BtnCloseEnabled = True
  42.     EnableCloseButton FrmMDIMain.hWnd, BtnCloseEnabled
  43.     FrmMDIMain.SetFocus
  44.     Set GrupRes = Nothing
  45.     Set GrupCon = Nothing
  46. End Function
  47.  
  48. Function Disabler_Main()
  49.     Dim i As Integer
  50.  
  51.     For i = 1 To FrmMDIMain.Toolbar1.Buttons.Count - 1
  52.         If FrmMDIMain.Toolbar1.Buttons(i).Enabled = True Then
  53.             FrmMDIMain.Toolbar1.Buttons(i).Enabled = False
  54.         End If
  55.         If FrmMDIMain.SubMnuModules(i).Enabled = True Then
  56.             If FrmMDIMain.SubMnuModules(i).Caption <> "-" Then
  57.                 FrmMDIMain.SubMnuModules(i).Enabled = False
  58.             End If
  59.         End If
  60.     Next i
  61.  
  62.     FrmMDIMain.MnuFile.Enabled = False
  63.     FrmMDIMain.MnuModules.Enabled = False
  64.     FrmMDIMain.MnuDefa.Enabled = False
  65.     BtnCloseEnabled = False
  66.     EnableCloseButton FrmMDIMain.hWnd, BtnCloseEnabled
  67. End Function
  68.  
  69. Private Sub cmdCancel_Click()
  70.     Me.Hide
  71.     FrmMDIMain.MDIForm_Unload (-1)
  72.     End
  73. End Sub
  74.  
  75. Private Sub cmdOK_Click()
  76.     On Error GoTo Err_Mes
  77.  
  78.     Login_UserCon.Open dbConnectString
  79.     Login_UserCon.CursorLocation = adUseClient
  80.     Login_UserRes.Open "Select * from UserAccess where USER_ID = '" & UCase(Trim(txtUserName.Te
    xt)) & "'", Login_UserCon, adOpenDynamic, adLockReadOnly
  81.  
  82.     If Login_UserRes.BOF And Login_UserRes.EOF Then
  83.         MsgBox "Incorrect Login Name", vbOKOnly, "Login"
  84.         cmdOK.Enabled = False
  85.         txtUserName.Text = ""
  86.         txtUserName.SetFocus
  87.         Login_UserCon.Close
  88.         Exit Sub
  89.     End If
  90.  
  91.     Set Login_UserRes.ActiveConnection = Nothing
  92.     Set Login_UserCon = Nothing
  93.  
  94.     If UCase(Trim(txtPassword.Text)) = Login_UserRes("PASSWORD") Then
  95.         If Login_UserRes("ACTIVE") = "Y" Then
  96.             LoginSucceeded = True
  97.             Global_User = Login_UserRes("USER_NAME")
  98.             Global_User_Code = Login_UserRes("User_Code")
  99.             Global_User_Group = Login_UserRes("User_Group")
  100.             Global_User_Admin = Login_UserRes("ADMINISTRATOR")
  101.             Global_User_Password = Login_UserRes("PASSWORD")
  102.             Global_User_Approver = IIf(Login_UserRes("USER_APPROVER") = "Y", True, False)
  103.             Global_User_Doctor = IIf(Login_UserRes("USER_DOCTOR_CODE") <> "", Login_UserRes("US
    ER_DOCTOR_CODE"), "")
  104.             DTPicker1.Format = dtpShortDate
  105.             ProcessDate = DTPicker1.Value
  106.             Me.Hide
  107.             FrmMDIMain.Toolbar1.Buttons(26).Enabled = True
  108.             FrmMainScreen.Show
  109.             Call Initializer
  110.             Call Enabler_Main
  111.             Login_UserRes.Close
  112.             Login_UserCon.Open dbConnectString
  113.             Login_UserRes.Open "Select * From USER_SCHEDULE Where (ACTION_STATUS = 'P' And (SUB
    MITTED_BY = '" & Global_User_Code & "' Or SUBMIT_TO_USER = '" & Global_User_Code & "')) OR (SUB
    MIT_DATE = '" & Format(ProcessDate, "dd-mmm-yyyy") & "' And (SUBMITTED_BY = '" & Global_User_Co
    de & "' Or SUBMIT_TO_USER = '" & Global_User_Code & "'))", Login_UserCon, adOpenDynamic, adLock
    ReadOnly
  114.             If Not (Login_UserRes.BOF And Login_UserRes.EOF) Then
  115.                 Frm_Alerter.Show vbModal
  116.             End If
  117.             Set Login_UserRes = Nothing
  118.             Set Login_UserCon = Nothing
  119.         Else
  120.             MsgBox "Unauthorized access: Not an active user", vbOKOnly, "Login"
  121.             Set Login_UserRes = Nothing
  122.             Set Login_UserCon = Nothing
  123.             Me.Hide
  124.             FrmMDIMain.MDIForm_Unload (-1)
  125.             End
  126.         End If
  127.     Else
  128.         Login_UserRes.Close
  129.         MsgBox "Invalid Password, try again!", , "Login"
  130.         txtPassword.Text = ""
  131.         cmdOK.Enabled = False
  132.         txtPassword.SetFocus
  133.         SendKeys "{Home}+{End}"
  134.     End If
  135. Err_Mes:
  136.     If Err.Number > 0 Then
  137.         MsgBox (Err.Number & ": " & Err.Description), vbOKOnly, "Error"
  138.     End If
  139. End Sub
  140.  
  141. Private Sub Form_Load()
  142.     FrmMDIMain.Toolbar1.Buttons(26).Enabled = False
  143.     frmLogin.Left = Screen.Width - Screen.Width + ((1 / 2) * (Screen.Width - frmLogin.Width))
  144.     frmLogin.Top = Screen.Height - Screen.Height + ((1 / 2) * (Screen.Height - frmLogin.Height)
    )
  145.     Div_Name = GetFromINI("Division", "DivisionType", "", "C:Program FilesHealPlusBinHealPl
    us.ini")
  146.  
  147.     If Div_Name = "Reception" Or Div_Name = "Pharmacy" Then
  148.         Div_Name = Div_Name & "-" & GetFromINI("Division", "DivisionID", "", "C:Program Files
    HealPlusBinHealPlus.ini")
  149.         Div_ID = Left(Div_Name, 3) & "-" & GetFromINI("Division", "DivisionID", "", "C:Program
     FilesHealPlusBinHealPlus.ini")
  150.     End If
  151.  
  152.     txtDiv.Text = Div_Name
  153.     cmdOK.Enabled = False
  154.     DTPicker1.CustomFormat = "ddd - MMM dd, yyyy"
  155.     DTPicker1.Format = dtpCustom
  156.     DTPicker1.ToolTipText = "Pick current working date"
  157.     DTPicker1.Value = Now
  158. End Sub
  159.  
  160. Private Sub Form_Unload(Cancel As Integer)
  161.     FrmMDIMain.MDIForm_Unload (-1)
  162.     End
  163. End Sub
  164.  
  165. Private Sub txtPassword_Change()
  166.     If txtUserName.Text <> "" And txtPassword.Text <> "" Then
  167.         cmdOK.Enabled = True
  168.     End If
  169. End Sub
  170.  
  171. Private Sub txtPassword_KeyPress(KeyAscii As Integer)
  172.     If KeyAscii = 13 Then
  173.         Call cmdOK_Click
  174.     End If
  175. End Sub
  176.  
  177. Private Sub txtUserName_KeyPress(KeyAscii As Integer)
  178.     If KeyAscii = 13 Then
  179.         txtPassword.SetFocus
  180.     End If
  181. End Sub
  182.  


      
      

      
وَ قُلِ اعْمَلُوا فَسَيَرَى اللهُ عَمَلَكُمْ وَ رَسُولُهُ وَ الْمُؤْمِنُونَ
صدق الله العظيم

    

  

    
    

      
#3
        
        

      
شكراً لك اخي الكريم و جزاك الله كل الخير

      
      

      
    

  

    
    
    
 مواضيع مشابهة





  

    
عدد الزوار حالياً
المتواجدون خلال آخر دقيقتين · يتحدّث كل ٣٠ ثانية

    
—الإجمالي—أعضاء مسجّلون—زوار بدون تسجيل

    
جارٍ التحقق من المتواجدين…