منتظر شما هستم . . .

امروز میخواهم بتون یه عیدی بدم.امیدوارم خوشتون بیاد.

می خواهید ساختن یک برنامه مالتی مدیا رو یاد بگیرید ؟؟؟

اگه می خواهید ، با من همراه بشید

این کارا رو که می گم دنبال کنید :

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

2)از لیست باز شده گزینه های زیر را تیک بزنید :

    Microsoft Common Dialog control 6.0                I

    Microsoft Windows Common Controls 5.0 (SP2)       II

    Windows Media Player                             III

  OK  کنید.(اگه تا اینجا مشکلی داشتید به من گزارش بدید)

  ضمنا وقتی که روی Windows Media Player کلیک کردید حتما باید نام فایلی که در پایین نشان داده میشود msdxm.ocx باشد.

3)به برنامه خود کنترلهای زیر را اضافه کنید :( مواد لازم )

4)کد زیر را وارد کنید :

***

Option Explicit
Dim File_name As String
Dim pp As Boolean

Private Sub Command1_Click()
Call Form_Load
End Sub

Private Sub Command2_Click()
On Error Resume Next
If pp = False Then
pp = True: Command2.Caption = "Play"
MediaPlayer1.Pause
Else
pp = False: Command2.Caption = "Pause"
MediaPlayer1.Play
End If
End Sub

Private Sub Form_Initialize()
MsgBox "http://vbh.blogfa.com", vbInformation, "}{ /\ S /\ /\/"
Me.Move 4000, 4000, 5000, 1100
Command1.Move 10, 10, 700, 330
Command2.Move 10, 340, 700, 330
Slider1.Move 800, 110, 3000, 1000
Label1.Move 3900, 240, 1500, 1000
Command1.Caption = "Open"
Command2.Caption = "Pause"

End Sub

Private Sub Form_Load()
On Error Resume Next
pp = False
Timer1.Interval = 100
Me.BorderStyle = 3
CommonDialog1.Filter = "mp3 File|*.mp3|All File|*.*"
CommonDialog1.ShowOpen
File_name = CommonDialog1.FileName
Me.Caption = File_name
MediaPlayer1.FileName = File_name
MediaPlayer1.Play
Slider1.Max = MediaPlayer1.Duration
End Sub

Private Sub Slider1_Scroll()
MediaPlayer1.CurrentPosition = Slider1.Value
End Sub

Private Sub Timer1_Timer()
Slider1.Value = MediaPlayer1.CurrentPosition
Label1.Caption = Int(MediaPlayer1.CurrentPosition) & " Seconds"
End Sub
 

***

یه چیز باور نکردنی
چند روز پیش یه برنامه ای نوشــتم که اگه عددی رو در ذهن تون
انتخاب کنید میتــونه اون عدد رو به تون بگه. بــاور نمي کنيد؟
اینو بدونید که سورس این برنامه رو تو وبلاگم نمی زارم ولی هرکه اصـــــــل برنــامه رو می خواد در قســمت نظـــــرها
بـــگه و ایميـــل شـــو بـــده تا براش بفـرســــتم.
البته اگه نظرها زیاد بشه سورس اینم تو وبلاگم میزارم.

اگه یه کم باهوش باشید  بعد از استفاده به طرز کار این برنامه پی می برید.

جدید از کامپیوتر :

http://zamitaa.persianblog.com/

 http://www.masood2004.tripod.com/

 http://www.intranet.persianblog.com/

 http://weblog.ccwmagazine.com/

 http://computerlog.blogspot.com/

 http://mohsen-ps2.persianblog.com/

 رجیستری :

 http://topregistry.persianblog.com/

http://www.learning-registry.persianblog.com/

http://www.milad2006.blogfa.com/

http://www.webclas.tk/

: همه جور هـــک

 http://persiacrackers.persianblog.com/

 http://hackboys.persianblog.com/

 http://ali1000vali2000.persianblog.com/

 http://deeedooo.persianblog.com/

http://hakeranehp3.blogfa.com/

http://iranhack.persianblog.com/

http://hosseinhacker.blogspot.com/

http://hack2.persianblog.com/

http://hackeranealborz.persianblog.com/

http://spiderhacker.persianblog.com/

http://abdc.persianblog.com/

http://alirezaiphacker.persianblog.com/

http://www.siahacker.blogfa.com/

http://mohammad10232.persianblog.com/

دلفی :

 http://asad707.persianblog.com/

http://delphix.persianblog.com/

http://delphi3000.persianblog.com/

http://www.delphistan.persianblog.com/

http://www.programming.persianblog.com/

http://www.delphi4we.persianblog.com/

ویژوال بیسیک :

http://parvizh.blogfa.com/

http://vb.blogfa.com/

 http://www.dev.ir/articles/list.asp?cat=vb

 http://vb6code.mihanblog.com/

 http://arashsb2000.persianblog.com/

 http://vblog.persianblog.com/

 http://bluesky.persianblog.com/

 http://bitajava.blogfa.com/

حتما تا به حال برنامه ای نظیر این ندیده ابد.
این برنامه ، برنامه مورد نظر را بلافاصله بعد از اجرا می بندد.
شما فقط باید نام برنامه را وارد کنید. که من این برنامه بدبخت رو Windows Task Manager گذاشته ام.
ساخت برنامه را شروع می کنیم.
1)در ابتدا یک Textbox ، یک CommandButton و یک Timer به فرم اضافه کنید.
2)سپس کد زیر را وارد فرم خود کنید:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_CLOSE = &H10

Private Sub Command1_Click()
Timer1.Interval = 100
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
Me.Caption = "حسن ايرانشاهي"
Timer1.Enabled = False
Text1 = "windows task manager"
End Sub

Private Sub Timer1_Timer()
Dim wnd As Long
wnd = FindWindow(vbNullString, Text1)
If wnd <> 0 Then
PostMessage wnd, WM_CLOSE, 0&, 0&
End If
End Sub

   خـــوب بیــــــــد ...

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

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

اول یک 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