صفحه 1 از 5 123 ... آخرآخر
نمایش نتایج 1 تا 40 از 198

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

  1. #1

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

    سلام!

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

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

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

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

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

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

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


    جواب نفر قبلي

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

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

    نفر بعدي ...


    آخرین ویرایش به وسیله vbhamed : سه شنبه 05 مرداد 1395 در 13:11 عصر
    اگر من و شما هر كدوم يك چيز ياد داشته باشيم و به هم ياد بديم، حالا هر كدوم دو تا چيز ياد داريم ! http://www.ArminaCo.com




  2. #2

    Wink نقل قول: نفر بعدي كيه ؟

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

    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"


    نفر بعدي يكي هست كه از اين تاپيك استقبال مي كنه !
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:07 عصر
    اگر من و شما هر كدوم يك چيز ياد داشته باشيم و به هم ياد بديم، حالا هر كدوم دو تا چيز ياد داريم ! http://www.ArminaCo.com

  3. #3

    نقل قول: نفر بعدي كيه ؟

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

    نكته ويژوالي :
    بدست آوردن مسير فولدرهاي 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


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

    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 10:21 صبح

  4. #4
    VIP آواتار xxxxx_xxxxx
    تاریخ عضویت
    شهریور 1386
    محل زندگی
    X place
    سن
    33
    پست
    4,768

    نقل قول: نفر بعدي كيه ؟

    بعداً كه معرفي شديم به كميته انضباطي سايت اونوقت بياين بازي كنيد
    ديدي اشتباه كردي، hrj1981 جان Game over شدي، چون نه من باسوادم نه باحال.

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

    بدون شك نفر بعدي يكي از اعضاي سايت برنامه نويس هست
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:01 عصر
    الگوریتم هایی که تاریخچه خود را فراموش می کنند، محکوم به تکرار آن هستند.

  5. #5
    منتظر تایید آدرس ایمیل
    تاریخ عضویت
    بهمن 1387
    محل زندگی
    سربیشه سیتی
    پست
    39

    نقل قول: نفر بعدي كيه ؟

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

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

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

    کپی برنامه در استارت آپ ویندوز به طوری که 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 )

    فکر کنم نفر بعدی آدم خیر خواهی باشه
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 10:22 صبح

  6. #6
    VIP آواتار xxxxx_xxxxx
    تاریخ عضویت
    شهریور 1386
    محل زندگی
    X place
    سن
    33
    پست
    4,768

    نقل قول: نفر بعدي كيه ؟

    سلام

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

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

    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 : سه شنبه 26 فروردین 1393 در 10:22 صبح
    الگوریتم هایی که تاریخچه خود را فراموش می کنند، محکوم به تکرار آن هستند.

  7. #7

    Wink نقل قول: نفر بعدي كيه ؟

    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


    نفر بعدي فكرشم نمي كرد نفر بعدي اين تاپيك باشه !
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 10:23 صبح
    اگر من و شما هر كدوم يك چيز ياد داشته باشيم و به هم ياد بديم، حالا هر كدوم دو تا چيز ياد داريم ! http://www.ArminaCo.com

  8. #8
    کاربر دائمی آواتار mhsmity
    تاریخ عضویت
    مهر 1387
    محل زندگی
    استان يزد
    سن
    34
    پست
    671
    با عرض سلام خدمت استادان ارجمند

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

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

    نفر بعدي شب زود مي خوابه و سحرخيزه
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 10:25 صبح

  9. #9
    کاربر دائمی
    تاریخ عضویت
    تیر 1384
    محل زندگی
    بندرعباس
    پست
    205

    نقل قول: نفر بعدي كيه ؟

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

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


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

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

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

    شرط میبندم نفر بعدی ساعت 9 صبح به بعد جواب میده. (ساعت رو بنویس)
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 10:25 صبح

  10. #10
    کاربر دائمی آواتار parselearn
    تاریخ عضویت
    مهر 1386
    محل زندگی
    مشهد || parsa.ws
    پست
    1,147

    Smile نقل قول: نفر بعدي كيه ؟

    اي چي بگم...

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


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

    بازم اي چي بگم...
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 10:26 صبح

  11. #11

    Lightbulb نقل قول: نفر بعدي كيه ؟

    ساعت 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 نفر بعد از نفر قبلیه... نوبتش رو رعایت کنه...
    آخرین ویرایش به وسیله sina_saravi1 : دوشنبه 12 اسفند 1387 در 09:10 صبح

  12. #12
    کاربر دائمی آواتار aidin1386
    تاریخ عضویت
    دی 1386
    محل زندگی
    سايت برنامه نويس ديگه
    سن
    28
    پست
    156

    Cool نقل قول: نفر بعدي كيه ؟

    باشه، رعايت مي كنم، حالا چرا گريه مي كني؟
    نكته ويژوال :
    خوب، منم هيچي به مغزم نمي رسه! ولي يه چيزي همين الان پيدا كردم، شايد جالب نباشه
    اميدوارم بدرد بخوره!
    آيا مي دونستين كه مي شه رنگ هاي qbasic كه 15 گانه هستند رو توي ويژوال ايجاد كرد؟
    با اين دستور:
    Me.backcolor=qbcolor(0 to 15)


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

  13. #13
    کاربر دائمی آواتار aidin1386
    تاریخ عضویت
    دی 1386
    محل زندگی
    سايت برنامه نويس ديگه
    سن
    28
    پست
    156

    نقل قول: نفر بعدي كيه ؟

    آفرين aidin1386، خوشم مياد كه همه منو ميشناسن
    نكته ويژوال :
    يك راه بسيار كوتاه براي جلوگيري از دادن داده اي به جز عدد به تكست باكس
    توي keypress تكست باكس اينو بذارين
    select case KeyAscii
    case 8,48 to 58:
    case else
    keyascii=0
    end select

    ببخشيد سعي مي كنم نكته هاي باحال تري دفعه ديگه بذارم. فعلاً مغزم كار نمي كنه
    نفر بعدي انسان بسيار خوشبختيه

  14. #14
    کاربر تازه وارد
    تاریخ عضویت
    مرداد 1385
    محل زندگی
    مشهد
    پست
    62

    Smile نقل قول: نفر بعدي كيه ؟

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

    نكته ويژوالي :
    تغيير نام كامپيوتر

    Private Declare Function SetComputerName Lib "kernel32.dll" 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


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

    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 10:27 صبح

  15. #15
    کاربر دائمی آواتار میلاد علوی
    تاریخ عضویت
    دی 1384
    محل زندگی
    پشت کامپیوتر
    پست
    200

    نقل قول: نفر بعدي كيه ؟

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

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

    این بیشتر یه ایده هست تا یه کد قوی
    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 : سه شنبه 26 فروردین 1393 در 10:28 صبح

  16. #16

    Wink نقل قول: نفر بعدي كيه ؟

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

    نكته ويژوال :

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

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

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


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

        Close #1


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

    نفر بعدي يكي از بهترين نكات ويژوالي كه بلده رو مي نويسه، مگه نه نفر بعدي ؟
    اگر من و شما هر كدوم يك چيز ياد داشته باشيم و به هم ياد بديم، حالا هر كدوم دو تا چيز ياد داريم ! http://www.ArminaCo.com

  17. #17
    کاربر دائمی آواتار DoctorJay
    تاریخ عضویت
    مرداد 1386
    محل زندگی
    پارس - شیراز
    پست
    348

    نقل قول: نفر بعدي كيه ؟

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

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

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

    !! حتم دارم نفر بعدی محدوده ای سنی بین 1 تا 100 دارد و اظهار بی اطلاعی از این نکته می کنه !!
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 10:28 صبح

  18. #18

    نقل قول: نفر بعدي كيه ؟

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

    نكته ويژوالي :
    اينها كتابخانه هاي ران تايم ويژوال بيسيك براي اجرا هستن
    • Msvbvm60.dll
    • Stdole2.tlb
    • Oleaut32.dll
    • Olepro32.dll
    • Comcat.dll
    • Asyncfilt.dll
    • Ctl3d32.dll

    نفر بعدي حتما الان كانكت هست لطفا كتمان نكنه چون همه اين رو ميدونن
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 02:26 صبح

  19. #19

    Talking نقل قول: نفر بعدي كيه ؟

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

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

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

    نفر بعدی پسره
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 02:33 صبح

  20. #20

    نقل قول: نفر بعدي كيه ؟

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

    نكته ويژوالي :
    اين هم كانكشن براي بانكهاي فاكس پرو
    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

    مهران جان لطفا آنتي كاظم رو هم اپديت كن مثل اينكه ورژن جديد داره
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 02:36 صبح

  21. #21
    کاربر دائمی آواتار butterfly8528
    تاریخ عضویت
    شهریور 1387
    محل زندگی
    CLR
    پست
    896

    Wink نقل قول: نفر بعدي كيه ؟

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

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

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

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


    نفر بعدي بهترين نكته این تاپیک رو مینویسه
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 02:37 صبح

  22. #22
    کاربر دائمی آواتار mhsmity
    تاریخ عضویت
    مهر 1387
    محل زندگی
    استان يزد
    سن
    34
    پست
    671

    نقل قول: نفر بعدي كيه ؟

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

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

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

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

    نفر بعدي خيلي منو دوست داره
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 02:38 صبح

  23. #23
    کاربر دائمی آواتار DoctorJay
    تاریخ عضویت
    مرداد 1386
    محل زندگی
    پارس - شیراز
    پست
    348

    نقل قول: نفر بعدي كيه ؟

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

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

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

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


    خب اینجوریه .

    !! نفر بعدی داره فکر می کنه چه نکته های تکراری ای , و چی بزاره که همه کف کنن !!
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 02:39 صبح

  24. #24
    کاربر تازه وارد آواتار MFiRE
    تاریخ عضویت
    مهر 1386
    محل زندگی
    كيانپارس
    پست
    98

    دانلود سورس کد ویژوال بیسیک با 30 موضوع مختلف.

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

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


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

    دانلود کل سورس ها - با حجم 38 مگابایت

    دانلود پروژه های آماتور - با حجم نیم مگابایت

    دانلود پروژه های آنتی ویروس - 2.66 مگابایت
    دانلود پروژه های Application Tools - با حجم 0.1 مگابایت
    دانلود پروژه های رایت سی دی - با حجم 0.13 مگابایت

    دانلود پروژه های Client & Server - با حجم 1.5 مگابایت

    دانلود پروژه های تبدیل کننده - با حجم 0.05 مگابایت
    دانلود پروژه های بانک اطلاعاتی - با حجم 8.78 مگابایت

    دانلود پروژه های دانلودر(Download Manager) - با حجم 2.44 مگابایت

    دانلود پروژه های افکت - با حجم 0.29 مگابایت

    دانلود پروژه های ایمیل - با حجم 0.81 مگابایت

    دانلود پروژه های رمز گذاری (Encrypt) - با حجم 0.5 مگابایت
    دانلود پروژه های بازی - با حجم .28 مگابایت

    دانلود پروژه های Hook - با حجم 0.01 مگابایت

    دانلود پروژه های اینترنت - با حجم 4.19 مگابایت

    دانلود پروژه های مالتی مدیا و گرافیک - با حجم 2.36 مگابایت

    دانلود پروژه های Other Hack - با حجم 0.19 مگابایت

    دانلود پروژه های دیگر - با حجم 3.07 مگابایت

    دانلود پروژه های بازیابی پسورد - با حجم 0.43 مگابایت

    دانلود پروژه های پورت و ای پی - با حجم 0.0 مگابایت

    دانلود پروژه های ریجستری - با حجم 0.10 مگابایت

    دانلود پروژه های سرویس - با حجم 0.25 مگابایت

    دانلود پروژه های Spy - با حجم 0.10 مگابایت

    دانلود پروژه های Toolbar - با حجم 0.68 مگابایت

    دانلود پروژه های Top Project - با حجم 3.24 مگابایت

    دانلود پروژه های Trojan - با حجم 1.70 مگابایت

    دانلود پروژه های کاربردی - با حجم 0.83 مگابایت

    دانلود پروژه های Win Optimizer & Win Tools - با حجم 0.04 مگابایت

    دانلود پروژه های XP Tools - با حجم 1.13 مگابایت

    دانلود پروژه های کار با فایل Zip - با حجم 2.66 مگابایت




    (لینک غیر مستقیم و دائمی) :
    دانلود کل سورس ها - با حجم 38 مگابایت
    دانلود پروژه های آماتور - با حجم نیم مگابایت
    دانلود پروژه های آنتی ویروس - 2.66 مگابایت
    دانلود پروژه های Application Tools - با حجم 0.1 مگابایت
    دانلود پروژه های رایت سی دی - با حجم 0.13 مگابایت
    دانلود پروژه های Client & Server - با حجم 1.5 مگابایت
    دانلود پروژه های تبدیل کننده - با حجم 0.05 مگابایت
    دانلود پروژه های بانک اطلاعاتی - با حجم 8.78 مگابایت
    دانلود پروژه های دانلودر(Download Manager) - با حجم 2.44 مگابایت
    دانلود پروژه های افکت - با حجم 0.29 مگابایت
    دانلود پروژه های ایمیل - با حجم 0.81 مگابایت
    دانلود پروژه های رمز گذاری (Encrypt) - با حجم 0.5 مگابایت
    دانلود پروژه های بازی - با حجم .28 مگابایت
    دانلود پروژه های Hook - با حجم 0.01 مگابایت
    دانلود پروژه های اینترنت - با حجم 4.19 مگابایت

    دانلود پروژه های مالتی مدیا و گرافیک - با حجم 2.36 مگابایت
    دانلود پروژه های Other Hack - با حجم 0.19 مگابایت
    دانلود پروژه های دیگر - با حجم 3.07 مگابایت
    دانلود پروژه های بازیابی پسورد - با حجم 0.43 مگابایت
    دانلود پروژه های پورت و ای پی - با حجم 0.0 مگابایت
    دانلود پروژه های ریجستری - با حجم 0.10 مگابایت
    دانلود پروژه های سرویس - با حجم 0.25 مگابایت
    دانلود پروژه های Spy - با حجم 0.10 مگابایت
    دانلود پروژه های Toolbar - با حجم 0.68 مگابایت
    دانلود پروژه های Top Project - با حجم 3.24 مگابایت
    دانلود پروژه های Trojan - با حجم 1.70 مگابایت
    دانلود پروژه های کاربردی - با حجم 0.83 مگابایت
    دانلود پروژه های Win Optimizer & Win Tools - با حجم 0.04 مگابایت
    دانلود پروژه های XP Tools - با حجم 1.13 مگابایت
    دانلود پروژه های کار با فایل Zip - با حجم 2.66 مگابایت


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

    نفر بعدي ... چه مي دونم بابا ! فقط نكته ضعيف نذاره !
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 02:44 صبح

  25. #25
    کاربر دائمی آواتار butterfly8528
    تاریخ عضویت
    شهریور 1387
    محل زندگی
    CLR
    پست
    896

    Wink نقل قول: نفر بعدي كيه ؟

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

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

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

    نفر بعدی یه برنامه نویس نخبه س
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 15:41 عصر

  26. #26
    کاربر جدید آواتار tizhoosh
    تاریخ عضویت
    خرداد 1386
    محل زندگی
    الف) آشيانه ب )لانه ج)خونتون؟!
    پست
    21

    Talking نقل قول: نفر بعدي كيه ؟

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

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

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


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

    و اما... نفر بعدی כגכגנ עהגיעיה ךדלמד נעהגהגשדדגכגבסכנםךחלח
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 15:42 عصر

  27. #27
    کاربر دائمی آواتار میلاد علوی
    تاریخ عضویت
    دی 1384
    محل زندگی
    پشت کامپیوتر
    پست
    200

    نقل قول: نفر بعدي كيه ؟

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

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

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

    نفر بعدی من نیستم
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 08:53 صبح

  28. #28
    کاربر دائمی آواتار aidin1386
    تاریخ عضویت
    دی 1386
    محل زندگی
    سايت برنامه نويس ديگه
    سن
    28
    پست
    156

    Cool نقل قول: نفر بعدي كيه ؟

    آره منم، دوباره منم

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

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


    ان الذين القادم، ان هو قد مبرج في السايت المبرجين
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 08:54 صبح

  29. #29

    نقل قول: نفر بعدي كيه ؟

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

    نكته ويژوال :

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

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

    نفر بعدي مشغول سر و كله زدن با اين موضوع هست
    عکس های ضمیمه عکس های ضمیمه
    فایل های ضمیمه فایل های ضمیمه
    اگر من و شما هر كدوم يك چيز ياد داشته باشيم و به هم ياد بديم، حالا هر كدوم دو تا چيز ياد داريم ! http://www.ArminaCo.com

  30. #30

    نقل قول: نفر بعدي كيه ؟

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

    نکته ویژوالي :
    نکته ندارم جاش سورس میزارم(فرم نیمه شفاف):
     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 یا هر چیز آماده دیگه استفاده کرد
    اگه شدنی نیست چرا؟!
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:00 صبح دلیل: قرار دادن کد در تگ

  31. #31
    VIP آواتار xxxxx_xxxxx
    تاریخ عضویت
    شهریور 1386
    محل زندگی
    X place
    سن
    33
    پست
    4,768

    نقل قول: نفر بعدي كيه ؟

    سلام،
    گفته شما رو به شدت تكذيب مي كنم. اصلاً اينطور نيست كه هر برنامه نويسي از سورسهاي آماده استفاده كنه. درسته كه مثلاً براي عكس گرفتن از مانيتور بايد از 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 هست

    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:04 صبح
    الگوریتم هایی که تاریخچه خود را فراموش می کنند، محکوم به تکرار آن هستند.

  32. #32
    کاربر دائمی آواتار butterfly8528
    تاریخ عضویت
    شهریور 1387
    محل زندگی
    CLR
    پست
    896

    Wink نقل قول: نفر بعدي كيه ؟

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


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

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


    کد HTML:
    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 عزیز با یه نکته با حال تره
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:04 صبح

  33. #33
    VIP آواتار xxxxx_xxxxx
    تاریخ عضویت
    شهریور 1386
    محل زندگی
    X place
    سن
    33
    پست
    4,768

    نقل قول: نفر بعدي كيه ؟

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

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

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

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


    نفر بعدي داره سعي ميكنه برعكس اينو بنويسه (Bin2Dec)
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:05 صبح
    الگوریتم هایی که تاریخچه خود را فراموش می کنند، محکوم به تکرار آن هستند.

  34. #34
    کاربر دائمی آواتار f.nabavi
    تاریخ عضویت
    اردیبهشت 1387
    محل زندگی
    طهرون جدید
    پست
    255

    نقل قول: نفر بعدي كيه ؟

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

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

    ذهن نفر بعدی الان کلی درگیری داره تا یه تاپیک خوب بزنه...
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:05 صبح

  35. #35
    کاربر تازه وارد آواتار hamid_sos
    تاریخ عضویت
    مهر 1387
    محل زندگی
    همه جا
    پست
    58

    نقل قول: نفر بعدي كيه ؟

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

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

    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


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

    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:06 صبح

  36. #36
    کاربر دائمی آواتار butterfly8528
    تاریخ عضویت
    شهریور 1387
    محل زندگی
    CLR
    پست
    896

    Wink نقل قول: نفر بعدي كيه ؟

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

    یک کد ساده برای استفاده از اکتیو ایکس ها فقط به صورت ریفرنس در منوی ریفرنس در قسمت منوی پروژه :
    می خواهیم از 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 % خودشه

    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:07 صبح

  37. #37
    کاربر دائمی
    تاریخ عضویت
    مرداد 1387
    محل زندگی
    MsgBox barnamenevis.org
    پست
    540

    Talking نقل قول: نفر بعدي كيه ؟

    آفرين جواب شما صحيح بود 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

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

  38. #38
    کاربر دائمی آواتار Mr'Jamshidy
    تاریخ عضویت
    مرداد 1386
    محل زندگی
    Network
    پست
    994

    نقل قول: نفر بعدي كيه ؟

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

    نكته ويژوال :

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

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

  39. #39
    کاربر تازه وارد
    تاریخ عضویت
    تیر 1386
    محل زندگی
    مشهد
    پست
    41

    نقل قول: نفر بعدي كيه ؟

    اون منم

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

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

     Dim valid As String 
    valid ="1234567890."

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


    اميدوارم نفر بعد نذاره تاپيك به صفحه دوم برود
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:09 عصر

  40. #40
    کاربر دائمی آواتار saeid12
    تاریخ عضویت
    مهر 1387
    محل زندگی
    تهران
    پست
    249

    نقل قول: نفر بعدي كيه ؟

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

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


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

    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


    نفر بعدی فامیل بیل گیتس باید باشه ؟؟!!
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:11 عصر

صفحه 1 از 5 123 ... آخرآخر

تاپیک های مشابه

  1. آموزش: ساعت توسط JavaScript با روشي جالب و متفاوت و جذاب
    نوشته شده توسط hakan648 در بخش طراحی وب (Web Design)
    پاسخ: 0
    آخرین پست: جمعه 30 اردیبهشت 1390, 17:31 عصر
  2. ساعت توسط JS با روشي جالب و متفاوت و جذاب
    نوشته شده توسط hakan648 در بخش طراحی وب (Web Design)
    پاسخ: 1
    آخرین پست: پنج شنبه 22 اردیبهشت 1390, 19:07 عصر
  3. یک برنامه جالب!
    نوشته شده توسط mr_esmaily در بخش VB.NET
    پاسخ: 20
    آخرین پست: سه شنبه 01 مهر 1382, 15:37 عصر
  4. پاسخ: 0
    آخرین پست: سه شنبه 25 شهریور 1382, 15:37 عصر
  5. دوستان یک سایت جالب
    نوشته شده توسط منصور بزرگمهر در بخش VB.NET
    پاسخ: 0
    آخرین پست: پنج شنبه 05 تیر 1382, 01:14 صبح

برچسب های این تاپیک

قوانین ایجاد تاپیک در تالار

  • شما نمی توانید تاپیک جدید ایجاد کنید
  • شما نمی توانید به تاپیک ها پاسخ دهید
  • شما نمی توانید ضمیمه ارسال کنید
  • شما نمی توانید پاسخ هایتان را ویرایش کنید
  •