كود لمعرفة كلمات السر على هيئة نجوم ***** *كود برمجي*- vb -

Abaaad-x0x

--------------------------------------------------------------------------------


كود لمعرفة كلمات السر على هيئة نجوم *****
*كود برمجي*


--------------------------------------------------------------------------------


Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


Private Sub Timer1_Timer()
Const EM_SETPASSWORDCHAR = &HCC
Dim coord As POINTAPI
'نقوم هنا بمعرفة احداثى الفأرة
s = GetCursorPos(coord)
x = coord.x
y = coord.y
'المكتوب بها كلمة المرور(textbox)نقوم هنا بمعرفة مقبض آداة التحرير
h = WindowFromPoint(x, y)
'Char 0 الى (PasswordChar)فى هذه الخطوة نقوم بتعديل خاصية ال
Dim NewChar As Integer
NewChar = CLng(0)
retval = SendMessage(h, EM_SETPASSWORDCHAR, ByVal NewChar, 0)
End Sub


--------------------------------------------------------------------------------


كود لاضافة بيانات حقل معين في قاعدة البيانات الى عنصر list
*كود برمجي*


--------------------------------------------------------------------------------


Private Sub Form_Activate()
Dim a As String
Do While Not Data1.Recordset.EOF = True
a = Data1.Recordset.Fields("name").Value
' هنا تمثل اسم الحقل في قاعدة البيانات name كلمة
List1.AddItem a
Data1.Recordset.MoveNext
Loop
End Sub


--------------------------------------------------------------------------------



يقوم بتحويل شكل التكست واليبل الى 3d
*كود برمجي*


--------------------------------------------------------------------------------


'Set form's AutoRedraw property toTrue
Sub PaintControl3D(frm As Form, Ctl As Control)
' This Sub draws lines around controls to make them 3d

' darkgrey, upper - horizontal
frm.Line (Ctl.Left, Ctl.______ - 15)-(Ctl.Left + _
Ctl.Width, Ctl.______ - 15), &H808080, BF
' darkgrey, left - vertical
frm.Line (Ctl.Left - 15, Ctl.______)-(Ctl.Left - 15, _
Ctl.______ + Ctl.Height), &H808080, BF
' white, right - vertical
frm.Line (Ctl.Left + Ctl.Width, Ctl.______)- _
(Ctl.Left + Ctl.Width, Ctl.______ + Ctl.Height), &HFFFFFF, BF
' white, lower - horizontal
frm.Line (Ctl.Left, Ctl.______ + Ctl.Height)- _
(Ctl.Left + Ctl.Width, Ctl.______ + Ctl.Height), &HFFFFFF, BF

End Sub

Sub PaintForm3D(frm As Form)
' This Sub draws lines around the Form to make it 3d

' white, upper - horizontal
frm.Line (0, 0)-(frm.ScaleWidth, 0), &HFFFFFF, BF
' white, left - vertical
frm.Line (0, 0)-(0, frm.ScaleHeight), &HFFFFFF, BF
' darkgrey, right - vertical
frm.Line (frm.ScaleWidth - 15, 0)-(frm.ScaleWidth - 15, _
frm.Height), &H808080, BF
' darkgrey, lower - horizontal
frm.Line (0, frm.ScaleHeight - 15)-(frm.ScaleWidth, _
frm.ScaleHeight - 15), &H808080, BF

End Sub

'DEMO USAGE
'Add 1 label and 1 textbox


Private Sub Form_Load()

Me.AutoRedraw = True
PaintForm3D Me
PaintControl3D Me, Label1 'Label1 is name of label
PaintControl3D Me, Text1 'Text1 is name of textbox

End Sub
ملاحظة في البداية لبد من انشاء تكست وليبل


--------------------------------------------------------------------------------


كود الاظهار النص بشكل عمودي
*كود برمجي*


--------------------------------------------------------------------------------


Private Sub Form_Activate()
Dim s As String
For i = 1 To Len(Label1)
s = s & Mid$(Label1, i, 1) & vbCrLf
Next
Label1 = s
End Sub



--------------------------------------------------------------------------------


كود تستطيع من خلاله حذف اي ملف
*كود برمجي*


--------------------------------------------------------------------------------


قم بوضع هذا الكود في قسم جنرال
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
ومن ثم حدد سار الملف مثال
Private Sub Command1_Click()
dim x
x = DeleteFile("C:\WINDOWS\system\LZEXPAND.DLL")


--------------------------------------------------------------------------------


كود لاستدعاء ملف من نوع mid
*كود برمجي*


--------------------------------------------------------------------------------


قم بوضع اداة
mmcontrol1


m و
اجعل نامي
Private Sub Form_Load()
m.DeviceType = "sequencer"
m.FileName = ("e:\Holiday3.mid")
m.Command = "open"
m.Command = "play"
END SUB


--------------------------------------------------------------------------------


كود لتحميل فلاش من نوع SWF
*كود برمجي*


--------------------------------------------------------------------------------


Private Sub Form_Load()
s.Movie = ("E:\Projects\Howl.swf")
End Sub


--------------------------------------------------------------------------------


كود لوضع مقطع الفيديو في بكتشر
*كود برمجي*


--------------------------------------------------------------------------------


Private Sub Command1_Click()
MM.HWNDDISPLAY=PICTURE1.HWND
End Sub


--------------------------------------------------------------------------------


الزر الأيمن للماوس
*كود برمجي*


--------------------------------------------------------------------------------


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

IF BUTTON=2 THEN
msgbox "الزر الأيمن للماوس"
END IF
End Sub


--------------------------------------------------------------------------------