أكواد فجول بيسك10

يحرك لك الفورم لمكان معينة

Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Private Sub Command1_Click()
r = MoveWindow(Me.hwnd, 90, 90, 300, 250, 1)
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
توسيط اسم الفورم في الوسط

Public Sub CenterC(frm As Form)
Dim SpcF As Integer 'How many spaces can fit
Dim clen As Integer 'caption length
Dim oldc As String 'oldcaption
Dim i As Integer 'not important
' 'remove any spaces at the ends of the caption
' 'very easy if you read it carefully
oldc = frm.Caption

Do While Left(oldc, 1) = Space(1)

DoEvents
oldc = Right(oldc, Len(oldc) - 1)
Loop
Do While Right(oldc, 1) = Space(1)

DoEvents
oldc = Left(oldc, Len(oldc) - 1)
Loop

clen = Len(oldc)

If InStr(oldc, "!") <> 0 Then

If InStr(oldc, " ") <> 0 Then
clen = clen * 1.5
Else
clen = clen * 1.4
End If

Else

If InStr(oldc, " ") <> 0 Then
clen = clen * 1.4
Else
clen = clen * 1.3
End If

End If

' ''see how many characters can fit
SpcF = frm.Width / 61.2244 ''how many space can fit it the caption
SpcF = SpcF - clen 'How many spaces can fit-How much space the
' 'caption takes up
' ''Now the tricky part

If SpcF > 1 Then
DoEvents 'speed up the program
frm.Caption = Space(Int(SpcF / 2)) + oldc
Else 'if the form is too small for spaces
frm.Caption = oldc
End If

End Sub

Private Sub Form_Resize()
If Me.Width = oldsize Then 'if the width hasn't changed
Exit Sub 'then dont mess with it
Else
CenterC Me
oldsize = Me.Width
End If

End Sub

Private Sub Form_Load()
CenterC Me
oldsize = Me.Width
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
يجعلك عندما تقرب الماوس فوق التست يبتعد ( يتحرك )

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If Text1.Top = 600 Then ' Move it to the bottom
For i = 600 To Form1.Height - 2 * Text1.Height Step Screen.TwipsPerPixelY
Text1.Top = i ' Change the command button's top property to i
Next i ' Reapeat

Else ' Move it to the top
For i = Form1.Height - 2 * Text1.Height To 600 Step -Screen.TwipsPerPixelY
Text1.Top = i
Next i
End If
End Sub
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
جعل الفورم أبعاد ثلاثية اضف كوماند للفورم

Sub ThreeDForm(frmForm As Form)

Const cPi = 3.1415926

Dim intLineWidth As Integer

intLineWidth = 5

' 'save scale mode
Dim intSaveScaleMode As Integer
intSaveScaleMode = frmForm.ScaleMode
frmForm.ScaleMode = 3

Dim intScaleWidth As Integer
Dim intScaleHeight As Integer

intScaleWidth = frmForm.ScaleWidth
intScaleHeight = frmForm.ScaleHeight

' 'clear form
frmForm.Cls

' 'draw white lines
frmForm.Line (0, intScaleHeight)-(intLineWidth, 0), &HFFFFFF, BF
frmForm.Line (0, intLineWidth)-(intScaleWidth, 0), &HFFFFFF, BF

' 'draw grey lines
frmForm.Line (intScaleWidth, 0)-(intScaleWidth - intLineWidth, _
intScaleHeight), &H808080, BF
frmForm.Line (intScaleWidth, intScaleHeight - intLineWidth)-(0, _
intScaleHeight), &H808080, BF

' 'draw triangles(actually circles) at corners
Dim intCircleWidth As Integer
intCircleWidth = Sqr(intLineWidth * intLineWidth + intLineWidth * intLineWidth)
frmForm.FillStyle = 0
frmForm.FillColor = QBColor(15)
frmForm.Circle (intLineWidth, intScaleHeight - intLineWidth), _
intCircleWidth, QBColor(15), -3.1415926, -3.90953745777778 '-180 * _
cPi / 180, -224 * cPi / 180

frmForm.Circle (intScaleWidth - intLineWidth, intLineWidth), _
intCircleWidth, QBColor(15), -0.78539815, -1.5707963 ' -45 * _
cPi / 180, -90 * cPi / 180

' 'draw black frame
frmForm.Line (0, intScaleHeight)-(0, 0), 0
frmForm.Line (0, 0)-(intScaleWidth - 1, 0), 0
frmForm.Line (intScaleWidth - 1, 0)-(intScaleWidth - 1, intScaleHeight - 1), 0
frmForm.Line (0, intScaleHeight - 1)-(intScaleWidth - 1, intScaleHeight - 1), 0
frmForm.ScaleMode = intSaveScaleMode

End Sub

Private Sub cmdDraw_Click()
ThreeDForm Me
End Sub