نفر بعدي كيه ؟ --------- ( ! يك تاپيك جالب و متفاوت ! )

[vbhamed]

سلام!

این تاپیک تقریبا مثل یه بازی می مونه .... و براي اينكه يك تنوعي تو سايت ايجاد بشه
(خودم هم از جايي الگو گرفتم كه خيلي هم استقبال شده بود)

البته هر كس بايد تو پستش يك نكته از ويژال بيسيك هم اضافه كنه تا اين بازي حالت آموزشي داشته باشه

هر شخصي كه پست ميده بايد علاوه بر اینکه جواب نفر قبلیشو مي ده، درباره نفر بعدش هم توضیحاتی رو بده و حدس بزنه نفر بعدش کیه یا در حال انجام چه کاریه یا هر چیز دیگه ای که به ذهنتون میرسه ...

فقط چند تا قانون تو نوشتن پست ها براي هماهنگي بيشتر

لطفا قوانين رو دقيقا رعايت كنيد و استايل و شكل فونتها و عناوين عبارات دقيقا همين باشه در غير اينصورت پستتون حذف ميشه، اينكار هم براي يكپارچگي تاپيك هست و رنگها هم به دليل مجزا شدن بخشهاي مختلف پست به اين شكل انتخاب شده

هدف تاپيك "نفر بعدي كيه ؟" بيان نكته هايي هست كه در حين كار مي‌بينيد و در حقيقت تجربيات ناب گذاشته ميشه، بنابراين گذاشتن كامپوننت يا سورسهايي كه نكته خاصي ندارن در اين تاپيك جايي نداره و بايد در تاپيك مربوطه خودش گذاشته بشه

پست ها رو حتما به اين شكل و با اين رنگها و استايل بديد :


جواب نفر قبلي

نكته ويژوالي :

...نكته مورد نظر شما...

نفر بعدي ...

[vbhamed]

به عنوان اولين نفر هم خودم جواب مي دم

vbhamed جان اينجا يك سايت علمي هست نه بازي، ممكنه با اين كارا اخراجت كنند ها

نكته ويژوالي :
ساخت شاخه تو در تو مثلا C:\Test\ali\hasan\reza

Public Function CreateDir(strDir As String) As Boolean
On Error Resume Next
Dim bytMax As Byte
Dim bytNdx As Byte
Dim strDirLevel As String
If Right(strDir, 1) <> "\" Then
strDir = strDir & "\"
End If
bytMax = Len(strDir)
For bytNdx = 4 To bytMax
If (Mid(strDir, bytNdx, 1) = "\") Then
strDirLevel = Left(strDir, bytNdx - 1)
If Dir(strDirLevel, vbDirectory) = "" Then
MkDir strDirLevel
End If
End If
Next
If Dir(strDir, vbDirectory) <> "" Then
CreateDir = True ' Succeeded creating directory
Else
CreateDir = False ' Failed creating directory
End If
End Function

نمونه استفاده :
If CreateDir("C:\Test\ali\hasan\reza") Then Msgbox "Ok"

نفر بعدي يكي هست كه از اين تاپيك استقبال مي كنه !

[hrj1981]

شايد هم اخراجمون نكن ، پست ميديم ببينيم چي ميشه!

نكته ويژوالي :
بدست آوردن مسير فولدرهاي system32 و temp ويندوز (البته قابل ارتقا)
Option Explicit
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Dim StrBuffer As String, winpath As String
Public Function WIN_Temp()
StrBuffer = Space(255)
winpath = GetWindowsDirectory(StrBuffer, 255)
StrBuffer = Left$(StrBuffer, winpath)
WIN_Temp = StrBuffer & "\TEMP\"
End Function
Public Function WIN_SYS32()
StrBuffer = Space(255)
winpath = GetWindowsDirectory(StrBuffer, 255)
StrBuffer = Left$(StrBuffer, winpath)
WIN_SYS32 = StrBuffer & "\system32\"
End Function

مطمئنم نفر بعدي آدم با سواد و باحاليه.

[xxxxx_xxxxx]

بعداً كه معرفي شديم به كميته انضباطي سايت اونوقت بياين بازي كنيد:چشمک:
ديدي اشتباه كردي، hrj1981 (http://barnamenevis.org/member.php?u=41307) جان Game over شدي، چون نه من باسوادم نه باحال.

نكته ويژوالي :
آيا مي دانستيد كه در ليست پراپرتي هاي يك شئ براي پيدا كردن سريع يك پراپرتي مي توانيد دكمه هاي Ctrl+Shift را به همراه حرف اول اون پراپرتي بگيريد تا مستقيماً بهش برسيد؟

بدون شك نفر بعدي يكي از اعضاي سايت برنامه نويس هست

[ehsan-avr]

ببینم شما مبتدی ها رو هم تو بازیتون راه میدین؟؟؟:لبخند:

نكته ويژوالي :

اینم یه نکته ی کوچولو (البته در حد خودم):
این که میخوام بگم شاید زیاد هم به نکته شبیه نباشه!!!

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

کد ماژول:

Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_CURRENT_USER = &H80000001
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

Public Const REG_SZ = 1
Public Const REG_DWORD = 4


Public Function GetString(hKey As Long, StrPath As String, strValue As String)
Dim Keyhand As Long
Dim datatype As Long
Dim lResult As Long
Dim strBuf As String
Dim lDataBufSize As Long
Dim intZeroPos As Integer
r = RegOpenKey(hKey, StrPath, Keyhand)
lResult = RegQueryValueEx(Keyhand, strValue, 0&, lValueType, ByVal 0&, lDataBufSize)
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, " ")
lResult = RegQueryValueEx(Keyhand, strValue, 0&, 0&, ByVal strBuf, lDataBufSize)
If lResult = ERROR_SUCCESS Then
intZeroPos = InStr(strBuf, Chr$(0))
If intZeroPos > 0 Then
GetString = Left$(strBuf, intZeroPos - 1)
Else
GetString = strBuf
End If
End If
End If
End Function

Public Sub SaveString(hKey As Long, StrPath As String, strValue As String, strdata As String)
Dim Keyhand As Long
Dim r As Long
r = RegCreateKey(hKey, StrPath, Keyhand)
r = RegSetValueEx(Keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(Keyhand)
End Sub
Public Sub Delete_String(hKey As Long, StrPath As String, strValue As String)
Dim Keyhand As Long

r = RegOpenKey(hKey, StrPath, Keyhand)
RegDeleteValue Keyhand, strValue
End Sub



اینم از کد نمونه:

M1.SaveString HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon", Key Name," explorer.exe File name.exe"


من بیشتر سوال دارم تا نکته :لبخندساده:
الان جند تا رو که یادم هست رو می پرسم نفر بعدی دست خالی نیاد.
-توابع مربوط به تبدیل مبنا (2و10و16)
-یک کد برای خالی کردن استارت آپ ویندوز (ضروری)
-End Process کردن یک برنامه (غیر از روش استفاده از Task Kill )

فکر کنم نفر بعدی آدم خیر خواهی باشه:لبخند:

[xxxxx_xxxxx]

سلام

نكته ويژوالي :

يه نكته كه خيلي جاها مي تونه كاربرد داشته باشه ولي نمي دونم چرا هيچ كس ازش استفاده نمي كنه.
من فقط اولي رو مي دونستم امروز بقيشم كشف كردم.

1- براي بدست آوردن آدرس فولدر Windows


MsgBox Environ("windir")

2- براي بدست آوردن نام كاربري ويندوز:


MsgBox Environ("username")

3- براي بدست آوردن آدرس كاربري ويندوز:


MsgBox Environ("userprofile")

4- براي بدست آوردن آدرس پوشه temp


MsgBox Environ("temp")

5- براي بدست آوردن آدرس فولدر Program Files


MsgBox Environ("programfiles")


ehsan-avr عزيز سوالات شما در حد نكته نيستند. فكر مي كنم براشون تاپيك ايجاد كنيد بهتره.

نفر بعدي الان خوابيده چون ساعت 12 شبه

[vbhamed]

xxxxx_xxxxx جان اشتباه كردي ديگه، چون الان ساعت 1:15 هست و من بيدارم

نكته ويژوالي :
تا حالا با رويداد Validate مربوط به TextBox كار كردين
با اين رويداد ميشه چك كرد مقدار درستي متناسب با شرط مورد نظر در TextBox وارد شده يا نه و اگر مقدار اشتباه بود جلوي خروج از TextBox رو گرفت

تو مثال زير اگر كاربر نمره اي بين 0 تا 20 وارد نكنه نمي تونه از TextBox خارج بشه


Private Sub Text1_Validate(Cancel As Boolean)

If Val(Text1) < 0 Or Val(Text1) > 20 Then Cancel = True

End Sub


نفر بعدي فكرشم نمي كرد نفر بعدي اين تاپيك باشه !

[mhsmity]

با عرض سلام خدمت استادان ارجمند

نكته ويژوالي :

به نظر من اين برنامه هم زياد بد نيست.
رنگTaskBar را كم زياد كنيد.

نفر بعدي شب زود مي خوابه و سحرخيزه

[mohsen57]

الان ساعت 3:5 بامداد

نکته ويژوالي :

من برای کم و زیاد کردن روزهای تاریخ خیلی سرچ کردم بالاخره پیداش کردم:


MsgBox DateAdd("D", -18, Date)

برای کم و زیاد کردن ماه و سال وساعت و ... هم میتونید بجای D از M , Y ,H و... استفاده کنید

شرط میبندم نفر بعدی ساعت 9 صبح به بعد جواب میده. (ساعت رو بنویس) :متفکر:

[parselearn]

اي چي بگم...

نكته ويژوالي :

هيچ فكر كردين چطوري ميشه در كنترل پنل برنامه قرار داد؟
با پسوند cpl ذخيره كنيد در پوشه system32

بازم اي چي بگم...

[sina_saravi1]

ساعت 9:20 بامداد

نكته ويژوال :
به دست اوردن تاریخ شمسی از تاریخ میلادی

به نظر من بهترینشه تو کد مشابه چون من خیلی دنبالش بودم و با همه مقایسش کردم
که همشون تو 2 تا چیز میلنگیدن
1 - سال های کبیثه
2 - سال های بعد از سال کبیثه

ولی این تست شده است
کلی زحمت کشیدم باسش
بهتره شما به عنوان مدول ذخیرش کنین


Dim m1 As Integer, m2 As Integer, m3 As Integer, m4 As Integer, m5 As Integer, m6 As Integer, m7 As Integer, m8 As Integer, m9 As Integer, m10 As Integer, m11 As Integer, m12 As Integer
Dim mon As Integer, kabises As Double
Dim days As Double, ndays As Double
Dim yr, yy, kb
Dim kbs As Boolean, kabise As Boolean
Dim ysd As Double, msd As Double, dsd As Double
Dim Fm(1 To 12) As Integer
Dim Em(1 To 12) As Integer

Private Function MiladiDays2(YYYY, MM, DD) As Double
On Error GoTo erh
MiladiDays2 = 0
ysd = YYYY
msd = MM
dsd = DD
kabises = Int(Val(ysd) / 4)
If Val(ysd) - Int(Val(ysd)) = 0 Then
kabise = True
m2 = 29
Else
kabise = False
m2 = 28
End If
m1 = 31
m3 = 31
m4 = 30
m5 = 31
m6 = 30
m7 = 31
m8 = 31
m9 = 30
m10 = 31
m11 = 30
m12 = 31
Select Case msd
Case 1
mon = 0
Case 2
mon = m1
Case 3
mon = m1 + m2
Case 4
mon = m1 + m2 + m3
Case 5
mon = m1 + m2 + m3 + m4
Case 6
mon = m1 + m2 + m3 + m4 + m5
Case 7
mon = m1 + m2 + m3 + m4 + m5 + m6
Case 8
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7
Case 9
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8
Case 10
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9
Case 11
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9 + m10
Case 12
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9 + m10 + m11
End Select
MiladiDays2 = (Val(ysd) * 365) + Val(kabises) + Val(mon) + Val(dsd)
Exit Function
erh:
MiladiDays2 = "-1"
End Function
Public Function ShamsiDays(YYYY, MM, DD) As Double
sysd = YYYY
smsd = MM
sdsd = DD
skabises = Val(sysd) \ 4
If Val(sysd) + 1 Mod 4 = 0 Then
skabises = Val(skabises) + 1
skabise = True
Else
skabise = False
End If
sm1 = 31
sm2 = 31
sm3 = 31
sm4 = 31
sm5 = 31
sm6 = 31
sm7 = 30
sm8 = 30
sm9 = 30
sm10 = 30
sm11 = 30
Select Case smsd
Case 1
smon = 0
Case 2
smon = sm1
Case 3
smon = sm1 + sm2
Case 4
smon = sm1 + sm2 + sm3
Case 5
smon = sm1 + sm2 + sm3 + sm4
Case 6
smon = sm1 + sm2 + sm3 + sm4 + sm5
Case 7
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6
Case 8
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6 + sm7
Case 9
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6 + sm7 + sm8
Case 10
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6 + sm7 + sm8 + sm9
Case 11
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6 + sm7 + sm8 + sm9 + sm10
Case 12
smon = sm1 + sm2 + sm3 + sm4 + sm5 + sm6 + sm7 + sm8 + sm9 + sm10 + sm11
End Select
ShamsiDays = (Val(sysd) * 365) + Val(skabises) + Val(smon) + Val(sdsd) - 365
Exit Function
erh:
ShamsiDays = "-1"
End Function
Public Function Miladi2Shamsi(YYYY, MM, DD) As String
yy = 0
ndays = 0
mmMmm = 0
Fm(1) = 31
Fm(2) = 31
Fm(3) = 31
Fm(4) = 31
Fm(5) = 31
Fm(6) = 31
Fm(7) = 30
Fm(8) = 30
Fm(9) = 30
Fm(10) = 30
Fm(11) = 30
Fm(12) = 29
days = MiladiDays2(YYYY, MM, DD)
ndays = days - 226899
yy = Int((ndays - 1) / 365.25)
ndays = Int(Val(ndays) - (yy * 365.25))
For ssss = 1 To 11
If Val(ndays) > Fm(ssss) Then
mmMmm = Val(mmMmm) + 1
ndays = Val(ndays) - Fm(ssss)
End If
Next ssss
mmMmm = Val(mmMmm) + 1
If Val(yy) Mod 4 = 0 Then
If Val(ndays) = 1 And Val(mmMmm) = 1 Then
Miladi2Shamsi = Val(yy) - 1 & "/" & "12" & "/" & "30"
ElseIf Val(ndays) = 1 And Val(mmMmm) <> 1 Then
Miladi2Shamsi = Val(yy) & "/" & Val(mmMmm) & "/" & Fm(Val(mmMmm) - 1)
ElseIf Val(ndays) > 1 Then
Miladi2Shamsi = Val(yy) & "/" & Val(mmMmm) & "/" & Val(ndays) - 1
End If
End If
If Val(yy) Mod 4 <> 0 Then
Miladi2Shamsi = yy & "/" & mmMmm & "/" & ndays
End If
End Function
Public Function Shamsi2Miladi(YYYY, MM, DD) As String
days = ShamsiDays(YYYY, MM, DD)
ndays = days + 226899
sal = YYYY + 622
Do
If sal * 365 + (sal \ 4) > ndays Then
sal = sal - 1
Else
Exit Do
End If
Loop
sal = sal + 1
ndays = ndays - ((sal - 1) * 365 + (sal \ 4))
If sal Mod 4 = 0 Then
kbs = True
mn(2) = 29
Else
kbs = False
mn(2) = 28
End If
mn(1) = 31
mn(3) = 31
mn(4) = 30
mn(5) = 31
mn(6) = 30
mn(7) = 31
mn(8) = 31
mn(9) = 30
mn(10) = 31
mn(11) = 30
mn(12) = 31
'makus kam kon > az mn(12) ba ghabli hash fe aghab bar gard
Shamsi2Miladi = sal & " " & ndays
End Function
Public Function MiladiDays(YYYY, MM, DD) As Double
On Error GoTo erh
MiladiDays = 0
ysd = YYYY
msd = MM
dsd = DD
kabises = Int(Val(ysd) / 4)
If Val(ysd) - Int(Val(ysd)) = 0 Then
kabise = True
m2 = 29
Else
kabise = False
m2 = 28
End If
m1 = 31
m3 = 31
m4 = 30
m5 = 31
m6 = 30
m7 = 31
m8 = 31
m9 = 30
m10 = 31
m11 = 30
m12 = 31
Select Case msd
Case 1
mon = 0
Case 2
mon = m1
Case 3
mon = m1 + m2
Case 4
mon = m1 + m2 + m3
Case 5
mon = m1 + m2 + m3 + m4
Case 6
mon = m1 + m2 + m3 + m4 + m5
Case 7
mon = m1 + m2 + m3 + m4 + m5 + m6
Case 8
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7
Case 9
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8
Case 10
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9
Case 11
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9 + m10
Case 12
mon = m1 + m2 + m3 + m4 + m5 + m6 + m7 + m8 + m9 + m10 + m11
End Select
MiladiDays = (Val(ysd) * 365) + Val(kabises) + Val(mon) + Val(dsd) - 365
Exit Function
erh:
MiladiDays = "-1"
End Function

برای به دست اوردن تاریخ روز هم باید از کد زیر استفده کنید
مثال:


MsgBox Miladi2Shamsi(Year(Date), Month(Date), Day(Date))


نفر بعدي 2 نفر بعد از نفر قبلیه... نوبتش رو رعایت کنه...

[aidin1386]

باشه، رعايت مي كنم، حالا چرا گريه مي كني؟:لبخند:
نكته ويژوال :
خوب، منم هيچي به مغزم نمي رسه! ولي يه چيزي همين الان پيدا كردم، شايد جالب نباشه:خجالت:
اميدوارم بدرد بخوره!
آيا مي دونستين كه مي شه رنگ هاي qbasic كه 15 گانه هستند رو توي ويژوال ايجاد كرد؟
با اين دستور:

Me.backcolor=qbcolor(0 to 15)

نفر بعدي انسان بسيار محترم و با شخصيتيه

[aidin1386]

آفرين aidin1386، خوشم مياد كه همه منو ميشناسن
نكته ويژوال :
يك راه بسيار كوتاه براي جلوگيري از دادن داده اي به جز عدد به تكست باكس
توي keypress تكست باكس اينو بذارين

select case KeyAscii
case 8,48 to 58:
case else
keyascii=0
end select
ببخشيد:ناراحت: سعي مي كنم نكته هاي باحال تري دفعه ديگه بذارم. فعلاً مغزم كار نمي كنه
نفر بعدي انسان بسيار خوشبختيه

[mormorbaba]

خواستار سعادت دیگران بودن، بزرگترین خوشخبتی هاست

نكته ويژوالي :

تغيير نام كامپيوتر


Private Declare Function SetComputerName Lib "kernel32.dll (http://www.andreavb.com/API_KERNEL32.html)" Alias
"SetComputerNameA" (ByVal lpComputerName As String) As Long



Module'
Public Function SetComputerName(Name as String) as Boolean
Dim res As Long


res=SetComputerName(Name)
SetComputerName=(res<>0)
End Function


نفر بعدي انسان موفقي بايد باشد

[میلاد علوی]

خوشحالم که موفقم

نكته ويژوالي :

این بیشتر یه ایده هست تا یه کد قوی
Private Sub Text1_LostFocus()
Image2.Visible = True
Text1.Visible = False
End Sub
Private Sub Image2_Click()
Image2.Visible = False
Text1.Visible = True
Text1.SetFocus
End Sub

Private Sub Form_Load()
Text1.Visible = False
Image2.Visible = True
Image2.MousePointer = 3
end sub

نفر بعد صد در صد خیلی باهوشه

[vbhamed]

سلام
اگر ميشه در مورد ايده تون مورد استفاده رو هم ذكر كنيد آخه من نفهميدم واسه چي خوبه (اينم از هوش زيادمه !!!)

نكته ويژوال :

تاحالا شده بخواهيد موقع اجراي برنامتون، فايلي رو قفل كنيد كه كسي نتونه اونو باز كنه و ازش كپي بگيره يا توش چيزي بنويسه

با نمونه كد زير فايل test.exe قفل ميشه


Open "c:\test.exe" For Binary Lock Read Write As #1

و با كد زير مي تونيد از حالت قفل درش بياريد


Close #1

اگر برنامه تو استارآپ ويندوز اجرا بشه اون فايل تا زمان خروج از ويندوز قفل شده هست

نفر بعدي يكي از بهترين نكات ويژوالي كه بلده رو مي نويسه، مگه نه نفر بعدي ؟

[DoctorJay]

ایول به طرح ها و ایده های نو .

نکته ی ویژوال :

آیا می دونستید لیست پردازه هایی که با VB بدست می آد ممکن است از لیست پردازه های استاندارد
ویندوز کامل تر باشد ؟؟؟

!! حتم دارم نفر بعدی محدوده ای سنی بین 1 تا 100 دارد و اظهار بی اطلاعی از این نکته می کنه !!

[m_vb1386]

همين كارها رو ميكنيد كه اين قدر برنامه هاتون باگ داره لطفا بازه زماني رو درست انتخاب كنيد تا دچار خطاهاي زمان اجرا نشين(البته حرفي كه زدم خودش يك نكته اموزشي بود)

نكته ويژوالي :
اينها كتابخانه هاي ران تايم ويژوال بيسيك براي اجرا هستن

Msvbvm60.dll
Stdole2.tlb
Oleaut32.dll
Olepro32.dll
Comcat.dll
Asyncfilt.dll
Ctl3d32.dll

نفر بعدي حتما الان كانكت هست لطفا كتمان نكنه چون همه اين رو ميدونن

[مهران رسا]

متاسفانه با نظر شما در مورد آواتارتون مخالفم . در حال حاضر بهترین مربی جهان آقای علی دایی هستند که ایران به داشتن ایشون باید افتخار کنه .. :ناراحت:

از جناب VbHamed هم به خاطر تاپیک بسیار زیباشون تشکر می کنم .

نكته ويژوالي :
می دونستید با Pset چه کارهایی میشه کرد ؟

http://up.exis.ir/storage/jpeg/exis-4877159957.jpgنفر بعدی پسره :لبخند:

[m_vb1386]

دوستان لطفا مطالب جديد بزاريد تا سطح تاپيك پايين نياد

نكته ويژوالي :
اين هم كانكشن براي بانكهاي فاكس پرو
Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\folder;Extended Properties=dBASE IV;User ID=Admin;Password=;

اين هم يكي ديگه براي vfp
Provider=vfpoledb;Data Source=C:\MyDbFolder\MyDbContainer.dbc;Collating Sequence=machine

مهران جان لطفا آنتي كاظم رو هم اپديت كن مثل اينكه ورژن جديد داره

[butterfly8528]

سلام به تمام دوستای گل

نكته ويژوالي :

اجرای برنامه در بین ساعت های مشخص شده

Private Sub Form_Load()
t = Hour(Time)
If (t >= 5 And t <= 10) = False Then
End
else
form1.show
End Sub

نفر بعدي بهترين نكته این تاپیک رو مینویسه

[mhsmity]

بخشيد اهل شماره بازي نيستم.

اي به چشم بنده قوانين رو رعايت مي كنم لطفا من رو تهديد نكنيد
شنيده ام كه انيشتن از دانشگاه اخراج شده خوب حالا كه چي ......

نكته ويژوالي :

اگر نام يك داريو (مثل c:\ ، f:\،z:\ ) داشته باشم چگونه نوع آن را تشخيص دهيم.

نفر بعدي خيلي منو دوست داره

[DoctorJay]

نکته غیر ویژوالی :
هیچوقت ندیده و نشناخته کسی رو دوست نداشته باشید !!

نكته ويژوالي :

بعضی ها نمی دونن چجوری می شه دکمه ارسال کرد !!

SendKeys "{right}"
SendKeys "{enter}"
SendKeys "{left}"
SendKeys "{enter}"

خب اینجوریه .

!! نفر بعدی داره فکر می کنه چه نکته های تکراری ای , و چی بزاره که همه کف کنن !!

[MFiRE]

نكته ويژوالي :
البته بيشتر معرفي وبلاگمه

سلام
گفتم شاید بخواین بدونین خود من از کجا ویژوال بیسیک رو یاد گرفتم.
در این پست تعداد زیادی سورس ویژوال بیسیک براتون می زارم که خود من ویژوال بیسیک رو از همین سورسا یاد گرفتم. همه سورس ها رو از سایت pscode.com گرفتم و یکی یکی فایلهایه زیپ رو باز می کردم و کدهایه پروژه ها رو می‌خوندم !
شاید وقت گیر باشه ! ولی نتایج نسبتا بهتری نسبت به مقاله خوندن داره !
به هر حال سورس هایی که اینجا می زارم دسته بندی شده هست و البته کل اونها رو هم جایه دیگه براتون آپلود کردم که کلاً حدود 38 مگابایت شده !


(لینک مستقیم و غیر دائمی) :

دانلود کل سورس ها (http://www.divshare.com/download/6475228-134) - با حجم 38 مگابایت

دانلود پروژه های آماتور (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Amateur.rar) - با حجم نیم مگابایت

دانلود پروژه های آنتی ویروس (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Anti%20virus.rar) - 2.66 مگابایت
دانلود پروژه های Application Tools (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Application%20Tools.rar) - با حجم 0.1 مگابایت
دانلود پروژه های رایت سی دی (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/CD%20Write.rar) - با حجم 0.13 مگابایت

دانلود پروژه های Client & Server (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Client%20%26%20Server.rar) - با حجم 1.5 مگابایت

دانلود پروژه های تبدیل کننده (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Convertors.rar)- با حجم 0.05 مگابایت
دانلود پروژه های بانک اطلاعاتی (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Database.rar) - با حجم 8.78 مگابایت

دانلود پروژه های دانلودر(Download Manager) (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Downloader.rar) - با حجم 2.44 مگابایت

دانلود پروژه های افکت (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Effect.rar) - با حجم 0.29 مگابایت

دانلود پروژه های ایمیل (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Email.rar) - با حجم 0.81 مگابایت

دانلود پروژه های رمز گذاری (Encrypt) (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Encrypt.rar) - با حجم 0.5 مگابایت
دانلود پروژه های بازی (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Game.rar) - با حجم .28 مگابایت

دانلود پروژه های Hook (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Hook.rar) - با حجم 0.01 مگابایت

دانلود پروژه های اینترنت (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Internet.rar)- با حجم 4.19 مگابایت

دانلود پروژه های مالتی مدیا و گرافیک (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Multimedia%20%26%20Graphic.rar) - با حجم 2.36 مگابایت

دانلود پروژه های Other Hack (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Other%20Hack.rar) - با حجم 0.19 مگابایت

دانلود پروژه های دیگر (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Other.rar) - با حجم 3.07 مگابایت

دانلود پروژه های بازیابی پسورد (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Password%20Recovery%20tools.rar) - با حجم 0.43 مگابایت

دانلود پروژه های پورت و ای پی (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Port%20%26%20IP.rar) - با حجم 0.0 مگابایت

دانلود پروژه های ریجستری (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Registry.rar) - با حجم 0.10 مگابایت

دانلود پروژه های سرویس (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Service.rar) - با حجم 0.25 مگابایت

دانلود پروژه های Spy (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Spy%20Software.rar)- با حجم 0.10 مگابایت

دانلود پروژه های Toolbar (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Toolbar.rar)- با حجم 0.68 مگابایت

دانلود پروژه های Top Project (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Top%20Project.rar)- با حجم 3.24 مگابایت

دانلود پروژه های Trojan (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Trojan%20Software.rar)- با حجم 1.70 مگابایت

دانلود پروژه های کاربردی (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/utility.rar)- با حجم 0.83 مگابایت

دانلود پروژه های Win Optimizer & Win Tools (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Win%20Optimizer%20%26%20Win%20Tools.rar)- با حجم 0.04 مگابایت

دانلود پروژه های XP Tools (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Xp%20Tools.rar)- با حجم 1.13 مگابایت

دانلود پروژه های کار با فایل Zip (http://fire-vb.persiangig.com/SourceCode%28rar%29/VB_SourceCode_Pack/Zip%20File.rar)- با حجم 2.66 مگابایت




(لینک غیر مستقیم و دائمی) :
دانلود کل سورس ها (http://www.divshare.com/download/6475228-134) - با حجم 38 مگابایت
دانلود پروژه های آماتور (http://www.divshare.com/download/6475033-3e3) - با حجم نیم مگابایت
دانلود پروژه های آنتی ویروس (http://www.divshare.com/download/6475036-81f) - 2.66 مگابایت
دانلود پروژه های Application Tools (http://www.divshare.com/download/6475037-0a5) - با حجم 0.1 مگابایت
دانلود پروژه های رایت سی دی (http://www.divshare.com/download/6475038-e5c) - با حجم 0.13 مگابایت
دانلود پروژه های Client & Server (http://www.divshare.com/download/6475039-b84) - با حجم 1.5 مگابایت
دانلود پروژه های تبدیل کننده (http://www.divshare.com/download/6475040-a67)- با حجم 0.05 مگابایت
دانلود پروژه های بانک اطلاعاتی (http://www.divshare.com/download/6475053-e81) - با حجم 8.78 مگابایت
دانلود پروژه های دانلودر(Download Manager) (http://www.divshare.com/download/6475054-bb9) - با حجم 2.44 مگابایت
دانلود پروژه های افکت (http://www.divshare.com/download/6475055-6ed) - با حجم 0.29 مگابایت
دانلود پروژه های ایمیل (http://www.divshare.com/download/6475056-c83) - با حجم 0.81 مگابایت
دانلود پروژه های رمز گذاری (Encrypt) (http://www.divshare.com/download/6475057-3ba) - با حجم 0.5 مگابایت
دانلود پروژه های بازی (http://www.divshare.com/download/6475060-69a) - با حجم .28 مگابایت
دانلود پروژه های Hook (http://www.divshare.com/download/6475061-3e1) - با حجم 0.01 مگابایت
دانلود پروژه های اینترنت (http://www.divshare.com/download/6475062-637)- با حجم 4.19 مگابایت

دانلود پروژه های مالتی مدیا و گرافیک (http://www.divshare.com/download/6475063-3a1) - با حجم 2.36 مگابایت
دانلود پروژه های Other Hack (http://www.divshare.com/download/6475169-98e) - با حجم 0.19 مگابایت
دانلود پروژه های دیگر (http://www.divshare.com/download/6475170-22a) - با حجم 3.07 مگابایت
دانلود پروژه های بازیابی پسورد (http://www.divshare.com/download/6475168-9b5) - با حجم 0.43 مگابایت
دانلود پروژه های پورت و ای پی (http://www.divshare.com/download/6475167-c3e) - با حجم 0.0 مگابایت
دانلود پروژه های ریجستری (http://www.divshare.com/download/6475128-f2d) - با حجم 0.10 مگابایت
دانلود پروژه های سرویس (http://www.divshare.com/download/6475127-d31) - با حجم 0.25 مگابایت
دانلود پروژه های Spy (http://www.divshare.com/download/6475126-4c2)- با حجم 0.10 مگابایت
دانلود پروژه های Toolbar (http://www.divshare.com/download/6475125-487)- با حجم 0.68 مگابایت
دانلود پروژه های Top Project (http://www.divshare.com/download/6475124-2b3)- با حجم 3.24 مگابایت
دانلود پروژه های Trojan (http://www.divshare.com/download/6475107-782)- با حجم 1.70 مگابایت
دانلود پروژه های کاربردی (http://www.divshare.com/download/6475106-4ab)- با حجم 0.83 مگابایت
دانلود پروژه های Win Optimizer & Win Tools (http://www.divshare.com/download/6475105-262)- با حجم 0.04 مگابایت
دانلود پروژه های XP Tools (http://www.divshare.com/download/6475104-deb)- با حجم 1.13 مگابایت
دانلود پروژه های کار با فایل Zip (http://www.divshare.com/download/6475103-7af)- با حجم 2.66 مگابایت


پسورد کلیه فایلهایه فشرده شده vb-delphi-cpp.blogfa.com می باشد.

نفر بعدي ... چه مي دونم بابا:گیج: ! فقط نكته ضعيف نذاره :لبخند:!

[butterfly8528]

سلام به همه برنامه نویسای عزیز

نكته ويژوالي :
در تكست باكس فقط عدد تايپ كنيد:

Private Sub Text1_KeyPress(KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0
End Sub

نفر بعدی یه برنامه نویس نخبه س

[tizhoosh]

اولا این که اشتباه کردی من Tizhoosh هستم نه نخبه

نكته ويژوالي :

Private Sub Form_Unload(Cancel As Integer)
Cancel = True
End Sub

با این کد، با زدن دکمه ی ضربدر فرم بسته نمی شود

و اما... نفر بعدی כגכגנ עהגיעיה ךדלמד נעהגהגשדדגכגבסכנםךחלח

[میلاد علوی]

من که نفهمیدم در موردم چی گفتی اما....

نکته ویژوالی :
محدود کردن صفحه ویندوز مثل jet Audio

نفر بعدی من نیستم

[aidin1386]

آره منم، دوباره منم:تشویق:

نکته ویژوالی :

خيليا فكر مي كنن كه با شل نمي شه فايلايي بجز exe رو بالا آورد. اينم راهش(واسه نمونه پي دي اف):
Shell "explorer.exe C:\fileNews.pdf"

ان الذين القادم، ان هو قد مبرج في السايت المبرجين:چشمک:

[vbhamed]

سلام
aidin1386 جان، مثل اينكه عربيت هم خيلي خوبه

نكته ويژوال :

همه مي دونيد كه فرم MDI كارش چيه و اينكه ميشه توش فرمهاي فرزند قرار بگيرن
اما مثلا نميشه TextBox رو مستقيما داخلش قرار داد
حالا دوست داريد هر شي ئي رو تو فرم MDI قرار بديد ؟
دوست داريد يك فرم رو تو يك فرم غير MDI ديگه قرار بدين ؟
دوست داريد به صورت مجازي چند فرم MDI با فرمهاي فرزند مختلف داشته باشيد
مي خواهيد دكمه رو داخل TextBox قرار بديد
دلتون مي خواد فرمتون رو داخل يك PictureBox بزاريد
دوست داريد مثلا برنامه Word يا اتوكد يا هر برنامه ديگه داخل فرم شما اجرا بشه

فقط كافيست Handle يك شيء يا فرم رو داشته باشيد
بقيه كار رو بسپريد به تابع زيباي SetParent
عكس و نمونه برنامه زير رو ببينيد

نفر بعدي مشغول سر و كله زدن با اين موضوع هست

[good_boy]

سلام
درست حدس زدی

نکته ویژوالي :
نکته ندارم جاش سورس میزارم(فرم نیمه شفاف):
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_ALPHA = &H2
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 Function TranslucentForm(frm As Form, TranslucenceLevel As Byte) As Boolean
SetWindowLong frm.hWnd, GWL_EXSTYLE, WS_EX_LAYERED
SetLayeredWindowAttributes frm.hWnd, 0, TranslucenceLevel, LWA_ALPHA
TranslucentForm = Err.LastDllError = 0
End Function
Private Sub Form_Load()
TranslucentForm Me, 100
End Sub

نفر بعدی باید خلاق باشه چون یه سوال دارم
در VB برای برنامه نویسی در ویندوز حتما باید از سورس آماده استفاده بشه
یه برنامه نویس نمی تونه خودش یه سورس جدید و متفاوت بنویسه
مثلا برای باز کردن در CD-Rom یا ایجاد کلید در رجیستری یا کارای مختلف دیگه حتما باید از API یا OCX یا Dll یا هر چیز آماده دیگه استفاده کرد
اگه شدنی نیست چرا؟!

[xxxxx_xxxxx]

سلام،
گفته شما رو به شدت تكذيب مي كنم. اصلاً اينطور نيست كه هر برنامه نويسي از سورسهاي آماده استفاده كنه. درسته كه مثلاً براي عكس گرفتن از مانيتور بايد از API استفاده كرد ولي تنها همون يك تابع كه نيست يا تنها همون يك روش كه نيست. من خودم چندتا برنامه ديدم كه ار مانيتور عكس ميگيرند و هركدوم شايد بيشتر از سي، چهل خط كد داشتند ولي خودم تونستم همين كارو با سه، چهار خط دستور انجام بدم.

نكته ويژوالي:
وقتي پيغامي به كاربر ميديم(MsgBox) يه همراهش يك صدا (Beep) توليد ميشه كه نوع اون صدا بستگي به علامت استفاده شده در MsgBox داره.
با اين API شما ميتونيد همه اين صداها رو توليد كنيد بدون اين كه پيغامي به كاربر داده بشه:


Private Const MB_OK = &H0
Private Const MB_HANDICON = &H10
Private Const MB_QUETSIONICON = &H20
Private Const MB_EXCLAMATION = &H30
Private Const MB_ASTERIKICON = &H40
Private Declare Function MessageBeep Lib "user32.dll" (ByVal wType As Long) As Long

Private Sub Command1_Click()
MessageBeep (&H0) 'OK Beep
End Sub

Private Sub Command2_Click()
MessageBeep (&H10) 'Error Beep
End Sub

Private Sub Command3_Click()
MessageBeep (&H30) 'Exlamation Beep
End Sub

Private Sub Command4_Click()
MessageBeep (&H40) 'Information Beep
End Sub


نفر بعدي اول نام كاربريش يكي از حروف a تا h هست:متفکر:

[butterfly8528]

سلام دوستان گل . من این پست رو فقط به خاطر xxxxx_xxxxx عزیز زدم که حرفش درست در بیاد. به افتخار xxxxx_xxxxx عزیز :تشویق::تشویق::تشویق::تشویق:


نکته ویژوالي :

پیدا کردن آدرس فولدرهای مهم :
دیگه با این کد نیازی به تعریف تابع های متعدد برای پیدا کردن هریک از فولدرها نیست .



Enum CSIDLFoldersSys
CSIDL_DESKTOP = &H0
CSIDL_PROGRAMS = &H2
CSIDL_PRINTERS = &H4
CSIDL_PERSONAL = &H5
CSIDL_FAVORITES = &H6
CSIDL_STARTUP = &H7
CSIDL_RECENT = &H8
CSIDL_SENDTO = &H9
CSIDL_STARTMENU = &HB
CSIDL_MYMUSIC = &HD
CSIDL_MYVIDEOS = &HE
CSIDL_DESKTOPDIRECTORY = &H10
CSIDL_MYCOMPUTER = &H11
CSIDL_NETWORKNEIGHBORHOOD = &H12
CSIDL_NETHOOD = &H13
CSIDL_FONTS = &H14
CSIDL_TEMPLATES = &H15
CSIDL_COMMON_STARTMENU = &H16
CSIDL_COMMON_PROGRAMS = &H17
CSIDL_COMMON_STARTUP = &H18
CSIDL_COMMON_DESKTOPDIRECTORY = &H19
CSIDL_APPDATA = &H1A
CSIDL_PRINTHOOD = &H1B
CSIDL_LOCAL_APPDATA = &H1C
CSIDL_COMMON_FAVORITES = &H1F
CSIDL_TEMPORARY_INTERNET_FILES = &H20
CSIDL_COOKIES = &H21
CSIDL_HISTORY = &H22
CSIDL_COMMON_APPDATA = &H23
CSIDL_WINDOWS = &H24
CSIDL_SYSTEM = &H25
CSIDL_PROGRAM_FILES = &H26
CSIDL_MYPICTURES = &H27
CSIDL_PROFILE = &H28
CSIDL_PROGRAM_FILES_COMMON = &H2B
CSIDL_COMMON_TEMPLATES = &H2D
CSIDL_COMMON_DOCUMENTS = &H2E
CSIDL_COMMON_ADMINTOOLS = &H2F
CSIDL_NETANDDIAlUpCONNECTIONS = &H31
CSIDL_COMMON_MYMUSIC = &H35
CSIDL_COMMON_MYPICTURES = &H36
CSIDL_RESOURCES = &H38
CSIDL_CDBURNING = &H3B
End Enum
Private Declare Function SHGetSpecialFolderLocation Lib "shell32" ( _
ByVal hwnd As Long, _
ByVal nFolder As Long, _
ppidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" ( _
ByVal Pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
Private Function GetPathSysFolder(ByVal FolderId As CSIDLFoldersSys) As String
On Error Resume Next
Const MAX_PATH = 260
Const NOERROR = 0
Dim lngPidlFound As Long
Dim FolderIdFound As Long
Dim lngPidl As Long
Dim strPath As String
strPath = Space(MAX_PATH)
lngPidlFound = SHGetSpecialFolderLocation(0, CLng(FolderId), lngPidl)
If lngPidlFound = NOERROR Then
FolderIdFound = SHGetPathFromIDList(lngPidl, strPath)
If FolderIdFound Then
GetPathSysFolder = Left$(strPath, InStr(1, strPath, vbNullChar) - 1)
End If
End If
CoTaskMemFree lngPidl
End Function


نفر بعدی حتما خود xxxxx_xxxxx عزیز با یه نکته با حال تره

[xxxxx_xxxxx]

خواهش مي كنم دوست عزيز.

نکته ویژوالي :

تبديل عدد دسيمال به باينري:


a = Val(txtDec.Text)
Do While a > 0
c = a Mod 2
a = a \ 2
d = Str(c) + d
txtBin.Text = d
Loop


نفر بعدي داره سعي ميكنه برعكس اينو بنويسه (Bin2Dec)

[f.nabavi]

من اصلا سعی نکردم...

نکته ویژوالي :
اگر از این کدها همراه اسکین های ویستا استفاده کنین، یه فرم کاملا ویستایی خواهید داشت.

ذهن نفر بعدی الان کلی درگیری داره تا یه تاپیک خوب بزنه...

[hamid_sos]

واقعا راست میگی.

نکته ویژوالي :

2 تا سورس میزارم شاید قدیمی باشی.:گریه:
با این کد میشه یک فرم دایره شکل درست کرد


Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Dim windowval, EllipticVal As String

Private Sub Form_Load()
EllipticVal = CreateEllipticRgn(30, 30, 230, 230)
windowval = SetWindowRgn(Me.hWnd, EllipticVal, True)
End Sub


با این کد میشه My Computer رو باز کرد
asanhack = Shell("Explorer ::{20D04FE0-3AEA-1069-A2D8-08002B30309D}", vbNormalFocus

نفر بعدی حتما یک بنده خداست

[butterfly8528]

نکته ویژوالي :

یک کد ساده برای استفاده از اکتیو ایکس ها فقط به صورت ریفرنس در منوی ریفرنس در قسمت منوی پروژه :
می خواهیم از microsoft script control که یک اکتیو ایکس است استفاده کنیم. نام فایل آن msscript.ocx است.
از منوی پورژه در قسمت ریفرنس این آیتم را انتخاب کنید.
سپس از کد زیر برای استفاده از این اکتیو ایکس بدون قرار دادن آن روی فرم می توان استفاده کرد

Private Sub Form_Load()

Dim xx As New ScriptControl
xx.Language = "vbscript"

' Create the function.
Dim strFunction As String
strFunction = _
"Function ReturnThis(x, y)" & vbCrLf & _
" ReturnThis = x * y" & vbCrLf & _
"End Function"
' Add the code, then run the function.
xx.AddCode strFunction
MsgBox xx.Run("ReturnThis", 3, 25)

End Sub

نفر بعدی100 % خودشه

[meys34]

آفرين جواب شما صحيح بود 10 امتياز مثبت براي شما! :لبخندساده:

نكته ويژوال :

وقتي از كد زير استفاده ميكنيد هنگام Shutt down يا Log off برنامه بسته نميشه

Private Sub Form_Unload(Cancel As Integer)
Cancel = True
End Sub

براي جلوگيري از اين مورد از كد زير به جاي بالايي استفاده كنيد

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode <> vbAppWindows Then Cancel = True
End Sub

نفر بعدي كسيه كه تا حالا توي اين تاپيك، پست نداده!

[Mr'Jamshidy]

بابا واسه ما یک چیز بهتر مینوشتی

نكته ويژوال :

همیشه در برنامه هاتون از فایل های تو در تو و زیاد (که استفاده هم بشه دکوری نباشه) استفاده کنید
چون کرک کردن برنامه سخت تر میشه

نفر بعدي معلوم نیست کیه!!! D:

[pooshiran]

اون منم

نكته ويژوالي :

معمولا نمونه كدهايي كه براي شناسايي اعداد گذاشته ميشه نقطه را براي اعداد اعشاري پشتيباني نمي كند اين كد اين كاركتر وهر كاركتر مورد نياز ديگري را پشتيباني مي كند

Dim valid As String
valid ="1234567890."

If KeyAscii > 26 Then If InStr(valid, Chr(KeyAscii)) = 0 Then KeyAscii = 0

اميدوارم نفر بعد نذاره تاپيك به صفحه دوم برود

[saeid12]

دیدی نزاشتم بره

نكته ويژوالي :

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

Dim NamaFile As String

Private Sub Command1_Click()

Cmd.Filter = "All Files|*.*"
Cmd.DialogTitle = "Select Target"
Cmd.ShowOpen
NamaFile = Cmd.FileName
Text1.Text = NamaFile

End Sub

Private Sub Command2_Click()

Dim NilaiAttributes As Byte

If NamaFile <> "" Then

NilaiAttributes = (Check1.Value * 2) + (Check2.Value * 4) + (Check3.Value * 1) + (Check1.Value * 32)
SetAttr NamaFile, NilaiAttributes
MsgBox "Set attributes successfull", vbInformation, "Setting Attributes"

End If

End Sub

Private Sub Text1_Change()

NamaFile = Text1.Text

End Sub

Private Sub Text1_GotFocus()

NamaFile = Text1.Text

End Sub


نفر بعدی فامیل بیل گیتس باید باشه ؟؟!!

[butterfly8528]

آفرین به تو .

نکته ویژوالي :
چطور ميشه رزولوشن صفحه نمايش رو تغيير داد؟


Option Explicit
Const WM_DISPLAYCHANGE = &H7E
Const HWND_BROADCAST = &HFFFF&
Const EWX_LOGOFF = 0
Const EWX_SHUTDOWN = 1
Const EWX_REBOOT = 2
Const EWX_FORCE = 4
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_BITSPERPEL = &H40000
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Const CDS_UPDATEREGISTRY = &H1
Const CDS_TEST = &H4
Const DISP_CHANGE_SUCCESSFUL = 0
Const DISP_CHANGE_RESTART = 1
Const BITSPIXEL = 12
Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private Declare Function EnumDisplaySettings Lib "user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwFlags As Long) As Long
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Any) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Dim OldX As Long, OldY As Long, nDC As Long
Sub ChangeRes(X As Long, Y As Long, Bits As Long)
Dim DevM As DEVMODE, ScInfo As Long, erg As Long, an As VbMsgBoxResult
'Get the info into DevM
erg = EnumDisplaySettings(0&, 0&, DevM)
'This is what we're going to change
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT Or DM_BITSPERPEL
DevM.dmPelsWidth = X 'ScreenWidth
DevM.dmPelsHeight = Y 'ScreenHeight
DevM.dmBitsPerPel = Bits '(can be 8, 16, 24, 32 or even 4)
'Now change the display and check if possible
erg = ChangeDisplaySettings(DevM, CDS_TEST)
'Check if succesfull
Select Case erg&
Case DISP_CHANGE_RESTART
an = MsgBox("You've to reboot", vbYesNo + vbSystemModal, "Info")
If an = vbYes Then
erg& = ExitWindowsEx(EWX_REBOOT, 0&)
End If
Case DISP_CHANGE_SUCCESSFUL
erg = ChangeDisplaySettings(DevM, CDS_UPDATEREGISTRY)
ScInfo = Y * 2 ^ 16 + X
'Notify all the windows of the screen resolution change
SendMessage HWND_BROADCAST, WM_DISPLAYCHANGE, ByVal Bits, ByVal ScInfo
MsgBox "Everything's ok", vbOKOnly + vbSystemModal, "It worked!"
Case Else
MsgBox "Mode not supported", vbOKOnly + vbSystemModal, "Error"
End Select
End Sub
Private Sub Form_Load()
Dim nDC As Long
'retrieve the screen's resolution
OldX = Screen.Width / Screen.TwipsPerPixelX
OldY = Screen.Height / Screen.TwipsPerPixelY
'Create a device context, compatible with the screen
nDC = CreateDC("DISPLAY", vbNullString, vbNullString, ByVal 0&)
'Change the screen's resolution
ChangeRes 640, 480, GetDeviceCaps(nDC, BITSPIXEL)
End Sub
Private Sub Form_Unload(Cancel As Integer)
'restore the screen resolution
ChangeRes OldX, OldY, GetDeviceCaps(nDC, BITSPIXEL)
'delete our device context
DeleteDC nDC
End Sub


نفر بعدی شاید mbt925 باشد، شاید :لبخند:

[M_P_1374]

اشتباه است

نکته ویژوالي :

برای سیو کردن اطلاعاتتون توی برنامه از SaveSetting استفاده نکنید بلکه اطلاعاتتون رو با PropertyBag سیو کنید و با دستورات Open FileAddress For AccessMode as FileNumber داخل فایلتون بذارین و بار دیگر همونا رو دریافت کنید
نمونه:


Dim PropBag As PropertyBag

Private Sub Form_Load()
Dim VarTemp As Variant

Open App.Path & "\" & App.EXEName & ".exe" For Binary As #1
Get #1, , VarTemp
Close #1

With PropBag
.Contents = VarTemp
Me.Caption = .ReadProperty("Caption")
End With
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim VarTemp As Variant

With PropBag
.WriteProperty "Caption", Me.Caption
End With

Open App.Path & "\" & App.EXEName & ".exe" For Output As #1
VarTemp = PropBag.Contents
Put #1, , VarTemp
Close #1
End Sub

Private Sub Text1_Change()
Me.Caption = Text1.Text
End Sub

فقط یه تکست باکس رو فرم بذارین

[mmssoft]

پاسخ سوال قبلی رو نمی شه داد.

نکته ویژوالي :

طریقه درج تاریخ فارسی به چهار صورت :

- ابتدا 4 تا Label به نام های Label1، Label2، Label3 و Label4 بر روی فرم ایجاد کنید.
- یک ماژول جدید ساخته و کدهای زیر را درون ان کپی کنید :

Option Explicit

Private Month_Name, Spring_Fall
Private Time_Difference, Time_Client
Private Base_Year

Private Sub Get_Date(ByVal Days, Sal, Mah, Rooz)

Dim Years, Year_Length

Do While Days >= 0

If Kabiseh(Years) Then

Year_Length = 366

Else

Year_Length = 365

End If

If Days - Year_Length >= 0 Then

Years = Years + 1
Days = Days - Year_Length

Else

Sal = Base_Year + Years

If Days <= 185 Then

Mah = 1 + (Days \ 31)
Rooz = 1 + (Days Mod 31)

Else

Days = Days - 186
Mah = 7 + (Days \ 30)
Rooz = 1 + (Days Mod 30)

End If

Exit Sub

End If

Loop

End Sub

Private Function Kabiseh(ByVal Years)

Dim Temp

Kabiseh = False
Temp = (Base_Year + Years) - 1309

If (((Temp Mod 32) - (Temp \ 32)) Mod 4) = 0 Then Kabiseh = True

End Function

Public Property Let SFhour(x)

Spring_Fall = x

End Property

Public Property Let Time_Diff(ByVal t)

Time_Difference = t

End Property

Public Property Let state(ByVal S)

Month_Name = S

End Property

Public Function To_Hejri(ByVal what_date, Optional Month_Name)

Dim Days, Day_Name, Day_Number, Temp_Days, Months

Spring_Fall = False

If IsMissing(Month_Name) Then Month_Name = 0

Time_Difference = #12:00:00 AM#
Base_Year = 1332

Months = Array("فروردين", "ارديبهشت", "خرداد", "تير", "مرداد", "شهريور", "مهر", "آبان", "آذر", "دي", "بهمن", "اسفند")

Day_Name = Array("يکشنبه", "دوشنبه", "سه شنبه", "چهارشنبه", "پنجشنبه", "جمعه", "شنبه")
Days = DateDiff("d", #3/21/1953#, what_date)
Day_Number = Weekday(what_date)

Dim Year_Length, Sal, Mah, Rooz, temp_date

If FormatDateTime(what_date + Time_Difference, vbShortDate) <> FormatDateTime(what_date, vbShortDate) Then

Days = Days + 1
Day_Number = (Day_Number + 1)

If Day_Number = 8 Then Day_Number = 1

End If

Time_Client = FormatDateTime(what_date + Time_Difference, vbLongTime)
Call Get_Date(Days, Sal, Mah, Rooz)

If ((Mah >= 1 And Mah <= 6) And Not ((Mah = 1 And Rooz = 1) Or (Mah = 6 And Rooz = 31))) And Spring_Fall = True Then
If FormatDateTime(what_date + Time_Difference + #1:00:00 AM#, vbShortDate) <> FormatDateTime(what_date + Time_Difference, vbShortDate) Then

Temp_Days = Days + 1
Day_Number = (Day_Number + 1)

If Day_Number = 8 Then Day_Number = 1

Else

Temp_Days = Days

End If

Time_Client = FormatDateTime(what_date + Time_Difference + #1:00:00 AM#, vbLongTime)

If Temp_Days <> Days Then

Days = Temp_Days

If Rooz = 30 And Mah = 6 Then
If DateDiff("n", Time_Client, #1:00:00 AM#) <= 60 And DateDiff("n", Time_Client, #1:00:00 AM#) >= 0 Then

Time_Client = FormatDateTime(what_date + Time_Difference, vbLongTime)
Days = Days - 1

If Day_Number = 1 Then

Day_Number = 7

Else

Day_Number = Day_Number - 1

End If
End If
End If

Call Get_Date(Days, Sal, Mah, Rooz)

End If
End If

If Month_Name = 0 Then
If Rooz < 10 Then Rooz = "0" & Rooz
If Mah < 10 Then Mah = "0" & Mah

To_Hejri = Sal & "/" & Mah & "/" & Rooz

ElseIf Month_Name = 1 Then

To_Hejri = Rooz & " " & Months(Mah - 1) & " " & Sal

ElseIf Month_Name = 2 Then

To_Hejri = Day_Name(Day_Number - 1) & " " & Sal & "/" & Mah & "/" & Rooz

ElseIf Month_Name = 3 Then

To_Hejri = Day_Name(Day_Number - 1) & " " & Rooz & " " & Months(Mah - 1) & " " & Sal

End If

End Function

Public Function To_Time(what_date)

Call To_Hejri(what_date)
To_Time = Time_Client

End Function

Private Sub Class_Initialize()

Spring_Fall = False
Month_Name = 0
Time_Difference = #12:00:00 AM#
Base_Year = 1332

End Sub


- بعد از این کار به فرم اصلی بیایید و کدهای زیر را در بخش From_Load فرم کپی کنید :

Label1 = To_Hejri(Date, 0)
Label2 = To_Hejri(Date, 1)
Label3 = To_Hejri(Date, 2)
Label4 = To_Hejri(Date, 3)






حالا برنامه را اجرا کنید و نتیجه را ببینید.

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

[iranian-pc]

:لبخند:من به این نتیجه رسیدم که هوش نفر قبلی خیلی زياده ؟! :متفکر:

نكته ويژوالي :

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

نفر بعدی یه آدمه روی این کره ی خاکی :تشویق:

[relax_cp]

نكته ويژوالي :

خاصیت Always on top رو جایی دیدم و به نظرم جالب رسید:
با علامت دار کردن CheckBox فرم همیشه رو قرار میگیره و با برداشتن علامت فرم به حالت عادی برمیگرده


Const HWND_TOPMOST = -1
Const HWND_NOTOPMOST = -2
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_NOACTIVATE = &H10
Const SWP_SHOWWINDOW = &H40
Private Declare Sub SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal
hWndInsertAfter As Long, ByVal X As Long, ByVal Y
As Long, ByVal cx As Long, ByVal cy As Long,
ByVal wFlags As Long)
Private Sub SetTopMost(frm As Form, ByVal blnMod As Boolean)
If blnMod Then
SetWindowPos frm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOACTIVATE
Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
Else
SetWindowPos frm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0,
SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End If
End Sub

Private Sub Check1_Click()
Call SetTopMost(Me, Check1.Value)
End Sub


امیدوارم مفید باشه

نفر بعد یک ایرانی با غیرته با یک نکته توپ

[mohsen002]

سلام
درست حدس زديد :چشمک:

نكته ويژوالي :

اگه ميخواين از كنترل هاي زيادي رو فرم اضافه كنين كه ظرفينش 256 تا كنترل هستش به گفته XXXXX_XXXXX عزيز. بهتره اسامي كنترل ها رو هم نام كنين :متعجب:
*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*.*
اين سورس چارت درايو هستش:

نفر بعدي حتماً داره فكر ميكنه كه راجع به نفر بعديش چي بگه:لبخندساده:

[Dr.Bronx]

نه دارم فکر می کنم چرا تاپیک به این خوبی و پرباری 2 ماه کسی چیزی نمی نویسه

نكته ويژوالي :

چطوری Header رو در Vsflexgrid تغییر بدیم

Vs.TextMatrix(0,1)= "کد"
Vs.TextMatrix(0,2)= "نام"

نفر بعدی داره فکر می کنه این تاپیک کجا بوده تا حالا ...

[shahmahi]

نكته ويژوالي :

یک چیز جالب در ویژوال بیسیک

ابتدا از منوی View گزینه Toolbar و سپس Customaize رو انتخاب کنید؛سپس تب

Commands رو انتخاب کنید و از لیست زیرین Help رو انتخاب
کنید و سپس از لیست روبرو گزینه About microsoft visual basic رو درگ کنید روی تولبار اصلی برنامه و رهاش کنید و سپس بدون بستن پنجره ی Customize روی آن راست
کلیک کنید و در قسمت نام عبارت Show VB Credits را وارد کنید و بعد پنجره Customaize رو ببندید و و روی دکمه کلیک کنید و لذت ببرید.

نفر بعدی میگه خداییش بچه های این سایت از کجا این همه اطلاعات دارند. :چشمک:

[Dr.Bronx]

واقعا هم که این اطلاعات عجیب غریب رو از از کجا میارید شما :تشویق:
1 چراغ سبز جمع امتیازات ... :لبخند:

نكته ويژوالي :
تبدیل ساعت به ثانیه ( دفعه بعد بر عکسش رو می گم)

Public Function Con_Time_To_Second(ByVal strTime As String) As Long
On Error Resume Next

Dim strTemp() As String
Dim i As Integer

strTemp = Split(strTime, ":")
Con_Time_To_Second = 0

For i = 0 To UBound(strTemp)
Con_Time_To_Second = Con_Time_To_Second + (Val(strTemp(i)) * (60 ^ (UBound(strTemp) - i)))
Next

End Function

نفر بعدی نفر بعد از نفر قبل تر از نفر قبلیه منه :متفکر:

[Samsam2010]

جناب آقای شعبده باز لینکت خرابه :قهقهه:

نكته ويژوالي :

هیچ میدونستید برای جمع زدن دوتا مقدار در کنترل های تکست باکس (مثلا text1) و text2 باید قبلشون از val استفاده کنیم !


نفر بعدی میگه نفر قبلی چقدر سرخوش بعد از2 ماه اومده بازی با اون نکته بی مزه اش ! منم بهش می گم همین نکته بی مزه روز اولی که وی بی یاد گرفتی برات از الگوریتم های هوش مصنوعی هم سخت تر بود
حالا نفر بعدی تو دلش یواشکی میگه !!@#@$#%#^^$)&#$!@##

[Dr.Bronx]

نه نکته خوبی بود


منم بهش می گم همین نکته بی مزه روز اولی که وی بی یاد گرفتی برات از الگوریتم های هوش مصنوعی هم سخت تر بود
فیلم زیاد نگاه می کنی نه ؟ :لبخند:

نكته ويژوالي :

می دونستین برای خالی کردن یک Picturebox نیازی نیست که بهش یک عکس خالی معرفی کنید ؟
یعنی مثلا اینجوری کنید : Picture1.Picture = loadpicture("")

فقط کافیه اینجوری بنویسید : picture1.picture = nothing

نفر بعدی داره فکر میکنه که آیا جواب بدم یا جواب ندم . :شیطان:

[MBG73]

نه من داشتم فکر میکردم برای نفر بعدی چی بنویسم .

نكته ويژوالي :

هیچ میدونستید از تابع StrComp میتونید جهت مقایسه دو رشته استفاده کنید ؟ شکل کلی این تابع به این صورت است
StrComp(string1,string2,compare)
اگر مقدار compare 1 باشد تابع بین حروف حروف کوچک و بزرگ تفاوت قائل نمیشود و اگه 0 باشد برعکس.

نفر بعدی حتما بعد از ساعت 12 پست میده.

[Faravahar]

من اینجام
یه کم بعد از شش صبحه!

نكته ويژوالي :

بهترین راه تشخیص اتصال به اینترنت روش پینگ هستش. چون هم با ADSL کار میکنه هم ...
اینم برنامش...

نفر بعدی قبله اینکه پست بزاره یه لیوان چایی خورده !

[REZADG]

تازه داره جالب میشه منم میخوام شروع کنم

نكته ويژوالي :

آیا میدونستید بهترین پک ساز و ستاپ ساز همون Package & Deployment Wizard وی بی هست که همه ی کامپونیت ها رو به سادگی تشخیص میده

نفر بعدی چیز با حال بگو نه مثل من مبتدی

[Dr.Bronx]

شما هم مثل همه بنویس دیگه . ممنون

نكته ويژوالي :

دستور Print می تواند انواع پیام ها ، عبارات رشته ای ، مقداد متغیر ها ، و خواص فرم ها و کنترل ها را روی فرم نمایش دهد.

نفر بعدی به این سوال جواب بده
The .......... Error Happen When The Programs Run.
a.Logical
b.Runtime
c.Logical And Runtime

[Faravahar]

نكته ويژوالي :

اون اوایل دنبال این می گشتم:

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.google.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

نفر بعدی در مورد کد بالا توضیح میدهد . بفرما!

[parselearn]

فكر كنم با اين تابع بشه فايلم باز كرد (مطمئن نيستم)

Private Declare Function GetDesktopWindow Lib "user32" () As Long
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

Function File_Start(FileName As String, Action As String) As Long
Dim Scr_hDC As Long
Scr_hDC = GetDesktopWindow()
File_Start = ShellExecute(Scr_hDC, Action, FileName, "", Left(FileName, 3), 1)
End Function

File_Start "http://www.barnameha.ir/", "Open"

[skh1300]

سلام
ایده بسیار عالی بود

نكته ويژوالي :

پخش کننده avi
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Sub Play_AVI(FileName As String)
Dim lngReturnVal As Long
lngReturnVal = mciSendString("play " & FileName & " fullscreen ", 0&, 0, 0&)
End Sub

این هم درون کنترل قرار دهید
Call Play_AVI("C:\windows\clock.avi")

آدم بعدی یه انسان با شخصیت هستش

[ramsess]

البته همه سايت با شخصيت هستن

نكته ويژوالي :

يه نكته توي ذخيره عكس توي پايگاه داده به خصوص access
من يه text و يك image توي فرم گذاشتم وقتي كه با commondialog يه عكس رو باز مي كنم مسير عكس و نام عكس توي text مي افته و بعد توي همون كمه ايي كه عكس رو لود مي كنم اين دستور رو براي ست كردن عكس مي نويسم image1.picture= loadpicture(text1.text) با اين كار حجم بانك بالا نمي ره و براي فراخواني عكس شما فقط مسير رو كه يك فيلد text هست رو فراخواني ميكنيد !!

اين نكته براي افرادي بود كه با عكس مشكل دارن

نفر بعدي يه راه حل بهتر پيشنهاد مي ده

[Dr.Bronx]

راه حل که زیاده ولی ....

نكته ويژوالي :

بهتر اینه که مستقیم این مسیر رو از داخل بانک بخونیم
نه اینکه یک بار داخل تکست باکس بیاریم و از اونجا بخونیم
البته باید ابتدا با تابع PathFileExistA چک کنیم که آیا فایل مورد نظر موجود هست یا نه .

if not PathFileExistA(Rs("Field_Img")) = "" Then
picture1.picture = loadpicture(Rs("Field_Img") )
else
msgbox " Tasvir Mojod Nist"
end if

The Next man is a Real man

[vbhamed]

سلام

تشکر، فکر می کنم Dr.Bronx عزیز از اون حرفه ای های وی بی هستن (البته مغرور نشین ها !)

نكته ويژوالي :

اگر بخواهیم با یک دستور SQL، اطلاعاتی رو در یک بانک اطلاعاتی دیگه غیر از بانک اصلی برناممون ثبت کنیم به شکل زیر میشه

Dim db As Database
Set db = DAO.OpenDatabase("d:\program\mydb.mdb")
db.Execute "Insert into Table1 in 'c:\test.mdb' Select * From Table2"
دستور بالا کلیه اطلاعات Table2 از بانک جاری رو به جدول Table1 از بانک c:\test.mdb اضافه می‌کنه، البته باید ساختار جداول مثل هم باشه

db.Execute "Delete * From Table1 in 'c:\test.mdb' Where Id >= 100"
دستور بالا کلیه رکوردهای با آی دی بزرگتر از 100 رو از بانک c:\test.mdb حذف می کنه

این روش برای سایر دستورات هم کاربرد داره

نفر بعدی راجع به این روش سؤال داره !

[Rezapcclick]

سلام
چه خبره اینجا ؟؟؟

نه عزیز من، الان وقت فکر کردن نیست که فکر کنی کی وی بی حرفه ای کی حرفه ای نیست
الان وقته اینه که یه فرم لیزری واسه خودت داشته باشی مگه بده ؟

نکته ویژوالي :

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

حالا واستون فایل ضمیمه شو می زارم تا حالی به حولی بشه

نفر بعدی فکر کنم یه آدم شوخ و باحال و اهل شادی باشه

[polisoftco]

واسه شوخی :
دعای شبهای یک کودک : خدایا میدونی با این که آب کم خوردم ولی باز جیش کردم، پس کمکم کن صبح کتک نخورم ..الهی آمین. :لبخند:

نکته ویژوالي :

چگونه میتوان تعداد خطوط تایپ شده توی یک TextBox رو بدست آورد ..؟
یک پروژه جدید وا کنین، یک تکست بنام Text! و یک کاماند بنام cmd_NoLine بندازین تو فرم :

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd as Long, ByVal wMsg as Long, ByVal wParam as Long, ByVal lParam as Long) as Long

Private Sub cmd_NoLine_Click()
Dim lngLineCount as Long
on Error Resume Next
lngLineCount = SendMessageLong(Text1.hwnd, &HBA , 0&, 0&)
MsgBox Format$ (lngLineCount, "##,###")
End Sub

نفر بعدی حتما میگه عجب جک مسخره ای ی ی ...!!!:گیج:
سوال من : فرستادن اطلاعات یک رکوردست به شیت اکسل ...؟

[unit001]

ببخشید نفر قبلی, ولی من اومدم و تاپیک رو از اول شروع به خوندن کردم :چشمک:به خاطر همین هم یه کم دیر نفر بعدی شدم:افسرده:.

نکته ویژوالي :

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

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

یعنی تمام دانلود هایی که داشتید

فک کنم نفر بعدی خودم باشم با این جواب دادن های کند شما. جالبه :کف:.

[Rezapcclick]

سلام نفر قبلی ....

نکته ویژوالي :

اینم یه چند تا برنامه ی جالب و بدون شرح....، مطمئنم حال می کنید ...

نفر بعدی من هیچی نمی گم تا بیایی میدون مطلب نایاب بزاری ببینیم.

[earse+erse]

مثل این که نفر بعدی منم

نکته ویژوالي :

Dim a As New GUtilLib.FdatClass
Dim s As String
Dim m As String
Dim gh As String
Dim ss As String

Private Sub Command1_Click()
Calendar = 0
s = (Text4.Text)
Text1.Text = Format(s, "dddd --- d / mm /yyyy")


m = a.s2m(Text4.Text)
Text2.Text = Format(m, "dddd --- d / mm /yyyy")
Calendar = 1
gh = a.s2m(Text4.Text)
Text3.Text = Format(gh, "dddd --- d / mm /yyyy")
Calendar = 0

End Sub

Private Sub Form_Load()
Me.Caption = "ÊÞæíã ÇãÑæÒ"
Text4.Text = a.m2s(Date)
Calendar = 0
s = a.m2s(Date)
m = (Date)
Text1.Text = Format(s, "dddd --- d / mm /yyyy")


Text2.Text = Format(m, "dddd --- d / mm /yyyy")
Calendar = 1
gh = Date
Text3.Text = Format(gh, "dddd --- d / mm /yyyy")
Calendar = 0

End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub


نفر بعدی آقا حامد نیست.

[aryasoft2872]

نكته ويژوالي :

روش تعیین اجرای یک برنامه برای اجرای یک پسوند خاص
Private Const REG_SZ As Long = 1
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const ERROR_SUCCESS = 0
Private Const KEY_ALL_ACCESS = &H3F
Private Const REG_OPTION_NON_VOLATILE = 0
Private PromptOnErr As Boolean
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long

Public Function CreateFileAss(Extension As String, FileType As String, _
FileTypeName As String, Action As String, AppPath As String, Optional Switch As String = "", _
Optional SetIcon As Boolean = False, Optional DefaultIcon As String, Optional PromptOnError As Boolean = False) As Boolean

On Error GoTo ErrorHandler:

PromptOnErr = PromptOnError

If Dir(AppPath, vbNormal) = "" Then
If PromptOnError Then MsgBox "The application path '" & AppPath & "' cannot be found.", vbCritical + vbOKOnly, "DLL/OCX Register"
CreateFileAss = False
Exit Function
End If

Dim ERROR_CHARS As String: ERROR_CHARS = "\/:*?<>|" & Chr(34)
Dim i As Integer

If Asc(Extension) <> 46 Then Extension = "." & Extension

For i = 1 To Len(Extension)
If InStr(1, ERROR_CHARS, Mid(Extension, i, 1), vbTextCompare) Then
If PromptOnError Then MsgBox "The file extension '" & Extension & "' contains an illegal char (\/:*?<>|" & Chr(34) & ").", vbCritical + vbOKOnly, "DLL/OCX Register"
CreateFileAss = False
Exit Function
End If
Next

If Switch <> "" Then Switch = " " & Trim(Switch)


Action = FileType & "\shell\" & Action & "\command"

Call CreateSubKey(HKEY_CLASSES_ROOT, Extension)
Call CreateSubKey(HKEY_CLASSES_ROOT, Action)

If SetIcon Then
Call CreateSubKey(HKEY_CLASSES_ROOT, (FileType & "\DefaultIcon"))
If DefaultIcon = "" Then
Call SetKeyDefault(HKEY_CLASSES_ROOT, FileType & "\DefaultIcon", Trim(AppPath & ",0"))
Else
Call SetKeyDefault(HKEY_CLASSES_ROOT, FileType & "\DefaultIcon", Trim(DefaultIcon))
End If
End If


Call SetKeyDefault(HKEY_CLASSES_ROOT, Extension, FileType)
Call SetKeyDefault(HKEY_CLASSES_ROOT, FileType, FileTypeName)
Call SetKeyDefault(HKEY_CLASSES_ROOT, Action, AppPath & Switch & " %1")

CreateFileAss = True
Exit Function

ErrorHandler:

If PromptOnError Then MsgBox "An error occured while attempting to create the file extension '" & Extension & "'.", vbCritical + vbOKOnly, "DLL/OCX Register"
CreateFileAss = False

End Function

Private Function CreateSubKey(RootKey As Long, NewKey As String) As Boolean
Dim hKey As Long, regReply As Long
regReply = RegCreateKeyEx(RootKey, NewKey, 0&, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey, 0&)

If regReply <> ERROR_SUCCESS Then
If PromptOnErr Then MsgBox "An error occured while attempting to to create a registery key.", vbCritical + vbOKOnly, "DLL/OCX Register"
CreateSubKey = False
Else
CreateSubKey = True
End If

Call RegCloseKey(hKey)
End Function

Private Function SetKeyDefault(RootKey As Long, Address As String, Value As String) As Boolean
Dim regReply As Long, hKey As Long
regReply = RegOpenKeyEx(RootKey, Address, 0, KEY_ALL_ACCESS, hKey)

If regReply <> ERROR_SUCCESS Then
If PromptOnErr Then MsgBox "An error occured while attempting to access the registery.", vbCritical + vbOKOnly, "DLL/OCX Register"
SetKeyDefault = False
Exit Function
End If
Value = Value & Chr(0)
regReply = RegSetValueExString(hKey, "", 0&, REG_SZ, Value, Len(Value))
If regReply <> ERROR_SUCCESS Then
If PromptOnErr Then MsgBox "An error occured while attempting to set key default value.", vbCritical + vbOKOnly, "DLL/OCX Register"
SetKeyDefault = False
Else
SetKeyDefault = True
End If

Call RegCloseKey(hKey)
End Function


نفر بعدی حتما میگه از این موضوع مزخرف تر پیدا نکرد بگه؟؟؟!!!

[IamOverlord]

نكته ويژوالي :

سلام دوستان!
این هم یه سورس برای کار با Webcam و Capture کردن تصویر از Webcam هست.البته خودم ازش سر در نیاوردم (:عصبانی++:) !

نفر بعدی احتمالا یه چیزی در مورد این سورس می گه !

[xxxxx_xxxxx]

سلام،
دوستان عزیز لطفاً به چند نکته در مورد این تاپیک توجه کنید:


از ارسال برنامه (پروژه) خودداری کنید.
در این تاپیک فقط نکاتی در مورد برنامه نویسی در VB6 مطرح میشه.
این تاپیک در تالار VB6 قرار داره، پس از ارائه کردن کدهای VB.NET و یا C#‎‎ خودداری کنید.
از ارسال های فاقد محتوا، که نکته ای در اون وجود نداره خودداری کنید.
نکات خودتون رو همراه با توضیحات ارائه کنید. (در حد چند جمله در مورد کد توضیح بدید)
به جهت حفظ نظم تاپیک، لطفاً پست های خودتون رو به این شکل (http://barnamenevis.org/forum/showpost.php?p=687465&postcount=9) ارسال کنید.

طبیعی‌ست که از این پس، پست هایی که موارد بالا در اونها رعایت نشده باشه بدون اطلاع قبلی حذف خواهند شد.
با تشکر از همکاری دوستان.

[ماهان مقدم]

چشم !.

نکته ویژوال:
آیا می دونستید می تونید با نوشتن یک دستور فاکتوریل تو در تو, Stack ویندوز رو پر کرده و باعث سوختن cpu تک هسته ای و دو هسته ای بشوید !. ( vb چه زوری داره ها... )

ای کاش vb6 شیء گرا بود ! نظر تو چیه ؟

[mahdi1373]

درسته، ولی vb6 یه حال دیگه ای داره...


نكته ويژوالي :

با این کد میتونید هر process ای رو که بخواهید توی ویندوز kill کنید:
shell("tskill processname") ← x
فقط بجای processname، نام پروسه تان را وارد کنید.(x← را هم وارد نکنید، اون رو گذاشتم که کد به هم نخوره!)
مثلاً:
shell("tskill taskmgr") ←x

نفر بعدی یه بازی سازه!

[HamedNet_ir]

از كجا فهميدي؟

نكته ويژوالي :

آيا ميدانيد كه براي ساخت يك نقطه ي حساس ( جهت اجراي رويداد ) ميتوانيد يك label بگذاريد و caption آن را پاك كنيد و در رويداد click آن رويداد مورد نظر خود را بنويسيد؟

نفر بعدي حتما تو اين تاپيكه!

[ماهان مقدم]

منظورت تو این فروم بود ؟ :لبخند:

نکته ویژوالي:
وصل شدن به اینترنت توسط دستور:
shell "rasdial connectionName Username Password"

می تونی مشکل من رو تو این تاپیک حل کنی ؟ --> http://barnamenevis.org/showthread.php?t=205356

[EHSAN_7417]

سلام
بابا اینجا که همه میبازن !!! آخه الان ساعت 11:20 شبه!!!

نكته ويژوالي :

شبیه سازی کنترل پنل

دوستان برای اینکه بخواهیم یکی از دستورات کنترل پنل را شبیه سازی کنیم باید از shell استفاده کنیم

مثلا ما میخوایم با فشار دادن یکی از command button ها قسمت تنظیمات ماوس ویندوز باز بشه
ابتدا caption یکی از command button ها رو تغییر بدین به mouse
و روش دابل کلیک کنید تا به قسمت کد نویسی وارد بشین.بعد کافیه از دستور shell استفاده کنید.
به اینصورت :
shell "control.exe mouse"

نفر بعدی مطمئنا میبازه !!

[xxxxx_xxxxx]

تاپیک قدیمی و دوست داشتنی، اولین پست سال 89 با یک نکته برای بهینه سازی

نكته ويژوالي :

احتمالاً شما یکی از این دو روش تعریف شئ جدید رو توی برنامه هاتون زیاد استفاده می کنید. این دو نوع تعریف ظاهراً یکسان هستند:
تعریف اول:
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset

تعریف دوم:
Dim rs As New ADODB.Recordset

اما یک تفاوت مهم در این دو روش تعریف وجود داره و اون هم این هست که در روش اول شما یک بار به کتابخانه موردنظر رجوع می کنید( در اینجا ADODB) و سپس یک Instance جدید از یک کلاس رو تعریف می کنید.(در اینجا Recordset)
اما در روش دوم، هم به همین صورت است با این تفاوت که هر زمان و هرجایی که در برنامه تان از کلاس تعریف شده استفاده کنید، به کتابخانه موردنظر توسط برنامه رجوع میشه و از وجود اون کتابخانه اطمینان حاصل میشه. در نتیجه روش اول به مراتب سریعتر از روش دوم می باشد، چرا که در روش اول تنها یک بار به کتابخانه موردنظر رجوع میشه.

نفر بعدی مطمئناً نفر بعدی خواهد بود (;

[trade_mark]

نفر بعدی منم
قلم و کاغذ رو آماده کنین

نكته ويژوالي :

با این کد می تونین فرم تون رو always on top کنین

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Sub Form_Load()

SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
End Sub

نفربعدی یه فرد باهوش مخترع و زرنگ نیست. یه آدمه که علاوه بر چیزهای قبلی یه آدم دلسوز و باحاله:قلب:

[trade_mark]

مثل اینکه خودمم :قهقهه:
حیفم اومد که این کد رو هم قرار ندم

نكته ويژوالي :

با این کد برنامه تون فقط 3 بار اجرا می شه
Private Sub Form_Load()
Dim S As String

S = GetSetting("RunOnce", "OnlyTest", "Times")

If S = "3" Then
MsgBox "اجرا نمی تواند از 3 بیشتر باشد ;)"

End
End If

S = Val(S) + 1
SaveSetting "RunOnce", "OnlyTest", "Times", S
Caption = "تعداد اجرا" & S
End Sub

نفر بعد یه فردیه که فردا صبح جواب می ده. یه پسر مودب و زرنگ

[kuh_nur]

سلام
دوست عزیز trade_mark اشتباه فرمودین، من همین امروز جواب دادم

نکته ویژوالی:

فارسی کردن msgbox

Private m_hHook As Long

Private Const IDOK = 1
Private Const IDCANCEL = 2
Private Const IDABORT = 3
Private Const IDRETRY = 4
Private Const IDIGNORE = 5
Private Const IDYES = 6
Private Const IDNO = 7
Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Public Sub MessageBoxH(hwndThreadOwner As Long)

Dim hInstance As Long
Dim hThreadId As Long

hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()
m_hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId)

End Sub

Private Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

If uMsg = HCBT_ACTIVATE Then

SetDlgItemText wParam, IDOK, "تأييد"
SetDlgItemText wParam, IDCANCEL, "لغو"
SetDlgItemText wParam, IDABORT, "قطع عمل"
SetDlgItemText wParam, IDRETRY, "سعي مجدد"
SetDlgItemText wParam, IDIGNORE, "صرف نظر"
SetDlgItemText wParam, IDYES, "بله"
SetDlgItemText wParam, IDNO, "خير"
UnhookWindowsHookEx m_hHook

End If

MsgBoxHookProc = False

End Function

Public Function MsgBox2(Form1 As Form, prompt As String, style As VbMsgBoxStyle, title As String) As Long

MessageBoxH Form1.hwnd
MsgBox2 = MsgBox(prompt, style, title)

End Function

Public Function MsgBox3(Form1 As Form, prompt As String, style As VbMsgBoxStyle, title As String) As Long

MessageBoxH Form1.hwnd
MsgBox3 = MsgBox(prompt, style + vbMsgBoxRtlReading + vbMsgBoxRight, title)

End Function

نفر بعدی حتما یه جواب به این فروم میده

[ehsan78mp]

بله درست فرمودید میده.

نكته ويژوالي :

از برنامه Source Safe که همراه خود ویژوال بیسیک نصب می شه ، برای محافظت از سورس ها استفاده می شه. به این طریق که شما در SourceSafe Admin نام کاربری و رمز عبور ایجاد می کنین. بعد اگه پروژه ای گفت که می خواین به سورس سیف بره یا نه را Yes و از اونجا یوزر و پسورد خودتون را وارد کنین. حالا پروژه بدون یوزر و پسورد درست باز نمیشه.

نفر بعدی به احتمال 99.9% فردیه که بیش از 1 سال با ویژوال بیسیک آشنا هست.

[juggle]

آفرین درست گفتین
من حدود یک سال که با vb6 آشنا شدم

نکته ویژوالی :

دستور Shell

توسط اين دستور مي تونيد فايلي را در وي بي اجرا كنيد .آدرسي كه جلوي اين دستور نوشته مي شه اجرا ميشه .شكل اين دستور به اين صورت است

Shell ProgramPath,RunModel

در آرگومان اول مسير فايل نوشته مي شود ودر آرگومان دوم مدلي كه برنامه بايد اجرا شود.در اين ارگومان از آرگومان هاي زير استفاده مي گردد

vbHide=0
vbMaximizedFocus=1
vbMinimizedFocus=2
vbMinimizedNoFocus=3
vbNormalFocus=4
vbNormalNoFocus=5

در مدل صفر برنامه به صورت پنهان ظاهر مي شود.براي مواقعي كه مي خواهيم عمل اجرا را از ديد كاربر پنهان كنيم .در مدل 2 برنامه اجرا مي شود به صورت كمينه(روي منوي استارت-مينيمايز شده)وفاكس هم روي ان مي رود يعني اين كه بعد از اجرا هي زرد و آبي مي شود تا كار بر روي آن كليك كند.مدل 3برنامه به

صورت ينيمايز -كمينه اجرا مي شود زرد وآبي نمي شود (معمولي-فاكس رويش نمي رود).مدل 1برنامه به صورت تمام صفحه اجرا شده فاكس هم روي آن مي رود(زرد و ابي مي شود).در مدل 4برنامه با اندازه پيش فرض اجرا مي شودوفاكس را هم مي گيرد.درمدل 5برنامه با اندازه معمولي اجرا شده و فاكس نمي گيرد

كار برد مهم ديگر شل اجرا فايل هاي معمولي با يك برنامه اجرايي است مثل اجراي يك متن در نت پد.براي اين كار نام فايل را بايك فاصله از نام فايل مي نويسيم

Shell "Notepad.exe"+" C:\Text1.txt"

توجه داشته باشيد كه براي اجراي فايل بايد نام و مسير فيل را با يك كاراكتر فاصله بنويسيد

اگر فاصله ندهيد خطا مي‌دهد. اگر فايلي در مسير برنامه تان كپي كرده ايد اين كد را بنويسيد

shell "notpad.exe "+(app.path+"\"+"your File Name")

app كلاسي است كه به برنامه اشاره مي كند ومي توان اطلاعات برنامه مانند مسير-نام فايل اجرائي-كمپاني وغيره

براي نوتپد ويندوز چون در درايو ويندوز قرار دارد احتياج به تايپ مسير كامل نيست همچنين اگر شما فايلي را از پوشه

اجرا كنيد به مسير كامل نياز نيست برنامه اي مانند كامند پرامپت بازي ها واسكرين سيور ها در اين پوشه system32

است.
Shell "cmd.exe"

اجراي يك فولدر با Shell

براي اين كار فايل اجرائي Explorer.exe واقع در درايو ويندوز را به همراه نام فايل اجرا مي كنيم

shell "explorer.exe "+" c:\windows"

با اجراي اين برنامه پوشه ويندوز اجرا مي شود روش بالا در سي دي هاي اتوران استفاده زيادي دارد

Shell "rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl "كادر حذف برنامه ها
Shell "rundll32.exe shell32.dll,Control_RunDLL desk.cpl"كادر تغيير پس زمينه
Shell "rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl"كادر اينتر نت
Shell "rundll32.exe shell32.dll,Control_RunDLL modem.cpl"كادر مودم
Shell "rundll32.exe shell32.dll,Control_RunDLL mmsys.cpl"كادر صدا
Shell "rundll32.exe shell32.dll,Control_RunDLL netcpl.cpl"كادر شبكه
Shell "rundll32.exe shell32.dll,Control_RunDLL powercfg.cpl"كادر پاور-برق
Shell "rundll32.exe shell32.dll,Control_RunDLL sysdm.cpl"كادر سيستم
Shell "rundll32.exe shell32.dll,Control_RunDLL telephon.cpl"كادر تلفن
Shell "rundll32.exe shell32.dll,Control_RunDLL timedate.cpl"كادر ساعت

كتابخانه وسيع Shell

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

كد هاي زير را هر جا استفاده كنيد جواب مي دهد البته بعد از اينكه كد بالا را در اولين خط فرم نوشتيد

Shell "arp"
Shell "drvspace"
Shell "drwatson"
Shell "explorer"براي my document
Shell "freecell"
Shell "ftp"براي تنظيم اف تي پي
Shell "ipconfig"كادر آي پي
Shell "mplayer"مديا پلير
Shell "mshearts"
Shell "nbtstat"
Shell "netstat"
Shell "calc"ماشين حساب
Shell "notepad"نوت پد
Shell "packager"
Shell "pbrush"نقاشي
Shell "ping"
Shell "regedit"ريجيستري
Shell "route"روت
Shell "scandskw"اسكن ديسك
Shell "scanregw"اسكن رجيستري
Shell "setdebug" تنظيم ويندوز
Shell "sigverif"
Shell "cdplayer"سي دي پلير
Shell "sndrec32"ضبط صدا
Shell "sndvol32"تنظيم ولوم صدا
Shell "sol"همون سول
Shell "taskman"وضعيت سي پي يو
Shell "telnet"تلفن
Shell "vcmui"
Shell "winfile"
Shell "winipcfg"
Shell "winmine"
Shell "winrep"
Shell "charmap"كاراكتر مپ
Shell "winver"
Shell "write"وورد پد
Shell "wscript"
Shell "cleanmgr"پاك كننده اشغال درايو
Shell "control"كنترل پنل
Shell "cvt1"
Shell "defrag"تفرق زدايي ديسك
Shell "drvspace" فضاي خالي ديسك

اجراي فايل اينترنت با Shell
shell "Explorer.exe "+" www.google.com

كادر ارسال ايميل
shell "explorer.exe"+" maileto:test@google.com.com"

نمايش يك فايل از اينترنت از حافظه
shell "explorer.exe"+" Your HTML File.html"

دانلود يك فايل از اينترنت
shell "explorer.exe "+" file://www.test.com/test.zip"

نفر بعدی به احتمال 99.999999% تا 1شب جواب میده و خیلی آدم باحال و عالمه.

[kuh_nur]

یادش بخیر، عجب تاپیک با حالی بود

نکته ویژوالی :

آیا می دانی که به جای علامت ' براي خط توضيحات، میشه از کلمه Rem استفاده کرد

[modirmasool]

بله میدونم.:چشمک:

نکته ویژوالی :

شما با اضافه کردن ; و , بعد از دستور Print فرم میتونین نحوه چاپ بر روی فرم رو تغییر بدین.
برنامه نمونه اش رو گذاشتم.

نفر بعدی حتما مثل من بار اولشه که این تاپیک رو میبینه.

[kuh_nur]

نخیر من دفعه اولم نیست

نکته ویژوالی :

روش اتصال به بانک اکسس

Dim Cn As New ADODB.Connection
Dim Rs As New ADODB.Recordset

Private Sub Form_Load()
Cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & App.Path & "\Access.mdb;" & _
"Mode=ReadWrite;" & _
"Persist Security Info=False;" & _
"Jet OLEDB:Database Password = 1"
Cn.Open
Rs.CursorLocation = adUseClient
Rs.Open "Table1", Cn, adOpenStatic, adLockPessimistic
End Sub


آیا اصلا نفر بعدی هم هست ؟

[ramzdar]

شک نکن هنوز هم نفر بعدی هست!!!

نکته ویژوالی :

با این کد میتونید آدرس یه سایت رو با مرورگر پیشفرض باز کنید.
کافیه کد رو توی یه ماژول قرار بدید و بعد توی یه دکمه بگین بره توی چه سایتی.
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
Const SW_SHOWNORMAL = 1

Public Function OpenX(YourURL As String) As Boolean
OpenX = ShellExecute(&O0, "Open", YourURL, vbNullString, vbNullString, 4)
End Function

مثلاً توی دکمه بنویسید:
OpenX "www.barnamenevis.org"

فقط یادتون باشه که www. یا http:// اولش باشه مثلاً:
www.barnamenevis.org (http://www.barnamenevis.org) یا http://www.barnamenevis.org یا http://barnamenevis.org

نفر بعدي kuh_nur خواهد بود.

[ehsanocx]

نکته ویژوالی :

انتخاب چند فایل

Private Sub cmdOpen_Click()

On Error GoTo ErrHandler
Dim vFiles As Variant
Dim lFile As Long

With CommonDialog1
.FileName = "" 'Clear the filename
.CancelError = True
.DialogTitle = "Select File(s)..."
.Flags = cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNHideReadOnly 'Flags, allows Multi select, Explorer style and hide the Read only tag
.Filter = "All files (*.*)|*.*"
.ShowOpen
vFiles = Split(.FileName, Chr(0)) 'Splits the filename up in segments
If UBound(vFiles) = 0 Then ' If there is only 1 file then do this
List1.AddItem .FileName
List2.AddItem .FileTitle
Else
For lFile = 1 To UBound(vFiles) ' More than 1 file then do this until there are no more files
List1.AddItem vFiles(0) + "\" & vFiles(lFile)
List2.AddItem vFiles(lFile)
Next
End If
End With

Exit Sub
ErrHandler:
If Err <> cdlCancel Then
MsgBox Err.Description
End If

End Sub

نفر بعدی لطفا به این تایپیک من پاسخ بده. با تشکر
http://barnamenevis.org/showthread.php?t=237971

[ehsanocx]

بازم خودم :

نکته ویژوالی :

بدست آوردن ریزولیشن صفحه

ین کدها رو تو یه دکمه کپی کنید:
Dim intWidth As Integer
Dim intHeight As Integer
intWidth = Screen.Width \ Screen.TwipsPerPixelX
intHeight = Screen.Height \ Screen.TwipsPerPixelY
MsgBox "Screen Resolution:" + vbCrLf + vbCrLf + Str$(intWidth) + " x" + Str$(intHeight), 64, "Info"

نفر بعدی یه آدم باحال و دوست داشتنیه

[juggle]

نکته ویژوالی :

قرار دادن متن به صورت عمودی در یک کنترل Text Box
ابتدا یک کنترل Picture Box به فرم اضافه کنید. که به طور پیش فرض Picture1 ایجاد می شود. خصوصیت AuotRedraw کنترل مذبور را به True تنظیم کنید. بعد یک کنترل Text Box به فرم روی کنترل Picture Box اضافه کنید. Text1 به وجود می اید و سپس خصوصیت MultiLine این را به True تنظیم کنید. بعد این کدها را در فرمتون کپی کنید

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_USER = &H400
Const EM_GETLINECOUNT = &HBA
Dim numlines As Long

Private Sub Form_Load()
Dim ht As Integer
Text1.Left = 0
Text1.Height = Picture1.Width - 400
Text1.Width = Picture1.TextHeight("A")
Text1.Top = (Picture1.Height - Text1.Height) / 2 + 170
Text1.Visible = True
numlines = 1
End Sub

Private Sub Text1_Change()
Dim ret As Long
Dim ht As Long
ret = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0, ByVal 0&)
If ret <> numlines Then
ht = Picture1.TextHeight("A")
Text1.Top = (Picture1.Height - Text1.Height) / 2 + 170
numlines = ret
SendKeys "{PGUP}", True
Text1.SelStart = Len(Text1)
End If
End Sub

نفر بعدی یه کاربر عادی مثل من نیست.

[vbhamed]

ما همه عادي هستيم

نكته ويژوالي :

توابع مفيد Choose و Switch

تابع Choose براي انتخاب از بين چند مقدار با توجه به يك انديس
Dim x%

Do
x = Val(InputBox("شماره روز هفته را وارد نماييد :"))

Loop While x < 1 Or x > 7

MsgBox Choose(x, "شنبه", "يكشنبه", "دوشنبه", "سه شنبه", "چهارشنبه", "پنجشنبه", "جمعه")

تابع Switvh براي تست چند شرط مختلف
Dim x!

x = Val(InputBox("معدل را وارد نماييد :"))

MsgBox Switch(x >= 18, "عالي", x >= 16, "خوب", x >= 12 And x < 16, "متوسط", x < 12, "ضعيف")

نفر بعدي داره فكر مي كنه چقدر تو برنامش مي تونست از اين توابع استفاده كنه !

[mds_boy]

نه داداش این کد رو قبلا استفاده میکردم، اما تازگیها کمی کم رنگ شده

نکته ویژوالی :

البته این رو برای تازه کارها مینویسم، 2 مورد هستش:
1- برای اینکه دقت نقطه های صفحه Design فرمتون بیشتر بشه از مسیر زیر استفاده کنید :


Tools Menu -> Options -> General


و دو خصیصه width را به 24 و Height را هم به 24 تغییر دهید، با اینکار شما کنترل راحتی تو حرکت اشیاعتون در حالته دیزاین دارید.

2- آیا میدونستی که در اوله کار، یعنی بعد از ساخته فرم، همون اول برید و فونت فرم را به فونته دلخواه با سایزه دلخواه تغییر دهید، کله اشیاء اون فرم، همون خصیصه رو از فرم میگیرند ؟!!!
این نکته ی دومی رو حتی استادم با اون همه سابقش تو کف موند !!! البته برای ما هیچه :کف: :چشمک: .

و اما : نوبت به ما رسید، نفره بعدی الان خوابه(ساعت: 1:11 بامداد) ، بزار بخوابه فردا ببینیم، چی میگه !
ما در مورده کسی یا چیزی که ندیدیم قضاوت نمیکنیم، ببینیم، چه چیزی برای رو کردن داره ؟

[returnx]

1-چیز خاصی برای رو کردن ندارم فقط امیدوارم تکراری نباشه.

نکته ویژوالی :

با این تابع میشه زمان روشن بودن سیستم رو بر حسب میلی ثانیه بدست اورد.
Public Declare Function GetTickCount Lib "kernel32" Alias "GetTickCount" () As Long

Dim a As Double
a = GetTickCount
Print a

احتمالا نفر بعدی میزنه تو ذوقم میگه این نکته تکراری بود.

[IamOverlord]

سلام دوستان
برای من که تکراری نبود!

نکته ویژوالی :

از این دو Function می تونید برای به دست آوردن موقعیت مکان نمای ماوس در نمایشگر اسفاده کنید:
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Public Type POINTAPI
X As Long
Y As Long
End Type

Public Function fGetCursorPositionX() As Long
Dim PointAPI1 As POINTAPI
GetCursorPos PointAPI1
fGetCursorPositionX = PointAPI1.X
End Function

Public Function fGetCursorPositionY() As Long
Dim PointAPI1 As POINTAPI
GetCursorPos PointAPI1
fGetCursorPositionY = PointAPI1.Y
End Function

نفر بعدی حتما امروز یه چیزی می گه!

[sina32]

خوب اين که درست!

نکته ویژوالی :

با vb ميشه اسکرين‌سيور ساخت، کافيه فايل exe خودتون رو با پسوند scr ذخيره کنيد. و براي تنظيماتش هم ميتونيد دکمه F1 رو تعريف کنيد که بهنگام اجرا فشرده بشه.

نفر بعدی الان ميگه تکراريه!

[returnx]

نه تو این تاپیک نیومده بود.

نکته ویژوالی :

تلفظ کلمات فقط با چهار خط کد:
Dim msg, sapi
msg = Text1.Text
Set sapi = CreateObject("sapi.spvoice")
sapi.Speak msg

نفر بعدی احتمالا mmssoft که پست میده بعد میگه این کد رو که من خودم تو این سایت گذاشته بودم.

[sina32]

نکته ویژوالی :

قطع کردن ارتباط اینترنت (Disconnect)

shell rasdial [connectionname] /disconnect

نفر بعدی بگه که فرق لپ تاپ با نوت بوک و با نت بوک چیه؟؟

[farzad93]

طرز نوشتنشون فرق میکنه (چیز دیگه ای نمیدونم)

نکته ویژوالي :

یه ویروسی هست به نام AVBtimer که شئ تایمر رو خراب میکنه!
البته این ویروس فقط با آنتی ویروس های خاص شناسایی میشه که نمیدونم درست هست که نام ببرم یا نه.

به نظر نفر بعدی درست هست که اسم آنتی ویروس ها رو بگم؟؟

[ramzdar]

بگو فکر نکنم بد باشه. راستی فرقشون اینه که لپ تاپ کارایی، حجم و تجهیزاتش از نوت بوک بیشتره و نوت بوک هم از نت بوک

نکته ویژوالي :

تشخیص کانکت بودن یا نبودن

Private Declare Function InternetGetConnectedStateEx Lib "wininet.dll" Alias "InternetGetConnectedStateExA" (lpdwFlags As Long, lpszConnectionName As Long, dwNameLen As Long, ByVal dwReserved As Long) As Long[/CODE][CODE]strConnectionName = Space(256)
lNameLen = 256
lPtr = StrPtr(strConnectionName)
lNameLenPtr = VarPtr(lNameLen)
RetVal = InternetGetConnectedStateEx(lConnectionFlags, ByVal lPtr, ByVal lNameLen, 0)
If RetVal = 0 Then Caption = "Disconnected" Else Caption = "Connected"

[pcdownload.bloghaa.com]

نکته ویژوالي :

برای نوشتن چند خط کد در یک خط از علامت : در انتهای خطوط استفاده کنید.
نکته جالبش اینجاست که می تونید کد زیر رو در یک سطر بنویسید:

If i = 0 Then
text1 = "hello"
End If

احتمالا کد زیر رو می دید:
If i = 0 Then text1 = "hello"
حالا برای نوشتن کد زیر در یک سطر چه پیشنهادی دارید:
If i = 0 Then
text1 = "hello"
text2 = "new"
End If
کد زیر روش پیشنهادیه:
If i = 0 Then: text1 = "hello": text2 = "new"

برای بزرگترین برنامه ای که ساختید چند خط کد نوشتید ؟

[www.pc3enter.tk]

نکته ویژوالي :

یک ترفند بسیار جالب حتی فکرش هم نمی توانید بکنید، یک تکس باکس باز کنید و بعد داخل آن این را بنویسد



<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity type="win32" processorArchitecture="*" version="6.0.0.0" name="mash"/>
<description>Enter your Description Here</description>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls" version="6.0.0.0"
language="*"
processorArchitecture="*"
publicKeyToken="6595b64144ccf1df"
/>
</dependentAssembly>
</dependency>
</assembly>


و بعد با نام VB6.exe.MANIFEST در محل برنامه ی ویژال بیسیک ذخیره کنید


C:\Program Files\Microsoft Visual Studio\Vb98



و حالا ويژوال بیسیک را اجرا کنید تمام

تشکر یادتون نره .........

[ali.rezaei7]

بابا نفر قبلی ترکوندی که.:متعجب: اصلا فکرشو نمی کردم کد به این معروفی رو بزاری.:لبخند:

نکته ویژوالي :

می دونید vb6 چه سالی عرضه شده؟ می دونید الان تو چه سالی هستیم؟ خبر دارید نسخه های جدید vb6 از سال 2001 در قالب یکی از زبان ها دات نت ارایه شده؟ اگه نمی دونید باید بگم که نسخه جدید vb6 از سال 2001 وارد بازار شده. هورااااااا!! .هنوزم دیر نشده بعد از گذشت 10 سال. فکر کنم این مهمترین نکته بود. نه؟ خدایی این تن بمیره این جوری نیست؟

نفر بعدی اگه قاتی باشه بامشت میاد تو صورتم، اگه هم نباشه حتما می خواد یه جواب دندون شیکن بهم بده

[محسن واژدی]

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

نکته: آیا میدانید که میتوانید با کلیک بر هر کدی و فشار دادن دو کلید ترکیبی Shift+F2 به سورس اون کد پرش کنید و مجددا با فشار دادن Ctrl+Shift+F2 به همان کد بازگردید بدون آنکه مجبور به جستجو در کدها باشید

نفر بعدی: یک ایرانی خردمند

[Hadirj]

بسی تاپیک جالبناکی هست

نکته ویژوالي :

برای غیرفعال کردن کیبرد و موس
' keyboard

Private Sub Command1_Click()
dim a
a=shell("rundll keyboard,disable")
End Sub

' mouse
Private Sub Command2_Click()
dim a
a=shell("RUNDLL MOUSE,DISABLE")
End Sub


برای اینکه دوباره کار کنند باید ریست کرد :لبخند:

نفر بعدی علاقه فراوانی به C داره

[farzad93]

نفر قبلی سخت در اشتباهی چون من علاقه ای به C ندارم

نکته ویژوالي :
برای خاموش کردن سیستم بعد از زمانی مشخص بر حسب ثانیه
Shell "shutdown -s -c " & comment.Text & " -t " & time.Text & ""

نفر بعدی حتما قبلا توی این تاپیک پست داده

[_behnam_]

100% پست دادم

نکته ویژوالي :

نفر بعدی یکارو میگم انجام بده
یک تکست باکس به فرمت اضافه کن مقدار top رو 12000 انتخاب کن بعد روی فرم کلیک کن.
الان دیگه تو فرم دیده نمیشه. اگه تونستی بیاریش :لبخند: منم بلد نیستم یاد منم بده

[ali.rezaei7]

اکِ هی بابا نفر قبلی شاهکاری بخدا. از اون combo box ی که بالا پنجره خواص هست، تکست رو انتخاب کن، بعدش درستش کن.

نکته ویژوالي :

اگه در هنگام تغییر اندازه یه کنترل، دکمه DELETE رو بزنی وی بی می پوکه.:لبخند:

نفر بعدی به حرفم گوش می کنه می ره سراغ دات نت

[www.pc3enter.tk]

نكته ويژوالي :

یک چیز خیلی جالب، هول نکنید
آیا می خواهید فرم شما آتش بگیره و بسوزه
خوب فقط این کد را کپی و پیست کنید

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 * 4)
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

و بعد اجرا، اگر قابلی نداشت تشکر یادتون نره

نفر بعدی کلی زور میزنه ببینه من این رو چه جوری نوشتم

[vbhamed]

سلام
نه راستش، ولي ممنون جالب بود

نكته ويژوالي :

گاهي اوقات به هر دليلي لازم ميشه يك فايل با حجم زياد ساخته بشه، با وي بي خيلي راحت ميشه اين كار رو انجام داد مثلا ساخت يك فايل 1 گيگابايتي در درايو E

Open "e:\sss" For Binary As #1
Put #1, 1000000000, " "
Close #1


نفر بعدي عيدت مبارك !!! :قلب:

[www.pc3enter.tk]

سلام

نکته ويژوالي :

به جای اینکه تایمر را با این دستور غیر فعال کنیم
timer1.enabel=false
می توانیم با این دستور همین کار را بکنیم
timer1=false

نفر بعدی هر چه زودتر بهتر

[vbhamed]

سلام

چشم نفر قبلي

نكته ويژوالي :

در تكميل نكته www.pc3enter.tk (http://www.pc3enter.tk) عزيز مي خوام بگم كه اكثر كنترلها يك خاصيت پيش فرض دارن مثلا براي TextBox خاصيت Text پيش فرض هست پس اگر تكست باكسي به نام Text1 داشته باشيم به جاي Text1.Text مي تونيم فقط Text1 رو بنويسيم
در مورد ساير كنترلهاي عمومي هم خاصيت هاي پيش فرض وجود داره كه من چند تاشون رو با مثال مي نويسم :


'CommandButton : Value , Command1 = True فشردن دكمه به صورت مجازي
'TextBox : Text , Text1 = "Test" متن درون جعبه متن
'Label : Caption , Label1 = "Test" متن برچسب
'ListBox : Text , MsgBox List1 متن سطر انتخاب شده
'ComboBox : Text , MsgBox Combo1 متن سطر انتخاب شده
'ScrollBar : Value , VScroll1 = 50 مكان اسكرول بار
'CheckBox : Value , Check1 = vbChecked حالت چك باكس
'OptionButton : Value , Option1 = True حالت دكمه راديويي
'Timer : Enabled , Timer1 = True روشن شدن تايمر
'PictureBox : Picture , Picture1 = Clipboard.GetData تصوير درون حافظه به پيكچر كپي شده
'Frame : Caption , Frame1 = "Test" متن عنوان قاب
'FileListBox : FileName , MsgBox File1 نام فايل انتخاب شده
'CommonDialog : Action , CommonDialog1 = 3 نمايش فرم انتخاب رنگ

اما در كل توصيه مي‌كنم از اين روش زياد استفاده نكنيد !

نفر بعدي از سفر برگشته داره دنبال نكته جديد در سال جديد مي گرده !

[www.pc3enter.tk]

نکته ويژوالي :

ابتدا از منوی View گزینه Toolbar و سپس customaize رو انتخاب کنید
سپس تب commands رو انتخاب کنید و از لیست زیرین Help رو انتخاب کنید و سپس از لیست روبرو گزینه About microsoft visual basic رو
درگ کنید روی تولبار اصلی برنامه و رهاش کنید و سپس روی او راست کلیک کنید و در قسمت نام عبارت Show VB Credits را وارد کنید و بعد
پنجره customaize رو ببندید و و روی دکمه کلیک کنید و لذت ببرید

نفر بعدي از يالا

[M.T.P]

نفر قبلی متوجه منظورتون از (نفر بعدی از یالا) نشدم :گیج:
اما به هرحال...

نکته ويژوالي (باگ) :

اگه در حین اجرای برنامه بخواهید style فرم رو تغییر بدید:


Me.BorderStyle = 0
قطعا اتفاقی نمیوفته و style فرم عوض نمیشه!!!
امتحان کنید.
حتی اگه یکبار فرم رو هم Refresh کنید.
چرا و به چه دلیل بماند... :اشتباه:

اما نگران نباشید...
با نوشتن کد زیر بعد از دستور بالا تغییرات اعمال خواهد شد:


Me.Caption = Me.Caption

نفر بعدی پیشاپیش از شما تشکر می کنم.

[aria1o]

با سلام خدمت دوستان

نکته ويژوالي :

از نکته های جالبتون متشکرم امیدوارم همچنان ادامه پیدا کنه و ما هم استفاده کنیم :قلب: من نکته ای ندارم ،ولی امید وارم این سایت براتون قابل توجه باشه

http://www.mvps.org/links.html#VisualBasic

[ali.rezaei7]

نكته ويژوالي :

اینم یه راهشه. جالب بود برام گفتم بزارم دوستان استفاده کنند.

Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Const GWL_STYLE As Long = (-16)
Private Const ES_NUMBER As Long = &H2000&

Call SetWindowLongPtr(Text1.hwnd, GWL_STYLE, GetWindowLongPtr(Text1.hwnd, GWL_STYLE) Or ES_NUMBER)


نفر بعدی استارتر تاپیک می باشد!، پ.ن:تاپیکو بعد گذشت سه قرن زنده کردم...

[vbhamed]

سلام

چشم نفر قبلي، گفتم روتو زمين نندازم !

نكته ويژوالي :
يك روش جستجوي بسيار جالب در كمبو باكس (حتما ببينيد)، يك كمبو باكس با خاصيت Style برابر 0 روي فرم بزاريد
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const CB_FINDSTRING = &H14C

Private Sub cmdExit_Click()

End

End Sub

Private Sub Combo1_Change()

Dim iStart As Integer
Dim sString As String

Static iLeftOff As Integer

iStart = 1
iStart = Combo1.SelStart

If iLeftOff <> 0 Then

Combo1.SelStart = iLeftOff
iStart = iLeftOff
End If

sString = CStr(Left(Combo1.Text, iStart))
Combo1.ListIndex = SendMessage(Combo1.hwnd, CB_FINDSTRING, -1, ByVal CStr(Left(Combo1.Text, iStart)))

If Combo1.ListIndex = -1 Then

iLeftOff = Len(sString)
Combo1.Text = sString
End If

Combo1.SelStart = iStart
iLeftOff = 0

End Sub

Private Sub Form_Load()

With Combo1

.AddItem "Ali"
.AddItem "Hamed"
.AddItem "Ahmad"
.AddItem "Reza"
.AddItem "Ali Reza"
.AddItem "Rahim"
.AddItem "Akbar"
.AddItem "Hamid Reza"
.AddItem "علي"
.AddItem "رضا"
.AddItem "عليرضا"
.AddItem "محمد"
.AddItem "حامد"
.AddItem "حميد"
.AddItem "احمد"
.AddItem "اكبر"
.AddItem "حميد رضا"

End With

End Sub

سلام نفر بعدي، خوبي، بفرما تو دم در بده !!!

[returnx]

O.k ، این نکته رو میزارم:

نكته ويژوالي :

تو VB6 خیلی راحت میشه یک کنترل رو به صورت RunTime ساخت ،به طور مثال:
یک پروژه جدید باز کنید و کد زیر رو توش کپی کنید:
Dim WithEvents Com As CommandButton
Dim m_com(10) As CommandButton
Dim k As String
Private Sub Form_Load()

Set Com = Me.Controls.Add("vb.commandbutton", "my_button")
With Com
.Left = Me.Width / 2
.Top = Me.Height / 2
.Visible = True
.Caption = "YES"
End With
End Sub
Private Sub Com_Click()

For i = 1 To 10
k = k & "p"
Set m_com(i) = Me.Controls.Add("vb.commandbutton", k)
Next i
For j = 1 To 10
With m_com(j)

.Visible = True
.Caption = "hello"
.Width = 400
If j > 1 Then
.Left = m_com(j - 1).Left + m_com(j - 1).Width + 10
End If
End With
Next j
End Sub

نفر بعدی یا این نکته رو میدونست ، یا نمیدونست مطمئنا از این دو حالت خارج نیست...:چشمک:

[pcdownload.bloghaa.com]

نكته ويژوالي :

هیچ میدونستین که الان زمان ویندوز 7 هست و ویندوز هشت هم تو راهه و توانایی مدیریت حافظه و گرافیک وی بی 6 پاسخ گوی نیازهای کاربران امروز نیست.
پس هرچه زودتر برید سمت vb.net یا با vb6 برای همیشه تفریحی برنامه بنویسید چون الان برنامه هاش خریدار نداره.(واقعیت تلخ)

نفر بعدی وقت خودتو تلف نکن همراه با تکنولوژی حرکت کن.

[محسن واژدی]

سلام


پس هرچه زودتر برید سمت vb.net یا با vb6 برای همیشه تفریحی برنامه بنویسید چون الان برنامه هاش خریدار نداره.(واقعیت تلخ)

چرا، داره :)



نفر بعدی وقت خودتو تلف نکن همراه با تکنولوژی حرکت کن.

از کجا میدونین با تکنولوژی حرکت نمیکنم ;)

نکته ویژوالی:
سعی کنید در همه حالات برای خارج شدن از برنامه از فشار دادن دکمه Stop اجتناب کنید، استفاده از دکمه stop همانند اجرای دستور End است و باعث میشود کدهای برنامه مرتب اجرا و خارج نشوند، خصوصا" زمانی که از subcalss در پروژه استفاده کرده اید چون اجرای دستور End یا فشار دادن دکمه stop بمنظور متوقف کردن پروژه نمیتواند آدرس اصلی فرم subclass شده را ذخیره کند در نتیجه vb متوقف شده و خارج میشود،
روش مناسب برای پایان دادن به یک برنامه unload کردن همه فرمها، غیرفعال کردن هر کنترل تایمر فعال، قبل از بسن فرم اصلی است، Nothing کردن فرم نیز همین عمل را انجام میدهد

نفر بعدی: فردی هست با یک نکته مفید ویژوالی

[محسن واژدی]

سلام
خودم نفر بعدی بودم و نمیدونستم

نکته ویژوالی:
آیا اطلاع داشتین که میتوان در زمان طراحی نیز دستورات نوشته شده را اجرا کرد بدون انکه پروژه را اجرا کنیم (F5)
1- برای نمونه یک Form با نام Form1 ایجاد میکنیم
2- داخل ماژول کد form1 یک روال عمومی نمونه زیر مینویسیم:

Public Sub my_msg(txt$)
MsgBox "Our text is : " & txt$, vbInformation
End Sub


دکمه Ctrl+G را فشار میدهیم تا فرم Immediate گشوده شود
آدرس روال را در این فرم نوشته و Enter میزنیم:

Form1.my_msg ("This is an sample")



یک نکته که در توضیحات بالا وجود دارد این است که همانند user-control ها برای اجرای توابع موجود در یک فرم حتما" بایستی محیط طراحی فرم بسته باشد در غیر اینصورت یک پیام خطا درمقابل اجرای فرم ظاهر میشود


نفر بعدی بدون شک یکی از اعضای فروم است

[MohammadGh2011]

سلام عليکم
:متفکر: بله منم يکي از اعضاي فورومم

نكته ويژوالي :
ميخوام نحوه تلفظ کلمات رو تو تکست باکس آموزش بدم
1)از منوي project در آخر References رو باز کنيد و گزينه ي Microsoft Speech Object Library رو انتخاب کنيد و OK رو بزنيد و داخل کامند کد زير رو بنويسيد

Dim Myspeech As New SpeechLib.SpVoice
Myspeech.Volume = 80
Myspeech.Speak (Text1.Text)
هر موقع داخل تکست باکس1 چيزي بنويسيد و روي کامند کليک کنيد براتون تلفظ ميشه


2)و يا ميتونيد از اين روش استفاده کنيد فقط کد زير رو تو کامند کپي کنيد.

Dim ras, sapi
ras = Text1.Text
Set sapi = CreateObject("sapi.spvoice")
sapi.Speak ras
Text1.SetFocus

نفر بعدي بهترين و جالب ترين مطلب از ويژوال بيسيک رو مطرح ميکنه

[محسن واژدی]

سلام علیکم
بله، احتمالا" این نکته باید جالب باشه

نکته ويژوالي (که نمیشه گفت نکته):
1- یک فرم ایجاد کرده، سپس در محیط آن دستگیره width را گرفته و تا اندازه ای که اسکرول بار پایین برنامه ظاهر شود پهنای فرم را افزایش میدهیم
2- اسکرول بار را گرفته و تا سمت راست بکشید تا اندازه ای که گوشه سمت راست فرم را ببینید
3- دوباره روی دستگیره کیک کرده و ان را به منتها الیه سمت چپ صفحه زمینه بکشید تا اندازه ای که اسکرول بار پایین مخفی میشود
4- حالا بر روی اسکرول بار کلیک کرده و آنرا تا اندازه ای که میتوانید به سمت چپ بکشید

چطور شد؟ :متعجب:

نفر بعدی هم با مراحل بالا موافقه

[amazon2]

وقتی انجامش دادم موافقت خودمو اعلام میکنم!

نکته ويژوالي:

نکاتی در مورد استفاده از چاپگر در ویژوال بیسیک

از جمله نکات:
چاپ محتویات یک RichTextBox
چاپ محتویات کل یک فرم
چاپ تصاویر
چاپ یک خط
چاپ متن
تنظیم قلم(فونت) چاپگر
چاپ متن در مکانی مشخص
اگر چاپگر خواص قلم را رعایت نکند
تنظیم مجدد چاپگر
چاپ متن تحت زاویه ای مشخص
چاپ یک صفحه وب
چاپ سریع چند کپی از یک سند
چاپ MSFlexGrid

http://78.38.187.11/3manage.com/learning/Printing.rar

نفر بعدی این پی دی افو دانلود میکنه و درآینده از دوستان من خواهد بود!

[returnx]

ما که کلا با شما موافقیم اما منظورتون رو از نکته نفهمیدم!! الان هدف شما مخفی شدن دوباره Scrollbar بود!؟

نکته ويژوالي :

خیلی ها با یک اندازه کردن کنترل های رو فرم مشکل دارن حالا شما به طور مثال 3 تا Textbox رو فرم بزارین یکی رو به اندازه مناسبی که مد نظرتون هست تبدیل کنید بعدش هم هر سه تا رو به ترتیب انتخاب کنید به طوری که Texbox که اندازش رو درست کردید و مد نظرتون هست رو آخر انتخاب کنید حالا به منوی Format برید و گزینه Make Same Size و بعدش هم گزینه ی Both رو انتخاب کنید میبینید دو textbox دیگه به راحتی هر چه تمام تر به اندازه Textbox اولی در اومده و یک اندازه شدند...

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

[MohammadGh2011]

سلام عليکم
اتفاقا برعکس من که خيلي حال کردم نميدونستم همين چيزي وجود داره
ممنونم که اينو گفتي و کار من رو آسون کردي
======================================

و کد آقاي واژدي

- یک فرم ایجاد کرده، سپس در محیط آن دستگیره width را گرفته و تا اندازه ای که اسکرول بار پایین برنامه ظاهر شود پهنای فرم را افزایش میدهیم
2- اسکرول بار را گرفته و تا سمت راست بکشید تا اندازه ای که گوشه سمت راست فرم را ببینید
3- دوباره روی دستگیره کیک کرده و ان را به منتها الیه سمت چپ صفحه زمینه بکشید تا اندازه ای که اسکرول بار پایین مخفی میشود
4- حالا بر روی اسکرول بار کلیک کرده و آنرا تا اندازه ای که میتوانید به سمت چپ بکشید

من هم نفهميدم منظور آقاي واژدي چيه!!!!!

نفر بعدي خود آقاي واژدي هستش که ميخواد در مورد کدشون توضيح بدن

[محسن واژدی]

اما منظورتون رو از نکته نفهمیدم!! الان هدف شما مخفی شدن دوباره Scrollbar بود!؟

سلام علیکم
اگر در ویندوز xp تست کنید، متوجه میشوید، اما در ویندوز 7 خیر، مشکلی نیست، نتیجه نکته بعد همان نتیجه ایست که در پست 133 اتفاق می افتد


نفر بعدي خود آقاي واژدي هستش که ميخواد در مورد کدشون توضيح بدن
دقیقا" درست بود :)

نکته ويژوالي (باز هم نمیشه گفت نکته):
یک شی مثلا" یک commandbutton بر روی فرم قرار بدین، سپس دستگیره هایش را گرفته و تغییر اندازه دهید، در حالی که هنوز دستگیره را رها نکرده اید دکمه Delete صفحه کلید را فشار دهید

باز چطور شد؟

نفر بعدی همان نتیجه ای را میگیرد که قرار بود در پست 135 اتفاق بیافتد ^_^

[محسن واژدی]

سلام


نفر بعدی همان نتیجه ای را میگیرد که قرار بود در پست 135 اتفاق بیافتد ^_^
بازم خودم نفر بعدی بودم و قبلا" نتیجه گرفته ام :)

نکته ويژوالي:
نمیدونم شما هم تاکنون با این مورد برخورد داشته اید یا نه؛ همانگونه که میدانیم برای دستیابی به خصوصیت یک شی یا type یا ... اگر پس از نام آن یک نقطه بگذاریم لیست خصوصیات در دسترس آن ظاهر میشود، زمانی هم وجود دارد که لیست خصوصیات بسته شده و ما میتوانیم با ctrl+space مجددا" لیست را نمایش دهیم
زمانی هم وجود دارد که دستور را نوشته ایم ولی با گذاشتن نقطه پس از آن لیست دستورات ظاهر نمیشود، به عنوان مثال قبلا" که نام فرم (Me) را مینوشتیم و نقطه می زدیم لیست متدهای فرم ظاهر میشد اما الآن هرکاری میکنیم این اتفاق نمی افتد، شاید بعضی از دوستان فکر کنند که ممکن است مشکل از برنامه باشد حال انکه اینطور نیست، چون این خود یکی از امکانات وی بی و یک نشانه و علامت است و باز نشدن لیست دستورات یا عدم نمایش ToolTip یک تابع (همون tooltipیی که بعد از نام یک تابع آرگومان دار با زدن space ظاهر میشود) و خیلی از موارد دیگر نشان از این دارد که خطایی در کدهای نوشته شده در روال فعلی وجود دارد، برای یافتن خطای مربوطه کافیست در همانجا یک لحظه F5 را فشار دهیم تا دستگیره خطا کدی که موجب این رفتار برنامه شده است را سریعا" آشکار کند

برای بهتر متوجه شدن موضوع یک CommandButton با نام Command1 بر روی فرم قرار میدهیم و کد های زیر را در فرم کپی میکنیم، سپس سعی میکنیم لیست متدهای Me را با نقطه گذاری پس از آن بدست بیاوریم، اما اینطور نمیشود اما وقتی F5 را فشار دهیم دلیل این بی تفاوتی وی بی را پیدا می کنیم:


Private Sub Command1_Click()
'
End Sub

Private Sub Command1_Click()
Me
End Sub


ببخشید خیلی موضوع را کش دادم:خجالت:

نفر بعدی اطلاعات مفیدی در زمینه وی بی دارند که قصد دارن در اختیار سایر دوستان هم بزارن

[returnx]

امیدوارم مفید باشه البته برای شما مفید نیست چون قطعا میدونید اما برای دوستانی که تازه شروع کردند قطعا مفیده...

نکته ويژوالي:

بعضی موقع ها ممکنه برنامتون به هر دلیلی تو یک حلقه بی پایان بیفته برای اینکه مجبور نشید VB6 رو Kill Proccess کنید میتونید از کلید های ترکیبی Ctrl+Pause استفاده کرده و برنامه رو متوقف کنید...
اما چطور میتونید یک حلقه بی نهایت تو VB6 درست کنید!؟
کسانی که با C++‎‎‎‎‎‎‎ کار کردند میدونند با نوشتن While(1) میتونن چنین حلقه ای رو ایجاد کنند اما درVb6 چطور !؟
در VB6 هم میشه به صورت بالا عمل کرد و هم به صورت زیر:
While True
Wend

نفر بعدی احتمالا خود جناب واژدی اند....

[محسن واژدی]

نفر بعدی احتمالا خود جناب واژدی اند....
بله، متاسفانه هنوز گرفتار بنده هستید :)

نکته ویژوالی:
1- بر روی Toolbars کلیک راست میکنیم و گزینه Customize را انتخاب میکنیم
2- پس از باز شدن فرم customize در نوار منو بر روی منوی Help کلیک میکنیم تا منو باز شود
3- بر روی گزینه آخر که "About Microsoft Visual Basic" باشد کلیک راست میکنیم
4- در منوی باز شده در گزینه Name نام "About Microsoft Visual Basic" را به "Show VB Credits" تغییر میدهیم
5- همه منو ها و فرم customize را میبندیم
6- به منوی Help رفته و بر روی "About Microsoft Visual Basic" که به "Show VB Credits" تغییرنام یافته است کلیک میکنیم تا فرم ...... ویژوال بیسیک گشوده شود

احتمالا" نفر بعدی فهمیدند جواب نقطه چین ها چی بود!

[returnx]

بله، متاسفانه هنوز گرفتار بنده هستید :):لبخند:نه بابا داریم استفاده میکنیم از تجربیاتتون...

احتمالا" نفر بعدی فهمیدند جواب نقطه چین ها چی بود!متاسفانه ، این یکی برای من تکراری بود...

نکته ویژوالی:

یکی از مشکلات Vb6 اینکه نمیشه از Cursor های انمیشنی استفاده کرد ، اما با کمک توابع API این امر قابل جبران ، برای استفاده از این نوع Cursor ها میتونید از کد های زیر استفاده کنید:
یک پروژه جدید ایجاد کنید و دو تا دکمه رو فرم بزارید و کد های زیر رو در پروژه کپی کنید:

Module:
'Add a module to your project (In the menu choose Project -> Add Module, Then click Open)
'Add 2 Command Buttons to your form.
'Press the first button to load the animated Cursor (move the cursor from the button to the
'form area to refresh the cursor).
'Press the second button to unload the cursor.
'Insert this code to the module :

Public Const GCL_HCURSOR = -12
Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Any) As Long
Declare Function LoadCursorFromFile Lib "user32" Alias _
"LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal _
hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal _
hwnd As Long, ByVal nIndex As Long) As Long

Form:
'Insert this code to your form:

Dim lResult As Long
Dim mhAniCursor As Long
Dim mhAniCursor2 As Long
Private Sub Command1_Click()
'Replace 'C:\windows\cursors\hourglas.ani' with your ANI Cursor
mhAniCursor = LoadCursorFromFile("C:\windows\cursors\hourglas.ani")
lResult = SetClassLong((hwnd), GCL_HCURSOR, mhAniCursor)
End Sub

Private Sub Command2_Click()
lResult = SetClassLong((hwnd), GCL_HCURSOR, mhBaseCursor)
lResult = DestroyCursor(mhAniCursor)
End Sub

Private Sub Form_Load()
mhBaseCursor = GetClassLong((hwnd), GCL_HCURSOR)
End Sub

Private Sub Form_Unload(Cancel As Integer)
lResult = SetClassLong((hwnd), GCL_HCURSOR, mhBaseCursor)
lResult = DestroyCursor(mhAniCursor)
End Sub


نفر بعدی احتمالا تو دلش گفته این کجاش نکته بود!؟ این خودش یک Source بود... ، باید بگم حق داره...

[محسن واژدی]

سلام



نفر بعدی احتمالا تو دلش گفته این کجاش نکته بود!؟ این خودش یک Source بود... ، باید بگم حق داره...

واقعیتش،،، بله یک سورس بود،
.
.
.
اما یک نکته هم قبلش بود :)

نکته ویژوالی:

در هنگام تست برنامه در صورت نياز به مشاهده عملکرد يک دستور کافيست اطراف آنرا انتخاب کنيم (منظورم زماني است که وقتي با موس متني را انتخاب ميکنيم اطراف آن آبي رنگ ميشود)، که در اين حال وي بي نتيجه دستور را در قالب يک tooltip نشان ميدهد (براي نمونه اگر "13+2" موجود در دستور a=13+2 را انتخاب کنيم متن tooltip ظاهر شده به اين صورت خواهد بود: 13+2=15)

البته نکاتي که خوب است اطلاع داشته باشيم:
- خط اجرايي برنامه حتما بايستي در همان روال قرار داشته باشد، مثلا اگر برنامه در روال Command1_Click قرار دارد و ما دستوري را در روال Command2_Click انتخاب کنيد نتيجه اي را نميبينيم
- اين اختيار منحصرا" مربوط به توابع و دستورات جزئي است (مانند Instr,Left,Right,Trim, محاسيات رياضي و خيلي دستورات مشابه اينها)
- از اين اختيار نميتوانيم براي ديدن نتيجه توابع خارجي مانند API ، کامپوننت ها و توابع داخلي که نيازمند مراجعه هستند، استفاده کنيم

نفر بعدي قبلا" از اين نکته اطلاع داشته

[محسن واژدی]

تست کردم نشد

کد زیر را در فرم کپی کنید و بعد فرم را اجرا کنید، و وقتی که برنامه در دستور stop ایست شد هریک از دستورات بالای stop را انتخاب و موس را روی آنها قرار بدین

Private Sub Form_Load()
Dim a%, txt_ps%
Const my_txt$ = "MySampleText"
a = 13 + 2 + 6 * 9
txt_ps% = InStr(1, my_txt$, "Sample")
Stop
End Sub

موفق باشید

[arenaw]

درست حدس زدید من هیچی نیستم :لبخند:

نكته ويژوالي :

آیا میدانستید دستورات ساده vb رو میشه با نوتپد و با پسوند .vbs ذخیره کرد و اونو بدون نصب vb اجرا کرد؟

نفر بعدي ... یک آقای دست راست، قد متوسط، موهای مشکی کم پشت، و همیشه دوغ رو به نوشابه ترجیح میده (حالا میبینی!)

[MohammadGh2011]

سلام عليکم
ميشه گفت تقريبا درسته

نکته ويژوالي(يا شايد سورس):

با سورس زير ميتونيد برنامتون رو در اجرا شدن محدود کنيد.کد زير رو تو فورم لود بزاريد.برنامه ي زير فقط 10 بار اجرا ميشود.
Dim RunCount As String
RunCount = GetSetting("Test1", "Setting1", "RunCount")
If Val(RunCount) > 10 Then
MsgBox "مهلت اجراي برنامه تمام شده است" , vbExclamation, "برنامه قابل اجرا نميباشد"
End
Else
SaveSetting "Test1", "Setting1", "RunCount", Str(Val(RunCount) + 1)
End If

فقط دوستان راه مطمئني براي امنيت برنامه هاتون نيستش.پيشنهاد ميکنم که در برنامه هايي که براتون مهم هست از اين کد براي امنيت يا تريال کردن استفاده نکنيد.

موفق باشيد

نفر بعدي يکي از عزيزاني هست که در اين صفحه(15)پست دادند، ميباشد

[ASedJavad]

سلام

متاسفانه اشتباه بود!!

نكته ويژوالي (که البته تکراری و بدیهی هست) :

ما سه فرمت متنی استاندارد داریم (که ویبی ازشون پشتیبانی میکنه):
یک: txt دو:rtf و سه:html
حالا فرض کنیم یه ریچ تکست باکس داریم که verbMenu اون رو غیرفعال کردیم و میخوایم خودمون براش یه منوی اختصاصی بنویسیم.
حالا برا منوی کپی اگه بنویسیم:
Private Sub MnuCopy_Click()
Clipboard.Clear
Clipboard.SetText RichTextBox1.SelText
End Sub

فقط متنمون کپی میشه و فرمتش کپی نمیشه
برا اینکه فرمتش هم کپی بشه و ما بتونیم تو ورد یا وردپد یا یه ریچ تکست باکس دیگه متنمون رو به همراه فرمتش پیست کنیم، باید بنویسیم:
Private Sub MnuCopy_Click()
Clipboard.Clear
Clipboard.SetText RichTextBox1.SelRTF, vbCFRTF
Clipboard.SetText RichTextBox1.SelText, vbCFText
End Sub

که این باعث میشه اگه خواستیم تو نت پد یا تکست باکس معمولی متن رو پیست کنیم، فقط تکستمون کپی بشه و اگه خواستیم تو ورد یا ... پیست کنیم، فرمتش هم پیست بشه.
مسلما برا html هم مشابه همین قضیه رو داریم


نفر بعدی اگرچه میدونه باید کم کم از ویبی نقل مکان کنه، ولی هنوز دلش نمیاد!

[arenaw]

ایول :لبخند:

نكته ويژوالي :

میدونید تو ویبی تا هرچند خط که دوست دارید رو تو یه خط جا بدید؟ فقط باید دستورات رو با : جدا کنید. به جز برخی موارد خاص ؛ مثلا استفاده if تو for و بعضی جاهای دیگه

نفر بعدي ... یک آقایی که زود به زود ویندوزشو عوض میکنه! اسم یکی از اقوام نزدیکشم علی اِ

[kitcat_m18]

من ويندوزم رو حداقل 6 ماه يه بار عوض مي کنم متاسفانه اقوام هم ندارم!

نكته ويژوالي :

مرجع کتابخانه regular expression چيست؟

درباره خود regular expression اينو بايد بگم که در واقع کتابخانه افعال باقاعده هست
مرجع اون سيستم عامل لينوکسه با دستور RegEx که دقيقا از اين کتابخانه استفاده ميکنه شما با مطالعه دستورات افعال باقاعده در لينوکس مي تونين اين کتابخانه رو در وي بي هم به خوبي به کار ببريد

نفر بعدي يه نفر بيشتر نيست!

[kitcat_m18]

کاملا درسته! :متعجب:

نكته ويژوالي :

براي ديباگ کردن برنامه هامون چند را وجود داره:

1 - اضافه کردن چرت و پرت به اول کدهامون که ديباگر ارور بگيره(مبتدي ها)
2 - استفاده از دکمه F8 که همه جا جواب نميده مخصوصا تو برنامه هايي که داراي تايمر و يا رويداد هاي تکرار شدني(Mouse Movie) هستند
2 - استفاده از دستور Debug.Assert False براي ديباگ دقيقا همان خط کدي که مي خواهيم
3 - استفاده از دستور Stop براي ديباگ دقيقا همان خط کدي که مي خواهيم

نفر بعدي 120 کيلو پرس سينه ميزه!

[kitcat_m18]

آفرين بر شما دوست عزيز(خودم)

نكته ويژوالي :

مرجع دستورات WebBrowser چيست؟

شايد براي شما هم اين سوال پيش اومده باشه که دستورات WebBrowser که داراي Library در ويژوال بيسيک نيستند رو از کجا در بيارم؟؟
خيلي سادست اينا دستورات زبان جاوا هستند جاوا ياد بگير کل پارامتر هاي ارسالي از طريق WebBrowser رو فول ميشي :لبخند:
در واقع شما ر دستوري مانند WebBrowser1.Document.Forms(0).elements("chkSave").Click دستورات جاوا رو قاطي VB استفاده کرديد!

چون دوست ندارم اشتباه حدس بزنم نفر بعدي خيلي وقته 6 سالش تموم شده :لبخند: بيا لپتو بکشم عمو :قلب:

[ASedJavad]

سلام

نكته ويژوالي :
تو ویبی چهار راه داریم برا اینکه بفهمیم یه رشته خالیه یا نه مثلا فرض کنیم متغیری به اسم x از نوع string داریم.
چهار دستور زیر به ما میگن که این رشته خالیه یا نه:
If x = "" Then
If x = vbNullString Then
If Len(x) = 0 Then
If LenB(x) = 0 Then
ظاهرا از نظر حجمی که دستورات از حافظه اشغال میکنن
به ترتیب دستور اول بیشترین حجم و دستور آخر کمترین حجم رو اشغال میکنن.
از نظر سرعت هم میتونین کد زیر رو اجرا کنین تا بفهمین فرقشون چیه:
Private Sub Form_Load()
Me.AutoRedraw = True
Dim x As String
x = ""
z = Timer
For i = 1 To 50000000
If x = "" Then a = 1
Next
Print Timer - z
z = Timer
For i = 1 To 50000000
If x = vbNullString Then a = 1
Next
Print Timer - z
z = Timer
For i = 1 To 50000000
If Len(x) = 0 Then a = 1
Next
Print Timer - z
z = Timer
For i = 1 To 50000000
If LenB(x) = 0 Then a = 1
Next
Print Timer - z
End Sub
درسته که این اختلاف سرعت و اختلاف حافظه تو کامپیوترای امروزی کمترین اهمیتی نداره ولی نکته جالبی بود که بیان کردنش رو بیضرر دونستم!

نفر بعدی هم خودمم چون یه نکته دیگه هم در همین رابطه دارم

[ASedJavad]

آفرین به خودم درست حدس زدم!

نكته ويژوالي :
برای اختصاص یک رشته خالی به یک متغیر رشته ای مثل x دو دستور عمده داریم:

x = ""
x = vbNullString

که دستور دوم هم از نظر حافظه به صرفه تر است (به نظرم 6 بایت اختلاف حافظه دارن) و هم از نظر سرعت که در مورد سرعت کد زیر به خوبی بیانگر مطلب هست:

Private Sub Form_Load()
Dim x As String
Me.AutoRedraw = True
z = Timer
For i = 1 To 10000000
x = ""
Next
Print Timer - z
z = Timer
For i = 1 To 10000000
x = vbNullString
Next
Print Timer - z
End Sub

نفر بعدی با خودش میگه این اختلاف سرعت و حافظه تو کامپیوترای امروزی اصلا به چشم نمیاد
که باید بهش بگم ما مغزمون تو دوره کامپیوترای دیزلی و حافظه های در حد فلاپی شکل گرفته و کاریش هم نمیشه کرد!

[_behnam_]

نفر قبلی جوابی ندارم بدم :بامزه:

نكته ويژوالي :

هرچی فکر میکنم نکته ای به ذهنم نمیرسه اما یه نکته میگم که از هیچی بهتره
نکته : این مسنجرا که میبینید واسه صفحه چت از تکست باکس استفاده نمیکنن اصلا نمیشه توی تکست باکس عکس گذاشت
وب بروزر هستش
حالا هی بیاید توی فروم سوال کنید که چطور میشه توی تکس باکس عکس گذاشت

نفر بعدی حتما میگه : با این نکتت :لبخند:

[محسن واژدی]

نفر قبلی: نه نمیگم :)
نکته مفیدی بود، چرا که برخی عزیزان اطلاع ندارند که در فروم مطرح میکنند!

نکته ویژوالی
البته در ادامه نکته جناب kitcat_m18 در پست 152 است:


نكته ويژوالي :

براي ديباگ کردن برنامه هامون چند را وجود داره:
1 - اضافه کردن چرت و پرت به اول کدهامون که ديباگر ارور بگيره(مبتدي ها)
2 - استفاده از دکمه F8 که همه جا جواب نميده مخصوصا تو برنامه هايي که داراي تايمر و يا رويداد هاي تکرار شدني(Mouse Movie) هستند
2 - استفاده از دستور Debug.Assert False براي ديباگ دقيقا همان خط کدي که مي خواهيم
3 - استفاده از دستور Stop براي ديباگ دقيقا همان خط کدي که مي خواهيم

4- در ساده ترین صورت میتوانیم بر روی دستور مورد نظر یک Break-Point را با کلیک در ستون کناری و سمت دستور یا انتخاب دستور و فشار دادن کلید F9 ایجاد میکنیم، در این هم برنامه با رسیدن به دستور مشخص شده متوقف میشود (البته این نقاط موقتی بوده و با بستن سورس پروژه از بین میروند)

نفر بعدی: یک ایرانی اصیل

[محسن واژدی]

معلوم نیست :)

نکته ویژوالی :

راه میانبر در نوشتن متد Print، قبل از نوشته کاراکتر "؟" قرار دهیم
به عنوان مثال:
?"Sample text"
یا

Me.?"Sample text"


نفر بعدی: عبدالله

[ali-a2]

سلام

نكته ويژوالي :

نکته که دوستان زیاد گذاشتن دیگه چیزی به ذهنم نمیرسه به جاش یه سورس میزارم .
سورس برنامه ی Yahoo Multi Login
89720

نفر بعدي : حسین سون

[vbhamed]

سلام

شرمنده ali-a2
butterfly8528 (http://barnamenevis.org/member.php?75627-butterfly8528) عزيز يه كم دير ديدم تاپيك رو

نكته ويژوالي :

يك مشكلي كه تو اكثر برنامه ها داريم اينه كه وقتي داره كار زمانبري انجام ميشه كه تغييراتش روي صفحه هم منعكس ميشه، سرعت كار پايين مياد و تغييرات فرم به چشم ديده ميشه
به عنوان مثال شما مي‌خواين وقتي فرمتون تغيير سايز داد، اجزاي روي اون هم متناسب با فرم كوچيك يا بزرگ بشه و اگر تعداد اين اجزا زياد باشه كار كند پيش ميره و كاربر اونو مي‌بينه

براي اين موارد اگر ميشد آپديت فرممون رو متوقف كنيم تا كارها انجام بشه و سپس نتيجه نهايي رو ببينيم خيلي بهتر بود
تابع API زير براي اينكار وجود داره
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
روش كار به اينصورت هست
تابع رو به صورت زير فراخواني كنيد
LockWindowUpdate Me.hwnd
با اينكار انگار فرمتون قفل شده و هيچ تغييري روي اون نمايش داده نميشه، البته شكل قبليش همچنان روي صفحه است
حالا شما تغييرات روي فرم و اشياء رو انجام بدين و بعد دستور زير رو بدين
LockWindowUpdate 0
اين دستور فرم رو از حالت قفل در مياره و همه تغييرات داده شده رو يكجا منعكس مي‌كنه

البته همونطور كه تو دستورات ديديد اين تابع با استفاده از هندل اشياء اونها روئ قفل مي‌كنه پس نه فقط فرم بلكه هر شي‌ئي قابل قفل شدن هست و مثلا مي‌تونيد فقط يك پيكچر باكس يا گرايد يا ... رو قفل كنيد
اما دستور باز كردن قفل همون پارامتر 0 هست كه همه اشياء قفل شده رو يكجا باز مي‌كنه

نفر بعدي شايد خيلي اين نكته رو لازم داشت !!؟؟

[R2du-soft]

سلام
خوب تند تند چک کن مطالب رو تا سریعتر ببینی تاپیک ها رو!!

نكته ويژوالي :

اگر از دستور شرط میخواهید استفاده کنید و چندید if در برنامتون تعریف کردید ، اگه اولین if چک کردن یم مقدار باشه و میخواید بگید که اول برابر نبودنش رو چک کنه میتونید از دستور زیر استفاده کنید

If Not UCase(Left(Text.Text, 4)) = "reza" Then

msgBox ("barabar nist")

else

msgBox ("barabar hast")

و بعد تعریف if ها

این دستور برای پیچوندن برنامه کاربرد داره
شاید متوجه نشید و بگید که از کد

If UCase(Left(Text.Text, 4)) <> "reza" Then

هم میشه استفاده کرد
ولی بعضی جاها نمیشه از این دستور استفاده کرد و گیر میکنید ، میتونید از این دستور استفاده کنید
نمیدونم تونستم خوب توضیح بدم یا نه !!!! ولی من خودم به مشکل خوردم و ازش استفاده کردم و مشکلم رفع شد.
مرسی از استادی که این دستور رو بهم یاد داد و همیشه دعاش میکنم
فکر کنم تومار نوشتم !!!

نفر بعدي یه دوست خوب

[رامین مرادی]

سلام آره منم یه دوست خوب واسه سایت برنامه نویس

نکته ویژوالي :

اینم یه تکه کد جالب که می تونه بارکد 39 رو ایجاد کنه شی ورودی یه پیکجر باکس هستش


Sub DrawBarcode(ByVal bc_string As String, obj As Object)

Dim xpos!, Y1!, Y2!, dw%, Th!, tw, new_string$
If bc_string = "" Then obj.Cls: Exit Sub
'define barcode patterns
Dim bc(90) As String
bc(1) = "1 1221" 'pre-amble
bc(2) = "1 1221" 'post-amble
bc(48) = "11 221" 'digits
bc(49) = "21 112"
bc(50) = "12 112"
bc(51) = "22 111"
bc(52) = "11 212"
bc(53) = "21 211"
bc(54) = "12 211"
bc(55) = "11 122"
bc(56) = "21 121"
bc(57) = "12 121"
'capital letters
bc(65) = "211 12" 'A
bc(66) = "121 12" 'B
bc(67) = "221 11" 'C
bc(68) = "112 12" 'D
bc(69) = "212 11" 'E
bc(70) = "122 11" 'F
bc(71) = "111 22" 'G
bc(72) = "211 21" 'H
bc(73) = "121 21" 'I
bc(74) = "112 21" 'J
bc(75) = "2111 2" 'K
bc(76) = "1211 2" 'L
bc(77) = "2211 1" 'M
bc(78) = "1121 2" 'N
bc(79) = "2121 1" 'O
bc(80) = "1221 1" 'P
bc(81) = "1112 2" 'Q
bc(82) = "2112 1" 'R
bc(83) = "1212 1" 'S
bc(84) = "1122 1" 'T
bc(85) = "2 1112" 'U
bc(86) = "1 2112" 'V
bc(87) = "2 2111" 'W
bc(88) = "1 1212" 'X
bc(89) = "2 1211" 'Y
bc(90) = "1 2211" 'Z
'Misc
bc(32) = "1 2121" 'space
bc(35) = "" '# cannot do!
bc(36) = "1 1 1 11" '$
bc(37) = "11 1 1 1" '%
bc(43) = "1 11 1 1" '+
bc(45) = "1 1122" '-
bc(47) = "1 1 11 1" '/
bc(46) = "2 1121" '.
bc(64) = "" '@ cannot do!
'A Fix made by changing 65 to 42.
bc(42) = "1 1221" '*
bc_string = UCase(bc_string)
'dimensions
obj.ScaleMode = 3 'pixels
obj.Cls
obj.Picture = Nothing
dw = CInt(obj.ScaleHeight / 40) 'space between bars
If dw < 1 Then dw = 1
'Debug.Print dw
Th = obj.TextHeight(bc_string) 'text height
tw = obj.TextWidth(bc_string) 'text width
new_string = Chr$(1) & bc_string & Chr$(2) 'add pre-amble, post-amble

Y1 = obj.ScaleTop
Y2 = obj.ScaleTop + obj.ScaleHeight - 1.5 * Th
obj.Width = 1.1 * Len(new_string) * (15 * dw) * obj.Width / obj.ScaleWidth


'draw each character in barcode string
xpos = obj.ScaleLeft
For n = 1 To Len(new_string)
c = Asc(Mid$(new_string, n, 1))
If c > 90 Then c = 0
bc_pattern$ = bc(c)

'draw each bar
For i = 1 To Len(bc_pattern$)
Select Case Mid$(bc_pattern$, i, 1)
Case " "
'space
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw

Case "1"
'space
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
'line
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &H0&, BF
xpos = xpos + dw

Case "2"
'space
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw
'wide line
obj.Line (xpos, Y1)-(xpos + 2 * dw, Y2), &H0&, BF
xpos = xpos + 2 * dw
End Select
Next
Next

'1 more space
obj.Line (xpos, Y1)-(xpos + 1 * dw, Y2), &HFFFFFF, BF
xpos = xpos + dw

'final size and text
obj.Width = (xpos + dw) * obj.Width / obj.ScaleWidth
obj.CurrentX = (obj.ScaleWidth - tw) / 2
obj.CurrentY = Y2 + 0.25 * Th
obj.Print bc_string
End Sub
نفر بعدی میگه ای ول به این کد جالب میگه چه پست درازی

[امین مستانی]

سلام

من اولین باره که دارم تو این بازی آموزنده شرکت میکنم . خیلی جالبه

نکته ویژوالي :

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

Private Sub Command1_Click()
Dim newfrm As Form1
Set newfrm = New Form1
newfrm.Visible = True
End Sub

نفر بعدی الان روزه هست :)

[ali586]

آره اگه خدا قبول کنه

نکته ویژوالی :

میدونید برای برنامه نویسی هر وقت کارتون گیر کرد از کلک مرغابی میتونی استفاده کنید
برای اینكه همیشه فرمتون وسط صفحه نمایش داده بشه حالا با هر resolution میتونید وارد خصوصیت فرم بشین و قسمت StartupPosition = 2 بذارین

نفر بعدی خواهشن تو این ماه مبارک منم دعا کن

[setroyd]

Private Sub Text1_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 8, 48 To 58:
Case Else
KeyAscii = 0
End Select
End Sub

اینم یه روش برای محدود کردن نوشته در textbox فقط به عدد بدون استفاده از if .

[program2vb]

سلام ..ههههههه کی فکرشو میکرد نفر بعد من باشم ... صبح از ساعت 9 دارم اینجا رو میخونم واقعا جالب بود آقای VBhamed عزیز ممنون
خیلی وقته این تاپیک رو میدیدم و همینجوری رد میشدم و تا حالا تو نیومده بودم امروز برای اولین بار اومدم و خیلی خوشم اومد از این به بعد نفر بعدی هر روز خودم هستم با نکته های جدید :لبخند:

جواب نفر قبل :

شر منده داداش سعید من تا حالا sql کار نکردم سوالتو نفربعد من اگه sql بلد باشه جواب میده ببخش شرمنده دیگه .....

نكته ويژوال :

میدونستین با استفاده از تابع ApI زیر میتونین تصویر زمینه ویندوز رو به فرمتون بدین :


Private Declare Function PaintDesktop Lib "user32.dll" (ByVal hdc As Long) As Long


و میتونین با استفاده از این کد از این تابع استفاده کنین البته پیشنهاد میکنم از یه تایمر با مقدار زمانی یک میلی ثانیه استفاده کنین و کد رو درون تایمر قرار بدین


PaintDesktop Me.hdc


براتون آرزوی موفقیت و پیروزی دارم . یا علی

نفر بعدي ...

با این شرایطی که این تاپیک میره جلو احتمالا نفر بعدی خودم باشم چون فردا دوباره میام :چشمک:
ولی اگه یکی دیگه باشه لطفا به سوال نفر قبل من جواب بده
احتمالا نفر بعدی خیلی آدم خوش شانسیه ...... :لبخند:

[program2vb]

سلام من نفر بعدی هستم :لبخند:

نكته ويژوالي :

آیا میدونستین با استفاده از تابع api زیر میتونین همون کار KeyDown رو انجام بدین ولی اینم بگم ها این قدرتش از KeyDown فرمتون بهتر عمل میکنه و اگه برنامه حتی فکش نباشه بازم کار میکنه

کد زیر رو در قسمت جنرال فرم قرار بدین :


Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer 'Key press API


حالا یدونه تایمر درس کنین با مقدار زمانی 100 میلی ثانیه و توش کد زیز رو بنویسید


If GetAsyncKeyState(vbKeyLeft) <> 0 Then
Shape1.Left = Shape1.Left - 10
End If


بجای Vbkeyleft میتونین هر کلیدی که خواستین بنویسید یا keyCode کلید رو بنویسید

موفق و پیروز باشید یا علی

نفر بعدی هم احتمالا بازم خودم خواهم بود .....

[setroyd]

Private Declare Function PrintWindow Lib "user32" (ByVal hWnd As Long, ByVal hdcBlt As Long, ByVal nFlags As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub Form_Load()
Dim mWnd As Long

Me.AutoRedraw = True
Shell "Notepad.exe", vbNormalNoFocus
DoEvents
mWnd = FindWindow("Notepad", vbNullString)
If mWnd = 0 Then
Me.Print "NotePad not found"
Else
PrintWindow mWnd, Me.hDC, ByVal 0&
'PrintWindow mWnd, Printer.hDC, ByVal 0&
End If
End Sub

با استفاده از کد بالا پنجره ی مورد نظر رو یه snap shot میشه از روش گرفت با PrintWindow و دادن هندل مورد نظر این کار به راهتی این کار شدنی است حتی اگر پنجره minimize باشد .

[program2vb]

به به سلام آقای setroyd داداش نیستی کم پیدا شدی یا ما کم سعادت شدیم
داداش نگفتی نفر بعدی کیه ؟
خب باشه نگو احتمالا میدونستی منم که نگفتی خودم اومدم مهم نیس

نكته ويژوالي :

آیا میدونستین میشه بدون اینکه زبان ویندوز ( keylayout ) رو تغییر داد بشه درون تکس باکس فارسی نوشت :چشمک:

البته این یه روش شاید بعضیهاتون بدونین اونایی که نمیدونن خب اونا هم بدونن

یه پروژه جدید باز کنید .... یدونه تکس باکس بزارین داخل فرم تو بخش کد نویسی کد زیر رو کپی کنید ... برنامه رو اجرا کنید ... حالا داخل تکس باکس بنویسید .... حال کنید :لبخند:


Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 72 Then KeyAscii = 194
If KeyAscii = 104 Then KeyAscii = 199
If KeyAscii = 102 Then KeyAscii = 200
If KeyAscii = 92 Then KeyAscii = 142
If KeyAscii = 106 Then KeyAscii = 202
If KeyAscii = 101 Then KeyAscii = 203
If KeyAscii = 91 Then KeyAscii = 204
If KeyAscii = 93 Then KeyAscii = 141
If KeyAscii = 112 Then KeyAscii = 205
If KeyAscii = 111 Then KeyAscii = 206
If KeyAscii = 110 Then KeyAscii = 207
If KeyAscii = 98 Then KeyAscii = 208
If KeyAscii = 118 Then KeyAscii = 209
If KeyAscii = 99 Then KeyAscii = 210
If KeyAscii = 96 Then KeyAscii = 129
If KeyAscii = 115 Then KeyAscii = 211
If KeyAscii = 97 Then KeyAscii = 212
If KeyAscii = 119 Then KeyAscii = 213
If KeyAscii = 113 Then KeyAscii = 214
If KeyAscii = 120 Then KeyAscii = 216
If KeyAscii = 122 Then KeyAscii = 217
If KeyAscii = 117 Then KeyAscii = 218
If KeyAscii = 121 Then KeyAscii = 219
If KeyAscii = 116 Then KeyAscii = 221
If KeyAscii = 114 Then KeyAscii = 222
If KeyAscii = 59 Then KeyAscii = 152
If KeyAscii = 39 Then KeyAscii = 144
If KeyAscii = 103 Then KeyAscii = 225
If KeyAscii = 108 Then KeyAscii = 227
If KeyAscii = 107 Then KeyAscii = 228
If KeyAscii = 44 Then KeyAscii = 230
If KeyAscii = 105 Then KeyAscii = 229
If KeyAscii = 100 Then KeyAscii = 237
If KeyAscii = 109 Then KeyAscii = 198
If KeyAscii = 57 Then KeyAscii = 49
End Sub


موفق و پیروز و سربلند باشید .... یا علی

نفر بعدی به احتمال زیاد آقای setroyd خواهد بود ...

[setroyd]

نكته ويژوالي :

به دست آوردن rgb با api

Private Declare Function LoByte Lib "TLBINF32" Alias "lobyte" (ByVal Word As Integer) As Byte
Private Declare Function HiByte Lib "TLBINF32" Alias "hibyte" (ByVal Word As Integer) As Byte
Private Declare Function loword Lib "TLBINF32" (ByVal DWord As Long) As Integer
Private Declare Function hiword Lib "TLBINF32" (ByVal DWord As Long) As Integer

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Color As Long
Dim R As Byte, G As Byte, B As Byte
Color = Point(X, Y)
R = LoByte(loword(Color))
G = HiByte(loword(Color))
B = LoByte(hiword(Color))
Me.Caption = R & Space(5) & G & Space(5) & B
End Sub


یه عکس رو فرم بزارید و موس رو حرکت بدید حالا کد rgb رو ببنید روی caption فرمتون .

[vbhamed]

سلام

كاربران گرامي saeedharati (http://barnamenevis.org/member.php?216300-saeedharati) و setroyd (http://barnamenevis.org/member.php?183390-setroyd) عزيز
لطفا قوانين پست دادن و رنگ بندي در اين تاپيك رو رعايت كنيد

جواب نفر قبلي
نكته ويژوالي :
نفر بعدي...

[saber67]

نکته ویژوالی:

اگه می خواین فرمتون تو یه رنج خاص تغییر اندازه بده و از اون کوچیکتر یا بزرگتر نشه مثلا از 200x200 کوچیکتر نشه و از 500x500 بزرگتر نشه

یه ماژول بسازید و کد زیر رو توش کپی کنید:

Private Const GWL_WNDPROC = -4
Private Const WM_GETMINMAXINFO = &H24

Private Type POINTAPI
x As Long
y As Long
End Type

Private Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type

Global lpPrevWndProc As Long
Global gHW As Long

Private Declare Function DefWindowProc Lib "user32" Alias _
"DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam 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 Sub CopyMemoryToMinMaxInfo Lib "KERNEL32" Alias _
"RtlMoveMemory" (hpvDest As MINMAXINFO, ByVal hpvSource As Long, ByVal cbCopy As Long)
Private Declare Sub CopyMemoryFromMinMaxInfo Lib "KERNEL32" Alias _
"RtlMoveMemory" (ByVal hpvDest As Long, hpvSource As MINMAXINFO, ByVal cbCopy As Long)

Public Sub Hook()
'Start subclassing.
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
AddressOf WindowProc)
End Sub

Public Sub Unhook()
Dim temp As Long

'Cease subclassing.
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub

Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim MinMax As MINMAXINFO

'Check for request for min/max window sizes.
If uMsg = WM_GETMINMAXINFO Then
'Retrieve default MinMax settings
CopyMemoryToMinMaxInfo MinMax, lParam, Len(MinMax)
'Specify new minimum size for window.
MinMax.ptMinTrackSize.x = 200
MinMax.ptMinTrackSize.y = 200

'Specify new maximum size for window.
MinMax.ptMaxTrackSize.x = 500
MinMax.ptMaxTrackSize.y = 500

'Copy local structure back.
CopyMemoryFromMinMaxInfo lParam, MinMax, Len(MinMax)
WindowProc = DefWindowProc(hw, uMsg, wParam, lParam)
Else
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, _
wParam, lParam)
End If
End Function

تو فرم برنامه هم کد زیر رو کپی کنید:

Private Sub Form_Load()
'Save handle to the form.
gHW = Me.hwnd
'Begin subclassing.
Hook
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Stop subclassing.
Unhook
End Sub


نفربعدی حتما به شهر کرمانشاه اومده، بیستون و طاق بستان رو دیده

[unit001]

نه اتفاقا نیومدم و ندیدم:بامزه: ولی از تلویزیون خیلی دیدم

نکته ویژوالی :

می دونستین از کد زیر می تونین برای اینکه یه متن شبیه یه متن دیگه هست استفاده کنید. مثلا من دیدم بعضیا می خوان چک کنن یه متنی ایمیل هست یا نه کلی کد نویسی می کنن:
If "YOURTEXT" Like "*@*.*" Then
' The Email is correct
End If

نفر بعدي فکر کنم Saber67 باشه چون رفته زحمت کشیده این تاپیکو آورده صفحه ی اول. شایدم چون می‌خواد بگه چرا تا حالا نیومدی کرمانشاه.:لبخند:

[saber67]

واقعا نیومدی؟ ای بابا! چرا!؟
حتما عید با خانواده تشریف بیارین:لبخند:

نکته ویژوالی:

تا حالا برنامه هایی که شکل یه فرم عادی رو ندارن دیدین؟ مثلا شکل یه گل یا یه ماشین باشه! یا هر عکسی!
برای این کار کافیه عکسی که می خواین برنامه تون به شکل اون بشه رو تو یه زمینه تک رنگ (که رنگش با رنگای اون عکس فرق داشته باشه) قرار بدین و اون عکس رو به عنوان بک گراند فرم تون قرار بدین و از کد های زیر استفاده کنین:

اینا رو توی فرم اصلی کپی کنین و اجرا کنین ببینین چی میشه!

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.dll" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Const LWA_COLORKEY = &H1
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Const BM_SETSTATE = &HF3

Private Sub Form_Load()
Dim Ret As Long
Dim CLR As Long
Me.BackColor = RGB(1, 1, 1)
CLR = Me.BackColor
Ret = GetWindowLong(Me.hWnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED
SetWindowLong Me.hWnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes Me.hWnd, CLR, 0, LWA_COLORKEY
End Sub

نفر بعدی unit001 هستش، می خواد بگه حتما واسه عید میاد کرمانشاه :چشمک:

[unit001]

نه بابا عید باید بریم شهرستان خودمون!! (اگه تونستم میام)

نکته ویژوالی :
ای بابا آدمو مجبور می کنید نکته بگه ها!
می دونستید تو ویندوز 7 (حالا دقیقا نمی دونم رو همشون یا بعضیاش) ویژوال بیسیک خاصیت Right to left ش کار نمی کنه. برای درست کردن اون باید یه Fix رو از سایت مایکروسافت بگیرید و روی ویندوزتون نصبش کنید.

نفر بعدی Saber67 که می خواد گیر بده بگه پاشو بیا کرمانشاه و بحث رو به درازا بکشونه!!:چشمک:

[SlowCode]

دوستان لطفا حرفاتونو یا پیغام خصوصی رد و بدل کنین چون به نظر میرسه تاپیک داره به هم میخوره و بار علمیش هم میاد پایین، البته جسارت نشه.

نکته ویژوالی:

میدونستین با متد AppActivate میشه روی یه برنامه فوکوس کرد؟مثال:
AppActivate "chrome"

نفر بعدی : احتمالا بهم گیر میده:لبخند:

[saber67]

آفرین منم می خواستم بگم محسن سوخته! چون نکته نگفته:چشمک:

نکته ویژوالی:

برای جلوگیری از اینکه کاربر نتونه برنامه تون رو به صورت هم زمان چندین بار اجرا کنه توی اولین فرمی که لود میشه از کد زیر استفاده کنین:


Private Sub Form_Load()
If App.PrevInstance Then
Unload Me
End If
End Sub

نفر بعدی unit001 هست که می خواد بگه به کسی نگم سوخته، باشه نمیگم بین خودمون می مونه:لبخند:

[unit001]

ها!!:متعجب: خوب شده نگفتیا!!:اشتباه:

نکته ی ویژوالی:

بعضی ها برای به دست آوردن آدرس فایل VB از کد App.Path خالی استفاده می کنند در حالی که این آدرس بدون \ در آخر آدرس هست و باید یه دونه \ آخرش بزارید. ولی همیشه بدون \ نیست, مثلا وقتی فایل exe که کامپایل شده توی درایو C باشه آدرس رو به صورت
C:\ نشون می ده که \ آخرش هست. پس بهتره چی کار کنیم؟ مثلا می تونیم از تابع زیر استفاده کنیم!
Public Function GetAppPath() As String
IIf Right(App.Path,1) = "\", GetAppPath=App.Path, GetAppPath=App.Path & "\"
End Function
وقتی از تابع بالا استفاده کنیم همیشه آدرس فایل Exe رو با \ داریم.

نفر بعدی : نمی دونم شاید یکی از مدیران عزیز باشه

[SlowCode]

نه بابا مدیر کجا بود!

نکته ویژوالی :

با تابع VarType می تونیم نوع متغیر رو بدست بیاریم، مثلا:

s=0.21455
Msgbox VarType(s)

خروجی میشه 5 و با توجه به مقادیر زیر میشه Double:
VbEmpty=0 , VbNull=1 , VbInteger=2 , VbLong=3 , VbSingle=4 , VbDouble=5 , VbCurrency=6 , Vbdate=7 , VbString=8 , VbObject=9 , VbError=10 , VbBoolean=11 , VbVariant=12 , VbDataObject=17
واسه آرایه هم هست ولی متناسب با نوعش هست، یعنی واسه آرایه از نوع integer و String عددش فرق میکنه ولی همشون از 8000 بیشتر هستن.

نفر بعدی: نحوه کار کردن با کلاس Financial رو توضیح بده.

[mehran901]

در اشتباهید من قرار نیست به این مورد بپردازم

نکته ویژوالی :

می دونستین آیا واسه اینکه روی فرم خاصی در برنامه فوکوس بشه و دسترسی به فرم های دیگه نداشته باشه تا اون فرم بازه میتونید از روش :
formX.show vbmodal
استفاده کنین !
نکته ساده و کارآمد

نفر بعدی ..... ممممم....مم... ورزشکاره !! ههه ، آدم با سوادی هم هس

[unit001]

ورزشكاريم كه كم و بيش! با سواديمم كه نمي دونم!

نکته ویژوالی :

مي دونستيد مي شه كنترل فعال روي فرم را با يه كد بدست آورد:
ActiveControl

نفر بعد: اينجوري كه معلومه هيچكس، آخرشم تاپيك از صفحه ي اول مي ره بيرون!

[mehran901]

خیر ! از صفحه اول بیرون نمیره میاد داخل !
نکته ويژوالي :

آیا میدانستید ؟ عمرا نمی دانستید که میشه آدرس یک متغیر عددی رو در ویبی با دستور varptr و متغییر رشته ای رو با strptr به دست آورد

نفر بعد ،دمش گرم ی حال اساسی میخواد بده ...

[Mr'Jamshidy]

نه عزیزم میخواستم حال بگیرم، بله میدونستیم

نکته ویژوالی :

با ObjPtr هم همون کار رو برای Object ها میشه انجام داد

نفر بعدی حتما عضو انجمن هست

[AbbasVB]

حالا تا این تاپیک بسته نشده ما هم یک نکته کوچولو بگیم
این که هر کس یه تاپیک رو ایجاد و مدیريت کنه ایده خوبیه

نکته ويژوالي :

آیا می دونستید اگر این کد رو استفاده کنید اگر روی دکمه Close کلیک کنید فرم بسته نمی شه؟
Private Sub Form_Unload(Cancel As Integer)
Cancel = 1
End Sub


نفر بعدی رو هم نمی دونم کیه

[M.T.P]

من نفر بعدی پست قبلی ام :چشمک:

نکته ويژوالي :

خیلی از دوستان این مطلب رو می دونند اما قابل توجه سایر برنامه نویس ها:
فرض کنید یه برنامه NotePad نوشتید و قراره فایل های txt با برنامه شما باز بشه ، یعنی کاربر Open with رو زده و برنامه شما رو برای باز کردن فایل های txt روی سیستمش انتخاب کرده .
خب بعد از انجام مراحل بالا وقتی کاربر روی فایل های txt روی سیستمش کلیک می کنه برنامه شما باز میشه.
اما برنامه شما باید متوجه این موضوع باشه ، یعنی اینکه بفهمه کاربر برنامه شما رو بصورت معمول اجرا نکرده بلکه قراره یک فایل txt تو برنامه شما باز شه ، برای پی بردن به این موضوع از تابع Commands استفاده می کنیم.

برای تست کردن این تابع یه پروژه جدید بسازید.
فرم رو حذف کنید و داخل یه Module بنویسید:


Sub Main()
MsgBox Command$
End Sub

خب حالا پروژه رو کامپایل کنید.

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

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

توجه: دقت داشته باشید که این تابع کلا دستورات ورودی به برنامه رو می گیره و همیشه آدرس فایل نیست ، پس با شرط
همیشه مقدار برگشتی تابع Command رو بررسی کنید .

برای مثال اگه کاربر برنامه شما رو اینطوری Shell کنه:
c:\myApp.exe salam

مقدار برگشتی تابع Command کلمه salam خواهد بود.

نفر بعدی مشتاقانه منتظریم...

[Mr'Jamshidy]

نکته ويژوالي :

غیر فعال کردن دکمه X در ویژوال بیسیک 6

Const MF_BYPOSITION = &H400
Private Declare Function GetSystemMenu Lib "User32" _
(ByVal hWnd As Long, ByVal bRevert _
As Long) As Long
Private Declare Function RemoveMenu Lib "User32" _
(ByVal hMenu As Long, ByVal nPosition _
As Long, ByVal wFlags As Long) As Long
Private Sub Form_Load()
RemoveMenu GetSystemMenu(Me.hWnd, 0), 6, MF_BYPOSITION
End Sub

نفر بعدی شما هستی، آره همونی که داری پست میدی

[AMIN_SG]

نکته ويژوالي :

خاموش کردن مانیتور

Private Declare Function MonTurnOff Lib "user32" Alias "SendMessageA" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

MonTurnOff(Me.hwnd, &H112S, &HF170, 2)

نفر بعدی خود Mr'Jamshidy هستش

[meys34]

نه!؟! این منم که پست میدم...

نکته ويژوالي :

روش های بستن دکمه close راه دور زدن داره مثل Alt+F4 یا sendmessage

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

دکمه فعاله ولی عمل نمیکنه...
Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = vbFormControlMenu Then Cancel = True
End Sub

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

میدونم که میدونستید میشه فایل mainifest رو به صورت resource به برنامه اضافه کرد...
اما...
هیچ میدونستید که اندازه فایل manifest درون res (نه اندازه فایل res) باید مضربی از 4 byte باشه تا هنگام کامپایل، فایل درست کامپایل بشه...


نفر بعدی بگه که چرا باید فایل manifest مضربی از 4 byte باشه؟

[saber67]

نکته ويژوالي :

برای اینکه چند خط از کد های ویژوال بیسیک رو یه پله جلو ببرید (مثلا کدهای داخل If, End If) که واضح تر بشن لازم نیست اول همه یه بار دکمه Tab رو بزنین! همه اون متنو انتخاب کنین و یه بار Tab رو فشار بدین همه متن انتخابی به اندازه یه Tab جلو میره

نفر بعدی میگه چه طوری عکس این کارو بکنیم! یعنی چند خط رو با یه دکمه یه پله بیاریم عقب

[saber67]

درست حدس زدم:چشمک:
ای بابا چقد آسون بودا! خودم فهمیدم چه طوری میشه! چرا قبلا به فکرم نرسیده بود؟!

نکته ويژوالي :
برای اینکه توی ویژوال بیسیک متن انتخابی یه پله بیاد عقب دکمه Shift رو پایین نگه دارین و دکمه Tab رو فشار بدین

نفر بعدی محسن 15 هستش، می خواد یه نکته جالب انگیز بگه

[ra0661]

زود گفتی چون نفر بعدی اون نبود بلکه من بودم


نکته ويژوالي :

اگه دیدی برنامه که وب بروزر توش بردید بکار موقع اجرا سورس خطا داد مشکل از همون iframe.dll هستش که حتما یه چیز جدید ریختید رو سیستمتون با نصب اکسپلورر6 حل میشه (مال من که حل شد)

نفر بعدی احتمالا میخواهد بیاد بگه این چه نکته ای بود که ایشون گفتن !

[SlowCode]

نفر قبلی: نه شاید به درد بعضی از دوستان بخوره.

نکته ويژوالي :

می دونستید با تابع Filter میتونید یه مقدار(حرف، کلمه، عدد) رو داخل یه آرایه جستجو کنید؟
مثلا:

Dim a(5) As String, z() As String
a(0) = "ali"
a(1) = "mohsen"
a(2) = "hassan"
a(3) = "reza"
a(4) = "mohammad"
a(5) = "kambiz"
z = Filter(a, "r")
MsgBox z(0) 'reza

توی آرایه حرف r رو جستجو میکنه و نتیجه رو به آرایه z میریزه، (z(0 اولین عنصر پیدا شده هست.
یا مثلا:

z = Filter(a, "m")
MsgBox z(2) 'kambiz

اینجا هم حرف m رو جستجو میکنه و سومین عنصر پیدا شده رو نشون میده.

نفر بعدی: اگه گفتی چرا روی بعضی سیستم ها گزینه Make project1.exe غیر فعال هست؟

[محسن واژدی]

سلام علیکم
در مورد غیرفعال بودن این گزینه هم ممکن هست بخاطر نسخه ویژوال بیسیکی باشه که ازش استفاده میشه و یا بخاطر نبودن کلاس های وی بی در ریجستری

نکته ویژوالی: چون آقای محسن15 عزیز به نکته ای درمورد آرایه ها اشاره کردن بنده هم نکته ای در مورد Array (که معرف حضور هست) عرض می کنم،
شاید برخی اوقات چند آرایه تودرتو با دستور Array ایجاد کرده باشیم، به عنوان مثال:

Dim arrDat()
arrDat = Array("1", "2", Array("3-1", Array("3-2-1", "3-2-2", "3-2-3"), "3-3"), "4", "5")

همانطور که مشاهده میکنیم عضو سوم آرایه اول خود شامل یک آرایه دیگه هست و عضو دوم این آرایه هم خود شامل یک آرایه با سه عضو است
در اینجا اگر بخواهیم دستور دریافت مقدار "2-2-3" از آرایه را بنویسیم دستور مشابه زیر میشود:

MsgBox arrDat(2)(1)(1)


نفر بعدی: حامل یک نکته ویژوالی دیگه

[Dr.Bronx]

بله ...

نکته ويژوالي :

حتما بلوک try.catch داخل vb.net رو دیدید .

این هم مدل vb6 . البته فقط ظاهرش شبیه :)

'Try
On Error Goto catchX
...
'Catch
catchX: if err.number then
...
resume resumX
resumX: end if
On Error Goto outside_catch_label_name
'End Try
موفق باشید ./

نفر بعدی قطعا نفر بعدی هست . ( bronx قدس سره )

[mehran901]

بعله ، نفر بعدی هم نفربعدی هست! آفرین

دوست عزیز ra0661 :
درضمن مشکل ieframe که در بعضی نسخه ها ی اکسپلورر موقع لود شدن داخل ویبی ارور میده یا برنامه ای که ازش استفاده کرده به ارور برخورد میکنه شما میتونید بجای نصب اکسپلورر 6! برای رفع مشکل ، همین ieframe رو تو رجیستری سرچ بزنین و کلیدی که یک \ آخرش هست وشامل مسیر این فایل هست رو چک کنین با حذف \ بلافاصله مشکل برطرف میشه

نکته ويژوالي :
همه میدونیم در زبان هایی مثل C++‎‎‎ برای اضافه کردن " در خروجی از سوییچ "\ استفاده میشه ولی در ویبی معادلش به این صورت هست :

مثال :
MsgBox "A " & """" & "B" & """" & " "


نفر بعدی : یك فرد با اطلاعات

[meys34]

?!?!?!?!?!??!

جالب بود من همیشه از کد Chr$(34) استفاده می کردم...

نکته ويژوالي :

هیچ میدونستید جای تابع
Private Declare Function GetLastError Lib "kernel32" () As Long
میشه از تابع داخلی وی بی استفاده کرد؟
Err.LastDllError

نفر بعدی کسی که فکر میکنه نمیشه با سرویسی که با ویبی نوشته یه برنامه رو تحت user اجرا کنه...

[vbhamed]

چرا اتفاقا ميشه !

نكته ويژوالي :

مي‌دونستيد ويژوال بيسيك به صورت داخلي دو تا تقويم داره، شمسي و قمري
Private Sub Form_Load()

Dim Miladi$, Ghamari$

Calendar = vbCalGreg
Miladi = Date

Calendar = vbCalHijri
Ghamari = Date

MsgBox "ميلادي : " & vbCrLf & Miladi & vbCrLf & vbCrLf & "قمري : " & vbCrLf & Ghamari

End Sub



نفر بعدي ميگه اوووووووه بعد از 1 سال تاپيك بالا اومد !

[CodeKhor]

بله این تاپیک دقیقا بعداز 1 سال و 2 ماه و 10 روز اومده بالا ! :کف: چه فعالیت چشم گیری دارن بچه های اینجا :لبخند:

نکته ويژوالي :

میدونستید اگر این کد توی یک تایمر با interval = 1 قرار بدین بعد برنامه رو اجرا کنید اول مجبور میشید کامپیوتر رو ریست کنید بعد هم تا اومدن ویندوز بالا بیاد به خودتون فحش میدید که چرا این کارو کردم ؟؟؟ :لبخند:
Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Sub Timer1_Timer()
SetCursorPos 1, 1
End Sub


نفر بعدی میخواد یه نکته خیلی جالب در مورد سوکت پروگرمینگ بهمون بگه ! :متفکر:

[NASA's Spaceman]

کد باحالی بود

نکته ويژوالي :

محاسبه اعداد نجومی 117969

نفر بعدی عاشق برنامه نویسی هست مثل خودم

[AbbasVB]

بله من عاشق برنامه نویسیم

نكته ويژوال :

توی اين آموزش می خوام بهتون یاد بدم که چه طور مثل ویژال استادیو(نه ورژن 6)دکمه کامپایل(Build) رو اضافه کنید

با یه کلیک می تونید برنامه رو کامپایل کنید

نفر بعدي Setroyd خواهد بود

[setroyd]

نكته ويژوالي

drag و drop کردن فایل بدون api انجام شده

Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, _
Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim i As Integer
For i = 1 To Data.Files.Count
Text1.Text = Text1.Text & Data.Files(i) & vbCrLf
Next

End Sub

textboxرو قسمت oledropmod رو manual کنید حالا یک فایل را بکشید با موس و بندازید داخل برنامه :) بله ادرس کامل فایل رو میبینید

نفر بعدي فکر کنم میخواد یه کد خاص بزاره !

[vbhamed]

سلام
احتمالا كدش كمي خاص هست

نكته ويژوالي :

همه برنامه هاي باز رو ببنديد، تو يك فرم يك دكمه با عنوان End بزاريد و كد زير رو تو فرم قرار بنويسيد و پروژه رو ذخيره كنيد

بعد براي تست :
1 - برنامه رو اجرا كنيد و دكمه End رو فشار بدين
2 - برنامه رو اجرا كنيد و ضربدر فرم رو بزنيد
3 - برنامه رو اجرا كنيد و با خيال راحت دكمه پاور كيس رو بزنيد

با اين روش راحت مي‌تونيد بفهميد كه بستن برنامه توسط دكمه ضربدر فرم انجام شده يا با كد خودتون يا اينكه سيستم دستور بسته شدن رو به برنامه داده

Private Sub Command1_Click()

Unload Me

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

MsgBox UnloadMode
If UnloadMode <> 0 And UnloadMode <> 1 Then Cancel = True: MsgBox UnloadMode

End Sub

نفر بعدي شايد همه حالتهاش رو نديده بود

[talent1]

روش خوبیه مخصوصا وقتی چندتا فرم داشته باشی

نکته ویژوالی :

تاحالا شده بخواین یه سری شی رو با اسکرول ست کنید
که وقتی اسکرول پایین میاد او شی بالا بره و وقتی اسکرول بالا میره اون پایین بیاد
راحت ترین روشش اینجوریه :

Me.Frame1.Top = (-Me.VScroll1.Value)

من چقدر مخم نمیدونستم

نفر بدی شاید اینجوری بشه :متعجب: !

[sa1378]

من از پشت همین تریبون اعلام میکنم:متعجب: نیستم الان

نکته ویژوالی :
من یه روش خودم کشف کردم نمیدونم بقیه بلدن یا نه
اگه تکراریه به بزرگیتون ببخشین:لبخند:
من دیروز داشتم چند تا کد رو کپی میکردم با ctr+c دستم خورد به shift یعنی شد ctr + shift+ c بعد برای هر خطی که انتخاب کردم ' اومد
وقتی میخواین یه متن بزرگ رو ' بزنین بدرد میخوره

نفر بعدی اندکی ویژوال بیسیک بلد است...

[as987498749874]

دقیقا!!!

نکته ویژوالی :

آیا میدونستید عمل بر عکس شده زدن Tab کلید ترکیبی Shift+tab هست!!!! (در محيط كد نويسي ويژوال بيسيك)

پاسخ نفر بعدی 100 درصد یه خصوصیت داره : شمارش 189 هست:تشویق::تشویق::تشویق:

[Rasul75]

:|
|:

نکته ویژوالی :

این کد شاید به دردتون بخوره برای باز کردن آدرس فولدر از کد زیر می تونید استفاده کنید:

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 Const SW_SHOWNORMAL As Long = 1

Private Sub Command1_Click()
ShellExecute Me.hwnd, "Open", "C:\TEST\", vbNullString, vbNullString, SW_SHOWNORMAL
End Sub

نفر بعد برای زدن تو ذوق من به دنیا اومده.

[Mr.305]

نکته ویژوالی :
از این کد میتونید برای رجیستر کردن فایل هاتون تو ویندوز استفاده کنید به صورت تمام کد و بدون استفاده از regsvr32 یعنی تقریبا کار regsvr32 رو براتون انجام میده

Option Explicit
Private Const CREATE_SUSPENDED = &H4
Private Const INFINITE = &HFFFFFFFF ' Infinite timeout
Private Const STATUS_WAIT_0 = &H0
Private Const STATUS_ABANDONED_WAIT_0 = &H80
Private Const STATUS_TIMEOUT = &H102
Private Const WAIT_FAILED = &HFFFFFFFF
Private Const WAIT_OBJECT_0 = ((STATUS_WAIT_0) + 0)
Private Const WAIT_ABANDONED = ((STATUS_ABANDONED_WAIT_0) + 0)
Private Const WAIT_TIMEOUT = STATUS_TIMEOUT
Private Const STATUS_PENDING = &H103
Private Const STILL_ACTIVE = STATUS_PENDING
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" _
(ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" _
(ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function CreateThread Lib "kernel32" _
(lpThreadAttributes As Any, ByVal dwStackSize As Long, _
lpStartAddress As Long, lpParameter As Any, _
ByVal dwCreationFlags As Long, lpThreadID As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" _
(ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long
Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Private Declare Function ResumeThread Lib "kernel32" _
(ByVal hThread As Long) As Long
Private Declare Function GetExitCodeThread Lib "kernel32" _
(ByVal hThread As Long, lpExitCode As Long) As Long
Public Function fVBRegServer(ByVal strFilePath As String, _
Optional ByVal blnRegister = True) As Boolean

Dim lngModuleHandle As Long ' module handle
Dim lngFunctionAdr As Long ' reg/unreg function address
Dim lngThreadID As Long ' dummy var that get's filled
Dim lngThreadHandle As Long ' thread handle
Dim lngExitCode As Long ' thread's exit code if it doesn't finish
Dim blnSuccess As Boolean ' if things worked
'
' Load the file into memory.
'
lngModuleHandle = LoadLibrary(strFilePath)

'
' Get the registration function's address.
'
If blnRegister Then
lngFunctionAdr = GetProcAddress(lngModuleHandle, "DllRegisterServer")
Else
lngFunctionAdr = GetProcAddress(lngModuleHandle, "DllUnregisterServer")
End If

If lngFunctionAdr <> 0 Then
'
' Create an alive thread and execute the function.
'
lngThreadHandle = CreateThread(ByVal 0, 0, ByVal lngFunctionAdr, ByVal 0, 0, lngThreadID)

'
' If we got the thread handle...
'
If lngThreadHandle Then
'
' Wait for the thread to finish.
'
blnSuccess = (WaitForSingleObject(lngThreadHandle, 10000) = WAIT_OBJECT_0)

'
' If it didn't finish...
'
If Not blnSuccess Then
'
' Something happened. Close the thread.
'
Call GetExitCodeThread(lngThreadHandle, lngExitCode)
Call ExitThread(lngExitCode)
End If

'
' Close the thread.
'
Call CloseHandle(lngThreadHandle)
End If
End If

'
' Free the file if we loaded it.
'
If lngModuleHandle Then Call FreeLibrary(lngModuleHandle)

fVBRegServer = blnSuccess

End Function
Public Function IsDLLActiveX(ByVal strDLLPath As String, Optional ByVal RaiseError As Boolean) As Boolean
Dim lngHMod As Long
Dim lngLastDllError As Long

lngHMod = LoadLibrary(strDLLPath)

If lngHMod = 0 Then
If RaiseError Then
lngLastDllError = Err.LastDllError
Err.Raise 10000 + lngLastDllError, "IsDLLActiveX", "LoadLibrary-Error: " & lngLastDllError
End If
End If

IsDLLActiveX = Abs(CBool(GetProcAddress(lngHMod, "DllRegisterServer")))
Call FreeLibrary(lngHMod)
End Function


فانکشن اول رجیستر میکنه و فانکشن دوم هم معلوم میکنه که آیا فایل ما دی ال ال قابل رجیستر هست یا نه

نفر بعدی ی کدی بهتر از مال من میاره

[Rasul75]

نفر بعد باز خودمم :))

نکته ویژوالی :

برای انتخاب فولدر از کد زیر استفاده کنید توجه داشته باشید که فقط انتخاب فولدر نه فایل :

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260


Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long


Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long


Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long


Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type


Private Sub Command1_Click()
'Opens a Treeview control that displays the directories in a computer


Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo


szTitle = "This is the title"
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With


lpIDList = SHBrowseForFolder(tBrowseInfo)


If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
Text1.Text = sBuffer
End If
end sub

نفر بعد رو کن ببینم چی داری؟؟

[vbhamed]

سلام
اولین اولین پست این تاپیک در سال 1394 رو میزارم

نکته ویژوالی :

یک کد گذاشتم برای غیر فعال و فعال کردن Clipboard
Open غیر فعال و Close فعالش میکنه، اگر غیر فعال کنید دیگه هیچ طوری نمی‌تونید چیزی در Clipboard ذخیره کنید، حتی کلیدهای Ctrl+C, Ctrl+X و ... هم کار نمی‌کنه

Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long

Private Sub Form_Load()

'Disable Clipboard
OpenClipboard Me.hwnd

'Enable Clipboard
CloseClipboard

End Sub


نفر بعدی دومین پست رو یک کد جالب بزار

[roo.row]

چشم پست جالب میزارم

نکته ویژوالی :
نمی خواستم اینو بزارم ولی خوب چیزی به ذهنم نرسید امیدوارم جدید باشه

Shell "attrib +h +s +r c:\virus1.exe"

با این کد برنامه شما به صورت exe که در میاد ناپدید میشه و حتی سایزش رو هم سیستم نشون نمیده در این کد +h هیدن می کنه +s به عنوان فایل سیستمی هیدن میکنه(غیر قابل حذف) +r فقط قابل خوانش

لازم به ذکر هست که این کد با فراخوانی خط فرمان دستور Attrib که یکی توابع اون هست رو اجرا میکنه .

نفر بعدی کسی است که فکرشم نمی کرد اینجا پست بده

[mehran901]

اره احتمالا همین طوره ...
بعد از سال ها سر زدم به این انجمن و خاطرات قشنگش .... آخرین پست من اینجا مربوط به بهمن سال 91 هست
چقدر زود میگذره

نکته ویژوالی :
با کد زیر اطلاعات داخل تمام تکست باکس ها رو در لود برنامه حذف کنین

Dim Contrl As Control
For Each Contrl In Form1.Controls
If (TypeOf Contrl Is TextBox) Then Contrl.Text = ""

Next Contrl

نفر بعد تلاششو فقط برای زنده نگه داشتن تاپیک بکنه .... حتی اگه نکته عجیب غریبی نداره

[محسن واژدی]

سلام
ان شاا... همین پست تاپیکو زنده نگهداره:لبخند:

نکته ویژوالی:
برای ایجاد کردن یک کلاس لزوما نیاز به تعریف یک متغیر جداگانه نیست میتوان آنرا بصورت دیگری هم اعلان کرد، در این شیوه فرض را بر این گذاشته ایم که از With برای دسترسی سریعتر به اعضای کلاس استفاده کرده ایم، در اینجا برخلاف باور بسیاری از کاربران عزیز که حتما بایستی برای استفاده از کلاس در With آنرا در یک متغیر جداگانه ایجاد کرد، میتوانیم مستقیما کلاس مورد نظر را در دستور With ایجاد کنیم، یعنی نوشتن دستورات زیر به هر دو صورت صحیح است:
Private Sub Command1_Click()
Dim CSmplItems As New Collection

With CSmplItems
.Add "ItemA"
.Add "ItemB"
For i = 1 To .Count
MsgBox "Cur Item: " & .Item(i)
Next 'i
End With
End Sub

یا
Private Sub Command1_Click()

With New Collection
.Add "ItemA"
.Add "ItemB"
For i = 1 To .Count
MsgBox "Cur Item: " & .Item(i)
Next 'i
End With

End Sub

البته دوستان توجه داشته باشند که این شیوه صرفا برای ایجاد و دسترسی سریع به اعضای کلاس است و محدودیت هایی در ارجاع و ... دارد.

نفر بعدی سعی کن مطلبی بزنی که دوستان تا یک ساعت از تعجب تاپیکو نتونن ببندن:لبخند:

[vbhamed]

سلام

محسن جان دیگه یک ساعت تعجب که یخورده بعید ولی بهرحال سعی می‌کنم نکته مفیدی بزارم

نکته ویژوالی :

دستورات انتسابی زیر رو ببینید، با این دستورات محتویات فیلدهای یک Ado به Ado دوم در یک فرم خاص منتقل میشه

frmIRANCustomers.adoIRANCustomerList.Recordset!MNa me = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M Name
frmIRANCustomers.adoIRANCustomerList.Recordset!Fam lily = frmIRANCustomers.adoIRANCustomerBackup.Recordset!F amlily
frmIRANCustomers.adoIRANCustomerList.Recordset!Com ment = frmIRANCustomers.adoIRANCustomerBackup.Recordset!C omment
frmIRANCustomers.adoIRANCustomerList.Recordset!Pho ne = frmIRANCustomers.adoIRANCustomerBackup.Recordset!P hone
frmIRANCustomers.adoIRANCustomerList.Recordset!Ema il = frmIRANCustomers.adoIRANCustomerBackup.Recordset!E mail
frmIRANCustomers.adoIRANCustomerList.Recordset!Add ress = frmIRANCustomers.adoIRANCustomerBackup.Recordset!A ddress
frmIRANCustomers.adoIRANCustomerList.Recordset!Cod e = frmIRANCustomers.adoIRANCustomerBackup.Recordset!C ode
frmIRANCustomers.adoIRANCustomerList.Recordset!Mob ile = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M obile
frmIRANCustomers.adoIRANCustomerList.Recordset!Per sonal = frmIRANCustomers.adoIRANCustomerBackup.Recordset!P ersonal
frmIRANCustomers.adoIRANCustomerList.Recordset!Wei ght = frmIRANCustomers.adoIRANCustomerBackup.Recordset!W eight
frmIRANCustomers.adoIRANCustomerList.Recordset!Old = frmIRANCustomers.adoIRANCustomerBackup.Recordset!O ld
frmIRANCustomers.adoIRANCustomerList.Recordset!Bir thday = frmIRANCustomers.adoIRANCustomerBackup.Recordset!B irthday
frmIRANCustomers.adoIRANCustomerList.Recordset!Fat her = frmIRANCustomers.adoIRANCustomerBackup.Recordset!F ather
frmIRANCustomers.adoIRANCustomerList.Recordset!Mel liCode = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M elliCode
frmIRANCustomers.adoIRANCustomerList.Recordset!Sal ary = frmIRANCustomers.adoIRANCustomerBackup.Recordset!S alary
frmIRANCustomers.adoIRANCustomerList.Recordset!Web site = frmIRANCustomers.adoIRANCustomerBackup.Recordset!W ebsite

خب دستورات طولانی و نسبتا ناخوانایی شده و میشه یه مقدار با With مختصرش کرد به شکل زیر

With frmIRANCustomers.adoIRANCustomerList.Recordset
!MName = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M Name
!Famlily = frmIRANCustomers.adoIRANCustomerBackup.Recordset!F amlily
!Comment = frmIRANCustomers.adoIRANCustomerBackup.Recordset!C omment
!Phone = frmIRANCustomers.adoIRANCustomerBackup.Recordset!P hone
!Email = frmIRANCustomers.adoIRANCustomerBackup.Recordset!E mail
!Address = frmIRANCustomers.adoIRANCustomerBackup.Recordset!A ddress
!Code = frmIRANCustomers.adoIRANCustomerBackup.Recordset!C ode
!Mobile = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M obile
!Personal = frmIRANCustomers.adoIRANCustomerBackup.Recordset!P ersonal
!Weight = frmIRANCustomers.adoIRANCustomerBackup.Recordset!W eight
!Old = frmIRANCustomers.adoIRANCustomerBackup.Recordset!O ld
!Birthday = frmIRANCustomers.adoIRANCustomerBackup.Recordset!B irthday
!Father = frmIRANCustomers.adoIRANCustomerBackup.Recordset!F ather
!MelliCode = frmIRANCustomers.adoIRANCustomerBackup.Recordset!M elliCode
!Salary = frmIRANCustomers.adoIRANCustomerBackup.Recordset!S alary
!Website = frmIRANCustomers.adoIRANCustomerBackup.Recordset!W ebsite
End With


الان بهتر شد ولی هنوزم اون عبارت بزرگ و تکراری وجود داره، ولی خب ویژوال بیسیک 6 رو دست کم نگیرید

Dim rs As Recordset
Set rs = frmIRANCustomers.adoIRANCustomerBackup.Recordset

With frmIRANCustomers.adoIRANCustomerList.Recordset
!MName = rs!MName
!Famlily = rs!Famlily
!Comment = rs!Comment
!Phone = rs!Phone
!Email = rs!Email
!Address = rs!Address
!Code = rs!Code
!Mobile = rs!Mobile
!Personal = rs!Personal
!Weight = rs!Weight
!Old = rs!Old
!Birthday = rs!Birthday
!Father = rs!Father
!MelliCode = rs!MelliCode
!Salary = rs!Salary
!Website = rs!Website
End With

حتما قبول دارید که تا اینجا خیلی بهتر و خواناتر شده و خیلی جاها به همین شکل باید استفاده بشه، ولی به نظرتون بازم میشه مختصر ترش کرد ؟

Dim r1 As Recordset, r2 As Recordset
Set r1 = frmIRANCustomers.adoIRANCustomerList.Recordset: Set r2 = frmIRANCustomers.adoIRANCustomerBackup.Recordset

For i = 0 To r1.Fields.Count - 1
r2.Fields(i) = r1.Fields(i)
Next


در اینجا با یک حلقه همه انتساب ها رو انجام دادیم و دیگه هر چی تعداد فیلدها زیاد بشه کد برنامه همین ثابته و مثل بالایی ها اضافه نمیشه


اما آیا به نظر شما باز هم میشه مختصر کرد ؟!! نظرتون راجع به این چیه

Set frmIRANCustomers.adoIRANCustomerBackup.Recordset = frmIRANCustomers.adoIRANCustomerList.Recordset


این روش رو با روش اول مقایسه کنید !، خیلی کارها رو میشه تو وی بی با این روش ها مختصر کرد و مطمئنا خوانایی برنامه خیلی افزایش پیدا میکنه، این روش آخر برای کلیه آرایه ها قابل انجامه، نمونه زیر رو تست کنید

Dim a1(10), a2(), i%

For i = 0 To 10
a1(i) = i
Next

a2 = a1


نفر بعدی لطفا مطلبی بزار که تو کاربردهای روزمره مفید باشه

[golbafan]

سلام
اولین پست من در تالارهای ویبی هست :O)
انشاالله مفید باشه

نکته ویژوالی:
همونطور که میدونید دستورات ویبی بصورت تک خطی هستند
اما شما میتونید از آندرلاین ( _ ) برای ایجاد دستورات چند خطی استفاده کنید:


cmd.CommandText = "SELECT * FROM Titles JOIN Publishers " _
& "ON Publishers.PubId = Titles.PubID " _
& "WHERE Publishers.State = 'CA'"


همچنین برای نوشتن چند دستور در یک خط از ( :) استفاده میشه کرد:


text1.Text = "Hello" : text1.BackColor = VbRed


نفر بعدی کارش درسته

[vbhamed]

سلام
کی فکرشو میکرد این تاپیک بعد از 6 سال بالا بیاد !!!!!

نکته ویژوالی:
ای کسانی که ترک vb6 کردین میدونید همین الان در سال 1401 میتونید با vb6 برای کل مجموعه آفیس، فتوشاپ، CorelDraw و ... برنامه و پلاگین بنویسید و کارهاتون رو تو این نرم افزارها اتوماتیک کنید ؟ چون این نرم افزارها همه بر پایه VBA که همون vb6 خودمونه تقریبا کار میکنن

ضمنا زبان ASP هم خیلی تشابه به VB6 داره، همچنین ماکرونویسی در ویندوز


نفر بعدی اصلا این تاپیک رو میبینه ؟ !

[adib202]

عجب تاپیک ماندگاری شده
برنامه هایی که حدود 15 سال هست تو بازار برای مشاغل و شرکت ها نوشتم داره براشون کار میده.
فکر کنم لااقل تا زمانی که پلتفرم ویندوز فایل اجرایی exe رو ساپورت کنه
دلم نمیاد از vb6 به محیط دیگه سوییچ کنم

نکته ویژوالی:

با اين كد ميشه عددي تصادفي بين 1 تا 6 پيدا كرد.

MyValue = CInt(Int((6 * Rnd()) + 1))


نفر بعدی احتمالا یه فرازمینی باشه https://barnamenevis.org/images/smilies/yahoo/109.gif

[shahryari]

سلام و عرض ادب
بله بنده از کره مریخ آمده ام چون بعد از مدتها دوری از vb6 و کار با دات نت، مجددا آمدم سراغش ، انگار غریبه بودیم باهم

نکته ویژوالی:

تابع CreateObject از vb6 اومده و در vb.net هم هنوز در دسترسه و کارهای زیادی میشه باهاش کرد
بعنوان مثال حذف تمامی فایل های موجود در یک فولدر..

Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.DeleteFolder "C:\MyFolder\*.*", True

نفر بعدی هرجا هست امیدوارم تنش سلامت باشه

[mehranfarvardin]

درود بر شما
عجیبه، برنامه هایی که بیش از بیست سال پیش با VB6 نوشتم و کامپایل کردم و پخش کردم، هنوز هم داره برای ملت ایران کار میکنه، حتی روی ویندوز ۱۱ هم هیچ مشکلی نداره و هزاران نفر، هنوز هم در حال استفاده هستند، واقعا Visual Studio 6 پکیج بی نظیری بوده، شاهکاری بوده

[vbhamed]

بله درسته دقیقا
منم از این برنامه ها دست مشتری دارم !