برگزیده های پرشین تولز

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

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
کدی برای آموزش کار با دیتابیس پسورد دار

With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
App.Path & "\data\bank.mdb;Persist Security Info=False;Jet OLEDB: Database Password=ali"
.RecordSource = "select * from tabel one"
End With
 
Last edited:

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
وقتی فوکوس میره روی TextBox تمام متن های داخل TextBox انتخاب میشن یا در حالت Selection در میان.
 

فایل های ضمیمه

  • SeleCt-Text.zip
    1.3 KB · نمایش ها: 15

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
با استفاده از كد زير در هر كجاي كد برنامه تون مي تونيد چك كنيد كه آيا كليد خاصي فشرده شده يا نه؟


Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer 'Key press API

Private Sub t_Timer()

If GetAsyncKeyState(vbKeyUp) <> 0 Then

END

End If

END SUB
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
تلفن زدن داخل برنامه
Private Declare Function tapiRequestMakeCall Lib "TAPI32.DLL" (ByVal Dest As String, ByVal AppName As String, ByVal CalledParty As String,ByVal Comment As String) As Long

()Private Sub Command1_Click
tapiRequestMakeCall Text1.Text, "", "", ""
End Sub
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
ساخت لینک
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
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
دادن تم 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 بزارين
از برنامه يه نسخه اجرايي بگيرين
حالا كيفش رو ببرين.:D
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
انتقال فایل

Private Sub Command1_Click()
Name "c:\a.bat" As "D:\h.bat"
End Sub
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
کادر باز کردن پوشه (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
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
بازیابی سطر معینی از یک فایل

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
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
پنجره ی غیر قابل حرکت
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
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
جستجو با کمک توابع 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
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
ایجاد شاخه
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: [email protected]
    'create the directory 'c:\test\dir\hello\something\apiguide\'
    SHCreateDirectoryEx Me.hwnd, "c:\test\dir\hello\something\apiguide\", ByVal 0&
End Sub
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
پخش فايل صوتي
راحت ترين روش
كافيه يه 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 تا واستون اجرا كنه
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
تغییر کلید میانبر یک منو در زمان اجرا

هنگامی که از ویرایگر منو در ویژوال بیسیک استفاده می کنید می توانید یک کلید میانبر یا سریع کننده به هر کدام از آنها اختصاص دهید . این بخش نحوه تغییر دادن این کلید ها را در زمان اجرا را در یک برنامه کاربردی مورد بررسی قرار می دهد.

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
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
تبديل يك عدد به ساعت ، دقيقه و ثانيه


فرض كنيد در حال نوشتن برنامه اي هستيد كه داراي يكسري رويداد ها و اتفاقات در خصوص زمان بوده و مقدار عددي زمان را متناسب با مجموع ثانيه هايي كه آن رويداد طول مي كشد تا كارش را انجام دهد ، بدست آورده و بازيابي كنيد . همچنين قصد آنرا داريد كه مقدار ثانيه ها را به معادلش بر حسب دقيقه و ثانيه تبديل و عبارت به دست آمده را به كاربر نمايش دهشد . عملگر Mod در ويژوال بيسيك اين پردازش تبديلي را برايتان انجام مي دهد.

بكارگيري عملگر Mod براي محاسبه دوره هاي زماني سپري شده
عملگر Mod در ويژوال بيسيك ، دو عدد را به هم تقسيم مي كند اما فقط باقيمانده عمل تقسيم را بر مي گرداند . اگر بخواهيد معين كنيد كه عدد 121 ( كل ثانيه هايي كه براي يك رويداد ثبت شده است ) چند دقيقه و ثانيه مي شود ، اين عدد را بر 60 تقسيم مي كنيد (‌ثانيه به ازاي هر دقيقه )‌نتيجه تقسيم عدد 2 و باقيمانده آن نيز 1 خواهد بود . اينك اگر از عملگر Mod ، مجددا بر روي عدد اصلي استفاده كنيد ، عدد 1 را دريافت خواهيد كرد كه همان باقيمانده تقسيم فوق است . اين تبديل ،‌در نهايت عدد 121 را به دو دقيقه و يك ثانيه تبديل مي كند.

برنامه نمونه

اين برنامه چگونگي بكارگيري عملگر mod براي تبديل عدد متناسب با زمان به يك رشته را نشان مي دهد .

1- پروژه جديدي در ويژوال بيسيك ايجاد نماييد به طور پيش فرض Form1 ايجاد مي شود.
2- كنترلي از نوع Label به Form1‌ اضافه كنيد . بطور پيش فرض Lable1 ايجاد مي شود. خصوصيت Caption آن را با عبارت "Enter A Value" تنظيم نماييد.
3- سپس كنترلي از نوع Text Box در كنار Label1 اضافه كنيد . بطور پيش فرض Text1 ايجاد مي شود. خصوصيت Text آنرا نيز با Null (خالي) تنظيم نماييد.
4- كد زير را به رويداد LostFocus مربوط به Text1 اضافه نماييد

PHP:
Sub Text1_Lostfocus()
Dim Isec as integer
Isec = val(text1.text)
Breaksex = Str$(Int(Isec /60 )) & "Minute" & Str$(Isec Mod 60) & " Second "
text2.text = Breaksec
end sub
5- كنترلي از نوع Label در زير Label1 به Form1 اضافه كنيد . به طور پيش فرض Label2 ايجاد مي شود خصوصيت Caption آن را با عبارت "Time Passed " تنظيم نماييد.
6- در كنار Label2 و در زير Text1 , كنترل ديگري از نوع Text box اضافه كنيد به طور پيش فرض Text2 ايجاد مي شود . خاصيت text آن را به مقدار خالي تنظيم نماييد.
8- هنگام اجراي برنامه كاربردي يك مقداد عددي در Textbox اول وارد كنيد . سپس كليد Tab را براي ريختن آن به دومين textbox فشار دهيد . برنامه عدد وارد شده را به رشته اي تبديل مي كند كه اين رشته متناسب با مقدار دقيقه و ثانيه مي باشد.
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
انتخاب اتوماتيك متن داخل يك Text Box هنگامي كه نقطه تمركز برنامه با زدن كليد TAB به اين كنترل منتقل مي شود.


اين كار با استفاده از تابغ GetKeyState امكان پذير است .

برنامه نمونه

جمله Declare زير را به قسمت معرفيهاي عمومي فرم اضافه نماييد
کد:
Public Declare Function GetKeyState Lib "user32" alias "GetKeyState" (Byval NVirtkey As Long ) As Integer
ثابت زير را نيز در قسمت معرفي هاي عمومي مربوط به Form1 وارد كنيد


کد:
Const VK_TAB = &H9
دو كنترل از نوع textbox بر روي فرم قرار دهيد . Text1 و text2 ايجاد مي شود.
كد زير را در رويداد Load مربوط به Form1 وارد نماييد.
کد:
Sun Form_load()
Text1.text = "Press Tab To Select The Text"
Text2.text = ""
Text2.Text = "This is a Paragraph that should be selected. "
end sub
كد زير را در رويداد GetFocus مربوط به text2 وارد نماييد.
کد:
Sub Text2_Getfocus()
Dim X as integer
X = GetKeyState(Vk_Tab)
If Getkeystate(VK_Tab) and -256 then
text2.setfocus
Text2.selstart = 0
Text2.SelLenght = Len(Text2.text)
end if
End sub
پس از اجراي برنامه نقطه تمركز بر روي Textbox اول است كليد TAB را فشار دهيد تا نقطه تمركز به سمت دومين TEXTBOX حر كت كند . در اين حالت متن درون TEXTBOX دوم به صورت اتوماتيك انتخاب مي شود.
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
استخراح فونتهاي صفحه نمايش و چاپگر


برنامه زير سه كنترل List Box را بر روي يك فرم نمايش مي دهد كه فونتهاي چاپگر در اولي فونتهاي صفحه نمايش در دومي و فونتهاي مشترك دو ويسله در سومي ليست شده اند.

پروژه جديد را آغاز كنيد . بطور پيش فرض Form1 ايجاد مي شود.
سه كنترل از نوع List Bpx و در كنار يكديگر به Form 1 ايجاد مي شود .
براي هر سه ليست باكس خصوصيت Sorted را با True تنظيم كنيد.
كد زير را در رويداد load مربوط به Form1‌ وارد كنيد.
PHP:
Sub Form_Load()
Dim X as integer 
Dim Y As integer
For x = 0 To Screen.Fontcount -1
For Y = 0 To Printer.Fontcount - 1
if screen.fonts(x) = printer.fonts(y) then
list3.additem Printer.Fonts(y)
end if
Next Y
Next X
For X = 0 to Printer.fontcount - 1 
List1.additem Printer.Fonts(X)
next x
For X = 0 To Screen.FontCount - 1 
List2.additem Screen.fonts (X)
next X
end sub
 

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
این یه سورسه برای تفکیک حروف از هم و کوچک و بزرگ کردن آن ها به صورت یک در میان
میشه تو برنامه ها ازش استفاده کرد:)
 

فایل های ضمیمه

  • Text Effect.rar
    5.4 KB · نمایش ها: 26

>-->O

همکار بازنشسته
تاریخ عضویت
25 نوامبر 2009
نوشته‌ها
2,530
لایک‌ها
468
محل سکونت
㋡ همین جا ㋡
ذخیره عکس در بانک اکسس در vb6
 

فایل های ضمیمه

  • Save Picture.rar
    109.5 KB · نمایش ها: 94
بالا