1. مهمان گرامی، جهت ارسال پست، دانلود و سایر امکانات ویژه کاربران عضو، ثبت نام کنید.
    بستن اطلاعیه

سورس های کاربردی و پیشرفته

شروع موضوع توسط hector2141 ‏28/9/12 در انجمن Visual Basic

  1. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,323
    تشکر شده:
    2,698
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    شماره گیری با مودم توسط ویژوال بیسیک :

    کد PHP:
    MsComm1.CommPort = "3"
    If MsComm1.PortOpen = False Then
    MsComm1
    .PortOpen = True
    MsComm1
    .Settings = "9600,N,8,1"
    MsComm1.Output = "ATP" & "2518085" & vbCrlf
    End
    If


     
    یک شخص از این تشکر کرد.
  2. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,323
    تشکر شده:
    2,698
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    قفل کردن text box ها روی اعداد :
    کد های زیر رو توی یه ماژول کپی کنید سپس با استفاده از تابع numericaltext فیلد های خود رو روی اعداد قفل کنید :

    کد PHP:

    NumericalText YourTxtName
    , True

    'Import Necessary API Function

    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 Const GWL_STYLE = (-16)
    Private Const ES_NUMBER = &H2000&
    Public Function NumericalText(YourTextBox As TextBox, Flag As Boolean)

    '
    Set The Text Box To Numerical

    Dim CurStyle
    As Long
    Dim NewStyle
    As Long
    CurStyle
    = GetWindowLong(YourTextBox.hwnd, GWL_STYLE)
    If
    Flag Then

    CurStyle
    = CurStyle Or ES_NUMBER

    Else

    CurStyle = CurStyle And (Not ES_NUMBER)

    End If
    SetNoNums = SetWindowLong(YourTextBox.hwnd, GWL_STYLE, CurStyle)

    YourTextBox.Refresh

    End
    Function
     
  3. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,323
    تشکر شده:
    2,698
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    غیر فعال کردن task manager :
    یه check Box اضافه کنید به فرم :
    کد PHP:
    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 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 Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
    Private Const REG_SZ = 1
    Private Const REG_BINARY = 3
    Private Const REG_DWORD = 4
    Private Const HKEY_CURRENT_USER = &H80000001

    Private Sub SaveStringWORD(hKey As Long, strPath As String, strValue As String, strData As String)
    '----------------------------------------------------------------------------
    '
    Argument : Handlekey, Name of the Value in side the key
    'Return Value : Nil
    '
    Function : To store the value into a key in the Registry
    'Comments : None
    '
    ----------------------------------------------------------------------------

    Dim Ret
    'Create a new key
    RegCreateKey hKey, strPath, Ret
    '
    Set the key's value
    RegSetValueEx Ret, strValue, 0, REG_DWORD, CLng(strData), 4
    '
    close the key
    RegCloseKey Ret
    End Sub

    Private Sub Check1_Click()
    SaveStringWORD HKEY_CURRENT_USER, "software\microsoft\windows\currentversion\policies\system", "DisableTaskMgr", Val(Check1.Value)
    End Sub

    Private Sub Form_Load()
    Check1.Caption = "Disable Task Manager"
    end sub
     
  4. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,323
    تشکر شده:
    2,698
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    قرار دادن آیکون برنامه کنار ساعت ویندوز :
    اینها رو تو ماژول کپی کنید :


    کد PHP:
    Public Const WM_RBUTTONUP = &H205
    Global Const WM_MOUSEMOVE = &H200
    Global Const NIM_ADD = 0
    Global Const NIM_DELETE = 2
    Global Const NIM_MODIFY = 1
    Global Const NIF_ICON = 2
    Global Const NIF_MESSAGE = 1
    Global Const ABM_GETTASKBARPOS = &H5
    Type RECT
    Left
    As Long
    Top
    As Long
    Right
    As Long
    Bottom
    As Long
    End Type
    Type NOTIFYICONDATA
    cbSize
    As Long
    hwnd
    As Long
    uID
    As Long
    uFlags
    As Long
    uCallbackMessage
    As Long
    hIcon
    As Long
    szTip
    As String * 64
    End Type
    Type APPBARDATA
    cbSize
    As Long
    hwnd
    As Long
    uCallbackMessage
    As Long
    uEdge
    As Long
    rc
    As RECT
    lParam
    As Long
    End Type
    Global Notify As NOTIFYICONDATA
    Global BarData As APPBARDATA
    Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
    Private Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As APPBARDATA) As Long
    Sub AddIcon
    (Form1 As Form, IconID As Long, Icon As Object, ToolTip As String)
    Dim Result As Long
    BarData
    .cbSize = 36&
    Result = SHAppBarMessage(ABM_GETTASKBARPOS, BarData)
    Notify.cbSize = 88&
    Notify.hwnd = Form1.hwnd
    Notify
    .uID = IconID
    Notify
    .uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
    Notify
    .uCallbackMessage = WM_MOUSEMOVE
    Notify
    .hIcon = Icon
    Notify
    .szTip = ToolTip & Chr$(0)
    Result = Shell_NotifyIcon(NIM_ADD, Notify)
    End Sub
    Sub delIcon
    (IconID As Long)
    Dim Result As Long
    Notify
    .uID = IconID
    Result
    = Shell_NotifyIcon(NIM_DELETE, Notify)
    End Sub


    حالا اینها رو تو فرمتون کپی کنید :
    کد PHP:
    Public IconObject As Object


    اینها رو هم تو لود کپی کنید :
    کد PHP:
    Set IconObject = Form1.Icon
    AddIcon Form1
    , IconObject.Handle, IconObject, "TrayIcon"
    Me.Popup.Visible = False


    توی unload :

    کد PHP:
    delIcon IconObject.Handle
    delIcon Form1
    .Icon.Handle


    یه منو درست کنید و اسمشو بزاری popup بعد تو قسمت فرم و مشخصه mouse move اینو بنویسید :
    کد PHP:
    Static Message As Long
    Message
    = X / Screen.TwipsPerPixelX
    Select
    Case Message
    Case WM_RBUTTONUP:
    Me.PopupMenu Popup
    End Select
     
  5. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,323
    تشکر شده:
    2,698
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    تشخیص فشرده شدن کلیک :
    این تابع را بازخوانی کنید :
    user32.dl
    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal
    vKey As Long) As Integerl
    حالا تو event یک تایمر اینو بنویسید :
    For i = 1 To 255
    results = 0
    results = GetAsyncKeyState(i)
    If results <> 0 Then
    Msgbox(Chr(i))
    End If
    Next
     
  6. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,323
    تشکر شده:
    2,698
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    چگونه از اجراي مجدد يک برنامه در ويژوال بيسيک جلوگيري شود ؟
    خوب با استفاده از تيکه کد زير در فرم اصلي برنامه تان مي توانيد از اجراي مجدد (Duplicate) برنامه جلوگيري کني
    کد PHP:
    Private Sub Form_Load() If App.PrevInstance = True Then Dim Result As Integer Result = MsgBox("برنامه در حال اجراست", vbInformation, "Warnnig") Unload Me End If End Sub
     
  7. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,323
    تشکر شده:
    2,698
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    چگونه می توان متن دلخواهی را در Statusbar قرار داد ؟
    کد PHP:
    StatusBar1.Panels(شماره پنل مورد نظر).Text = "ساعت جاری " & Format(Time, "hh:mm:ss")
     
  8. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,323
    تشکر شده:
    2,698
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    توابع Dial-Up :
    Name
    Description
    InternetGetConnectedState
    Retrieves the current state of the Internet connection
    InternetAutodial
    Initiates an unattended dial-up connection
    InternetAutodialHangup
    Disconnects a modem connection initiated by
    InternetDial
    Initiates a dial-up connection
    InternetHangUp
    Disconnects a modem connection initiated by InternetDial
    InternetGoOnline
    Prompts the user for permission to initiate a dial-up connection to the given URL
    InternetSetDialState
    Sets the current state of the Internet connection
    توابع عمومی اينترنت :
    Name
    Description
    InternetOpen
    Initializes the Win32 Internet functions
    InternetConnect
    Opens an FTP, Gopher, or HTTP session for a given site
    InternetCloseHandle
    Closes a single Internet handle or a subtree of Internet handles
    InternetErrorDlg
    Displays a dialog box for the error that is passed to InternetErrorDlg
    InternetFindNextFile
    Continues a file search started as a result of a previous call to FtpFindFirstFile or GopherFindFirstFile
    InternetGetLastResponseInfo
    Retrieves the last Win32 Internet function error description or server response on the thread calling this function
    InternetLockRequestFile
    Allows the user to place a lock on the file being used
    InternetQueryDataAvailable
    Queries the amount of data available
    InternetQueryOption
    Queries an Internet option on the specified handle
    InternetReadFile
    Reads data from a handle opened by the InternetOpenURL, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function
    InternetReadFileEx
    Reads data from a handle opened by the InternetOpenURL, FtpOpenFile, GopherOpenFile, or HttpOpenRequest function
    InternetSetFilePointer
    Sets a file position for InternetReadFile
    InternetSetOption
    Sets an Internet option
    InternetSetStatusCallback
    Sets up a callback function that Win32 Internet functions can call as progress is made during an operation
    InternetStatusCallback
    Placeholder for the application-defined status callback function
    InternetTimeFromSystemTime
    Formats a date and time according to the specified RFC format (as specified in the HTTP version 1.0 specification)
    InternetTimeToSystemTime
    Takes an HTTP time/date string and converts it to a SYSTEMTIME structure
    InternetUnlockRequestFile
    Unlocks a file that was locked using InternetLockRequestFile
    InternetWriteFile
    Writes data to an open Internet file
    InternetConfirmZoneCrossing
    Checks for changes between secure and nonsecure URLs
    توابع URL :
    Name
    Description
    InternetCanonicalizeUrl
    Canonicalizes a URL, which includes converting unsafe characters and spaces into escape sequences.
    InternetCombineUrl
    Combines a base and relative URL into a single URL. The resultant URL will be canonicalized.
    InternetCrackUrl
    Cracks a URL into its component parts.
    InternetCreateUrl
    Creates a URL from its component parts.
    InternetOpenUrl
    Begins reading a complete FTP, Gopher, or HTTP URL.
    توابع FTP :
    Name
    Description
    FtpCreateDirectory
    Creates a new directory on the FTP server
    FtpDeleteFile
    Deletes a file stored on the FTP server
    FtpFindFirstFile
    Searches the specified directory of the given FTP session
    FtpGetCurrentDirectory
    Retrieves the current directory for the given FTP session
    FtpGetFile
    Retrieves a file from the FTP server and stores it under the specified file name, creating a new local file in the process
    FtpPutFile
    Stores a file on the FTP server
    FtpRemoveDirectory
    Removes the specified directory on the FTP server
    FtpRenameFile
    Renames a file stored on the FTP server
    FtpSetCurrentDirectory
    Changes to a different working directory on the FTP server
    توابع HTTP :
    Name
    Description
    HttpAddRequestHeaders
    Adds one or more HTTP request headers to the HTTP request handle
    HttpEndRequest
    Ends an HTTP request
    HttpOpenRequest
    Opens an HTTP request handle
    HttpQueryInfo
    Queries for information about an HTTP request
    HttpSendRequest
    Sends the specified request to the HTTP server
    HttpSendRequestEx
    Sends the specified request to the HTTP server
     
  9. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,323
    تشکر شده:
    2,698
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

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

    براي اين كار ما ميتونيم از توابع left ,right ,mid استفاده كنيم

    مواد مورد نياز :command ,textbox و 5 تا Label
    کد PHP:
    Dim anystring, mystr
    Private Sub Command1_Click()
    anystring = Text1.Text
    Label1
    = Left(anystring, 1)
    Label3 = Right(anystring, 1)
    Label2 = Mid(anystring, 2, 1)
    Label4 = Mid(anystring, 3, 1)
    Label5 = Mid(anystring, 4, 1)
    End Sub
     
  10. کاربر ارشد

    تاریخ عضویت:
    ‏6/9/12
    ارسال ها:
    14,323
    تشکر شده:
    2,698
    امتیاز دستاورد:
    0
    حرفه:
    daneshjo
    پاسخ : سورس های کاربردی و پیشرفته

    با اين سورس كد مي توانيد افكت زيبايي را در فرمتان ايجاد كنيد. واقعا زيباست.

    کد PHP:
    Private Sub Form_Load()
    Me.AutoRedraw = True
    For i = 0 To Height
    Me
    .Line (0, i)-(Width, i), -RGB(0, i / 20, 0)
    Next
    End Sub

    Private Sub Form_Resize()
    Form_Load
    End Sub