سنتر العرب
 

ماشاء الله تبارك الله ماشاء الله لاقوة الا بالله , اللهم اني اسالك الهدى والتقى والعفاف والغنى

   

 

 

    تويتر فيس بوك

 

Loading


العودة   منتديات سنتر العرب > سنتر العرب - الاقسام العامة > سنتر العرب - الأنترنت والكمبيوتر و الـ DSL > سنتر العرب لخدمات الويب > لغات البرمجه, php , asp,Ajax, visual basic Java

لغات البرمجه, php , asp,Ajax, visual basic Java لغات البرمجه, php , asp,Ajax, visual basic Java,لغات البرمجه, php , asp,Ajax, visual basic Java,لغات البرمجه, php , asp,Ajax, visual basic Java,لغات البرمجه, php , asp,Ajax, visual basic Java,

المواضيع المتشابهه
الموضوع كاتب الموضوع المنتدى مشاركات آخر مشاركة
تعلم أساسيات فيجوال بيسك 6 عنـ الشوق ـاد كتب الحاسب والتقنية والتكنلوجيا ولغات البرمجة 1 12-15-2010 11:20 PM
تعلم أساسيات فيجوال بيسك 6 عنـ الشوق ـاد كتب الحاسب والتقنية والتكنلوجيا ولغات البرمجة 0 06-27-2010 06:12 AM
اكواد فيجوال بيسك 1 ضمتني الين طاح عقالي لغات البرمجه, php , asp,Ajax, visual basic Java 3 04-26-2008 08:34 PM
اكواد فيجوال بيسك ضمتني الين طاح عقالي لغات البرمجه, php , asp,Ajax, visual basic Java 1 03-23-2008 06:50 PM
ماهو الفيجوال بيسيك جموح لغات البرمجه, php , asp,Ajax, visual basic Java 5 03-22-2008 06:41 PM


اكواد فيجوال بيسك 2

لغات البرمجه, php , asp,Ajax, visual basic Java


إضافة رد
 
أدوات الموضوع
قديم 03-23-2008, 06:07 PM   رقم المشاركة : [1]
ضمتني الين طاح عقالي
आँखों

 الصورة الرمزية ضمتني الين طاح عقالي
 




ضمتني الين طاح عقالي is just really nice ضمتني الين طاح عقالي is just really nice ضمتني الين طاح عقالي is just really nice ضمتني الين طاح عقالي is just really nice

 
Post اكواد فيجوال بيسك 2

لمعرفة عدد الاسطر في مربع النص ****Box


كود PHP:
Private Declare Function SendMessageLong Lib "user32" Alias _
    
"SendMessageA" (ByVal hwnd As LongByVal wMsg As Long_
    ByVal wParam 
As LongByVal lParam As Long) As Long
Private Const EM_GETLINECOUNT = &HBA
Private Sub Command1_Click()
    
Dim lineCount As Long
    On Local Error Resume Next
    lineCount 
SendMessageLong(****1.hwndEM_GETLINECOUNT0&, 0)
    
MsgBox Format$(lineCount"##,###")
End Sub 

لفتح وإغلاق سواقة الأقراص المدمجة


كود PHP:
Private Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As StringByVal _
lpstrReturnString 
As StringByVal uReturnLength As Long_
ByVal hwndCallback 
As Long) As Long
'?E?
Private Sub cmdOpen_Click()
retvalue = mciSendString("set CDAudio door open", _
returnstring, 127, 0)
End Sub
'
CU?C?
Private 
Sub cmdClose_Click()
retvalue mciSendString("set CDAudio door closed"_
returnstring
1270)
End Sub 

منع تشغيل أكثر من نسخة من برنامجك


كود PHP:
Private Sub Form_Load()
If 
App.PrevInstance True Then
    MsgBox 
"لا يمكن تشغيل أكثر من نسخة من البرنامج"
    
Unload Me
    
Exit Sub
End 
If
End Sub 
اجعل برنامجك فوق الجميع always on top

كود PHP:
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long_
ByVal hWndInsertAfter 
As LongByVal X As Long_
ByVal Y 
As LongByVal CX As LongByVal CY As Long_
ByVal wFlags 
As Long) As Long
Private Const SWP_NOMOVE 2
Private Const SWP_NOSIZE 1
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2

Public Sub SetOnTop(ByVal hwnd As LongByVal bSetOnTop As Boolean)
Dim lR As Long
If bSetOnTop Then
    lR 
SetWindowPos(hwndHWND_TOPMOST0000SWP_NOMOVE Or SWP_NOSIZE)
Else
    
lR SetWindowPos(hwndHWND_NOTOPMOST0000SWP_NOMOVE Or SWP_NOSIZE)
End If
End Sub

Private Sub Form_Load()
    
SetOnTop Form1.hwndTrue
End Sub 


معرفة العدد الاولي فقط ارسم كوماند مع ليبل و تست



كود PHP:
Private Sub Command1_Click()
Dim s
Dim a

Val(****1.****)
If 
Or 0 Then
Label1
.Caption "عدد غير أولي"
GoTo 20
End 
If

For 
2 To (1)

If (
i) = Int(iThen

1

Else
a
End 
If
Next i
If 0 Then

Label1
.Caption "عدد أولي"
Else
Label1.Caption "عدد غير أولي"
End If

20 End Sub

Private Sub ****1_Change()
'هذا الكود يرسل رسالة للمستخدم إذا أدخل غير الارقام
If Not IsNumeric(****1.****) Then
'
المفتاح ليس رقم
MsgBox 
("أدخل أرقاما فقط")
****
1.**** = ""
End If
End Sub 

كود يعمل إذا ضغط على حرف يكتبه



كود PHP:
Private Sub Form_KeyPress(KeyAscii As Integer)
Print 
Chr$(KeyAscii) & "=" KeyAscii
End Sub 

تحويل الحروف الإنجليزية لأحرف كبيرة



كود PHP:
Private Sub ****1_KeyPress(KeyAscii As Integer)
KeyAscii Asc(UCase(Chr$(KeyAscii)))
End Sub 

كود يعمل في مربع تست يقوم بأن يجعل المستخدم فقط يدخل أرقام من صفر إلى 9 و إذا ضغط على ازرار في الكي بورد لا يطبعها في التست بوكس



كود PHP:
Private Sub ****1_KeyPress(KeyAscii As Integer)
If 
KeyAscii Asc("0") Or KeyAscii Asc("9"Then
     KeyAscii 
0
     End 
If
End Sub 


كود للبحث عن كلمة في التست بوكس


كود PHP:
Private Sub Form_Load()
   ****
1.**** = "Two of the peak human experiences"
   
****1.**** = ****1.**** & " are good food and classical music."
End Sub
Private Sub Form_Click()
   
Dim SearchWhere   ' Declare variables.
   ' 
Get search string from user.
   
Search InputBox("Enter **** to be found:")
   
Where InStr(****1.****, Search)   ' Find string in ****.
   If Where Then   ' 
If found,
      ****
1.SetFocus
      
****1.SelStart Where 1   ' set selection start and
      ****1.SelLength = Len(Search)   ' 
set selection length.
   Else 


هذه دالة تفيد في الرسم مستطيل له حواف دائرية"

كود PHP:
Command1_Click()
Dim i As Single
Dim a 
As Integer
Me.hdc
RoundRect(i001001005050)
End Sub

Public Declare Function RoundRect Lib "gdi32" Alias "RoundRect" (ByVal hdc As LongByVal X1 As LongByVal Y1 As LongByVal X2 As LongByVal Y2 As LongByVal X3 As LongByVal Y3 As Long) As Long 
لنقل ملف من مسار الى مسار اخر



كود PHP:
Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As StringByVal lpNewFileName As String) As Long
Private Sub Command1_Click()
MoveFile "c:\my ********s\a.txt""c:\a.txt"
End Sub 

تغيير ارتفاع قائمة مربع السرد Combobox



كود PHP:
Private Declare Function MoveWindow Lib "user32" _
(ByVal hwnd As LongByVal x As LongByVal y As _
Long
ByVal nWidth As LongByVal nHeight As Long_
ByVal bRepaint 
As Long) As Long

Public Sub SetComboHeight(oComboBox As ComboBoxlNewHeight As Long)
Dim oldscalemode As Integer
If TypeOf oComboBox.Parent Is Frame Then Exit Sub

' Change the ScaleMode on the parent to Pixels.
oldscalemode = oComboBox.Parent.ScaleMode
oComboBox.Parent.ScaleMode = vbPixels

Resize the combo box ********
MoveWindow oComboBox.hwndoComboBox.Left_
oComboBox
.TopoComboBox.WidthlNewHeight1

' Replace the old ScaleMode
oComboBox.Parent.ScaleMode = oldscalemode
End Sub


Private Sub Form_Load()
Call SetComboHeight(Combo1, 400) ' 
400 Pixels
End Sub 
تغيير عرض قائمة مربع السرد Combobox

كود PHP:
Private Declare Function SendMessage Lib "user32" _
Alias 
"SendMessageA" (ByVal hwnd As Long_
ByVal wMsg 
As LongByVal wParam As Long_
lParam 
As Long) As Long

Private Const CB_SETDROPPEDWIDTH = &H160

Public Sub SetComboWidth(oComboBox As ComboBoxlWidth As Long)
 
lWidth is in pixels
SendMessage oComboBox
.hwndCB_SETDROPPEDWIDTHlWidth0
End Sub

Private Sub Form_Load()
SetComboWidth Combo1400
End Sub 

كيف تقوم بتعيين مفتاح لبرنامجك (Hotkey)



كود PHP:
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long_
ByVal wMsg 
As LongByVal wParam As Long_
lParam 
As Long) As Long

Private Declare Function DefWindowProc Lib "user32" _
Alias 
"DefWindowProcA" (ByVal hwnd As Long_
ByVal wMsg 
As LongByVal wParam As Long_
ByVal lParam 
As Long) As Long

Private Const WM_SETHOTKEY = &H32
Private Const WM_SHOWWINDOW = &H18
Private Const HK_SHIFTA = &H141 'Shift + A
Private Const HK_SHIFTB = &H142 '
Shift B
Private Const HK_CONTROLA = &H241 'Control + A
Private Const HK_ALTZ = &H45A ' 
ALT+Z

Private Sub Form_Load()
Me.WindowState vbMinimized
' ALT+Z نقوم بتعيين المفتاح
erg& = SendMessage(Me.hwnd, WM_SETHOTKEY, HK_ALTZ, 0)
'
يتم التأكد من أن المفتاح الذي تم اختياره غير مستخدم من قبل تطبيق آخر
If erg& <> 1 Then
    MsgBox 
"يجب عليك تعيين مفتاح آخر"vbOKOnly"Error"
End If
لإظهار النافذة عند الضغط على المفتاح المعين
DefWindowProc Me
.hwndWM_SHOWWINDOW00
End Sub 

نسخ خلفية سطح المكتب إلى نموذجك


كود PHP:
'انسخ هذ الكودالى قسم التصريحات العامة
Private Declare Function PaintDesktop Lib "user32" _
    (ByVal hdc As Long) As Long

'
انسخ هذ الكودالى حدث النقر في زر الامر
Private Sub Command1_Click()
    
PaintDesktop Form1.hdc
End Sub 

أنشاء وتنسيق وطبع وثيقة وورد من داخل برنامج بنقرة زر الامر


كود PHP:
Private Sub Command1_Click()

'تعريف المتغيرات
Dim objWord As New Word.Application

'
تشغيل مايكروسوفت وورد
objWord
.Visible True

'ينشئ وثيقة جديدة
objWord.********s.Add

يضيف النص لوثيقة وورد
objWord
.Selection.Type**** "اكتب النص الذي سيضاف لوثيقة مستند وورد"

'يختار كل النص 
objWord.Selection.WholeStory

تغيير حجم الخط
objWord
.Selection.Font.Size 100

' لتغيير لون الخط
objWord.Selection.Font.Color = wdColorRed

لدفع المستخدم لحفظ الوثيقة
objWord
.********s.Save

يطبع الوثيقة
objWord
.PrintOut

Set objWord 
Nothing

End Sub 

قلب الصور عمودياً أو افقيا او نسخها

كود PHP:
Private Sub Command1_Click()
'الوضع الطبيعي النسخ
Picture2.PaintPicture Picture1.Picture, 0, 0, _
Picture1.Width, Picture1.Height, 0, 0, _
Picture1.Width, Picture1.Height, vbSrcCopy
End Sub

Private Sub Command2_Click()
'
الوضع الافقي
Picture2
.PaintPicture Picture1.Picture00_
Picture1
.WidthPicture1.HeightPicture1.Width_
0
, -Picture1.WidthPicture1.HeightvbSrcCopy
End Sub

Private Sub Command3_Click()
'الوضع العمودي
Picture2.PaintPicture Picture1.Picture, 0, 0, _
Picture1.Width, Picture1.Height, 0, Picture1.Height, _
Picture1.Width, -Picture1.Height, vbSrcCopy
End Sub

Private Sub Command4_Click()
'
لقلب الصورة
Picture2
.PaintPicture Picture1.Picture00_
Picture1
.WidthPicture1.HeightPicture1.Width_
Picture1
.Height, -Picture1.Width, -Picture1.HeightvbSrcCopy
End Sub 

لإنهاء صلاحيات برنامجك التجريبي بعد30 يوماً فقط


كود PHP:
Dim startdate As String
Dim differenceofdate
Dim TRACEDATE 
As String
Dim newdate
Dim chk

    
If GetSetting(App.Title"Startup""counter""") = "" Then
       SaveSetting App
.Title"Startup""counter"1
       SaveSetting App
.Title"Startup""Started"Format(Date"mm dd yyyy")
       
SaveSetting App.Title"Startup""Last Used"Format(Date"mm dd yyyy")
       
lblcnt.Caption "1"
       
    
ElseIf GetSetting(App.Title"Startup""counter""") = "31" Then

MsgBox 
"شكراً لستخدامك هذا البرنامج  " Chr(10) + Chr(1) & "الرجاء إيقاف عمل هذا البرنامج او سيتم فقدان كل المعلومات التي قمت بإدخالها "vbCritical"شكراً لك "

End
       
 
Else
       
TRACEDATE GetSetting(App.Title"Startup""Last Used""")
chk DateDiff("d"CDate(TRACEDATE), Now)
       If 
chk 0 Then CHECK IF THE DATE WAS CHANGE which is lesser than the PREVIOUS DATE WHERE THE SYSTEM USED.

 
MsgBox "لم يتم العثور على تاريخ النظام لديك !!  " Chr(10) + Chr(13) & "  الرجاء تغييرة الأن وإلا لن يكون بإمكانك إستخدام هذا البرنامج لاحقاً"vbCritical"تاريخ مفقود"

 
End
       
Else
      
startdate GetSetting(App.Title"Startup""Started""")
       
differenceofdate DateDiff("d"startdateNow)
         If 
differenceofdate <> 0 Then
                    lblcnt
.Caption differenceofdate 1
        SaveSetting App
.Title"Startup""Last Used"Format(Now"MM DD YYYY")
               
SaveSetting App.Title"Startup""counter"differenceofdate 1
                End 
If
                If 
differenceofdate 0 Then
                lblcnt
.Caption GetSetting(App.Title"Startup""Counter""")
                
End If
       
End If
  
End If
End Sub 

لتبديل أزرار الفأرة


كود PHP:
Const SPI_SETMOUSEBUTTONSWAP 33
Const SPIF_UPDATEINIFILE = &H1
Private Declare Function SystemParametersInfo Lib "user32.dll" Alias _
    
"SystemParametersInfoA" (ByVal uAction As LongByVal uiParam As Long_
    pvParam 
As AnyByVal fWinIni As Long) As Long
Private Sub Form_Load()
SystemParametersInfo SPI_SETMOUSEBUTTONSWAP10SPIF_UPDATEINIFILE
End Sub 

لإنهاء البرنامج عند النقر على Esc في لوحة المفاتيح مهما كان موقع التركيز بين الأدوات.


كود PHP:
'Load انسخ هذا الكود لحدث تحميل النموذج

Private Sub Form_Load()
Form1.KeyPreview = True
End Sub
 
'
KeyPress انسخ هذا الكود لحدث النموذج

Private Sub Form_KeyPress(KeyAscii As Integer)
If 
KeyAscii 27 Then
End
End 
If
End Sub
 
 
KeyPress بدلاً من كود الحدث  KeyDownويمكن ايضاًوضع الكود التالي في الحدث 

Private Sub Form_KeyDown(KeyCode As IntegerShift As Integer)
If 
KeyCode vbKeyEscape Then End
End Sub 

لاختبار وجود بطاقة إخراج الصوت



كود PHP:
Private Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
Private Sub Command1_Click()
    
Get the number of installed waveout devices
    ret
& = waveOutGetNumDevs
    
If ret& > 0 Then
        MsgBox 
"يوجد بطاقة لإخراج الصوت مثبتة على هذا الجهاز"
    
Else
        
MsgBox "للأسف لايوجد بطاقة لإخراج الصوت على هذا الجهاز"
    
End If
End Sub 

توقيع ضمتني الين طاح عقالي
 

لاتغتر بحلمي .... سعة صدري ليست عجز .... لكنني مللت من تربية المشردين أخلاقياً
هذا قلبي ... فليرني امرؤ قلبه
ضمتني الين طاح عقالي غير متواجد حالياً   رد مع اقتباس
قديم 03-23-2008, 06:53 PM   رقم المشاركة : [2]
جموح
.
 




جموح is a jewel in the rough جموح is a jewel in the rough جموح is a jewel in the rough

 
افتراضي رد: اكواد فيجوال بيسك 2

الله يعطيك العافية

جوزيت خيرا

توقيع جموح
 





سبحان الله وبحمده سبحان الله العظيم
جموح غير متواجد حالياً   رد مع اقتباس
إضافة رد

مواقع النشر (المفضلة)


الذين يشاهدون محتوى الموضوع الآن : 1 ( الأعضاء 0 والزوار 1)
 
أدوات الموضوع

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

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

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

  Bookmark and Share

  


الساعة الآن 05:40 PM

|

www.swsws.net® Version 3.8.6
Copyright ©2000 - 2012, 7: swsws Ltd.
تنبية جميع ما يتم كتابته في المنتدى يعبر عن رأي كاتبه فقط ولا تتحمل إدارة منتديات سنتر العرب أدنى مسؤولية

Security team