موقع المطورين
  العودة  موقع المطورين \ أقسام الأكواد والدروس \ ركن أكواد فيجويل بيسك visual Basic المجانيه \ تغير اللغه من خلال البرنامج

http://mtweren.com/bb.pngحـساباتنا البنــكيةhttp://mtweren.com/bb.png

 
 
أدوات الموضوع العرض العاديالعرض المتطورالعرض الشجري
  #1  
قديم 10-07-2017, 01:10 PM
W!ndows W!ndows غير متواجد حالياً
Administrator
 
تاريخ التسجيل: Sep 2017
المشاركات: 350
افتراضي تغير اللغه من خلال البرنامج

كود:
Option Explicit 'This Project requires 4 Buttons 'Textbox to test changes to input language 'API's to adjust the keyboardlayout Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long Private Declare Function GetLastError Lib "kernel32" () As Long Const KLF_ACTIVATE = &H1 'Languages Const Lang_AR_SAU As String = "00000401" 'Arabic Const Lang_EN_USA As String = "00000409" 'English Const Lang_FR_FRA As String = "0000040C" 'French 'Switch input language to French Private Sub Command3_Click() Form1.Caption = SetKbLayout(Lang_FR_FRA) End Sub 'Switch input language to English Private Sub Command2_Click() Form1.Caption = SetKbLayout(Lang_EN_USA) End Sub 'Switch input language to Arabic Private Sub Command1_Click() Form1.Caption = SetKbLayout(Lang_AR_SAU) End Sub 'Test invalid langauge ! Private Sub Command4_Click() 'Invalid language Form1.Caption = SetKbLayout("00000D0D") End Sub 'Will return True if succeeds ! Public Function SetKbLayout(strLocaleId As String) As Boolean 'Changes the KeyboardLayout 'Returns TRUE when the KeyboardLayout was adjusted properly, FALSE otherwise 'If the KeyboardLayout isn't installed, this function will install it for you On Error Resume Next Dim strLocId As String 'used to retrieve current KeyboardLayout 'create a buffer strLocId = String(9, 0) 'retrieve the current KeyboardLayout GetKeyboardLayoutName strLocId 'Check whether the current KeyboardLayout and the 'new one are the same If strLocId = (strLocaleId & Chr(0)) Then 'If they're the same, we return immediately SetKbLayout = True Exit Function Else 'create buffer strLocId = String(9, 0) 'load and activate the layout for the current thread strLocId = LoadKeyboardLayout((strLocaleId & Chr(0)), KLF_ACTIVATE) End If 'Test success GetKeyboardLayoutName strLocId If strLocId = (strLocaleId) Then SetKbLayout = True End Function Private Sub Form_Load() 'Set buttons caption for you ! Command1.Caption = "Arabic" Command2.Caption = "English" Command3.Caption = "French" Command4.Caption = "Invalid lang" End Sub
رد مع اقتباس


أدوات الموضوع
انواع عرض الموضوع

تعليمات المشاركة
لا تستطيع إضافة مواضيع جديدة
لا تستطيع الرد على المواضيع
لا تستطيع إرفاق ملفات
لا تستطيع تعديل مشاركاتك

BB code is متاحة
كود [IMG] متاحة
كود HTML معطلة

الانتقال السريع