الحصول على اسم المستخدم
Dim s As String
Dim cnt As Long
Dim dl As Long
Dim CurUser as String
cnt = 199
s = String$(200, 0)
dl = GetUserName(s, cnt)
If dl <> 0 Then curuser = Left$(s, cnt) Else curuser = ""
You must declare the following function in the declarations section
of a form or module in the project.
Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long
تعطيل مفاتيح Alt + Shift + Delete
Copy this code into the declarations section of your project.
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
Code
Sub DisableCtrlAltDelete(bDisabled As Boolean)
Dim X As Long
X = SystemParametersInfo(97, bDisabled, CStr(1), 0)
End Sub
Use
To disable Ctrl-Alt-Delete:
Call DisableCtrlAltDelete(True)
To enable Ctrl-Alt-Delete:
Call DisableCtrlAltDelete(False)
جعل اسم النموذج يومض Create a new .exe project, add a module to it with the following code:
Public Declare Function FlashWindow _
Lib "user32" (ByVal hwnd As Long, _
ByVal bInvert As Long) As Long
Put a timer and 2 commandbuttons on form1 with these properties:
command1.caption="Start"
command2.caption="Stop"
timer1.interval=500 'flashes every 1/2 second
timer1.enabled=false
Code
Private Sub Timer1_Timer()
a& = FlashWindow(Me.hwnd, 1)
End Sub
Private Sub Command1_Click()
Timer1.Enabled = True
End Sub
Private Sub Command2_Click()
Timer1.Enabled = False
End Sub
Execute the app. (F5) and click the buttons.
كود لتحويل ألوان الصور إلى الرمادي
أضف زر كوماند ومربع صورة واكتب في الكوماند الكود التالي
code:
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
هذا الكود لقلب الصورة بشكل عمودي
code:
Picture2.PaintPicture Picture1.Picture, 0, 0, _
Picture1.Width, Picture1.Height, 0, Picture1.Height, _
Picture1.Width, -Picture1.Height, vbSrcCopy
هذا الكود لطباعة النص الموجود في التكست بوكس
code:
Printer.Print Text1.Text
هذه لعبة سناك برمجة الفيجوال بيسك
تحويل مشروع فيجوال بيسك إلى ملف تنفيذى (EXE) عن طريق الكود
Private Sub Command1_Click()
Shell "vb6.exe /make C:ProgramsProject.vbp C:ProgramsProject.exe"
End Sub
مثال على كيفية وضع جميع الفونتات (Fonts) فى الأداة TreeView
Private Sub Form_Load()
Dim root As Node
Dim i As Integer
With TreeView1.Nodes
Set root = .Add(, , , "Fonts")
.Add root.Index, tvwChild, , Screen.Fonts(i)
For i = 1 To Screen.FontCount - 1
.Add root.Index, tvwChild, , Screen.Fonts(i)
Next
End With
End Sub
عمل كلمة مرور للبرنامج
Private Sub Form_Load()
Dim s As Integer
Dim passw As String
Do Until (s = 5 Or passw = "00000")
passw = InputBox("ادخل كلمة المرور", "كلمة مرور مطلوبة")
s = s + 1
Loop
If s = 5 Then
MsgBox "كلمة المرور التي ادخلتها خاطئة... الرجاء حاول مرة أخرى", vbOKOnly, "خطأ في كلمة المرور"
End
'عرض النموذج بعد التأكد من تحقق الشرط
frmLogo.Show "frmlogo"
'خروج من التكرار
End If
End Sub
كود يجعل الشاشة تبدوا و كأنها منصهره الصق الكود التالي
Private Declare Function GetDC Lib "user32" ( _
ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" ( _
ByVal hDestDC As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyEscape Then Unload Me
End Sub
Private Sub Form_Load()
Dim lngDC As Long
Dim intWidth As Integer, intHeight As Integer
Dim intX As Integer, intY As Integer
lngDC = GetDC(0)
intWidth = Screen.Width / Screen.TwipsPerPixelX
intHeight = Screen.Height / Screen.TwipsPerPixelY
frmMain.Width = intWidth * 15
frmMain.Height = intHeight * 15
Call BitBlt(hDC, 0, 0, intWidth, intHeight, lngDC, 0, 0, vbSrcCopy)
frmMain.Visible = vbTrue
Do
intX = (intWidth - 128) * Rnd
intY = (intHeight - 128) * Rnd
Call BitBlt(lngDC, intX, intY + 1, 128, 128, lngDC, intX, intY, vbSrcCopy)
DoEvents
Loop
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmMain = Nothing
End
End Sub
لعبة بلاك وينتر
لعبة Connect4
هذا مثال لعمل برنامج لاخذ صورة للشاشة
الفورم الشفاف
لصنع بروجريس بار
3d label
مجموعة اكواد
الله ينور عليك اخى دراكولا2002 يبدو انك متعطش هههههههه ليس للدماء طبعا :) الله ينور عليك والله بارك الله فيك .(f)
يبدو ان الموضوع لم ينال اعجبكم
الله يعطيك الخير ،ويوفقك في الدنيا والآخرة
أما الموضوع فيكفيه عدد التحميلات
وحبذا لو تكرم المشاركون بالمشاركة في مثل هذه الأعمال المفيدة
هذا الموضوع مغلق.