طريق الجرافيك


    اكواد فيجول بيزك

    شاطر
    avatar
    عمار
    عضو ذهبى
    عضو ذهبى

    ذكر عدد الرسائل : 903
    العمر : 29
    علم الدولة : سوريا
    تاريخ التسجيل : 02/02/2009

    اكواد فيجول بيزك

    مُساهمة من طرف عمار في الأربعاء 04 نوفمبر 2009, 9:38 am

    هذا كود للتأكد من وجود ملف ، فإذا كان موجوداً تظهر رسالة مكتوب فيها الرقم 1 أما إذا لم يكن موجوداً فتظهر لك رسالة مكتوب فيها الرقم 0



    private Declare Function SHFileExists Lib "shell32" Alias "#45" (ByVal szPath As String) As Long
    Private Sub Form_Load()
    MsgBox Str$(SHFileExists("c:\autoexec.bat"))
    End Sub
    -------------------------------------------------------------
    كود لتحويل ألوان الصور إلى الرمادي
    أضف زر كوماند ومربع صورة واكتب في الكوماند الكود التالي
    Picture1.ScaleMode = vbPixels
    x = Picture1.ScaleWidth
    y = Picture1.ScaleHeight
    For i = 0 To y - 1
    For j = 0 To x - 1
    pixel = Picture1.Point(j, i)
    red = pixel Mod 256
    green = ((pixel And &HFF00) / 256) Mod 256
    blue = (pixel And &HFF0000) / 65536
    g = ((red * 30) + (green * 60) + (blue * 20)) / 100
    Picture1.PSet (j, i), RGB(g, g, g)
    Next
    Next
    Picture1.ScaleMode = vbTwips
    -------------------------------------
    هذا الكود لمعرفة هل أنت متصل بالإنترنت أم لا
    ضع هذا في قم التصريحات General
    Private Declare Function InternetGetConnectedState _
    Lib "wininet.dll" (ByRef lpSFlags As Long, _
    ByVal dwReserved As Long) As Long
    Private Function Online() As Boolean
    Online = InternetGetConnectedState(0&, 0&)
    End Function
    أضف زر كوماند واكتب الكود التالي
    MsgBox Online()
    تحياتي..
    ----------------------------------------------
    لإلغاء تحميل فورم ما وليكن
    Form2 إستعمل الكود
    Unload Form2
    --------------------------------
    لتشغيل حدث معين عند الضغط على مفتاح Enter وليكن ظهور رسالة إكتب الكود التالي
    Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
    MsgBox "Syphonfilter مع تحيات"
    End If
    End Sub
    -------------------------------------
    ما هو التصريح ؟
    التصريح هو كلام تكتبه مع الكود من غير إحتسابه كود أي لا يتعامل معه فيجوال بيسيك ككود ولاكن كتصريح .
    ماذا نستفيد من التصريح ؟
    يمكنك من خلال التصريح توصيل معلومة أو ملاحظة للمستخدم البرنامج إذا كنت لم تحول البرنامج إلى إمتداد EXE
    لوضع تصريح ما عليك إلا كتابة الرمز (') ثم كتابة الكلام الذي تريد .
    تحياتي
    ---------------------------------------
    هل تريد مسح الكتابة المحدد في اليست إذاً إكتب الكود
    If List1.ListIndex > -1 Then
    List1.RemoveItem List1.ListIndex
    End If
    تحياتي
    --------------------------------------
    هل تريد جعل الفورم في حجم واحد لا يتغير إستخدم الكود التالي
    Private Sub Form_Resize()
    Width = 3000
    Height = 3000
    End Sub
    ----------------------------------------
    هل تريد حذف النص المحدد في ال TextBox إكتب الكود
    Text1.Seltext = Clear
    تحياتي
    ----------------------------------------
    هل تريد تشغيل كود زر الأمر بمجرد الضغط على مفتاح Enter من لوحة المفاتيح ما عليك تحديد زر الأمر ومن ثم تغيير خاصية Default إلى True
    تحياتي
    -----------------------------------------
    هل فكرة يوماً أن تغير لون زر الأمر Command ، تستطيع ذلك من خلال تغيير خاصية Style إلى 1 ثم اختيار اللون الذي تريد من خلال خاصية BackGround
    تحياتي
    -------------------------------------------------------
    هل سمعة عن أداة ما ولم تجدها في صندوق الأدوات ، تستطيع إضافة الأداة التي تريد وذلك من خلال الضغط على Ctrl+t ثم اختيار الأدات التي ترد بوع علامة صح أمام الآدات ثم الضغط على Enter
    تحياتي
    ------------------------------------------------------------
    هل تريد فتح ملف نصي تلقائياً في برنامج ال Notepad أضف الكود التالي مع تغيير المسار إلى مسار الملف الذي تريد
    Shell "notepad.exe" & " " & "C:\windows\desktop\books.txt", vbNormalFocus
    تحياتي
    ---------------------------------------------
    هل تريد عمل رقم سري لبرنامجك ؟ هذا الكود يمكنك من عمل ذلك ( كلمة السر هي فلسطين )
    [a = InputBox("إدخل الرقم السري", "الرقم السري")
    If a = "فلسطين" Then '
    MsgBox "كلمة السر صحيحة"
    Else
    MsgBox "كلمة السر خاطئة"
    End If
    تحيات
    -----------------------------------------------
    هذا الكود لإظهار رسالة للمستخدم عند الضغط بزر الفأرة الأيمن
    ضع الكود في حدث MouseMove
    IF Button = 2 then
    MsgBox "ممنوع الضغط بزر الفأرة الأيمن"
    End if
    ------------------------------------------
    إذا كنت تريد ظهور رسالة عند الضغط بزر الفأرة الأيسر إكتب الكود التالي في حدث MouseMove
    IF Button = 1 then
    MsgBox "ممنوع الضغط بزر الفأرة الأيسر"
    End if
    ------------------------------------------
    لإضافة النص من التسكت بوكس إلى اليست بوكس إتبع الآتي :
    1- أضف زر Command .
    2- أضف TextBox و ListBox .
    3- إكتب الكود التالي في زر الأمر Command في حدث Click
    List1.AddItem Text1.text
    تحياتي
    ----------------------------------------
    هل تريد عمل ساعة رقمية ؟؟ هذا الكود يمكنك من ذلك ؟!
    إتبع الخطواة التالية :
    1- أضف Timer إلى الفورم .
    2- أضف Label إلى الفورم وامسح الكتابة الموجودة في خاصية Caption أي إجعله بدون إسم .
    3- إجعل خاصية Enterval للتايمر بقيمة 100 .
    4- أضف الكود التالي للتايمر :
    Label1.Caption = Time
    تحياتي
    ------------------------------------------
    لجعل الخط في التكست بوكس غامق
    Text1.FontBold = True
    تحياتي
    -----------------------------------
    لجعل الخط مائل
    Text1.FontItalic = True
    لجعل خط تحت الكلمات في التكست بوكس
    Text1.FontUnderline = True
    تحياتي
    ------------------------------------
    لتغيير لون الخط في التكست بوكس ما عليك إلا كتابة الكود
    Text1.ForeColor = Color
    مع تغيير كلمة Color إلى شفرة اللون الذي تريد
    تحياتي..
    ---------------------------------------
    هذا الكود يحول الحروف الإنجليزية لإحرف كبيرة
    Private Sub Text1_KeyPress(KeyAscii As Integer)
    KeyAscii = Asc(UCase(Chr$(KeyAscii)))
    End Sub
    --------------------------------------------------------------------------------
    هل تريد إدارج التاريخ في التكست بوكس ..إذاً إكتب الكود التالي
    Text1.text = Date
    --------------------------------------------------------------------------------
    هذا الكود لإضافة الوقت للتكست بوكس
    Text1.text = Time
    --------------------------------------------------------------------------------
    هذا الكود لإظهار رسالة للمستخدم
    MsgBox "String", vbInformation, "Title"
    حيث String تضع فيها جسم الرسالة من نوع بيانات String و vbInformation نوع الرسالة أي رسالة خطأ أو معلومات فهنا وضعت شكل رسالة معلومات تستطيع تبديلها لتكون vbyesno أي زر نعم أو لا
    و ال Title هو العنوان
    -----------------------------------------------------------------------------
    هذا الكود لقلب الصورة بشكل عمودي
    Picture2.PaintPicture Picture1.Picture, 0, 0, _
    Picture1.Width, Picture1.Height, 0, Picture1.Height, _
    Picture1.Width, -Picture1.Height, vbSrcCopy
    --------------------------------------------------------------------------------
    هذا الكود لمعرفة مجلد الملفات الؤقته
    strTempDir = Environ$("temp")
    MsgBox strTempDir
    --------------------------------------------------------------------------------
    هذا الكود لطباعة النص الموجود في التكست بوكس
    Printer.Print Text1.Text
    --------------------------------------------------------------------------------
    هذا الكود لمعرفة عدد الأسطر في التكست بوكس
    ضع هذا في قسم التصريحات General

    code:--------------------------------------------------------------------------------
    Private Declare Function SendMessageLong Lib "user32" Alias _
    "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, ByVal lParam As Long) As Long
    Private Const EM_GETLINECOUNT = &HBA
    --------------------------------------------------------------------------------
    وهذا في زر Command مثلاً
    Dim lineCount As Long
    On Local Error Resume Next
    lineCount = SendMessageLong(Text1.hwnd, EM_GETLINECOUNT, 0&, 0)
    MsgBox Format$(lineCount, "##,###")
    --------------------------------------------------------------------------------
    هذا الكود لإبطال عمل مفاتيح Ctrl+Del+Shift
    ضع هذا في قسم التصريحات General
    Private Declare Function SystemParametersInfo Lib _
    "user32" Alias "SystemParametersInfoA" (ByVal uAction _
    As Long, ByVal uParam As Long, ByVal lpvParam As Any, _
    ByVal fuWinIni As Long) As Long
    Sub DisableCtrlAltDelete(bDisabled As Boolean)
    Dim X As Long
    X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
    End Sub
    --------------------------------------------------------------------------------
    لإبطال عمل المفاتيح
    code:--------------------------------------------------------------------------------
    Call DisableCtrlAltDelete(True)
    --------------------------------------------------------------------------------
    لإرجاعها

    Call DisableCtrlAltDelete(False)
    --------------------------------------------------------------------------------
    ا الكود لمعرفة مجلد الويندوز
    Dim winPath As String
    winPath = Environ$("windir")
    --------------------------------------------------------------------------------
    هذا الكود لمنع إستخدام المسافة في صندوق النص
    Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 32 Then
    KeyAscii = 0
    End If
    End Sub
    تستطيع منع مفتاح آخر من لوحة المفاتيح وذلك بتغيير القيمة 32 إلى قيمة المفتاح الذي تريد منعه
    --------------------------------------------------------------------------------
    هذا الكود للربط بين صندوق اليسة مع صندوق ليسة بوكس آخر
    List2.ListIndex = List1.ListIndex
    --------------------------------------------------------------------------------
    هل تريد معرفة دقة الشاشة عندك ..ضع هذا الكود في Command
    Dim intWidth As Integer
    Dim intHeight As Integer
    intWidth = Screen.Width \ Screen.TwipsPerPixelX
    intHeight = Screen.Height \ Screen.TwipsPerPixelY
    MsgBox "Screen Resolution:" + Str$(intWidth) + " x" + Str$(intHeight)
    --------------------------------------------------------------------------------
    إذا كنت تريد فتح أي ملف ما عليك إلا كتابة الكود
    Shell ""
    ضع عنوان الملف المراد مع إسمه بين علامتي الإقتباس
    --------------------------------------------------------------------------------
    لإظهار فورم ما وليكن إسمه Form2 إكتب الكود التالي
    Form2.Show
    --------------------------------------------------------------------------------
    ولإخفاءه
    Form2.Hide
    --------------------------------------------------------------------------------
    لتغيير إسم الخط في التكست بوكس إكتب الكود
    Text1.FontName = Andalus
    تستطيع إختيار إسم الخط الذي تريد وذلك بتغيير Andalusإلى إسم الخط الذي تريد
    تحياتي
    --------------------------------------------------------------------------------
    لجعل النص في التكست بوكس يتوسطه خط إكتب الكود
    Text1.FontStrikethru = True
    ولتغيير حجم الخط إكتب الكود
    Text1.FontSize = 12
    غير الرقم 12 إلى الرقم الذي تريد
    تحياتي
    --------------------------------------------------------------------------------
    لتحميل صورة إلى ال Picture Box إكتب الكود التالي
    Picture1 = LoadPicture("C:\Picture.bmp")
    ولحفظ صورة إكتب الكود التالي
    savepicture picture1.picture, "C:\Picture.bmp
    --------------------------------------------------------------------------------
    لتحميل جميع خطوط الكمبيوتر في ال Combo Box إكتب الكود
    Private Sub Form_Load()
    Dim i As Integer
    For i = 0 To Screen.FontCount - 1
    Combo1.AddItem Screen.Fonts(i)
    Next i
    Combo1.Text = Combo1.List(0)
    End Sub
    تحياتي
    --------------------------------------------------------------------------------
    تستطيع إخفاء زر الكوماند أو أي شيء آخر وذلك بالكود التالي كمثال نطبق على زر الأمر Command
    Command1.Visible = False
    حيث أنه يغير في الخصائص أي تستطيع عمل هذا التغيير مباشرة من الخصائص
    تحياتي
    --------------------------------------------------------------------------------
    هل تريد تجميد الويندوز ؟ إستخدم الكود التالي
    أضف هذا الكود في قسم التصريحات General
    Public Declare Function SetParent Lib "user32" (ByVal _
    hWndChild As Long, ByVal hWndNewParent As Long) As Long
    وأضف هذا الكود في زر الأمر Command
    SetParent Me, Me
    تحياتي
    --------------------------------------------------------------------------------
    هذا الكود لعمل فورم رخامي
    ضع هذا الكود في قسم التصريحات General
    Private Sub GradientFill()
    Dim i As Long
    Dim c As Integer
    Dim r As Double
    r = ScaleHeight / 3.142
    For i = 0 To ScaleHeight
    c = Abs(220 * Sin(i / r))
    Me.Line (0, i)-(ScaleWidth, i), RGB(c, c, c + 30) 'Notice the bias To blue. You can be more subtle by reducing this number (try 10). Try other colours too.
    Next
    End Sub
    وهذا الكود في حدث Resize للفورم
    GradientFill
    تحياتي
    --------------------------------------------------------------------------------
    هل تريد الخروج من البرنامج بواسطة الضغط على مفتاح Esc إكتب الكود التالي :
    في حدث التحميل للفورم إكتب الكود
    Form1.KeyPreview = True
    وفي حدث KeyPress للفورم إكتب
    If KeyAscii = 27 Then
    End
    End If
    --------------------------------------------------------------------------------
    هذه الدالة لتحميل صفحة من الإنترنت
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
    Private Sub Command1_Click()
    lngRetVal = URLDownloadToFile(0, "http://www.arabsgate.com/", "c:\Arabsgate.htm", 0, 0)
    End Sub
    في هذا المثال وضعت موقع بوابة العرب للتحميل
    --------------------------------------------------------------------------------
    هذه الدالة تقوم بنقل ملف من مسار إلى مسار آخر
    Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
    Private Sub Command1_Click()
    MoveFile "c:\Windows\Desktop\a.txt", "c:\a.txt"
    End Sub
    --------------------------------------------------------------------------------
    هذه الدالة تقوم بتعطيل زر إغلاق Close الذي يوجد في كل نافذة
    Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
    Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
    Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
    Const MF_BYPOSITION = &H400&
    Private Sub Form_Load()
    Dim a As Long, b As Long
    a = GetSystemMenu(Me.hwnd, False)
    b = GetMenuItemCount(a)
    RemoveMenu a, b - 1, MF_BYPOSITION
    DrawMenuBar Me.hwnd
    End Sub
    --------------------------------------------------------------------------------
    هذا الكود للكتابة في ال TextBox
    Text1.Text = "القدس لنا"
    --------------------------------------------------------------------------------
    هذه الدالة لتغيير ألوان الواجهة للويندوز
    Private Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long
    Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
    Const COLOR_ACTIVECAPTION = 2
    Private Sub Form_Load()
    a = GetSysColor(COLOR_ACTIVECAPTION)
    SetSysColors 1, COLOR_ACTIVECAPTION, RGB(255, 200, 140)
    MsgBox "The old title bar color was" + Str$(a) + " And is now" + Str$(GetSysColor(COLOR_ACTIVECAPTION))
    End Sub
    --------------------------------------------------------------------------------
    هذا الكود للتحويل من المئوي إلى الفهرنهايتي
    أضف 2 تكست بوكس الأول للإدخال والثاني للقيمة بعد التحويل ، واضف زر كوماند واكتب بداخله الشفرة التالية
    Private Sub Command1_Click()
    Dim m
    m = Text1.Text
    Text2.Text = (9 / 5 * m) + 32
    End sub
    تحياتي
    --------------------------------------------------------------------------------
    هذه الدالة تعرض مربع حوار تهيئة القرص المرن
    Const SHFD_CAPACITY_DEFAULT = 0
    Const SHFD_FORMAT_QUICK = 0
    Private Declare Function SHFormatDrive Lib "shell32" (ByVal hwndOwner As Long, ByVal iDrive As Long, ByVal iCapacity As Long, ByVal iFormatType As Long) As Long
    Private Sub Form_Load()
    SHFormatDrive Me.hwnd, 0, SHFD_CAPACITY_DEFAULT, SHFD_FORMAT_QUICK
    End Sub
    --------------------------------------------------------------------------------
    هذا الكود لإعادة تشغيل الجهاز
    أضف هذا الكود في قسم التعريفات General
    Private Declare Function SetupPromptReboot Lib "setupapi.dll" (ByRef FileQueue As Long, ByVal Owner As Long, ByVal ScanOnly As Long) As Long
    أضف هذا الكود في حدث الضغط على زر Command
    SetupPromptReboot ByVal 0&, Me.hWnd, 0
    تحياتي
    --------------------------------------------------------------------------------
    هذا الكود يقوم بإخبارك هب يوجد كرت صوت أم لا أي هل تستطيع تشغيل ملفات الأصوات في جهازك
    ضع هذا الكود في الموديل Module
    Declare Function waveOutGetNumDevs Lib "winmm.dll" () As Long
    اضف زر Command وضع فيه الكود التالي
    Dim i As Integer
    i = waveOutGetNumDevs()
    If i > 0 Then
    MsgBox "بالإمكان تشغيل ملفات الأصوات في جهازك", _
    vbInformation, "التأكد من وجود كرت الصوت"
    Else
    MsgBox "ليس بالإمكان تشغيل ملفات الأصوات في جهازك", _
    vbInformation, "التأكد من وجود كرت الصوت"
    End If
    --------------------------------------------------------------------------------
    هل تريد التعرف على خصائص الطابعة أي هل تريد إظهار نافذة خصائص الطابعة إتبع ما يلي :
    إضغط على ctrl+t
    إختر من النافذة التي سوف تظهر لك Microsoft Common Dialog وذلك بوضع أمامه صح ثم OK
    أضفه في الفورم واكتب الكود التالي في حدث الضغط على زر
    Dim BeginPage, EndPage, NumCopies, i
    CommonDialog1.CancelError = True
    On Error GoTo ErrHandler
    CommonDialog1.ShowPrinter
    BeginPage = CommonDialog1.FromPage
    EndPage = CommonDialog1.ToPage
    NumCopies = CommonDialog1.Copies
    For i = 1 To NumCopies
    Next i
    Exit Sub
    ErrHandler:
    Exit Sub
    --------------------------------------------------------------------------------
    ل تريد عمل قائمة منبثقة إتبع الآتي :
    إصنع قائمة عادية وضع خاصية Visible للقائمة الأولى False الآن إكتب الكود التالي في حدث Mouse Down
    if button = 2 then
    PoPupMenu MenuName
    إستبدل ال Menu Name بإسم قائمتك
    --------------------------------------------------------------------------------
    هذا الكود يقوم بتحديد كلي للنص الموجود في مربع النص TextBxo
    With Text1
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1)
    Text1.SetFocus
    End With
    --------------------------------------------------------------------------------
    هذا الكود لستبدال كلمة أو حرف أو جملة في ال TextBox
    أضف زر Command و TextBox إلى الفورم
    ضع هذا في حدث التحميل للفورم
    Text1.Text = "فلسطين لنا"
    وهذا في حدث الضغط على زر Command
    Text1.Text = Replace(Text1.Text, "فلسطين", "القدس", 1)
    --------------------------------------------------------------------------------
    هذا الكود يقوم بإظار رسالة للمستخدم عند إدخال غير الأرقام في ال TextBox
    ضع الكود التالي في حدث التغيير لل TextBox
    If Text1.Text <> Numeric Then
    MsgBox "يجب أن تدخل أرقاماً وليس حروفاً أو رموزاً", vbInformation, "Syphonfilter مع تحيات"
    End If
    --------------------------------------------------------------------------------
    هذا الكود لإزالة جميع العناصر الموجودة في ال ListBox
    List1.Clear
    وهذا الكود لإزالة عنصر واحد من ال ListBox
    List1.RemoveItem "1"
    تحياتي
    --------------------------------------------------------------------------------
    هذا الكود يقوم بجمع الأرقام الموجود في Text1 و Text2 ويضع الناتج في Label1
    Label1.Caption = Val(Text1.Text) + Val(Text2.Text)
    وهذا الكود يقوم بطرح ال Text1 من ال Text2 ويضع الناتج في ال Label1
    Label1.Caption = Val(Text1.Text) - Val(Text2.Text)
    هذا الكود يقوم بضرب Text1 بـ Text2 ويضع الناتج في ال Label1
    Label1.Caption = Val(Text1.Text) * Val(Text2.Text)
    هذا الكود يقوم بقسمة Text1 على Text2 ويضع الناتج في ال Label1
    Label1.Caption = Val(Text1.Text) / Val(Text2.Text
    --------------------------------------------------------------------------------
    'يقوم بنسخ النص من مربع النص الأول إلى مربع النص الثاني الموجود في الفورم الثاني
    Form2.Text1 = Form1.Text1.Text
    'يقوم بإخفاء الفورم الأول
    Unload Form1
    End Sub

      الوقت/التاريخ الآن هو الثلاثاء 13 نوفمبر 2018, 7:57 pm