***سلام***به وبلاگ من خوش آمدین***امیدوارم از مطالب این وبلاگ بهره برده باشین***لطف کنید اول نظر بدین***بعد برین***

MPS-V-Basic
bullet تبلیغات
bullet آرشیو موضوعی
متفرقه
bullet نویسندگان
bullet ساعت
bullet تصویر تصادفی
bullet آمار و اطلاعات

entryمحو کردن نمایشگر موس
categoryدسته:Unspecified hit ارسال نظر

فقط کافیه دو تا کنترل Command بذارین روی فرمتون

Declare Function ShowCursor& Lib "user32" _ (ByVal bShow As Long)

Private Sub Command1_Click()
ShowCursor (bShow = True)
End Sub
 
Private Sub Command2_Click()
ShowCursor (bShow = False)
End Sub


authorنوشته:پویا date تاریخ:1388/4/15 | comment نظرات [ 2 ]
entryخواندن فایل های متنی توسط تکست باکس
categoryدسته:Unspecified hit ارسال نظر

با این کد می تونید یک فایل txt را بصورت خط به خط بخونید . اگه حجم فایل زیاد باشه کمی طول میکشه ولی با این می تونید خیلی کار ها بکنید، بدردتون میخوره.

Sub ReadLineByLine()

    ' Variable Declarations
    Dim folderName As String
    Dim fileName As String
    folderName = "C:Dump"
    fileName = "test.txt"
    Open folderName & fileName For Input As #1


    Do While Not EOF(1)
        Line Input #1, inputdata
        MsgBox inputdata  ' or txtFile.Text = TxtFile.Text + vbcrlf + Input Data
    Loop

    Close #1
End Sub

حالا ReadLineByLine رو فراخوانی کنید

authorنوشته:پویا date تاریخ:1388/4/15 | comment نظرات [ 0 ]
entryتابع AlphaBlend
categoryدسته:Unspecified hit ارسال نظر

تابع AlphaBlend (منبع: برنامه نویس)

امروز شما را با یک تابع آشنا میکنم که میتواند تصاویرتان را به زیبایی محو کند یا نمایش دهد.
مراحل زیر را انجام دهید
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

authorنوشته:پویا date تاریخ:1388/4/15 | comment نظرات [ 0 ]
entryکار با Agent های ویندوز
categoryدسته:Unspecified hit ارسال نظر

از منوی 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

authorنوشته:پویا date تاریخ:1388/4/15 | comment نظرات [ 0 ]
entryایجاد آتش در فرم
categoryدسته:Unspecified hit ارسال نظر

روی فرم یه دونه تایمر بذارین و از این کد استفاده کنید

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


authorنوشته:پویا date تاریخ:1388/4/15 | comment نظرات [ 0 ]
صفحه قبل «|» صفحه بعد
Rss | Hpage | Favorite | Email
Copyright © 2006-2008 Infotec™ Template Design:Infotec
.تمامی حقوق مطالب، تصاویر برای این وبلاگ محفوظ است، نقل و استفاده از آنها در سایت ها و نشریات تنها با ذکر منبع امکانپذیز میباشد