پاسخ : سورس های کاربردی و پیشرفته ساخت لینک کد PHP: 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.persiancoder.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
پاسخ : سورس های کاربردی و پیشرفته دادن تم Xp به برنامه واسه اين كار Notepad رو باز كنين و كد زير رو توش كپي كنيد کد PHP: <?xml version="1.0" encoding="UTF-8" standalone="yes"?> <assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0"> <assemblyIdentity version="1.0.0.0" processorArchitecture="X86" name=" Name" type="win32" /> <dependency> <dependentAssembly> <assemblyIdentity type="win32" name="Microsoft.Windows.Common-Controls" version="6.0.0.0" processorArchitecture="X86" publicKeyToken="6595b64144ccf1df" language="*" /> </dependentAssembly> </dependency> </assembly> و بجاي Name در كد بالا نام برنامه تون رو بزارين فايل را با نام x.exe.MANIFEST ذخيره كنين x همون نام برنامه است حالا توي VB برين و توي فرم يه ProgressBar بزارين از برنامه يه نسخه اجرايي بگيرين
پاسخ : سورس های کاربردی و پیشرفته انتقال فایل Private Sub Command1_Click() Name "c:\a.bat" As "D:\h.bat" End Sub
پاسخ : سورس های کاربردی و پیشرفته کادر باز کردن پوشه (Folder Browse ) در ماوژول : کد PHP: Public Const BIF_RETURNONLYFSDIRS = 1 Public Const BIF_DONTGOBELOWDOMAIN = 2 Public Const MAX_PATH = 260 Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long '*** Public Type BrowseInfo hWndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type در فرم : کد PHP: Private Sub Command1_Click() Dim lpIDList As Long Dim sBuffer As String Dim szTitle As String Dim BrowseInf As BrowseInfo szTitle = "ÌÓÊÌæí Ú˜Ó" With BrowseInf .hWndOwner = Me.hWnd .lpszTitle = lstrcat(szTitle, "") .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN End With lpIDList = SHBrowseForFolder(BrowseInf) If (lpIDList) Then sBuffer = Space(MAX_PATH) SHGetPathFromIDList lpIDList, sBuffer 'sBuffer value is the directory that the user choose from the dialog. sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1) Text1.Text = sBuffer End If End Sub
پاسخ : سورس های کاربردی و پیشرفته بازیابی سطر معینی از یک فایل کد PHP: Public Function readLine(ByRef strFilePath As String, ByRef nLine _ As Integer) As String Dim NextLine As String Dim n As Integer FileNum = FreeFile Open strFilePath For Input As FileNum Do Until EOF(FileNum) Line Input #FileNum, NextLine n = n + 1 If n = nLine Then readLine = NextLine Loop Close End Function Private Sub Command1_Click() Text1.Text = readLine("d:\a.bat", 3) End Sub
پاسخ : سورس های کاربردی و پیشرفته پنجره ی غیر قابل حرکت کد PHP: Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, _ ByVal bRevert As Long) As Long Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, _ ByVal nPosition As Long, ByVal wFlags As Long) As Long Private Const SC_MOVE = &HF010& Private Const MF_BYCOMMAND = &H0& Private Sub Command1_Click() lhSysMenu = GetSystemMenu(Me.hwnd, False) lRetVal = RemoveMenu(lhSysMenu, SC_MOVE, MF_BYCOMMAND) End Sub
پاسخ : سورس های کاربردی و پیشرفته جستجو با کمک توابع API کد PHP: 'Add a module to your project (In the menu choose Project -> Add Module, Then click Open) 'Add 1 Command Button, 4 Text Boxes and 1 List Box to your Form. 'At Run-Time, Enter the path that you want to start to search from it to Text1, 'Enter the file pattern to Text2 (like *.* or *.exe), and press the button. 'List1 will be filled with all the matching files, Text3 will display the number of files found, 'And Text4 will display the total size of the files found. 'Insert this code to the module : Private Declare Function FindFirstFile Lib "kernel32" Alias _ "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _ As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _ (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function GetFileAttributes Lib "kernel32" Alias _ "GetFileAttributesA" (ByVal lpFileName As String) As Long Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) _ As Long Private Const MAX_PATH = 260 Private Const MAXDWORD = &HFFFF Private Const INVALID_HANDLE_VALUE = -1 Private Const FILE_ATTRIBUTE_ARCHIVE = &H20 Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 Private Const FILE_ATTRIBUTE_HIDDEN = &H2 Private Const FILE_ATTRIBUTE_NORMAL = &H80 Private Const FILE_ATTRIBUTE_READONLY = &H1 Private Const FILE_ATTRIBUTE_SYSTEM = &H4 Private Const FILE_ATTRIBUTE_TEMPORARY = &H100 Private Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As FILETIME ftLastAccessTime As FILETIME ftLastWriteTime As FILETIME nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14 End Type Private Function StripNulls(OriginalStr As String) As String If (InStr(OriginalStr, Chr(0)) > 0) Then OriginalStr = Left(OriginalStr, _ InStr(OriginalStr, Chr(0)) - 1) End If StripNulls = OriginalStr End Function 'Insert the following code to your form: Private Function FindFilesAPI(path As String, SearchStr As String, _ FileCount As Integer, DirCount As Integer) Dim FileName As String Dim DirName As String Dim dirNames() As String Dim nDir As Integer Dim i As Integer Dim hSearch As Long Dim WFD As WIN32_FIND_DATA Dim Cont As Integer If Right(path, 1) <> "\" Then path = path & "\" nDir = 0 ReDim dirNames(nDir) Cont = True hSearch = FindFirstFile(path & "*", WFD) If hSearch <> INVALID_HANDLE_VALUE Then Do While Cont DirName = StripNulls(WFD.cFileName) If (DirName <> ".") And (DirName <> "..") Then If GetFileAttributes(path & DirName) And _ FILE_ATTRIBUTE_DIRECTORY Then dirNames(nDir) = DirName DirCount = DirCount + 1 nDir = nDir + 1 ReDim Preserve dirNames(nDir) End If End If Cont = FindNextFile(hSearch, WFD) Loop Cont = FindClose(hSearch) End If hSearch = FindFirstFile(path & SearchStr, WFD) Cont = True If hSearch <> INVALID_HANDLE_VALUE Then While Cont FileName = StripNulls(WFD.cFileName) If (FileName <> ".") And (FileName <> "..") Then FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * _ MAXDWORD) + WFD.nFileSizeLow FileCount = FileCount + 1 List1.AddItem path & FileName End If Cont = FindNextFile(hSearch, WFD) Wend Cont = FindClose(hSearch) End If If nDir > 0 Then For i = 0 To nDir - 1 FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) _ & "\", SearchStr, FileCount, DirCount) Next i End If End Function Private Sub Command1_Click() Dim SearchPath As String, FindStr As String Dim FileSize As Long Dim NumFiles As Integer, NumDirs As Integer Screen.MousePointer = vbHourglass List1.Clear SearchPath = Text1.Text FindStr = Text2.Text FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs) Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & _ " Directories" Text4.Text = "Size of files found under " & SearchPath & " = " & _ Format(FileSize, "#,###,###,##0") & " Bytes" Screen.MousePointer = vbDefault End Sub
پاسخ : سورس های کاربردی و پیشرفته ایجاد شاخه کد PHP: Private Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Any) As Long Private Sub Form_Load() 'KPD-Team 2000 'URL: http://www.allapi.net/ 'E-Mail: KPDTeam[MENTION=54160]alla[/MENTION]pi.net 'create the directory 'c:\test\dir\hello\something\apiguide\' SHCreateDirectoryEx Me.hwnd, "c:\test\dir\hello\something\apiguide\", ByVal 0& End Sub
پاسخ : سورس های کاربردی و پیشرفته پخش فايل صوتي راحت ترين روش كافيه يه Textbox بزارين و دو command Button به صورتي كه دومي كپي اولي باشه و آرايه درست بشه اين كد ها رو تو جنرال فرمتون كپي كنين کد PHP: Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _ ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Dim isPlaying As Boolean Dim Mp3File As String Private Sub Command1_Click(Index As Integer) Mp3File = Chr$(34) + Trim(Text1.Text) + Chr$(34) Select Case Index Case 0 mciSendString "open " + Mp3File, 0&, 0&, 0& mciSendString "play " + Mp3File, "", 0&, 0& isPlaying = True Case 1 mciSendString "close " + Mp3File, 0&, 0&, 0& isPlaying = False End Select End Sub Private Sub Command2_Click() Unload Me End Sub Private Sub Form_Load() Command1(0).Caption = "Start" Command1(1).Caption = "Stop" Command2.Caption = "Exit" End Sub Private Sub Form_Unload(Cancel As Integer) If isPlaying = True Then mciSendString "close " + Mp3File, 0&, 0&, 0& End If End Sub حالا آدرس فايل صوتي رو بنويسين تو Textbox تا واستون اجرا كنه
پاسخ : سورس های کاربردی و پیشرفته تغییر کلید میانبر یک منو در زمان اجرا هنگامی که از ویرایگر منو در ویژوال بیسیک استفاده می کنید می توانید یک کلید میانبر یا سریع کننده به هر کدام از آنها اختصاص دهید . این بخش نحوه تغییر دادن این کلید ها را در زمان اجرا را در یک برنامه کاربردی مورد بررسی قرار می دهد. 1- پروژه جدیدی را در ویژوال بیسیک آغاز کنید . بطور پیش فرض Form1 ایجاد می شود. 2- کد زیر را به قسمت معرفیهای عمومی فرم اضافه کنید : Option Explicit Dim ShortCut as String * 1 3- از منوی Tools روی گزینه Menu Editor کلیک کنید تا یک منوی ساده ایجاد شود . در محل Caoption کلمه : File& و در محل مربوط به نام mnuFile را وارد و روی Ok کلیک کنید تا یک ساختار منویی ایجاد شود . سپس به حالت طراحی ویژوال بیسیک برگردید. 4- کد زیر را در رویداد Load مربوط به Form1 وارد کنید. Private Sub Form_Load() Command1.Caption = "Change ShortCut" KeyPreview = True End Sub 5- کد زیر را هم در رویداد KeyDown فرم اضافه نمایید : Private Sub Form_KeyDown (KeyCode As Integer , Shift As Integer) If Shift And 2 <> 2 Then Exit Sub If Keycode = Asc(ShortCut) Then mnuFile_Click End If End Sub 6- کد زیر را در رویداد Click منوی mnuFile وارد کنید : Private Sub mnuFile_Click() MsgBox "Menu Was Selected" End Sub 7- کنترلی از نوع Command Button به فرم اضافه کنید . Command1 بطور پیش فرض ایجاد می شود . خصوصیت Caption آنرا به Change Item تنظیم نمایید. 8- کد زیر را به رویداد Click این دکمه اضافه کنید : Private Sub Command1_Click() ShortCut = "E" mnuFile.Caption = "Fill" & "&" & LCase$(ShortCut) End Sub با فشاردادن کلید F5 برنامه را اجرا کنید . به منوی بالای فرم توجه کنید . گزینه منو File"" می باشد که زیر حرف F آن خط کشیده شده است . حرف F ، کلید دستیابی به منوی مزبور می باشد . روی دکمه کلیک کنید . گزینه منوی به File تغییر داده می شود منتهی این بار زیر حرف e آن خط کشیده شده است . کلید ترکیبی Ctrl + E را روی ضفحه فشار دهید . یک کادر پیغام باز می شود که مضمون آن به این صورت است : Menu Was Selected