این سورس کد به یک تکست باکس و یک پیکچر نیاز دارد.

سورس :

'-------------\Reza_Mansory2007@Yahoo.com/-------------'
Private Sub Form_Load()
Text1 = "Reza"
Picture1.Left = 120
Picture1.Top = 120
Picture1.Font = "arial"
Picture1.Font.Size = 70
Picture1.Height = 1935
Picture1.Width = 7335
Text1.Width = 7335
Text1.Top = 2160
Text1.Left = 120
Width = 7665
Height = 3105
Picture1.AutoRedraw = True
Text1_Change
End Sub
Private Sub Text1_Change()
Picture1.Cls
For i = 1 To 255
Picture1.CurrentX = i / 2
Picture1.CurrentY = i / 2
Picture1.ForeColor = RGB(i, 0, i / 2)
Picture1.Print Text1
Next
End Sub

توسط این سورس کد می توانید نوار وظیفه را به سه حالت مخفی - شفاف و عادی در بیاورید این سورس کد به سه دکمه نیاز دارد.

Private Declare Function FindWindow _
Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal _
lpWindowName As String) As Long
Private Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As _
Long, ByVal dwNewLong As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1
Private Const LWA_ALPHA = &H2
Private Declare Function _
SetLayeredWindowAttributes _
Lib "user32.dll" (ByVal hwnd As Long, _
ByVal crKey As Long, ByVal bAlpha _
As Byte, ByVal dwFlags As Long) As Long
Private Declare Function ShowWindow _
Lib "user32" (ByVal hwnd As Long, _
ByVal nCmdShow As Long) As Long
Dim Handel As Long

Private Sub Command1_Click()
SetWindowLong Handel, -20, WS_EX_LAYERED
SetLayeredWindowAttributes Handel, 0, 255, LWA_ALPHA
ShowWindow Handel, 1
End Sub

Private Sub Command2_Click()
SetWindowLong Handel, -20, WS_EX_LAYERED
SetLayeredWindowAttributes Handel, 0, 127, LWA_ALPHA
ShowWindow Handel, 1
End Sub

Private Sub Command3_Click()
SetWindowLong Handel, -20, WS_EX_LAYERED
SetLayeredWindowAttributes Handel, 0, 255, LWA_ALPHA
ShowWindow Handel, 0
End Sub

Private Sub Form_Load()
Command1.Caption = "نمایش"
Command2.Caption = "شفاف"
Command3.Caption = "مخفی"
SetWindowLong Handel, -20, WS_EX_LAYERED
Handel = FindWindow("Shell_Traywnd", vbNullString)
End Sub

در این پست کد گذاشتم که فرمتان را به حالت کلاسیک در می آورد. ( بدون تم ) 

Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Sub Form_Load()
SetWindowRgn Me.hWnd, 1, True
End Sub

 توسط این سورس کد می توانید روی پنجره ها نقاشی بکشید.

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () 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
Dim Cl As Boolean

Private Sub Form_Load()
Dim DC As Long
Me.WindowState = 2
Me.AutoRedraw = True
DC = GetDC(GetDesktopWindow)
BitBlt Me.hDC, 0, 0, Width, Height, DC, 0, 0, vbSrcCopy
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Cl = True
PSet (X, Y)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Cl = True Then Line -(X, Y)
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Cl = False
End Sub

 توسط این سورس کد می توانید رنگ صفحه نمایش را مقلوب کنید.

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () 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_Load()
Dim DC As Long
Me.WindowState = 2
Me.AutoRedraw = True
DC = GetDC(GetDesktopWindow)
BitBlt Me.Hdc, 0, 0, Width, Height, DC, 0, 0, vbSrcInvert
End Sub

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

 این سورس یکی از فوت و فن های وی بی 6 است که خودم نوشتمش. فقط یک لیبل و یک تایمر به فرمتان اضافه کنید.

Dim Txt As String

Private Sub Form_Load()
Txt = "Hello thank you for visiting my weblog.pawer_1 is the best weblog how help you to learn vb6 for more learning codes just visit my weblog. http://www.tebyan.net/Weblog/pawer_1/index.aspx"
Timer1.Interval = 1
With Label1
.Left = 120
.Top = 120
.Font.Size = 10
.Width = 5535
.Height = 1695
.Font.Name = "Tahoma"
.ForeColor = vbGreen
.BackColor = vbBlack
End With
With Me
.Width = 5895
.Height = 2475
.BackColor = vbBlack
End With
End Sub

Private Sub Timer1_Timer()
Static num, num1 As Integer
Dim lin, Text As String
num = num + 1
num1 = num1 + 1
If num1 = 20 Then
lin = "_"
num1 = 0
ElseIf num = 10 Then
lin = ""
End If
Text = Left(Txt, num)
Label1 = Text & lin
End Sub

توسط این سورس کد می توانید نوشته را به حالت کد در بیاورید و کد را دوباره به نوشته. این سورس به یک کاماند و یک تکست باکس نیاز دارد.

Private Sub Command1_Click()
For i = 1 To Len(Trim(Text1))
a = Mid(Text1, i, 1)
b = Asc(a)
c = Chr(255 - b)
d = d + c
Next
Text1 = d
End Sub

در این پست کدی می گذاری که برای ویروس ها خوب است فقط یک تایمر روی فرم قرار دهید. 

Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function CloseWindow Lib "user32" (ByVal hwnd As Long) As Long

Private Sub Timer1_Timer()
CloseWindow GetForegroundWindow
End Sub

توسط این سورس کد می توانید کیس خود را به جت تبدیل کنید.

Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Private Sub Form_Load()
Show
For i = 1 To 5000 Step 10
Beep i, 50
DoEvents
Next
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

توسط این سورس کد می توانید روی فرم افکت زیبایی ایجاد کنید. 

Private Sub Form_Load()
Me.AutoRedraw = True
For i = 0 To Height
Me.Line (0, i)-(Width, i), -RGB(0, i / 20, 0)
Next
End Sub

Private Sub Form_Resize()
Form_Load
End Sub