صفحه 2 از 6 اولاول 1234 ... آخرآخر
نمایش نتایج 41 تا 80 از 202

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

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

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

    آفرین به تو .

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

        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 باشد، شاید
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:11 صبح

  2. #42

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

    اشتباه است

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

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


    فقط یه تکست باکس رو فرم بذارین
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:11 صبح

  3. #43
    کاربر دائمی آواتار mmssoft
    تاریخ عضویت
    خرداد 1388
    محل زندگی
    Middle of nowhere
    پست
    847

    Lightbulb

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

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

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

    - ابتدا 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)



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

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


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

  4. #44
    کاربر تازه وارد آواتار iranian-pc
    تاریخ عضویت
    اردیبهشت 1388
    محل زندگی
    نصف جهان
    پست
    79

    Arrow

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

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

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

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

    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:33 عصر

  5. #45
    کاربر دائمی آواتار relax_cp
    تاریخ عضویت
    فروردین 1388
    محل زندگی
    مشهد مقدس
    پست
    216

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

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

    خاصیت 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

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

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

    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:33 عصر

  6. #46
    کاربر جدید آواتار mohsen002
    تاریخ عضویت
    اردیبهشت 1388
    محل زندگی
    C:\windows\system32
    پست
    28

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

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

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

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

    نفر بعدي حتماً داره فكر ميكنه كه راجع به نفر بعديش چي بگه
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:30 صبح

  7. #47
    کاربر دائمی آواتار Dr.Bronx
    تاریخ عضویت
    مهر 1386
    محل زندگی
    Hosna Soft
    پست
    1,108

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

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

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

    چطوری Header رو در Vsflexgrid تغییر بدیم
    Vs.TextMatrix(0,1)= "کد"
    Vs.TextMatrix(0,2)= "نام"


    نفر بعدی داره فکر می کنه این تاپیک کجا بوده تا حالا ...
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:31 صبح

  8. #48
    کاربر دائمی آواتار shahmahi
    تاریخ عضویت
    مرداد 1388
    محل زندگی
    مشهد
    پست
    161

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

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

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

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

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

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

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

  9. #49
    کاربر دائمی آواتار Dr.Bronx
    تاریخ عضویت
    مهر 1386
    محل زندگی
    Hosna Soft
    پست
    1,108
    واقعا هم که این اطلاعات عجیب غریب رو از از کجا میارید شما
    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


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

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

  10. #50
    کاربر دائمی آواتار Samsam2010
    تاریخ عضویت
    آبان 1388
    محل زندگی
    همدان
    پست
    238

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

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

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

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


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

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

  11. #51
    کاربر دائمی آواتار Dr.Bronx
    تاریخ عضویت
    مهر 1386
    محل زندگی
    Hosna Soft
    پست
    1,108

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

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

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

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

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

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

    نفر بعدی داره فکر میکنه که آیا جواب بدم یا جواب ندم .
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:36 صبح

  12. #52
    کاربر دائمی آواتار MBG73
    تاریخ عضویت
    فروردین 1388
    محل زندگی
    Canada-Frederecton
    سن
    29
    پست
    138

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

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

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

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

    اگر مقدار compare 1 باشد تابع بین حروف حروف کوچک و بزرگ تفاوت قائل نمیشود و اگه 0 باشد برعکس.

    نفر بعدی حتما بعد از ساعت 12 پست میده.
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:36 صبح

  13. #53
    کاربر تازه وارد آواتار Faravahar
    تاریخ عضویت
    بهمن 1387
    محل زندگی
    جای ثابتی ندارم!
    سن
    34
    پست
    32

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

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

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

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

    نفر بعدی قبله اینکه پست بزاره یه لیوان چایی خورده !
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:42 صبح دلیل: خطای املایی!

  14. #54
    کاربر دائمی آواتار REZADG
    تاریخ عضویت
    فروردین 1387
    محل زندگی
    هر جایی که انسان میتونه باشه
    پست
    472
    تازه داره جالب میشه منم میخوام شروع کنم

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

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

    نفر بعدی چیز با حال بگو نه مثل من مبتدی
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:45 صبح دلیل: ادغام

  15. #55
    کاربر دائمی آواتار Dr.Bronx
    تاریخ عضویت
    مهر 1386
    محل زندگی
    Hosna Soft
    پست
    1,108
    شما هم مثل همه بنویس دیگه . ممنون

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

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

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

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

  16. #56
    کاربر تازه وارد آواتار Faravahar
    تاریخ عضویت
    بهمن 1387
    محل زندگی
    جای ثابتی ندارم!
    سن
    34
    پست
    32

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

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

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

    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


    نفر بعدی در مورد کد بالا توضیح میدهد . بفرما!
    آخرین ویرایش به وسیله vbhamed : سه شنبه 26 فروردین 1393 در 09:48 صبح

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

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

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

    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"

  18. #58
    کاربر دائمی آواتار skh1300
    تاریخ عضویت
    بهمن 1387
    محل زندگی
    یه جای خوش آب هوا
    پست
    207

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

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

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

    پخش کننده 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")


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

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

  19. #59
    کاربر دائمی
    تاریخ عضویت
    فروردین 1387
    محل زندگی
    شهر ایلام
    سن
    41
    پست
    261

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

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

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


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

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

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

  20. #60
    کاربر دائمی آواتار Dr.Bronx
    تاریخ عضویت
    مهر 1386
    محل زندگی
    Hosna Soft
    پست
    1,108

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

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

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

    بهتر اینه که مستقیم این مسیر رو از داخل بانک بخونیم
    نه اینکه یک بار داخل تکست باکس بیاریم و از اونجا بخونیم
    البته باید ابتدا با تابع 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 : سه شنبه 26 فروردین 1393 در 09:51 صبح

  21. #61

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

    سلام

    تشکر، فکر می کنم 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 حذف می کنه

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

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

  22. #62
    کاربر دائمی آواتار Rezapcclick
    تاریخ عضویت
    اردیبهشت 1388
    محل زندگی
    دنیای من و تو
    پست
    114

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

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

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

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

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

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

    نفر بعدی فکر کنم یه آدم شوخ و باحال و اهل شادی باشه
    فایل های ضمیمه فایل های ضمیمه
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:37 عصر

  23. #63
    کاربر دائمی آواتار polisoftco
    تاریخ عضویت
    مهر 1385
    محل زندگی
    Temporary Internet Files
    پست
    209

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

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

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

    چگونه میتوان تعداد خطوط تایپ شده توی یک 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


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

    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:37 عصر

  24. #64
    کاربر دائمی آواتار unit001
    تاریخ عضویت
    آذر 1387
    محل زندگی
    قم
    پست
    101

    نقل قول: نفر بعدی کیه ؟

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

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

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

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

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

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

  25. #65
    کاربر دائمی آواتار Rezapcclick
    تاریخ عضویت
    اردیبهشت 1388
    محل زندگی
    دنیای من و تو
    پست
    114

    نقل قول: نفر بعدی کیه ؟

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

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

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

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

  26. #66
    کاربر دائمی آواتار earse+erse
    تاریخ عضویت
    اسفند 1387
    محل زندگی
    ساري
    پست
    315

    Cool

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

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

    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


    نفر بعدی آقا حامد نیست.
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:39 عصر

  27. #67
    کاربر دائمی آواتار aryasoft2872
    تاریخ عضویت
    بهمن 1386
    محل زندگی
    بیرجند
    پست
    399
    نكته ويژوالي :

    روش تعیین اجرای یک برنامه برای اجرای یک پسوند خاص
      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


    نفر بعدی حتما میگه از این موضوع مزخرف تر پیدا نکرد بگه؟؟؟!!!
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:42 عصر

  28. #68
    کاربر دائمی
    تاریخ عضویت
    مرداد 1387
    محل زندگی
    35°41′46″N 51°25′23″E
    سن
    28
    پست
    1,545

    Smile نقل قول: نفر بعدی کیه ؟

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

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

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

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

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

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

    • از ارسال برنامه (پروژه) خودداری کنید.
    • در این تاپیک فقط نکاتی در مورد برنامه نویسی در VB6 مطرح میشه.
    • این تاپیک در تالار VB6 قرار داره، پس از ارائه کردن کدهای VB.NET و یا C#‎‎‎ خودداری کنید.
    • از ارسال های فاقد محتوا، که نکته ای در اون وجود نداره خودداری کنید.
    • نکات خودتون رو همراه با توضیحات ارائه کنید. (در حد چند جمله در مورد کد توضیح بدید)
    • به جهت حفظ نظم تاپیک، لطفاً پست های خودتون رو به این شکل ارسال کنید.

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

  30. #70
    کاربر دائمی آواتار ماهان مقدم
    تاریخ عضویت
    خرداد 1387
    محل زندگی
    خونه
    پست
    134

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

    چشم !.

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

    ای کاش vb6 شیء گرا بود ! نظر تو چیه ؟
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:44 عصر

  31. #71
    کاربر دائمی آواتار mahdi1373
    تاریخ عضویت
    فروردین 1388
    محل زندگی
    Shahid Beheshti Developer Center
    پست
    278

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

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


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

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

    نفر بعدی یه بازی سازه!
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:45 عصر

  32. #72

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

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

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

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

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

  33. #73
    کاربر دائمی آواتار ماهان مقدم
    تاریخ عضویت
    خرداد 1387
    محل زندگی
    خونه
    پست
    134
    منظورت تو این فروم بود ؟

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


    می تونی مشکل من رو تو این تاپیک حل کنی ؟ --> https://barnamenevis.org/showthread.php?t=205356
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:47 عصر

  34. #74

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

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

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

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

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

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


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

    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:48 عصر دلیل: استفاده از تگ کد

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

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

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

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

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


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


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

    نفر بعدی مطمئناً نفر بعدی خواهد بود (;
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:49 عصر
    الگوریتم هایی که تاریخچه خود را فراموش می کنند، محکوم به تکرار آن هستند.

  36. #76

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

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

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

    با این کد می تونین فرم تون رو 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


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

  37. #77

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

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

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

    با این کد برنامه تون فقط 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


    نفر بعد یه فردیه که فردا صبح جواب می ده. یه پسر مودب و زرنگ
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 13:51 عصر

  38. #78
    کاربر دائمی آواتار kuh_nur
    تاریخ عضویت
    بهمن 1386
    محل زندگی
    C:\Windows\Temp
    پست
    326

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

    سلام
    دوست عزیز 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


    نفر بعدی حتما یه جواب به این فروم میده
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 15:45 عصر

  39. #79
    کاربر تازه وارد آواتار ehsan78mp
    تاریخ عضویت
    مرداد 1389
    محل زندگی
    اصفهان
    سن
    24
    پست
    58

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

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

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

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

    نفر بعدی به احتمال 99.9% فردیه که بیش از 1 سال با ویژوال بیسیک آشنا هست.
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 15:27 عصر

  40. #80
    کاربر تازه وارد آواتار juggle
    تاریخ عضویت
    تیر 1389
    محل زندگی
    یه خورده بالا تر
    پست
    55

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

    آفرین درست گفتین
    من حدود یک سال که با 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شب جواب میده و خیلی آدم باحال و عالمه.
    آخرین ویرایش به وسیله vbhamed : چهارشنبه 27 فروردین 1393 در 15:47 عصر

صفحه 2 از 6 اولاول 1234 ... آخرآخر

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

  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, 14:37 عصر
  4. پاسخ: 0
    آخرین پست: سه شنبه 25 شهریور 1382, 15:37 عصر
  5. دوستان یک سایت جالب
    نوشته شده توسط منصور بزرگمهر در بخش VB.NET
    پاسخ: 0
    آخرین پست: پنج شنبه 05 تیر 1382, 01:14 صبح

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

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

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