هر مطلبی میخواهید بگید بنویسم

شاید موقع اجرا از این کد خوشتون بیاد .

اول یک Timer ایجاد کنید بعدش کد رو وارد کنید .

Private Declare Function SetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Fire() As Byte

Private Sub Form_Load()
Timer1.Interval = 10
Me.AutoRedraw = True
ReDim Fire(0 To 100, 0 To 100)
For x = 0 To 100
For y = 0 To 100
Fire(x, y) = 0
Next y
Next x

End Sub

Private Sub Timer1_Timer()
On Error Resume Next
Dim x As Integer
Dim y As Integer
Dim Color As Integer
Dim table As Byte
For y = 100 To 0 Step -1
For x = 0 To 100
Randomize
Fire(x, y) = Fire(x, y) - Int(Rnd * 3)
table = Int(Rnd * 3)
Fire(x, y - table) = Fire(x, y)
Color = (Int(Fire(x, y) * 3))
SetPixel Me.hDC, x + (Rnd * 2), y, RGB(Color + Color, Color, Color / 2)
Next x
Next y

For x = 0 To 100
For y = 95 To 100
Fire(x, y) = 110
Next y
Next x
Me.Refresh


End Sub

سخت بود ؟؟؟؟

از منوی Project گزینه Component را انتخاب کنید.

از لیست باز شدهMicrosoft Agent Control2.0 را تيک بزنید.

حال یک Agent و یک ListBox را به فرم اضافه کنید.

اگه زحمتی نیست اینا رو هم اضافه کنید.

Dim Merlin As IAgentCtlCharacterEx
Dim nName As String

Private Sub Form_Load()
With List1
.AddItem "Surprised"
.AddItem "Greet"
.AddItem "Explain"
.AddItem "Announce"
.AddItem "Pleased"
.AddItem "DoMagic1"
.AddItem "DoMagic2"
.AddItem "Suggest"
.AddItem "Read"
.AddItem "Write"
.AddItem "Wave"
.AddItem "Acknowledge"
.AddItem "Alert"
.AddItem "Blink"
.AddItem "Confused"
.AddItem "DontRecognize"
.AddItem "Sad"
.AddItem "Think"
.AddItem "Uncertain"
.AddItem "Search"
.AddItem "Process"
.AddItem "MoveLeft"
.AddItem "MoveDown"
.AddItem "MoveUp"
.AddItem "MoveRight"
.AddItem "LookUp"
.AddItem "LookDown"
.AddItem "LookRight"
.AddItem "LookLeft"
.AddItem "Idle1_1"
.AddItem "Idle1_2"
.AddItem "Idle2_1"
.AddItem "Idle2_2"
.AddItem "Idle3_1"
.AddItem "Idle3_2"
.AddItem "Decline"
.AddItem "Congratulate"
.AddItem "GetAttention"
.AddItem "GestureUp"
.AddItem "GestureDown"
.AddItem "GestureLeft"
.AddItem "GestureRight"
End With
nName = "merlin"
Agent1.Characters.Load nName
Set Merlin = Agent1.Characters(nName)
Merlin.Show
End Sub

Private Sub List1_Click()
Merlin.Play List1.Text
Merlin.Play "Restpose"
End Sub
 

* Control Panel

Shell "control.exe", vbMaximizedFocus
* Accessibility Options
Shell "rundll32.exe shell32.dll,Control_RunDLL access.cpl"
* Add/Remove Programs
Shell "rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl"
* Date/Time Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL timedate.cpl"
* Display Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL desk.cpl"
* Internet Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL Inetcpl.cpl"
* Joystick Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL Joy.cpl"
* Mouse Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL Main.cpl"
* Modem Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL modem.cpl"
* System Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl"
* Regional Settings
Shell "rundll32.exe shell32.dll,Control_RunDLL intl.cpl"
* Sound Properties
Shell "rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl"

برای بدست آوردن مدت زمان روشن بودن کامپیوتر خود مراحل زیر را دنبال کنید .

1) در فرم خود يك  Timer  و يك  Textbox  ایجاد کنید .

2) کد زیر را به برنامه خود اضافه کنید .

Private Declare Function GetTickCount& Lib "kernel32" ()
Private Sub Form_Load()
Timer1.Interval = 1000
End Sub

امروز شما را با یک تابع آشنا میکنم که میتواند تصاویرتان را به زیبایی محو کند یا نمایش دهد.
مراحل زیر را انجام دهید
1)یک Picturebox و Scrollbar با نام قبلی Picture1 و HScroll1 به فرم خوداضافه کنید.
2)به Picture1 یک تصویر بدهید.
3)حال کد زیر را پروژه خود اضافه کنید:
***
Private Declare Function AlphaBlend Lib "msimg32" (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 widthSrc As Long, ByVal heightSrc As Long, ByVal dreamAKA As Long) As Boolean
Dim nBlend As Long

Private Sub Form_Load()
Me.AutoRedraw = True
HScroll1.Max = 255
With Picture1
.ScaleMode = 3
.Visible = False
.AutoRedraw = True
.AutoSize = True
End With
End Sub

Private Sub HScroll1_Scroll()
nBlend = vbBlue - CLng(HScroll1.Value) * (vbYellow + 1)
Me.Cls
AlphaBlend Me.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, Picture1.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, nBlend
End Sub

***
می توانید برای فرم خود هم تصویر قرار دهیدو نتیجه را ببینید.
 

اگرمیخواهیداین دو کنترل به کنترلهای دیگر بپیوندند.
از منوی project گزینه Components را کلیک کنید.
از بین لیست کنترلها دو گزینه microsoft internet transfer control 6.0 
و microsoft internet controls را تیک بزنید و OK کنید.

کاراصلی WebBrowser نمایش صفحات وب و معمول ترین کار کنترل Inet بدست آوردن سورس یک آدرس است.

کنترلها: Command1,Text1,Text2,WebBrowser1,Inet1


Private Sub Command1_Click()
If Text1.Text <> "" Then
WebBrowser1.Navigate Text1.Text
Text2 = Inet1.OpenURL(Text1.Text)
End If
End Sub

Private Sub Form_Load()
Me.Width = 5325
Me.Height = 5400
Me.Caption = "Mini browser"
With WebBrowser1
.Width = 4575
.Height = 2375
.Top = 600
.Left = 240
End With
With Text1
.Top = 240
.Left = 1680
.Height = 285
.Width = 3135
.Text = "http://www.blogfa.com"
End With
With Text2
.Width = 4575
.Height = 2375
.Top = 3000
.Left = 240
.Text = ""
End With
With Command1
.Top = 120
.Left = 240
.Height = 375
.Width = 1215
.Caption = "Navigate"
.Default = True
End With
End Sub

***

اگر میخواهید کد بالا درست عمل کندباید خاصیت MultiLine از Text2 را 
True کنید.
اگر هنگام اجرای کد بالا Offline هستید میتوانید در Text1 آدرس یک 
فایل htmlیاhtm راکه درکامپیوترخود وجود دارد به صورت زیربنویسید. 
file://C:\WINDOWS\Help\Tours\htmlTour\start_icons.htm