| تبليغات | X |
ورود شما را به این وبلاگ خوش آمد می گویم
افتادگی آموز اگر طالب فیضی *** هرگز نخورد آب زمینی که بلند است
امید وارم لحظات خوبی را در این وبلاگ سپری کنید
به زودی مطالب زیادی اظافه خواهم کرد
شهرستان مینودشت یکی از شهرستانهای استان گلستان ایران است. شهر مینودشت مرکز این شهرستان است و جمعیت آن در سال ۱۳۸۵، برابر با ۱۲۸٫۷۳۹ نفر بوده است [۱].
شهر: مینودشت
شهر: گالیکش
این شهرستان در ابتدا به صورت یک روستا حیات خود را آغاز کرد. گفته می شود رضا شاه پهلوی دوره سربازی خود را در مینودشت گذرانده است. وی شبی در خانه یکی از دوستان خود در این شهر میهمان شد. صاحب خانه در خواب دید روزی او پادشاه ایران می شود و خوابی که دیده بود برای رضا خان تعریف می کند که رضا خان در آن زمان حرف او را نمی پذیرد. پس از چندین سال که رضا خان پهلوی پادشاه شد به دیدن دوست خود به حاجیلر (نام قدیم مینودشت) آمد اما با خبر شد که دوستش به دیار باقی شتافته است. رضا خان در حین برگشت به تهران دستور داد نام حاجیلر را به مینودشت تغییر دهند
در این وبلاگ به مطالب آموزشی پرداخته می شود همه جور آموزشی هست
می خواهم در اولین قسمت از وبلاگم آموزش برنامه نویسی با زبان ویژوال بیسیک رو یاد بدم
تغيير روشنايي تصوير
اينكار با استفاده از آموزش بالا (بدست آوردن كد RGB رنگ مورد نظر) انجام ميشه به اينصورت كه رنگ هر پيكسل رو بدست آورده و به هر يك از رنگهاي قرمز، سبز و آبي عددي رو اضافه ميكنيم تا رنگش روشنتر بشه. بعد از اين كار، رنگ بدست اومده رو دقيقاً روي همون پيكسل ترسيم ميكنيم.
يك پروژه جديد باز كنيد و يك PictureBox و يك Command Button به فرمتون اضافه كنيد و كد زير رو تو قسمت جنرال فرمتون كپي كنيد :
Dim lngColor As Long
Private Sub Form_Load()
Picture1.AutoRedraw = True
Picture1.PaintPicture Picture1.Picture, 0, 0, Picture1.Width, Picture1.Height
Picture1.ScaleMode = 3
Text1.Text = -20
End Sub
Private Sub Picture1_Click()
On Error Resume Next
For X = 1 To Picture1.ScaleWidth
For Y = 1 To Picture1.ScaleHeight
lngColor = Picture1.Point(X, Y)
R = ConvertToRGB(lngColor, 0) + Val(Text1.Text)
G = ConvertToRGB(lngColor, 1) + Val(Text1.Text)
B = ConvertToRGB(lngColor, 2) + Val(Text1.Text)
If R < 0 Then R = 0 Else If R > 255 Then R = 255
If G < 0 Then G = 0 Else If G > 255 Then G = 255
If B < 0 Then B = 0 Else If B > 255 Then B = 255
Picture1.PSet (X, Y), RGB(R, G, B)
Next Y
DoEvents
Next X
End Sub
Public Function ConvertToRGB(ByVal Colors As Long, ByVal Index As Integer) As Long
Dim Red As Integer, Green As Integer, Blue As Integer
Dim lngColor As Long
lngColor = Colors
Red = lngColor Mod &H100
Green = (lngColor \ &H100) Mod &H100
Blue = lngColor \ &H10000
If Index = 0 Then ConvertToRGB = Red
If Index = 1 Then ConvertToRGB = Green
If Index = 2 Then ConvertToRGB = Blue
End Function
حالا يك عكس براي PictureBox قرار بديد و برنامتون رو اجرا كنيد حالا براي تغيير روشنايي تصوير از اعداد مثبت يا منفي استفاده كنيد بعد روي PictureBox كليك كنيد. موفق باشيد.
حمید رضا سهیلی
من براي نوشتن اين كد و بدست آوردن راهي براي تاريك يا روشن شدن رنگها چيزي حدود 10 تا 15 ساعت وقت گذاشتم و شكر خدا بالاخره تونستم راه حلش رو بدست بيارم. اونچه كه براي من سخت و دشوار بود طيف تمام رنگهاي پر رنگ به تاريك (چپ كليك درون فرم) و همچنين طيف تمام رنگهاي پر رنگ به روشن (راست كليك) بود. يعني هر چي كه به سمت پايين فرم مياييم رنگها تيره تر يا روشن تر بشن. اينم چيزه ساده اي به نظر ميرسه امّا اينطور نيست. حالا ممكنه با يك نگاه به كد زير بگيد: بابا اينكه ديگه كاري نداره كه...! بلــــــه معمّا چون حل شود آسان شود.
اساسه كار اين كد چيه؟
طيف رنگها به صورت: قرمز » سبز » آبي » قرمز هست. يعني از قرمز شروع ميشه و به سمت سبز حركت ميكنه و بعد، از سبز به سمته آبي و بعد از آبي به سمت قرمز حركت ميكنه.
همون طور كه ملاحظه ميكنيد، ترسيم هر سطر برنامه، از شش مرحله (Level) تشكيل شده:
مرحله اول: اضافه شدن رنگ سبز RGB(R ,+G ,B )
مرحله دوم: كم شدن رنگ قرمز RGB(-R ,G ,B )
مرحله سوم: اضافه شدن رنگ آبي RGB(R ,G ,+B )
مرحله چهام: كم شدن رنگ سبز RGB(R ,-G ,B )
مرحله پنجم: اضافه شدن رنگ قرمز RGB(+R ,G ,B )
مرحله ششم: كم شدن رنگ آبي RGB(R ,G ,-B )
اينا مراحل ترسيم يك سطر بودند و چون در هر مرحله 255 رنگ ترسيم ميشه پس در تمام سطر بايد 1530 رنگ ترسيم بشه (6*255=1530)؛ به همين خاطر من عرض فرم رو 1530 در نظر گرفتم ولي طول فرم رو همون 255 در نظر گرفتم چون رنگهاي ما يا تاريك ميشن يا روشن ميشن و براي اينكار نياز به 255 رنگ داريم (اعداد كوچكتر = رنگ تاريكتر، اعداد بزرگتر = رنگ روشنتر).
يك پروژه جديد باز كنيد و كد زير رو تو قسمت جنرال فرمتون كپي كنيد :
Dim intRGB(3) As Single, intAddNum As Single
Dim intLevel As Integer
Dim intColorLevel1 As Integer, intColorLevel2 As Integer
Private Sub Form_Load()
Me.DrawWidth = 2
Me.AutoRedraw = True
Me.Caption = "Click Me."
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Me.ScaleWidth = 1530
Me.ScaleHeight = 255
'Me.Cls
intAddNum = 1
intLevel = 1
If Button = vbLeftButton Then
intColorLevel1 = 255
intColorLevel2 = 0
intRGB(1) = 255
intRGB(2) = 0
intRGB(3) = 0
Y = 0
ElseIf Button = vbRightButton Then
intColorLevel1 = 255
intColorLevel2 = 0
intRGB(1) = 255
intRGB(2) = 0
intRGB(3) = 0
Y = 255
End If
For Y = 0 To Me.ScaleHeight
For X = 0 To Me.ScaleWidth
Select Case intLevel
Case 1:
intRGB(2) = intRGB(2) + intAddNum
If intRGB(2) >= intColorLevel1 Then intLevel = 2
Case 2:
intRGB(1) = intRGB(1) – intAddNum
If intRGB(1) <= intColorLevel2 Then intRGB(1) = Abs(intRGB(1)): intLevel = 3
Case 3:
intRGB(3) = intRGB(3) + intAddNum
If intRGB(3) >= intColorLevel1 Then intLevel = 4
Case 4:
intRGB(2) = intRGB(2) – intAddNum
If intRGB(2) <= intColorLevel2 Then intRGB(2) = Abs(intRGB(2)): intLevel = 5
Case 5:
intRGB(1) = intRGB(1) + intAddNum
If intRGB(1) >= intColorLevel1 Then intLevel = 6
Case 6:
intRGB(3) = intRGB(3) – intAddNum
If intRGB(3) <= intColorLevel2 Then intRGB(3) = Abs(intRGB(3))
End Select
Me.PSet (X, Y), RGB(intRGB(1), intRGB(2), intRGB(3))
Next X
DoEvents
If Button = vbLeftButton Then
intColorLevel1 = intColorLevel1 – 1
intAddNum = (intColorLevel1 / 256)
intRGB(1) = intColorLevel1
intRGB(2) = 0
intRGB(3) = 0
ElseIf Button = vbRightButton Then
intColorLevel2 = intColorLevel2 + 1
intAddNum = ((255 - intColorLevel2) / 256)
intRGB(1) = 255
intRGB(2) = intColorLevel2
intRGB(3) = intColorLevel2
End If
intLevel = 1
Me.Caption = CStr((Y * 100) \ Me.ScaleHeight) & "%"
Next Y
Me.Caption = "Complated."
End Sub
حالا برنامه و اجرا كنيد و تو فرمتون راست كليك كنيد بعد از ترسيم تصوير چپ كليك كنيد تا تفاوت دو تصوير و نتيجه 15 ساعت تلاش منو ببينيد، شايد به نظرتون ساده يا بي كاربرد بياد اما واقعاً اينطور نيست. در ضمن سرعت ترسيم تصوير بستگي به CPU كامپيوتر شما داره، براي من كه سريع ترسيم ميشه. موفق باشيد.
شبیه سازی برنامه Paint
این برنامه تقریباً کاره برنامه Paint رو انجام میده امّا کامل نیست که خودتون میتونید تکمیلش کنید، من فقط اساس کارو بهتون آموزش میدم.
یک پروژه جدید باز کنید و دو تا منو به نامهای mnuClear و mnuSave درست كنيد و Caption اونارو بذارید Clear و Save بعد کد زیر رو تو قسمت جنرال فرمتون کپی کنید:
Dim sngOldX, sngOldY As Single
Private Sub Form_Load()
Me.Appearance = 0
Me.AutoRedraw = True
Me.DrawWidth = 3
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
Me.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbLeftButton Then
Me.Line (sngOldX, sngOldY)-(X, Y)
End If
sngOldX = X
sngOldY = Y
End Sub
Private Sub mnuClear_Click()
Me.Cls
End Sub
Private Sub mnuSave_Click()
SavePicture Me.Image, "C:\Pic.bmp"
MsgBox ("C:\Pic.bmp")
End Sub
حالا برنامه رو اجرا کنید و شروع به نقاشی کردن کنید با کلیک راست هم رنگ قلم رو به صورت اتفاقی عوض کنید. موفق باشید.
ساخت Link برای سایت یا وبلاگ (درخواستی)
یک پروژه جدید باز کنید و توش یک Label بزارید و کدهای زیر رو تو قسمت جنرال فرمتون کپی کنید :
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Form_Load()
Label1.Caption = "www.v-basic.mihanblog.com"
End Sub
Private Sub Label1_Click()
Link Label1.Caption
End Sub
Public Function Link(ByVal URL As String) As Long
Link = ShellExecute(0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus)
End Function
حالا برنامتون رو اجرا كنيد و روي Label كليك كنيد تا وارد سايت مربروطه بشه، به همين سادگي. موفق باشید.
تبدیل تاریخ میلادی به تاریخ شمسی
خیلی از شما دوستان دنبال این کد هستید ولی پیدا نمیکنید، حق دارید پیدا نکنید چون این کد اون قدر طولانیه که هیچ کسی اونو تو وبلاگش نمیذاره. در ضمن من این کد رو خودم ننوشتم بلکه از اینترنت گرفتم ولی متأسفانه یادم نمیاد اسم سایتش چی بود امیدوارم که منو حلال کنه. خب حالا یک پروژه جدید باز کنید و از منوی Project گزینه ی Add Module رو انتخاب کنید تا یک Module به فرمتون اضافه بشه و بعد کد زیر رو توش کپی کنید :
Option Explicit
Private Const mcDayOff = 226894
Private mvarGDayTab
Private mvarJDayTab
Private mcSolar As Double
Public Sub GetJalaliDate(ByVal vGYear As Integer, ByVal vGMonth As Integer, ByVal vGDay As Integer, pJYear As Integer, pJMonth As Integer, pJDay As Integer, pDayName As String)
Dim mGTotalDay As Long
SetConstants
mGTotalDay = GetDayFromFirstGregorianDay(vGYear, vGMonth, vGDay)
pDayName = GetWeekDayName(mGTotalDay)
GetJalaliYearMonthDay mGTotalDay, vGYear, vGMonth, vGDay
pJDay = vGDay
pJMonth = vGMonth
pJYear = vGYear
End Sub
Private Sub SetConstants()
mvarGDayTab = Array(Array(0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31), Array(0, 31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31))
mvarJDayTab = Array(Array(0, 31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29), Array(0, 31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 30))
mcSolar = 365.25 - 0.25 / 33
End Sub
Private Function GetDayFromFirstGregorianDay(ByVal vGYaer As Integer, ByVal vGMonth As Integer, ByVal vGDay As Integer) As Long
Dim mGYearDiv4 As Integer, mGYearDiv100 As Integer, mGYearDiv400 As Integer
Dim mGTotalDays As Long
mGYearDiv4 = vGYaer \ 4
mGYearDiv100 = vGYaer \ 100
mGYearDiv400 = vGYaer \ 400
mGTotalDays = GetGDayFromBeginOfYear(vGYaer, vGMonth, vGDay)
mGTotalDays = CLng(vGYaer - 1) * 365 + mGTotalDays + mGYearDiv4 - mGYearDiv100 + mGYearDiv400
GetDayFromFirstGregorianDay = mGTotalDays
End Function
Private Function GetGDayFromBeginOfYear(ByVal vGYear As Integer, ByVal vGMonth As Integer, ByVal vGDay As Integer) As Long
Dim mGLeap As Integer
Dim mCount As Integer
GetGDayFromBeginOfYear = vGDay
mGLeap = IsLeapGregorian(vGYear)
For mCount = 1 To vGMonth – 1
GetGDayFromBeginOfYear = GetGDayFromBeginOfYear + mvarGDayTab(mGLeap)(mCount)
Next mCount
End Function
Private Function IsLeapGregorian(ByVal vGYear As Integer) As Integer
If (vGYear Mod 4 = 0 And vGYear Mod 100 <> 0) Or (vGYear Mod 400 = 0) Then
IsLeapGregorian = 1
Else
IsLeapGregorian = 0
End If
End Function
Private Function GetJalaliYearMonthDay(vGTotalDay As Long, pJYear As Integer, pJMonth As Integer, pJDay As Integer)
Dim mJTotalDay As Long
Dim mJYear As Integer
Dim mJDay As Integer
Dim mJLeaps As Integer
mJTotalDay = vGTotalDay – mcDayOff
mJYear = mJTotalDay \ mcSolar
mJLeaps = GetAllJalaliLeapFromBegin(mJYear)
mJDay = mJTotalDay - (365 * CLng(mJYear) + mJLeaps)
mJYear = mJYear + 1
Do While mJDay <= 0
mJYear = mJYear – 1
If IsLeapJalali(mJYear) = 1 Then
mJDay = mJDay + 366
Else
mJDay = mJDay + 365
End If
Loop
If (mJDay = 366 And IsLeapJalali(mJYear) = 0) Then
mJDay = 1
mJYear = mJYear + 1
End If
pJYear = mJYear
GetJalaliMonthDay mJYear, mJDay, pJMonth, pJDay
End Function
Private Function IsLeapJalali(ByVal vJYear As Integer) As Integer
Dim mTemp As Integer
mTemp = vJYear Mod 33
If mTemp = 1 Or mTemp = 5 Or mTemp = 9 Or mTemp = 13 Or mTemp = 17 Or mTemp = 22 Or mTemp = 26 Or mTemp = 30 Then
IsLeapJalali = 1
Else
IsLeapJalali = 0
End If
End Function
Private Function GetAllJalaliLeapFromBegin(ByVal vJYear As Integer) As Integer
Dim mJLeap As Integer
Dim mCurrentCycle As Integer
Dim mJDiv33 As Integer
Dim mCount As Integer
Dim mTemp As Integer
mJDiv33 = vJYear \ 33
mCurrentCycle = vJYear - (mJDiv33 * 33)
mJLeap = mJDiv33 * 8
If mCurrentCycle > 0 Then
mTemp = IIf(mCurrentCycle <= 18, mCurrentCycle, 18)
For mCount = 1 To mTemp Step 4
mJLeap = mJLeap + 1
Next
End If
If mCurrentCycle > 21 Then
mTemp = IIf(mCurrentCycle <= 30, mCurrentCycle, 30)
For mCount = 22 To mTemp Step 4
mJLeap = mJLeap + 1
Next
End If
GetAllJalaliLeapFromBegin = mJLeap
End Function
Private Sub GetJalaliMonthDay(ByVal vJYear As Integer, ByVal vJDayOfYear As Integer, pJMonth As Integer, pJDay As Integer)
Dim mCount As Integer
Dim mJLeap As Integer
mJLeap = IsLeapJalali(vJYear)
mCount = 1
Do While vJDayOfYear > mvarJDayTab(mJLeap)(mCount)
vJDayOfYear = vJDayOfYear - mvarJDayTab(mJLeap)(mCount)
mCount = mCount + 1
Loop
pJMonth = mCount
pJDay = vJDayOfYear
End Sub
Private Function GetWeekDayName(DayFromBegin As Long) As String
Dim Temp As Integer
Temp = DayFromBegin Mod 7
Select Case Temp
Case 0
GetWeekDayName = "يك شنبه"
Case 1
GetWeekDayName = "دو شنبه"
Case 2
GetWeekDayName = "سه شنبه"
Case 3
GetWeekDayName = "چهار شنبه"
Case 4
GetWeekDayName = "پنج شنبه"
Case 5
GetWeekDayName = "جمعه"
Case 6
GetWeekDayName = "شنبه"
End Select
End Function
Public Sub GetGregorianDate(ByVal vJYear As Integer, ByVal vJMonth As Integer, ByVal vJDay As Integer, ByRef pGYear As Integer, ByRef pGMonth As Integer, ByRef pGDay As Integer, pDayName As String)
Dim mJTotalDays As Long
Dim mGYear As Integer
Dim mGMonth As Integer
Dim mGDay As Integer
SetConstants
mJTotalDays = GetDayFromFirstJalaliDay(vJYear, vJMonth, vJDay)
GetWeekDayName (mJTotalDays + mcDayOff)
GetGregorianYearMonthDay mJTotalDays, mGYear, mGMonth, mGDay
pGYear = mGYear
pGMonth = mGMonth
pGDay = mGDay
End Sub
Private Function GetDayFromFirstJalaliDay(ByVal vJYear As Integer, ByVal vJMonth As Integer, ByVal vJDay As Integer) As Long
Dim mJLeap As Integer
Dim mTemp As Integer
mJLeap = GetAllJalaliLeapFromBegin(vJYear - 1)
mTemp = GetJDayFromBeginOfYear(vJYear, vJMonth, vJDay)
GetDayFromFirstJalaliDay = CLng((vJYear - 1)) * 365 + mJLeap + mTemp
End Function
Private Function GetJDayFromBeginOfYear(ByVal vJYear As Integer, ByVal vJMonth As Integer, ByVal vJDay As Integer) As Integer
Dim mCount As Integer
Dim mJLeap As Integer
GetJDayFromBeginOfYear = vJDay
mJLeap = IsLeapJalali(vJYear)
For mCount = 1 To vJMonth – 1
GetJDayFromBeginOfYear = GetJDayFromBeginOfYear + mvarJDayTab(mJLeap)(mCount)
Next mCount
End Function
Private Sub GetGregorianYearMonthDay(vJTotalDays As Long, pGYear As Integer, pGMonth As Integer, pGDay As Integer)
Dim mGTotalDays As Long
Dim mGDiv4 As Integer
Dim mGDiv100 As Integer
Dim mGDiv400 As Integer
Dim mGDays As Integer
mGTotalDays = vJTotalDays + mcDayOff
pGYear = mGTotalDays \ mcSolar
mGDiv4 = pGYear \ 4
mGDiv100 = pGYear \ 100
mGDiv400 = pGYear \ 400
' Find Gregorian day of year
mGDays = mGTotalDays - (365 * CLng(pGYear)) - (mGDiv4 - mGDiv100 + mGDiv400)
pGYear = pGYear + 1
Do While mGDays <= 0
pGYear = pGYear – 1
If IsLeapGregorian(pGYear) = 1 Then
mGDays = mGDays + 366
Else
mGDays = mGDays + 365
End If
Loop
If (mGDays = 366 And IsLeapGregorian(pGYear) = 0) Then
mGDays = 1
pGYear = pGYear + 1
End If
GetGregorianMonthDay pGYear, mGDays, pGMonth, pGDay
End Sub
Private Sub GetGregorianMonthDay(ByVal vGYear As Integer, ByVal vGDayOfYear As Integer, pGMonth As Integer, pGDay As Integer)
Dim mCount As Integer
Dim mGLeap
mGLeap = IsLeapGregorian(vGYear)
mCount = 1
Do While vGDayOfYear > mvarGDayTab(mGLeap)(mCount)
vGDayOfYear = vGDayOfYear - mvarGDayTab(mGLeap)(mCount)
mCount = mCount + 1
Loop
pGMonth = mCount
pGDay = vGDayOfYear
End Sub
حالا کد زیر رو تو قسمت جنرال فرمتون کپی کنید :
Private Sub Form_Load()
Dim intYear As Integer, intMonth As Integer, intDay As Integer
Dim strDayName As String, strShamsi As String
GetJalaliDate Year(Date), Month(Date), Day(Date), intYear, intMonth, intDay, strDayName
strShamsi = intYear & "/" & intMonth & "/" & intDay & " " & strDayName
Me.Caption = strShamsi
End Sub
حالا برنامه رو اجرا کنید و از اون لذّت ببرید. موفق باشید.
ساعت عقربه ای (آنالوگ)
یک پروژه جدید باز کنید و تو فرمتون یک Timer بذارید و Interval اونو 1000 بذارید، حالا کد زیر رو تو قسمت جنرال فرمتون کپی کنید :
Private Sub Form_Load()
Me.BackColor = vbBlack
End Sub
Private Sub Timer1_Timer()
Form1.Refresh
X = Form1.Width / 2
Y = Form1.Height / 2.2
Circle (X, Y), Y - 200, vbWhite
Circle (X, Y), Y - 220, vbWhite
For i = 1 To 12
Circle (X + (Y - 400) * Cos(i * 22 / 42), Y + (Y - 400) * Sin(i * 22 / 42)), 50, vbRed
Next
h = Hour(Time())
If h > 12 Then
h = h – 12
End If
m = Minute(Time())
s = Second(Time())
Line (X, Y)-(X + (Y - 600) * Cos((66 / 14 + s * (44 / 420))), Y + (Y - 600) * Sin((66 / 14 + s * (44 / 420)))), vbBlue
Line (X, Y)-(X + (Y - 800) * Cos((66 / 14 + m * (44 / 420))), Y + (Y - 800) * Sin((66 / 14 + m * (44 / 420)))), vbYellow
Line (X, Y)-(X + (Y - 1200) * Cos(66 / 14 + h * (44 / 84) + (m / 12) * (44 / 420)), Y + (Y - 1200) * Sin(66 / 14 + h * (44 / 84) + (m / 12) * (44 / 420))), vbWhite
End Sub
حالا برنامه رو اجرا کنید و ببینید که ساعت به چه زیبایی کار میکنه. موفق باشید
حمید رضا سهیلی
درگ کردن فرم به وسيله يك كنترل (بهترین و مطمئن ترین روش)
اینکار که با توابع API به روش ویندوز انجام میشه، بهترین، مطمئن ترین، ساده ترین و سریع ترین روش برای درگ (Drag) کردنه فرمه. در ضمن در این روش بوسیله یک کنترل هم میشه فرم رو درگ کرد.
یک پروژه جدید باز کنید و توش یک Command Button و یک Label بذارید و کد زیر رو قسمت جنرال فرمتون کپی کنید :
Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lngReturnValue As Long
If Button = 1 Then
Call ReleaseCapture
lngReturnValue = SendMessage(Me.hWnd, &HA1, 2, 0&)
End If
End Sub
حالا یک بار بوسیله Label و یک بار هم بوسیله Command Button سعی کنید فرمتون رو درگ کنید. اگه بخواید بوسیله Label هم درگ بشه میتونید از کد داخل رویداد Command1_MouseMove برای رویداد Label1_MouseMove استفاده کنید به همین سادگی. موفق باشید.
این قفل کردن تمام ورودی ها مثل Keyboard و Mouse کار با تابع BlockInput انجام میشه و تمام ورودیهای کامپیوتر رو قفل میکنه. توجه داشته باشید که سیستم عامل هنگ نمیکنه و به کار خودش ادامه میده امّا شما نمیتونید هیچ کاری انجام بدید به جز Restart کردن.
یک پروژه جدید باز کنید و کد زیر رو تو قسمت جنرال فرمتون کپی کنید :
Private Declare Function BlockInput Lib "user32" (ByVal fBlock As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
BlockInput True
Sleep 5000
BlockInput False
End Sub
به محض شروع برنامه، تمام وروردیها به مدّت 5 ثانیه قفل میشن و بعد از اون دوباره به حالت اول برمیگردن. در اینجا تابع Sleep فقط برای اتلاف وقت به کار رفته و استفاده دیگه ای نداره. موفق باشید
شفاف کردن فرم به صورت شیشه ای و مات
یک پروژه جدید باز کنید و تو قسمت جنرال فرمتون کدهای زیر رو کپی کنید :
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) 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 Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Sub Command1_Click()
Dim Retval As Long
Retval = GetWindowLong(hWnd, -20)
Retval = Retval Or 524288
SetWindowLong hWnd, -20, Retval
SetLayeredWindowAttributes hWnd, 0, Val(Text1.Text), 2
End Sub
Private Sub Form_Load()
Text1.Text = 100
Command1_Click
End Sub
تو TextBox یک عدد از 0 تا 255 وارد کنید و کلید Command1 رو بزنید و شاهد شفاف شدن فرم باشید. فقط توجه داشته باشید که اگه از اعداد پایین مثل 1 استفاده کنید فرمتون تقریباً نامرئی میشه پس بهتون پیشنهاد میکنم تا حد امکان از اعداد بالای 50 استقاده کنید. موفق باشید
|
Show All |