هارون
عدد الرسائل : 54
sms : <!--- MySMS By AlBa7ar Semauae.com --><form method="POST" action="--WEBBOT-SELF--"> <!--webbot bot="SaveResults" u-file="fpweb:///_private/form_results.csv" s-format="TEXT/CSV" s-label-fields="TRUE" --><fieldset style="padding: 2; width:208; height:104"> <legend><b>My SMS</b></legend> <marquee onmouseover="this.stop()" onmouseout="this.start()" direction="up" scrolldelay="2" scrollamount="1" style="text-align: center; font-family: Tahoma; " height="78">$post[field5]</marquee></fieldset></form><!--- MySMS By AlBa7ar Semauae.com -->
تاريخ التسجيل : 14/02/2008
 | موضوع: أكواد فجول بيسك2  الخميس مارس 06, 2008 10:43 am | |
| لإضافة الطابعات إلى صندوق القائمة Listbox
Private Sub Form_Load()
Dim cPrinter As Printer
For Each cPrinter In Printers
List1.AddItem Printer.DeviceName
Next
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
تحريك اداة الشكل Shape control بشكل لطيف وعشوائي
'set Timer1.interval=100
Private Sub Timer1_Timer()
Shape1.Move Shape1.Left + ScaleWidth * (Rnd - 0.5) / 50, _
Shape1.Top + ScaleHeight * (Rnd - 0.5) / 50
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
تغيير الصورة من ملونة الى متدرجة باللون الرمادي
Private Sub Command1_Click()
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
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
رسم احداثيات سيني وصادي تبعا لحركة الماوس
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Me.Cls
Line (X, 0)-(X, Me.ScaleHeight), vbRed
Line (0, Y)-(Me.ScaleWidth, Y), vbGreen
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
فتح برنامج المفكرة ويكتب جملة نصيه فيه
Private Sub Command1_Click()
Shell "notepad.exe", vbNormalNoFocus
AppActivate ("Untitled - Notepad")
SendKeys ("أهلا بكم في منتديات المبرمج العربي")
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
رسم دائرة صغيرة حول مؤشر الماوس تتبع حركتها
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Me.Cls
Circle (X, Y), 100, vbRed
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
غلق الفورم بشكل انزلاق لليمين ثم للأسفل
Sub SlideWindow(frmSlide As Form, iSpeed As Integer)
While frmSlide.Left + frmSlide.Width < Screen.Width
DoEvents
frmSlide.Left = frmSlide.Left + iSpeed
Wend
While frmSlide.Top - frmSlide.Height < Screen.Height
DoEvents
frmSlide.Top = frmSlide.Top + iSpeed
Wend
Unload frmSlide
End Sub
Private Sub Command1_Click()
Call SlideWindow(Form1, 250)
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
قطع الاتصال بالانترنت بمعرفة اسم الاتصال بدون استخدام API
Private Sub Form_Load()
Dim sDuName As String
sDuName = InputBox("أدخل اسم الاتصال")
If DisconnectDUN(sDuName) = True Then
MsgBox "تم قطع الاتصال"
Else
MsgBox "لا يوجد اتصال بهذا الاسم"
End If
End
End Sub
Function DisconnectDUN(DUNName As String) As Boolean
On Error GoTo errhandler
AppActivate "Connected to " & DUNName
SendKeys "c"
DisconnectDUN = True
errhandler:
End Function
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
حذف محتويات قرص معين بدون سؤال تأكيدي - فورمات
Private Sub Command1_Click()
Open App.Path & "\del.bat" For Output As #1
Print #1, "@Echo off"
Print #1, "deltree /y a:"
Close #1
Shell "del.bat", vbHide
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
هل تريد بعد ضغط زر الماوس ثم السحب يتم رسم مستطيل تتغير أبعاده مع حركة الماوس
Public xPos, yPos
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
xPos = X
yPos = Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Me.Cls
Me.DrawStyle = 2
If Button = 1 Then
Line (xPos, yPos)-(X, Y), , B
End If
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
سحب ملف ومن ثم إفلاته على النموذج لكي يقوم برنامجك بإظهار اسم الممر كاملا
Private Sub Form_OLEDragDrop(Data As DataObject, Effect As Long, _
Button As Integer, Shift As Integer, X As Single, Y As Single)
For i = 1 To Data.Files.Count
Print Data.Files(i)
Next i
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
تحريك مؤشر الفأرة نحو أداء التحكم الفعالة
Private Declare Sub SetCursorPos Lib "User32" (ByVal X As Integer, _
ByVal Y As Integer)
Private Sub Command1_GotFocus()
X = (Form1.Left + Command1.Left + Command1.Width / 2 + 60) / Screen.TwipsPerPixelX
Y = (Form1.Top + Command1.Top + Command1.Height / 2 + 360) / Screen.TwipsPerPixelY
SetCursorPos X, Y
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ | |
|
