موسوعة الكودات

    • موسوعة الكودات

      أرجو ان تكون هده الكودات جديدة على اعضاء الساحة

      هدا كود تاثير التموج عل الصور

      كود المصدر

      1. Option Explicit
      3. Dim WaveRate As Integer
      5. Private Sub Form_Load()
      6. WaveRate = 25
      7. End Sub
      9. Private Sub Option1_Click(Index As Integer)
      10. Timer1.Interval = 200 - Index * 90
      11. End Sub
      13. Private Sub Option2_Click(Index As Integer)
      14. WaveRate = 25 - Index * 5
      15. End Sub
      17. Private Sub P2_Click()
      19. End Sub
      21. Private Sub Timer1_Timer()
      22. Static X As Integer, dX As Integer
      23. Dim I As Integer, J As Integer
      25. Const W = 20
      27. If dX = 0 Then dX = 1
      28. If X = 0 Then X = 5
      30. For J = 0 To P1.ScaleHeight Step WaveRate
      32. If Option2(0).Value Then
      33. If dX + X <= 5 Or dX + X >= WaveRate \ 2 Then dX = -dX
      34. X = X + dX
      35. End If
      37. For I = 0 To P1.ScaleWidth Step WaveRate
      38. If dX + X <= 5 Or dX + X >= WaveRate \ 2 Then dX = -dX
      39. X = X + dX
      41. P2.PaintPicture P1.Picture, I, J, X, WaveRate, I, J, WaveRate \ 2, WaveRate
      42. P2.PaintPicture P1.Picture, I + X, J, WaveRate - X, WaveRate, I + WaveRate \ 2, J, WaveRate \ 2, WaveRate
      43. Next
      44. Next
      45. End Sub
      عرض الكل

    • اجعل البرنامج في المقدمة

      اجعل البرنامج في المقدمة





      كود المصدر

      1. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
      2. ByVal hWndInsertAfter As Long, ByVal X As Long, _
      3. ByVal Y As Long, ByVal CX As Long, ByVal CY As Long, _
      4. ByVal wFlags As Long) As Long
      5. Private Const SWP_NOMOVE = 2
      6. Private Const SWP_NOSIZE = 1
      7. Private Const HWND_TOPMOST = -1
      8. Private Const HWND_NOTOPMOST = -2
      10. Public Sub SetOnTop(ByVal hwnd As Long, ByVal bSetOnTop As Boolean)
      11. Dim lR As Long
      12. If bSetOnTop Then
      13. lR = SetWindowPos(hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
      14. Else
      15. lR = SetWindowPos(hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
      16. End If
      17. End Sub
      19. Private Sub Form_Load()
      20. SetOnTop Form1.hwnd, True
      21. End Sub
      عرض الكل

    • للتحويل من الميلادي الى الهجري

      كود للتحويل من الميلادي الى الهجري




      كود المصدر

      1. ' Module &iacute;&Igrave;&Egrave; &THORN;&Ntilde;&Ccedil;&Aacute;&Eacute; &Ccedil;&aacute;&Ocirc;&Ntilde;&Iacute; &Ccedil;&aacute;&ETH;&iacute; &Yacute;&iacute;
      2. Private Sub Command1_Click()
      3. a = TransDate(text2, 1)
      4. Text1.Text = a
      5. End Sub
      7. Private Sub Command2_Click()
      8. b = TransDate(Text1, 2)
      9. text2.Text = Format(b, "dd/mm/yyyy")
      10. End Sub
      12. Private Sub Form_Load()
      13. text2 = Date
      14. text2.Text = Format(text2.Text, "dd/mm/yyyy")
      15. Text1.Text = Format(Text1.Text, "dd/mm/yyyy")
      17. End Sub
      عرض الكل

    • كود لجعل الفورم على شكل دائرة

      كود لجعل الفورم على شكل دائرة

      'يمكن تغير القيم بين الاقواس



      كود المصدر

      1. Private Declare Function CreateEllipticRgn Lib "gdi32" _
      2. (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, _
      3. ByVal Y2 As Long) As Long
      4. Private Declare Function SetWindowRgn Lib "user32" _
      5. (ByVal hWnd As Long, ByVal hRgn As Long, _
      6. ByVal bRedraw As Boolean) As Long
      8. Private Sub Form_Load()
      9. SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 300, 200), True
      10. End Sub

    • كود الرسم في الفورم

      كود الرسم في الفورم



      كود المصدر

      1. Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
      2. Form1.CurrentX = X
      3. Form1.CurrentY = Y
      4. End Sub
      6. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
      7. If Button = 1 Then
      8. Line (Form1.CurrentX, Form1.CurrentY)-(X, Y), QBColor(0)
      9. End If
      10. End Sub