# Native Code > برنامه نویسی در 6 VB >  مرجع حل مشکلات زبان فارسی و سورسهای مربوطه

## M-Gheibi

با سلام خدمت همه برنامه نویسان عزیز
در این تاپیک راه حل های خود را جهت نمایش صحیح حروف فارسی٬ تایپ فارسی بدون نیاز به ویندوز فارسی٬ استفاده از تاریخ شمسی٬ راست چین کردن نوشته ها در برنامه ها و سایر مطالب مربوط به زبان فارسی در 6 VB را بنویسید (مشابه کاری که در بخش Dot Net صورت گرفته است).
در صورتی که قبلا در تاپیکی در یکی از زمینه های فوق به نتیجه رسیده اید و یا مطلبی هرچند ساده و مشخص در این مورد مشاهده کرده اید٬ مطالب صحیح و بکار رفته در آن تاپیک را با ذکر نام شخص راهنمایی کننده در اینجا بنویسید.

این کار علاوه بر اینکه باعث نظم بیشتر در بخش می شود٬ این تاپیک را به مرجعی برای حل مشکلات زبان فارسی در 6 VB مبدل ساخته٬ از ایجاد تاپیکهای تکراری جلوگیری می کند.

----------


## M-Gheibi

*فعال نمودن امکان تایپ فارسی در ویندوز XP*

دقت داشته باشید به هنگام نصب زبان فارسی ٬ ممکن است به سی‌دی نصب ویندوز نیاز پیدا کنید .

1. به Control Panel ویندوز بروید .

2. به بخش Regional and Language Options بروید :
حالت غیر کلاسیک :
الف) حال گزینه Regional and Language Options را کلیک نمایید .
ب) در پنجره باز شده گزینه Date, Time, Language, and Regional Options را کلیک کنید .

حالت کلاسیک :
روی آیکون Regional and Language Options دوبار کلیک کنید .

3. در پنجره باز شده به تب Languages بروید .

4. حال گزینه Install files for complex script and right-to left languages (including Thai) را تیک زده ( با کلیک بر روی آن ) ٬ روی دکمه Apply کلیک بزنید .



 6. به برگه‌ی Advanced بروید و در لیست انتخاب زبان٬  زبان Farsi را انتخاب نمایید .



 7. سپس به برگه‌ی Regional Options بازگردید و در لیست انتخاب زبان ٬ Farsi را انتخاب کنید .

8. در لیست پایینی ٬ کشور Iran را انتخاب کنید .

9. در آخر دکمه Apply و سپس OK را کلیک نمایید .

----------


## M-Gheibi

برای استفاده از امکان Right to Left در برنامه ها فایل VBAME.DLL موجود در پوشه سیستم را به همراه برنامه خود قرار دهید.

----------


## M-Gheibi

*تبدیل صفحه کلید به فارسی در ویژوال بیسیک 6*

ابتدا تابع زیر را تعریف کنید :
Public Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Longویندوز پارسا 99 ، اکس پی و 2000 که فارسی نصب شده باشد :
 Dim xx As Long
xx = LoadKeyboardLayout("00000429", 1)ویندوز پارسا 2001 و امثال آن :
Dim xx As Long
xx = LoadKeyboardLayout("00000401", 1)کد 401 برای عربی عربستان است که در ویندوز پارسا 2001 به جای فارسی به کار می رود .

----------


## M-Gheibi

کد زیر برای تبدیل مقدار عددی به حروف است .
به این نکته دقت داشته باشید که حداکثر مقدار قابل قبول برای این تابع 999,999,999,999 ( نهصد و نود و نه میلیارد و نهصد و نود و نه میلیون و نهصد و نود نه هزار و نهصد و نود و نه ) می باشد .
تابع زیر نوشته جناب آقای بابک بخشایش هست .
Option Explicit
Private Const hezar = " هزار"
Private Const melun = " میلیون"
Private Const melyard = " میلیارد"
Private Const va = " و "

Public Function heji_adad(ByVal adad As Double) As String
Dim hooroof As String
Dim SS As Integer  'sadgan
Dim hh As Integer   'hezargan
Dim mm As Integer  'melungan
Dim yy As Integer   'melyardgan
Dim STRadad As String
Dim LENadad As Integer

STRadad = Str(Val(Str(adad)))
LENadad = Len(STRadad)

Select Case adad
    Case Is = 0
        hooroof = "صفر"
    Case 1 To 999
        hooroof = Adad_Heji(adad)
    Case 1000 To 999999
       If (adad Mod 1000 = 0) Then hooroof = Adad_Heji(Int(adad / 1000)) + hezar
       If (adad Mod 1000 &lt;> 0) Then hooroof = Adad_Heji(Int(adad / 1000)) + hezar + va + (Adad_Heji(adad Mod 1000))
    Case 1000000 To 999999999
        SS = Val(Right$(STRadad, 3))
        hh = Val(Mid$(STRadad, LENadad - 5, 3))
        mm = Val(Left$(STRadad, LENadad - 6))
        If (SS = 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun
        If (SS = 0 And hh &lt;> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
        If (SS &lt;> 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(SS)
        If (SS &lt;> 0 And hh &lt;> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar + va + Adad_Heji(SS)
    Case 1000000000 To 999999999999#
        SS = Val(Right$(STRadad, 3))
        hh = Val(Mid$(STRadad, LENadad - 5, 3))
        mm = Val(Mid$(STRadad, LENadad - 8, 3))
        yy = Val(Left$(STRadad, LENadad - 9))
        If (SS = 0 And hh = 0 And mm = 0) Then hooroof = Adad_Heji(yy) + melyard
        If (SS = 0 And hh = 0 And mm &lt;> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun
        If (SS = 0 And hh &lt;> 0 And mm &lt;> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
        If (SS &lt;> 0 And hh &lt;> 0 And mm &lt;> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar + va + Adad_Heji(SS)
    Case Is > 999999999999#
        hooroof = "عدد وارد شده بزرگتر از 999999999999 است"
End Select
heji_adad = hooroof
End Function

Private Function Adad_Heji(ByVal adad As Integer) As String
Dim yekan As Byte
Dim dahgan As Byte
Dim sadgan As Byte
Dim behooroof As String
Dim heji(19) As String
Dim heji_dahgan(9) As String
Dim heji_sadgan(9) As String
'-------------------------------
heji(1) = "یک": heji(2) = "دو": heji(3) = "سه": heji(4) = "چهار": heji(5) = "پنج"
heji(6) = "شش": heji(7) = "هفت": heji(8) = "هشت": heji(9) = "نه": heji(10) = "ده"
heji(11) = "یازده": heji(12) = "دوازده": heji(13) = "سیزده": heji(14) = "چهارده": heji(15) = "پانزده"
heji(16) = "شانزده": heji(17) = "هفده": heji(18) = "هیجده": heji(19) = "نوزده"
'-------------------------------
heji_dahgan(1) = "ده"
heji_dahgan(2) = "بیست"
heji_dahgan(3) = "سی": heji_dahgan(4) = "چهل": heji_dahgan(5) = "پنجاه"
heji_dahgan(6) = "شصت": heji_dahgan(7) = "هفتاد": heji_dahgan(8) = "هشتاد"
heji_dahgan(9) = "نود"
'-------------------------------
heji_sadgan(1) = "یکصد": heji_sadgan(2) = "دویست": heji_sadgan(3) = "سیصد"
heji_sadgan(4) = "چهارصد": heji_sadgan(5) = "پانصد": heji_sadgan(6) = "ششصد"
heji_sadgan(7) = "هفتصد": heji_sadgan(8) = "هشتصد": heji_sadgan(9) = "نهصد"
'-------------------------------
yekan = adad Mod 10
dahgan = adad Mod 100
sadgan = Int(adad / 100)
'-------------------------------
If dahgan &lt; 20 Then
    If (sadgan = 0) Then behooroof = heji(dahgan)
    If (sadgan &lt;> 0) Then behooroof = heji_sadgan(sadgan) + va + heji(dahgan)
    If (yekan = 0 And dahgan = 0) Then behooroof = heji_sadgan(sadgan)
Else
    dahgan = (adad Mod 100) - yekan
    If (sadgan = 0 And yekan = 0) Then behooroof = heji_dahgan(dahgan / 10)
    If (sadgan = 0 And yekan &lt;> 0) Then behooroof = heji_dahgan(dahgan / 10) + va + heji(yekan)
    If (sadgan &lt;> 0 And yekan = 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10)
    If (sadgan &lt;> 0 And yekan &lt;> 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10) + va + heji(yekan)
End If
        
Adad_Heji = behooroof
End Functionطرز استفاده :
Text1.text = heji_adad(156489)با اجرای کد بالا عبارت "یکصد و پنجاه و شش هزار و چهارصد و هشتاد و نه" در Text1 نمایش داده خواهد شد .

----------


## M-Gheibi

کد زیر را در ماژول قرار دهید :

Public Text_Object As Object
Public max_index As Integer
Public OldScroll As Integer
Public MatnHa() As String
Public CurrentText As Integer
Public IsFarsi As Boolean
Sub Change_Lang(KeyCode, Shift)
    If KeyCode = vbKeyF2 And Shift = 1 Then
        IsFarsi = Not (IsFarsi)
    End If
End Sub
Function convert_txt(getch As Integer)
Select Case LCase(Chr(getch))
    Case "q": getch = 174
    Case "w": getch = 172
    Case "e": getch = 153
    Case "r": getch = 236
    Case "t": getch = 234
    Case "y": getch = 232
    Case "u": getch = 228
    Case "i": getch = 251
    Case "o": getch = 161
    Case "p": getch = 159
    Case "[", "{": getch = 155
    Case "]", "}": getch = 157
    Case "a": getch = 170
    Case "s": getch = 168
    Case "d": getch = 254
    Case "f": getch = 147
    Case "g": getch = 243
    Case "h":
            If Chr(getch) = "h" Then
                getch = 144
            Else
                getch = 141
            End If
    Case "j": getch = 151
    Case "k": getch = 247
    Case "l": getch = 245
    Case ";": getch = 238
    Case "'": getch = 240
    Case "z": getch = 224
    Case "x": getch = 175
    Case "c": getch = 165
    Case "v": getch = 164
    Case "b": getch = 163
    Case "n": getch = 162
    Case "m":
            If Chr(getch) = "m" Then
                getch = 142
            Else
                getch = 143
            End If
    Case ",": getch = 248
    Case "`": getch = 149
    Case "\": getch = 166
    Case "?": getch = 140
    Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9": getch = getch + 80
    Case "!": getch = 33
    Case "@": getch = 34
    Case "#": getch = 35
    Case "$": getch = 197
    Case "%": getch = 37
    Case "^": getch = 58
    Case "&amp;": getch = 138
    Case "*": getch = 120
    Case "(": getch = 40
    Case ")": getch = 41
    'Case ".": getch = 46
End Select
    'zero to point!
    'If getch = 128 Then getch = 46
    If getch = 128 Then getch = 189
    convert_txt = getch
End Function
Function Convert_Num(getch As Integer)
    Convert_Num = IIf(getch > 57, 0, getch + IIf(getch > 47, 80, 0))
    If getch = 46 Then Convert_Num = 47
    'zero to point!
    'If Convert_Num = 128 Then Convert_Num = 46
    If Convert_Num = 128 Then Convert_Num = 189
End Function
Sub Txt_Change()
If Len(Text_Object.Text) > 1 And Text_Object.SelStart > 0 Then
    'Detect Last Character!
    Text_Object.SelStart = Text_Object.SelStart - 1
    Text_Object.SelLength = 2
    ' If it was number!
    If Asc(Left(Text_Object.SelText, 1)) = 189 Or (Asc(Left(Text_Object.SelText, 1)) > 127 And Asc(Left(Text_Object.SelText, 1)) &lt; 138) Then
    'If Asc(Left(Text_Object.SelText, 1)) = 189 Or Asc(Left(Text_Object.SelText, 1)) = 46 Or Asc(Left(Text_Object.SelText, 1)) = 47 Or (Asc(Left(Text_Object.SelText, 1)) > 127 And Asc(Left(Text_Object.SelText, 1)) &lt; 138) Then
        Text_Object.SelStart = Text_Object.SelStart + 1
        Text_Object.SelLength = 0
        Exit Sub
    End If
    If Asc(Left(Text_Object.SelText, 1)) = 32 Then
            Select Case Asc(Right(Text_Object.SelText, 1))
                Case 159:
                    Text_Object.SelText = " " + Chr(190)
                    Text_Object.SelStart = Text_Object.SelStart - 1
                Case 142:
                    Text_Object.SelText = " " + Chr(143)
                    Text_Object.SelStart = Text_Object.SelStart - 1
                Case 147, 149, 151, 153, 155, 157, 168, 170, 172, 174, 227, 231, 238, 234, 236, 238, 240, 245, 247, 250:
                    Text_Object.SelText = " " + Chr(Asc(Right(Text_Object.SelText, 1)) - 1)
                    Text_Object.SelStart = Text_Object.SelStart - 1
                Case 161:
                    Text_Object.SelText = " " + Chr(176)
                    Text_Object.SelStart = Text_Object.SelStart - 1
                Case 243, 251, 254:
                    Text_Object.SelText = " " + Chr(Asc(Right(Text_Object.SelText, 1)) - 2)
                    Text_Object.SelStart = Text_Object.SelStart - 1
                Case 228, 232:
                    Text_Object.SelText = " " + Chr(Asc(Right(Text_Object.SelText, 1)) - 3)
                    Text_Object.SelStart = Text_Object.SelStart - 1
                End Select
            
    Else
        If Asc(Left(Text_Object.SelText, 1)) = 228 Or Asc(Left(Text_Object.SelText, 1)) = 232 Or Asc(Left(Text_Object.SelText, 1)) = 251 Then
            Select Case Asc(Right(Text_Object.SelText, 1))
                Case 243, 245, 247, 249, 250, 251, 254, 142, 147, 149, 151, 153, 155, 157, 159, 161, 168, 170, 172, 174, 175, 224, 227, 228, 231, 232, 234, 236, 238, 240:
                    Select Case Asc(Left(Text_Object.SelText, 1))
                        Case 228: Text_Object.SelText = Chr(227) + Right(Text_Object.SelText, 1)
                        Case 232: Text_Object.SelText = Chr(231) + Right(Text_Object.SelText, 1)
                        Case 251: Text_Object.SelText = Chr(250) + Right(Text_Object.SelText, 1)
                    End Select
                Text_Object.SelStart = Text_Object.SelStart - 1
            End Select
        Else
            Select Case Asc(Right(Text_Object.SelText, 1))
                Case 243:
                    If Asc(Left(Text_Object.SelText, 1)) = 144 Then
                        Text_Object.SelText = Chr(242)
                    End If
                Case 142, 147, 149, 151, 153, 155, 157, 159, 161, 168, 170, 172, 174, 175, 224, 227, 228, 231, 232, 234, 236, 238, 240, 245, 247, 250, 251, 254:
                    Text_Object.SelLength = 1
                    If Asc(Text_Object.SelText) = 144 Then
                        Text_Object.SelText = Chr(145)
                    End If
                End Select
        End If
    End If
    Text_Object.SelStart = Text_Object.SelStart + 1
End If
If Text_Object.SelStart &lt;> 0 Then
    Text_Object.SelStart = Text_Object.SelStart - 1
End If
If Len(Text_Object) = 1 Then
    If Asc(Left(Text_Object, 1)) &lt; 138 And Asc(Left(Text_Object, 1)) > 127 Then
        Text_Object.SelStart = 1
    End If
End If
End Sub
در اینجا فرض میکنیم که در برنامه ما چند TextBox وجود دارد . به دلیل اینکه نوشتن کد فعال کردن زبان فارسی برای هر TextBox کمی غیر معقول هست و ... ٬ نام جعبه های متنی خود را به شکل آرایه می نویسیم . بدین شکل :

text(0)
text(1)
text(2)
...
حال نوبت به کد فرم اصلی می رسد :
Private Sub Form_Load()
    IsFarsi = True
End Sub

Private Sub Text_Change(Index As Integer)
If IsFarsi = True Then
    Set Text_Object = Text(Index)
    Txt_Change
End If
End Sub
Private Sub Text_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    Call Change_Lang(KeyCode, Shift)
End Sub
Private Sub Text_KeyPress(Index As Integer, KeyAscii As Integer)
If IsFarsi = True Then
    If KeyAscii = 13 Then
        KeyAscii = 0
        'Call SetF(Index, 2)
    Else
        KeyAscii = convert_txt(KeyAscii)
    End If
End If
If KeyAscii = 65 Then KeyAscii = 191
If KeyAscii = 90 Then KeyAscii = 192
If KeyAscii = 67 Then KeyAscii = 193
If KeyAscii = 83 Then KeyAscii = 194
If KeyAscii &lt; 91 And KeyAscii > 64 Then KeyAscii = KeyAscii + 32
End Sub
برای استفاده از برنامه فوق به فونت با کدپیج ایران سیستم نیاز دارید که در فایل ضمیمه چندتا از اونها رو برای دانلود گذاشتم .

----------


## M-Gheibi

همانطور که در تصویر مشاهده می کنید این کنترل یک تقویم شمسی در Combobox باز می کند که با کلیک روی هر روز آن تاریخ آن روز را به شما می دهد.
<p align="center"></p>
کاری از محمد تاجیک

----------


## M-Gheibi

با استفاده از برنامه نومنه زیر که نوشته شده توسط جناب نصیری هست٬ می تونید در ویندوزهای با قابلیت تایپ فارسی بدون تغییر زبان به تایپ فارسی بپردازید. مطابق تصویر زیر:
<p align="center"></p>

----------


## M-Gheibi

با استفاده از نمونه کد زیر می تونید کنترلی تهیه کنید که با کدپیج ایران سیستم تایپ فارسی انجام می دهد.
<p align="center">
</p>
برنامه نویس : سید مسعود مازار

----------


## vbprogramer

> کد زیر برای تبدیل مقدار عددی به حروف است. 
> به این نکته دقت داشته باشید که حداکثر مقدار قابل قبول برای این تابع 999,999,999,999 (نهصد و نود و نه میلیارد و نهصد و نود و نه میلیون و نهصد و نود نه هزار و نهصد و نود و نه) می باشد. 
> تابع زیر نوشته جناب آقای بابک بخشایش هست.


سلام آقا مسعود
دست شما درد نکنه خیلی نکات جالبی هستن
ولی راجع به این کدی که گذاشتین می خواستم ببینم که آیا کدی با تبدیل اعشار (تا دو رقم) رو هم شما یا کسی از دوستان دارن یا نه چون من بهش احتیاج داشتم
یعنی مثلا 10.5 رو بنویسه ده و نیم
ممنون از شما و همه دوستان :oops: 
 :thnx:

----------


## بابک زواری

کد زیر هم برای تقویم درست شده هرچند ممکنه که بطور بهینه کار نشده باشه 
امامطمئن باشید که درست کار میکنه چند جایی که از اون استفاده میشه عبارتند از
معاونت مهندسی شهرداری ؛ بیمه آسیا ؛ بیمه دانا و چند شرکت بزرگ و معتبر که 
مسائل تقویمی رو با این کدها حل و فصل کردن


Public Function Fa_Day&#40;En_Date As String&#41; As String
Select Case Weekday&#40;En_Date&#41;
Case 1
    Fa_Day = "یکشنبه"
Case 2
    Fa_Day = "دوشنبه"
Case 3
    Fa_Day = "سه شنبه"
Case 4
    Fa_Day = "چهارشنبه"
Case 5
    Fa_Day = "پنجشنبه"
Case 6
    Fa_Day = "جمعه"
Case 7
    Fa_Day = "شنبه"
End Select
End Function

Public Function Fa_Date&#40;En_Date As String&#41; As String
Dim The_Select As Integer
Dim The_Year As Integer
Dim The_Month As Integer
Dim The_Day As Integer
The_Year = CInt&#40;Mid&#40;En_Date, 7, 4&#41;&#41;
The_Month = CInt&#40;Mid&#40;En_Date, 1, 2&#41;&#41;
The_Day = CInt&#40;Mid&#40;En_Date, 4, 2&#41;&#41;

If &#40;The_Year Mod 4 = 0&#41; Then
    The_Select = 1
Else
    The_Select = 2
End If

If &#40;&#40;The_Year - 1&#41; Mod 4 = 0&#41; Then
    The_Select = 3
End If

If The_Select = 1 Then
'------------------------------------------------------
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 10
    The_Month = 10
    The_Year = The_Year - 622
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 11
    The_Year = The_Year - 622
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 19&#58; The_Day = The_Day + 11
    The_Month = 11
    The_Year = The_Year - 622
    Case 20 To 29&#58; The_Day = The_Day - 19
    The_Month = 12
    The_Year = The_Year - 622
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 19&#58; The_Day = The_Day + 10
    The_Month = 12
    The_Year = The_Year - 622
    Case 20 To 31&#58; The_Day = The_Day - 19
    The_Month = 1
    The_Year = The_Year - 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 19&#58; The_Day = The_Day + 12
    The_Month = 1
    The_Year = The_Year - 621
    Case 20 To 30&#58; The_Day = The_Day - 19
    The_Month = 2
    The_Year = The_Year - 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 11
    The_Month = 2
    The_Year = The_Year - 621
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 3
    The_Year = The_Year - 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 11
    The_Month = 3
    The_Year = The_Year - 621
    Case 21 To 30&#58; The_Day = The_Day - 20
    The_Month = 4
    The_Year = The_Year - 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 4
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 5
    The_Year = The_Year - 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 5
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 6
    The_Year = The_Year - 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 6
    The_Year = The_Year - 621
    Case 22 To 30&#58; The_Day = The_Day - 21
    The_Month = 7
    The_Year = The_Year - 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 9
    The_Month = 7
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 8
    The_Year = The_Year - 621
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 10
    The_Month = 8
    The_Year = The_Year - 621
    Case 21 To 30&#58; The_Day = The_Day - 20
    The_Month = 9
    The_Year = The_Year - 621
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 10
    The_Month = 9
    The_Year = The_Year - 621
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 10
    The_Year = The_Year - 621
    End Select
End Select
'------------------------------------------------------
End If

If The_Select = 2 Then
'------------------------------------------------------
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 10
    The_Month = 10
    The_Year = The_Year - 622
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 11
    The_Year = The_Year - 622
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 19&#58; The_Day = The_Day + 11
    The_Month = 11
    The_Year = The_Year - 622
    Case 19 To 28&#58; The_Day = The_Day - 19
    The_Month = 12
    The_Year = The_Year - 622
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 9
    The_Month = 12
    The_Year = The_Year - 622
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 1
    The_Year = The_Year - 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 11
    The_Month = 1
    The_Year = The_Year - 621
    Case 21 To 30&#58; The_Day = The_Day - 20
    The_Month = 2
    The_Year = The_Year - 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 2
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 3
    The_Year = The_Year - 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 3
    The_Year = The_Year - 621
    Case 22 To 30&#58; The_Day = The_Day - 21
    The_Month = 4
    The_Year = The_Year - 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 4
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 5
    The_Year = The_Year - 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 5
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 6
    The_Year = The_Year - 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 6
    The_Year = The_Year - 621
    Case 23 To 30&#58; The_Day = The_Day - 22
    The_Month = 7
    The_Year = The_Year - 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 8
    The_Month = 7
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 8
    The_Year = The_Year - 621
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 9
    The_Month = 8
    The_Year = The_Year - 621
    Case 22 To 30&#58; The_Day = The_Day - 21
    The_Month = 9
    The_Year = The_Year - 621
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 9
    The_Month = 9
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 10
    The_Year = The_Year - 621
    End Select
End Select
'------------------------------------------------------
End If

If The_Select = 3 Then
'------------------------------------------------------
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 19&#58; The_Day = The_Day + 11
    The_Month = 10
    The_Year = The_Year - 622
    Case 20 To 31&#58; The_Day = The_Day - 19
    The_Month = 11
    The_Year = The_Year - 622
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 18&#58; The_Day = The_Day + 12
    The_Month = 11
    The_Year = The_Year - 622
    Case 19 To 28&#58; The_Day = The_Day - 18
    The_Month = 12
    The_Year = The_Year - 622
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 10
    The_Month = 12
    The_Year = The_Year - 622
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 1
    The_Year = The_Year - 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 11
    The_Month = 1
    The_Year = The_Year - 621
    Case 21 To 30&#58; The_Day = The_Day - 20
    The_Month = 2
    The_Year = The_Year - 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 2
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 3
    The_Year = The_Year - 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 3
    The_Year = The_Year - 621
    Case 22 To 30&#58; The_Day = The_Day - 21
    The_Month = 4
    The_Year = The_Year - 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 4
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 5
    The_Year = The_Year - 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 5
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 6
    The_Year = The_Year - 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 6
    The_Year = The_Year - 621
    Case 23 To 30&#58; The_Day = The_Day - 22
    The_Month = 7
    The_Year = The_Year - 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 8
    The_Month = 7
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 8
    The_Year = The_Year - 621
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 9
    The_Month = 8
    The_Year = The_Year - 621
    Case 22 To 30&#58; The_Day = The_Day - 21
    The_Month = 9
    The_Year = The_Year - 621
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 9
    The_Month = 9
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 10
    The_Year = The_Year - 621
    End Select
End Select
'------------------------------------------------------
End If

Fa_Date = Format&#40;CStr&#40;The_Year&#41;, "0000"&#41; & "/" & _
         Format&#40;CStr&#40;The_Month&#41;, "00"&#41; & "/" & _
         Format&#40;CStr&#40;The_Day&#41;, "00"&#41;
End Function


Public Function En_Date&#40;Fa_Date As String&#41; As String
Dim The_Year As Integer
Dim The_Month As Integer
Dim The_Day As Integer
The_Year = CInt&#40;Mid&#40;Fa_Date, 1, 4&#41;&#41;
The_Month = CInt&#40;Mid&#40;Fa_Date, 6, 2&#41;&#41;
The_Day = CInt&#40;Mid&#40;Fa_Date, 9, 2&#41;&#41;

Dim The_Select As Integer
The_Select = The_Year Mod 4

'------------------------------------------------------------------------------------------------------------------------
If The_Select = 0 Then                'Like &#58; 1360, 1364, 1368, 1372, 1376, 1380, 1384, ...
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 3
    The_Year = The_Year + 621
    Case 12 To 31&#58; The_Day = The_Day - 11
    The_Month = 4
    The_Year = The_Year + 621
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 20
    The_Month = 4
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 5
    The_Year = The_Year + 621
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 5
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 6
    The_Year = The_Year + 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 6
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 7
    The_Year = The_Year + 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 7
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 8
    The_Year = The_Year + 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 8
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 9
    The_Year = The_Year + 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 8&#58; The_Day = The_Day + 22
    The_Month = 9
    The_Year = The_Year + 621
    Case 9 To 30&#58; The_Day = The_Day - 8
    The_Month = 10
    The_Year = The_Year + 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 10
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 11
    The_Year = The_Year + 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 11
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 12
    The_Year = The_Year + 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 12
    The_Year = The_Year + 621
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 1
    The_Year = The_Year + 622
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 1
    The_Year = The_Year + 622
    Case 12 To 30&#58; The_Day = The_Day - 11
    The_Month = 2
    The_Year = The_Year + 622
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 19
    The_Month = 2
    The_Year = The_Year + 622
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 3
    The_Year = The_Year + 622
    End Select
End Select
End If
'------------------------------------------------------------------------------------------------------------------------
If The_Select = 1 Then                'Like &#58; 1361, 1365, 1369, 1373, 1377, 1381, 1385, ...
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 3
    The_Year = The_Year + 621
    Case 12 To 31&#58; The_Day = The_Day - 11
    The_Month = 4
    The_Year = The_Year + 621
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 20
    The_Month = 4
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 5
    The_Year = The_Year + 621
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 22
    The_Month = 5
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 6
    The_Year = The_Year + 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 6
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 7
    The_Year = The_Year + 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 7
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 8
    The_Year = The_Year + 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 8
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 9
    The_Year = The_Year + 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 8&#58; The_Day = The_Day + 22
    The_Month = 9
    The_Year = The_Year + 621
    Case 9 To 30&#58; The_Day = The_Day - 8
    The_Month = 10
    The_Year = The_Year + 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 10
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 11
    The_Year = The_Year + 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 11
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 12
    The_Year = The_Year + 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 12
    The_Year = The_Year + 621
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 1
    The_Year = The_Year + 622
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 1
    The_Year = The_Year + 622
    Case 12 To 30&#58; The_Day = The_Day - 11
    The_Month = 2
    The_Year = The_Year + 622
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 19
    The_Month = 2
    The_Year = The_Year + 622
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 3
    The_Year = The_Year + 622
    End Select
End Select
End If
'------------------------------------------------------------------------------------------------------------------------
If The_Select = 2 Then                'Like &#58; 1362, 1366, 1370, 1374, 1378, 1382, 1386, ...
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 3
    The_Year = The_Year + 621
    Case 12 To 31&#58; The_Day = The_Day - 11
    The_Month = 4
    The_Year = The_Year + 621
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 20
    The_Month = 4
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 5
    The_Year = The_Year + 621
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 5
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 6
    The_Year = The_Year + 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 6
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 7
    The_Year = The_Year + 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 7
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 8
    The_Year = The_Year + 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 8
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 9
    The_Year = The_Year + 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 8&#58; The_Day = The_Day + 22
    The_Month = 9
    The_Year = The_Year + 621
    Case 9 To 30&#58; The_Day = The_Day - 8
    The_Month = 10
    The_Year = The_Year + 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 10
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 11
    The_Year = The_Year + 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 11
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 12
    The_Year = The_Year + 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 12
    The_Year = The_Year + 621
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 1
    The_Year = The_Year + 622
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 1
    The_Year = The_Year + 622
    Case 12 To 30&#58; The_Day = The_Day - 11
    The_Month = 2
    The_Year = The_Year + 622
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 19
    The_Month = 2
    The_Year = The_Year + 622
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 3
    The_Year = The_Year + 622
    End Select
End Select
End If
'------------------------------------------------------------------------------------------------------------------------
If The_Select = 3 Then                'Like &#58; 1363, 1367, 1371, 1375, 1379, 1383, 1387, ...
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 12&#58; The_Day = The_Day + 19
    The_Month = 3
    The_Year = The_Year + 621
    Case 13 To 31&#58; The_Day = The_Day - 12
    The_Month = 4
    The_Year = The_Year + 621
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 19
    The_Month = 4
    The_Year = The_Year + 621
    Case 12 To 31&#58; The_Day = The_Day - 11
    The_Month = 5
    The_Year = The_Year + 621
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 5
    The_Year = The_Year + 621
    Case 12 To 31&#58; The_Day = The_Day - 11
    The_Month = 6
    The_Year = The_Year + 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 20
    The_Month = 6
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 7
    The_Year = The_Year + 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 7
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 8
    The_Year = The_Year + 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 8
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 9
    The_Year = The_Year + 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 9
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 10
    The_Year = The_Year + 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 10
    The_Year = The_Year + 621
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 11
    The_Year = The_Year + 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 20
    The_Month = 11
    The_Year = The_Year + 621
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 12
    The_Year = The_Year + 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 12
    The_Year = The_Year + 621
    Case 12 To 30&#58; The_Day = The_Day - 11
    The_Month = 1
    The_Year = The_Year + 622
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 12&#58; The_Day = The_Day + 19
    The_Month = 1
    The_Year = The_Year + 622
    Case 13 To 30&#58; The_Day = The_Day - 12
    The_Month = 2
    The_Year = The_Year + 622
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 18
    The_Month = 2
    The_Year = The_Year + 622
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 3
    The_Year = The_Year + 622
    End Select
End Select
End If
'------------------------------------------------------------------------------------------------------------------------
En_Date = Format&#40;CStr&#40;The_Month&#41;, "00"&#41; & "/" & _
                            Format&#40;CStr&#40;The_Day&#41;, "00"&#41; & "/" & _
                                    Format&#40;CStr&#40;The_Year&#41;, "0000"&#41;
End Function

----------


## بابک زواری

فونت فارسی tahoma با این تفاوت که نمایش اعداد هم به شکل فارسی است

----------


## vbprogramer

ممنون بابک جان  :flower: 
عالی بود  :thnx: 
مخصوصاْ فونت

----------


## M-Gheibi

با سلام خدمت همه دوستان مخصوصا جناب کد نویس که به من در این تاپیک کمک می کنند. بقیه که ...
خب بگذریم
آقای VBProgrammer من دفعه پیش که پست شما رو دیدم (اعشاری) فکر کردم تنها کد تبدیل اعشاری رو می خواید واسه همین فقط همون رو نوشتم. البته خودتون می تونید این کد را با کد قبلی با هم استفاده کنید و به نتیجه ای که می خواید برسید. اگه نتونستید همینجا بگید.  :)  :wink: 

Option Explicit
Private Const dahom = "دهم"
Private Const sadom = "صدم"

Private Function Meghdar&#40;Addad&#41;
Dim ziredah&#40;9&#41; As String
Dim dahtabist&#40;19&#41; As String
Dim dahi&#40;9&#41; As String

Dim Dot, Ashar, Yekan, Dahgan

ziredah&#40;1&#41; = "یک"&#58; ziredah&#40;2&#41; = "دو"&#58; ziredah&#40;3&#41; = "سه"&#58; ziredah&#40;4&#41; = "چهار"&#58; ziredah&#40;5&#41; = "پنج"
ziredah&#40;6&#41; = "شش"&#58; ziredah&#40;7&#41; = "هفت"&#58; ziredah&#40;8&#41; = "هشت"&#58; ziredah&#40;9&#41; = "نه"

dahtabist&#40;11&#41; = "یازده"&#58; dahtabist&#40;12&#41; = "دوازده"&#58; dahtabist&#40;13&#41; = "سیزده"&#58; dahtabist&#40;14&#41; = "چهارده"&#58; dahtabist&#40;15&#41; = "پانزده"
dahtabist&#40;16&#41; = "شانزده"&#58; dahtabist&#40;17&#41; = "هفده"&#58; dahtabist&#40;18&#41; = "هیجده"&#58; dahtabist&#40;19&#41; = "نوزده"

dahi&#40;2&#41; = "بیست"&#58; dahi&#40;3&#41; = "سی"&#58; dahi&#40;4&#41; = "چهل"&#58; dahi&#40;5&#41; = "پنجاه"
dahi&#40;6&#41; = "شصت"&#58; dahi&#40;7&#41; = "هفتاد"&#58; dahi&#40;8&#41; = "هشتاد"&#58; dahi&#40;9&#41; = "نود"

Dot = InStr&#40;1, Addad, ".", vbTextCompare&#41;
If Dot &lt;> 0 Then
    Ashar = Mid&#40;Addad, Dot + 1, 2&#41;
    Select Case Len&#40;Ashar&#41;
        Case Is = 2
            If Mid&#40;Ashar, 1, 1&#41; = 0 And Mid&#40;Ashar, 2, 2&#41; &lt;> 0 Then Meghdar = ziredah&#40;Mid&#40;Ashar, 2, 2&#41;&#41; &amp; " " &amp; sadom
            If Ashar Mod 10 = 0 And Mid&#40;Ashar, 2, 2&#41; = 0 Then Meghdar = ziredah&#40;Mid&#40;Ashar, 1, 1&#41;&#41; &amp; " " &amp; dahom
            If Ashar Mod 10 &lt;> 0 And Mid&#40;Ashar, 1, 1&#41; &lt;> 0 Then Meghdar = dahi&#40;Mid&#40;Ashar, 1, 1&#41;&#41; &amp; " &amp;aelig; " &amp; ziredah&#40;Mid&#40;Ashar, 2, 2&#41;&#41; &amp; " " &amp; sadom
            If Mid&#40;Ashar, 1, 1&#41; = 0 And Mid&#40;Ashar, 2, 2&#41; = 0 Then Meghdar = "بدون اعشار"
            If Ashar > 10 And Ashar &lt; 20 Then Meghdar = dahtabist&#40;Ashar&#41; &amp; " " &amp; sadom
        Case Is = 1
            If Mid&#40;Ashar, 1, 1&#41; = 0 Then Meghdar = "بدون اعشار"
            If Mid&#40;Ashar, 1, 1&#41; &lt;> 0 Then Meghdar = ziredah&#40;Mid&#40;Ashar, 1, 1&#41;&#41; &amp; " " &amp; dahom
        Case Is = 0
            Meghdar = "بدون اعشار"
    End Select
Else
    Meghdar = "بدون اعشار"
End If
End Function
برنامه نویس : مسعود غیبی

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

----------


## ساران سافت

با سلام :
این کد را هم من داشتم جهت تبدیل عدد به حروف :wink:  :oops: 


Function Cntc&#40;No As Currency&#41; As String
    If No &lt; 0 Then
        Exit Function
    End If
    
    Dim NN As Currency
    Dim N As Integer
    Dim S As String
    Dim SS As String
    Dim Ten As Integer
    Ten = 3
    NN = No
    Do While Ten >= 0
        N = Int&#40;NN / 10 ^ &#40;Ten * 3&#41;&#41;
        NN = NN - N * 10 ^ &#40;Ten * 3&#41;
        SS = Msntc&#40;N&#41;
        If SS &lt;> "" Then
            S = S + SS
            Select Case Ten
                Case 1
                    S = S + "هزار "
                Case 2
                    S = S + "میلیون "
                Case 3
                    S = S + "میلیارد "
            End Select
        End If
        Ten = Ten - 1
        If NN > 0 Then
            If N > 0 Then
                S = S + " و "
            End If
        Else
            Exit Do
        End If
    Loop
    If Trim&#40;S&#41; = "" Then '0 rials
        S = " صفر "
    End If
    Cntc = S
End Function

Private Function Msntc&#40;N As Integer&#41; As String
    If N = 0 Then Exit Function
    If N &lt; 10 Then
        Msntc = Choose&#40;N, "یک", "دو", "سه", "چهار", "پنج", "شش", "هفت", "هشت", "نه"&#41;
    ElseIf N &lt; 20 Then
        Msntc = Choose&#40;N - 9, "ده", "یازده", "دوازده", "سیزده", "چهارده", "پانزده", "شانزده", "هفده", "هجده", "نوزده"&#41;
    ElseIf N &lt; 100 Then
        If &#40;N Mod 10&#41; > 0 Then
            Msntc = Msntc&#40;&#40;N \ 10&#41; * 10&#41; + " و " + Msntc&#40;N Mod 10&#41;
        End If
        If Int&#40;N / 10 - 1&#41; = &#40;N / 10 - 1&#41; Then Msntc = Choose&#40;N / 10 - 1, "بیست", "سی", "چهل", "پنجاه", "شصت", "هفتاد", "هشتاد", "نود"&#41;
        
    ElseIf N &lt; 1000 Then
        If &#40;N Mod 100&#41; > 0 Then
            Msntc = Msntc&#40;&#40;N \ 100&#41; * 100&#41; + " و " + Msntc&#40;N Mod 100&#41;
        End If
        If Int&#40;N / 100&#41; = &#40;N / 100&#41; Then Msntc = Choose&#40;N / 100, "یکصد", "دویست", "سیصد", "چهارصد", "پانصد", "ششصد", "هفتصد", "هشتصد", "نهصد"&#41;
    End If
End Function

----------


## M-Gheibi

دوست عزیز از کدی که ارسال کردید ممنون
حسنی کد قبلی به این مد داره٬ قابلیت برگرداندن مقدار عددی ماکزیمم 999999999999 هست. در صورتی که این کد تا 999 بیشتر قابلیت نداره.
 :wink:

----------


## بابک زواری

امشب میخواستم یه برنامه بهتون هدیه بدم که بدون نیاز به محیط و ویندوز
فارسی یا عربی میتونه فارسی تایپ کنه و اونو به پنج کدپیج مختلف هم 
تبدیل کنه اما دیدم اگر اونو به شکل setup و مرتب شده با چند فونت اصافه
بدم بهتره .
الان هم نشستم دارم setup میسازم تا فردا براتون بذارم همین جا .
منتظر باشید

----------


## Hamedm

سلام

کد زیر تبدیل تاریخ میلادی به شمسی است. البته این کد از کد آقای کدنویس کمتره اما مطمئن باشید که درست کار میکنه چون خودم توی تمام روزهای سال تستش کردم.
Public Const Gregorian = ISO_8601
Public Function FarsiDate&#40;intYear As Integer, intMonth As Integer, intDay As Integer, YMD&#41;
Call jdn_persian&#40;civil_jdn&#40;intYear, intMonth, intDay&#41;, intYear, intMonth, intDay&#41;
iShamsiYear = CStr&#40;intYear&#41;
iShamsiMonth = CStr&#40;intMonth&#41;
iShamsiDay = CStr&#40;intDay&#41;
If Len&#40;iShamsiMonth&#41; = 1 Then iShamsiMonth = "0" &amp; iShamsiMonth
If Len&#40;iShamsiDay&#41; = 1 Then iShamsiDay = "0" &amp; iShamsiDay
Select Case UCase&#40;Trim&#40;YMD&#41;&#41;
    Case "Y"
        FarsiDate = iShamsiYear
    Case "M"
        FarsiDate = iShamsiMonth
    Case "D"
        FarsiDate = iShamsiDay
End Select
End Function
Function julian_jdn&#40;iYear As Integer, _
                    iMonth As Integer, _
                    iDay As Integer&#41; As Long
    Dim lYear As Long
    Dim lMonth As Long
    Dim lDay As Long

    lYear = CLng&#40;iYear&#41;
    lMonth = CLng&#40;iMonth&#41;
    lDay = CLng&#40;iDay&#41;

    julian_jdn = 367 * lYear - _
            &#40;&#40;7 * &#40;lYear + 5001 + &#40;&#40;lMonth - 9&#41; \ 7&#41;&#41;&#41; \ 4&#41; _
            + &#40;&#40;275 * lMonth&#41; \ 9&#41; + lDay + 1729777

End Function
Function civil_jdn&#40;iYear As Integer, _
                   iMonth As Integer, _
                   iDay As Integer, _
                   Optional CalendarType As Integer = Gregorian&#41; As Long
    Dim lYear As Long
    Dim lMonth As Long
    Dim lDay As Long

    If CalendarType = Gregorian And &#40;&#40;iYear > 1582&#41; Or _
        &#40;&#40;iYear = 1582&#41; And &#40;iMonth > 10&#41;&#41; Or _
        &#40;&#40;iYear = 1582&#41; And &#40;iMonth = 10&#41; And &#40;iDay > 14&#41;&#41;&#41; _
    Then
        lYear = CLng&#40;iYear&#41;
        lMonth = CLng&#40;iMonth&#41;
        lDay = CLng&#40;iDay&#41;
        civil_jdn = &#40;&#40;1461 * &#40;lYear + 4800 + &#40;&#40;lMonth - 14&#41; \ 12&#41;&#41;&#41; \ 4&#41; _
            + &#40;&#40;367 * &#40;lMonth - 2 - 12 * &#40;&#40;&#40;lMonth - 14&#41; \ 12&#41;&#41;&#41;&#41; \ 12&#41; _
            - &#40;&#40;3 * &#40;&#40;&#40;lYear + 4900 + &#40;&#40;lMonth - 14&#41; \ 12&#41;&#41; \ 100&#41;&#41;&#41; \ 4&#41; _
            + lDay - 32075
    Else
        civil_jdn = julian_jdn&#40;iYear, iMonth, iDay&#41;
    End If

End Function
Function persian_jdn&#40;iYear As Integer, _
                     iMonth As Integer, _
                     iDay As Integer&#41; As Long
    Const PERSIAN_EPOCH = 1948321 ' The JDN of 1 Farvardin 1
    Dim epbase As Long
    Dim epyear As Long
    Dim mdays As Long
    If iYear >= 0 Then
        epbase = iYear - 474
    Else
        epbase = iYear - 473
    End If
    epyear = 474 + &#40;epbase Mod 2820&#41;
    If iMonth &lt;= 7 Then
        mdays = &#40;CLng&#40;iMonth&#41; - 1&#41; * 31
    Else
        mdays = &#40;CLng&#40;iMonth&#41; - 1&#41; * 30 + 6
    End If
    persian_jdn = CLng&#40;iDay&#41; _
            + mdays _
            + Fix&#40;&#40;&#40;epyear * 682&#41; - 110&#41; / 2816&#41; _
            + &#40;epyear - 1&#41; * 365 _
            + Fix&#40;epbase / 2820&#41; * 1029983 _
            + &#40;PERSIAN_EPOCH - 1&#41;
End Function
Sub jdn_persian&#40;jdn As Long, _
                ByRef iYear As Integer, _
                ByRef iMonth As Integer, _
                ByRef iDay As Integer&#41;
    Dim depoch
    Dim cycle
    Dim cyear
    Dim ycycle
    Dim aux1, aux2
    Dim yday
    depoch = jdn - persian_jdn&#40;475, 1, 1&#41;
    cycle = Fix&#40;depoch / 1029983&#41;
    cyear = depoch Mod 1029983
    If cyear = 1029982 Then
        ycycle = 2820
    Else
        aux1 = Fix&#40;cyear / 366&#41;
        aux2 = cyear Mod 366
        ycycle = Int&#40;&#40;&#40;2134 * aux1&#41; + &#40;2816 * aux2&#41; + 2815&#41; / 1028522&#41; + aux1 + 1
    End If
    iYear = ycycle + &#40;2820 * cycle&#41; + 474
    If iYear &lt;= 0 Then
        iYear = iYear - 1
    End If
    yday = &#40;jdn - persian_jdn&#40;iYear, 1, 1&#41;&#41; + 1
    If yday &lt;= 186 Then
        iMonth = Ceil&#40;yday / 31&#41;
    Else
        iMonth = Ceil&#40;&#40;yday - 6&#41; / 30&#41;
    End If
    iDay = &#40;jdn - persian_jdn&#40;iYear, iMonth, 1&#41;&#41; + 1
End Sub
Private Function Ceil&#40;number As Single&#41; As Long
    Ceil = -Sgn&#40;number&#41; * Int&#40;-Abs&#40;number&#41;&#41;
End Function
در ورودی آخر اگر "y" را وارد کنید سال و یا اگر "m" را وارد نمایید ماه و اگر "d" را وارد نمایید روز میلادی را به عنوان خروجی میدهید.

----------


## M-Gheibi

> کد زیر تبدیل تاریخ میلادی به شمسی است. البته این کد از کد آقای کدنویس کمتره اما مطمئن باشید که درست کار میکنه چون خودم توی تمام روزهای سال تستش کردم.


دوست عزیز من که نتونستم ازش استفاده کنم. ارور زیر را می دهد (ایراد از خط اول):

----------


## بابک زواری

حال برنامه ایی دارید که در هر ویندوز راست به چپ رو داره . فارسی هم مینویسه و 
ار طریق منوی اون میتونید نوشته خودتون رو به چند کد پیج تبدیل کنید.
تو نسخه بعدی امکانات پیشرفته تری مثل تبدیل از داس و .... خواهیم داشت
فعلا نسخه محدود تک خطی رو داشته باشید تا بعد.
setup اضافه شد

----------


## بابک زواری

ستاپ اضافه شد دریافت کنید

----------


## M-Gheibi

برناش که عالی بود ولی:



> اگر نتونستید استفاده کنید چاره ایی نداریم جز آپلود ستاپ برنامه


فکر کنم باید همین کار را کرد چون --->

----------


## بابک زواری

بله activex قفل داره و من منظورم استفاده از خود برنامه بوده

----------


## vbprogramer

آقا مسعود خیلی ممنون از برنامه تبدیل اعداد اعشار به حروف   :تشویق:  

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


مرسی  :wise1: 

جناب کد نویس از شما هم متشکر ( راستی می تونم بپرسم ستاپش رو با چه نرم افزاری درست کردین ؟ ):wink: 

عجب تاپیک پر محتوایی شده دست همه درد نکنه  :تشویق:

----------


## H_r_m

:تشویق:   :تشویق:   :تشویق:   :thnx:

----------


## (سیدشریفی)

آقای کد نویس امر شما اطاعت میشود .

 :flower: 
 :sorry:

----------


## mr_esmaily

سلام
البته منو بخشید که پا برهنه پریدم وسط !



> در صورتی که قبلا در تاپیکی در یکی از زمینه های فوق به نتیجه رسیده اید و یا مطلبی هرچند ساده و مشخص در این مورد مشاهده کرده اید٬ مطالب صحیح و بکار رفته در آن تاپیک را با ذکر نام شخص راهنمایی کننده در اینجا بنویسید.


شما که خودتون اینو گفیتن چرا؟
البته جسارته منو ببخشید.

----------


## Spate

سلام
بازم طبق معمول همیشه من کمک می خوام
در مورد سرچ کردن فارسی تو دیتابیس اکسس
وقتی سرچ می کنم قاتی پاتی میشه و خلاصه فارسی نمی ساپورته   :گیج:

----------


## M-Gheibi

> شما که خودتون اینو گفیتن چرا؟ 
> البته جسارته منو ببخشید.


خواهش می کنم ولی متاسفانه منظورتون رو متوجه نمیشم.
به نظرم اومد که شاید منظورتون نام نویسنده باشه که خب من هر کردوم رو می دونستم نوشتم. ولی با این اگه کسی به نظرش اومد اسم کسی رو نبردم بگه. من قصدی ندارم.




> وقتی سرچ می کنم قاتی پاتی میشه و خلاصه فارسی نمی ساپورته


دلایل معمول:
1. تنظیمات زبان فارسی را مطابق پست دوم همین تاپیک انتخاب نکرده اید (که برای حل مشکل این کار را بکنید)
2. فونت نمایش اطلاعات در برنامتون زبان فارسی رو پشتیبانی نمیکنه.
3. کدپیج مورد استفاده در زمان ثبت اطلاعات با کدپیج فعلی متفاوت است.

اگه این موارد نبود٬ تصویری از برنامتون (قسمت نمایش اطلاعات) رو اینجا بذارید تا ببینیم.

ممنون

----------


## mr_esmaily

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

----------


## بابک زواری

ممنون آقای سیدشریفی از لطف شما
اینم به افتخار آقای سیدشریفی بااین کدمیتونیدیک منوی قابل قبول باتصویر
و رنگ دلخواه و چند تا خرت پرت دیگه بسازید.
سورس ساختن منوهم اینجاست البته اینم بگم که کد برنامه
زیاد بهینه نیست و ممکنه اشکالاتی ریزی هم داشته باشه.
اینم اوپن سورس ما هرکس امکانی اضافه کرد یا باگی گرفت
با ذکر دقیق کار انجام شده و تغییرات صورت گرفته بذاره 
همین جا بقیه بردارن.
فقط مشکلات رو برای من PM نزنید چون من تا اینجا آوردم
بقیه رو دوستان زحمتش رو بکشن.

----------


## coral

آقای اسماعیلی آیا شما تنظیمات farsi ویندوز ایکس پی خود را  ست کرده اید؟چون معمولا علامت سوال را وقتی می دهد که آن ها تنظیم نشده باشند.

----------


## mr_esmaily

سلام
آره ست شدن.
البته مشکله بالا درصورتیکه که کپی پِیست کنم اگه خودم دستی فارسی تایپ کنم مشکلی ندار.

----------


## coral

دوستان برای من یک اشکال در رابطه باright to left در وی بی پیش اومده یعنی وقتی من برنامه وی بی را به یک ویندوز ایکس پی خام می برم که نه office دارد و نه وی بی ، تمام right to left هایم به هم می خورد.یعنی  منوهایم از چپ به راست چیده می شوندو تمام text box هایم هم دچار مشکل شده اند و مثلا اگر من نوشته باشم 
1- روش کنترل
شده:
روش کنترل 1-

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

----------


## vbprogramer

فکر می کنم مشکل شما فایل vbame.dll باشه که جناب  غیبی در چند پست قبل در همین تاپیک ذکر کردند  :wink:

----------


## coral

اتفاقا من هم اون پست را دیدم اما نمی دانم چطور باید از اون dll استفاده کرد وچگونه باید اونو به ستاپ برنامه اضافه کرد.

----------


## M-Gheibi

> اتفاقا من هم اون پست را دیدم اما نمی دانم چطور باید از اون dll استفاده کرد وچگونه باید اونو به ستاپ برنامه اضافه کرد.


نحوه استفادش که راحته. باید اون رو به همراه ستاپ برنامه داشته باشید. در همه برنامه های ستاپ ساز قسمتی برای تعریف فایلهای اضافی مورد نیاز برنامه هست (حتی برنامه Package & Deployment Wizard موجود در سی دی نصب ویژوال بیسیک). این فایل رو باید به پوشه سیستم دستگاه کپی کنید.

----------


## setarehman

برای اینکه آقای غیبی عصبانی نشن من تابع تبدیل تاریخ رو اینجا میذارم هم ساده هست و هم کوتاه

Function Shamsi&#40;Optional date1 As String, Optional SmallDate1 As Boolean&#41; As String
      '=================================================  ===
      Dim d, P, w, mon, mm, ym, u, v, rp, X, i, ys, ms, dm, p1, d1, ds, DateShamsi
      d = Array&#40;20, 19, 20, 20, 21, 21, 22, 22, 22, 22, 21, 21&#41;
      P = Array&#40;11, 12, 10, 12, 11, 11, 10, 10, 10, 9, 10, 10&#41;
      w = Array&#40;"یکشنبه","دوشنبه","سه شنبه","چهارشنبه","پنج شنبه","جمعه","شنبه"&#41;
      
      If SmallDate1 = True Then
            mon = Array&#40;"01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12"&#41;
      Else
            mon = Array&#40;"اسفند", "بهمن", "دی", "آذر", "آبان", "مهر", "شهریور", "مرداد", "تیر", "خرداد", "اردیبهشت", "فروردین"&#41;
      End If
      
      If date1 = "" Then date1 = DateAdd&#40;"d", 1, Date&#41;
      
      dm = Day&#40;date1&#41;
      mm = Month&#40;date1&#41;
      ym = Year&#40;date1&#41;
      u = 0
      rp = 0
      If &#40;ym Mod 4&#41; = 0 Then u = 1
      If &#40;&#40;ym Mod 100&#41; = 0 And &#40;ym Mod 400&#41; &lt;> 0&#41; Then u = 0
      ys = ym - 622
      X = ys - 22
      X = X Mod 33
      If &#40;&#40;X Mod 4&#41; = 0 And X &lt;> 32&#41; Then rp = 1
      i = Not &#40;rp - 2&#41; + Not &#40;u - 2&#41; * 2
      X = 0
      If &#40;i = 0 And mm = 3&#41; Then X = 1
      If i = 0 Then i = 3
      ms = &#40;9 + mm&#41; Mod 13
      If ms &lt; 10 Then ms = ms + 1
      d1 = d&#40;mm - 1&#41;
      If &#40;i = 1 And mm > 2&#41; Then d1 = d1 - 1
      If &#40;i = 2 And mm &lt; 3&#41; Then d1 = d1 - 1
      p1 = P&#40;mm - 1&#41;
      If &#40;i = 1 And mm > 2&#41; Then p1 = p1 + 1
      If &#40;i = 2 And mm &lt; 4&#41; Then p1 = p1 + 1
      If &#40;dm > 0 And dm &lt;= d1&#41; Then
             ds = p1 + dm + X - 1
          X = 1
      Else
          ds = dm - d1
          ms = ms + 1
          If ms = 13 Then ms = 1
          X = 2
      End If
      If &#40;&#40;mm = 3 And X = 2&#41; Or mm > 3&#41; Then ys = ys + 1
      ds = Str&#40;ds&#41;
      If Len&#40;Trim&#40;ds&#41;&#41; = 1 Then ds = "0" + Trim&#40;ds&#41;
      If SmallDate1 = True Then
'     اگر سال به صورت دو کارکتری میخواهید خط زیر را از حالت کامنت در آورید
'            Shamsi = Mid&#40;Trim&#40;Str&#40;Ys&#41;&#41;, 3, 2&#41; + "/" + Trim&#40;mon&#40;Ms - 1&#41;&#41; + "/" + Trim&#40;Ds&#41;
'     اگر سال به صورت چهار کارکتری میخواهید خط زیر را از حالت کامنت در آورید
            Shamsi = Trim&#40;Str&#40;ys&#41;&#41; + "/" + Trim&#40;mon&#40;ms - 1&#41;&#41; + "/" + Trim&#40;ds&#41;
      Else
            Shamsi = w&#40;Weekday&#40;Date&#41; - 1&#41; + " " + Str&#40;ds&#41; + " " + mon&#40;ms - 1&#41; + " " + Str&#40;ys&#41;
      End If
End Function

----------


## coral

من اون vbame.dll را در قسمت سیستم کپ کردم ومشکلم حل شد.باتشکر از آقای غیبی و وی بی پروگرمر عزیز.

----------


## M-Gheibi

> برای اینکه آقای غیبی عصبانی نشن من تابع تبدیل تاریخ رو اینجا میذارم هم ساده هست و هم کوتاه


ممنون از کمکتون
فقط به نطر این تابع مشکل داره. خروجی که امروز به من داد اینه : سه شنبه 15 خرداد 1383 البته این در صورتیه که از تابع به این شکل استفاده بشه :
Shamsi&#40;&#41;
اگه کد زیر باشه خروجی اینه : سه شنبه 14 خرداد 1383
Shamsi&#40;Date&#41;
اگه میتونید تصحیحش کنید.



> من اون vbame.dll را در قسمت سیستم کپ کردم ومشکلم حل شد.باتشکر از آقای غیبی و وی بی پروگرمر عزیز.


 :موفق:

----------


## coral

سوال
من مطالب جدولم را در محیط وی بی و در ‏Textbox ها و در ویندوز ایکس پی تایپ کرده ام هنگام نمایش تکست ها در هیچ ویندوزی مشکلی ندارد.اما من با کمک دیتاریپورت از این ها ریپورت ساختم.حالا مشکل این است: هنگام پیش نمایش چاپ برای بعضی از تکست ها حروف رادرهم برهم و خرچنگ و قورباغه می زند. جالب این جا است که 3 خط اون درسته و مثلا 1 خط خراب است. این اشکال در ویندوز ایکس پی من وجود دارد.
قابل ذکر است که هنگام چاپ حروف را درست چاپ میکند.
چکار کنم که پیش نمایش چاپم هم درست بشه؟

----------


## MM_Mofidi

راه حل
بجای خط
      If date1 = "" Then date1 = DateAdd&#40;"d", 1, Date&#41;
بنویسید
      If date1 = "" Then
        date1 = DateAdd&#40;"d", 1, Date&#41;
      Else
        date1 = DateAdd&#40;"d", 1, date1&#41;
      End If
البته علت اضافه کردن 1 روز به تاریخ را برای انجتم محاسبه نمیدانم :sad2:

----------


## vbprogramer

> سوال
> من مطالب جدولم را در محیط وی بی و در ‏Textbox ها و در ویندوز ایکس پی تایپ کرده ام هنگام نمایش تکست ها در هیچ ویندوزی مشکلی ندارد.اما من با کمک دیتاریپورت از این ها ریپورت ساختم.حالا مشکل این است: هنگام پیش نمایش چاپ برای بعضی از تکست ها حروف رادرهم برهم و خرچنگ و قورباغه می زند. جالب این جا است که 3 خط اون درسته و مثلا 1 خط خراب است. این اشکال در ویندوز ایکس پی من وجود دارد.
> قابل ذکر است که هنگام چاپ حروف را درست چاپ میکند.
> چکار کنم که پیش نمایش چاپم هم درست بشه؟


بله من هم این مشکل را دیدم
البته اگر zoom  را بالا ببریم خوب دیده میشن ولی درحالت معمولی عجق وجق دیده میشن  :sad2:

----------


## coral

من zoom را تا 200 درصد افزایش دادم اما فایدهای نداشت این هم تصویر حروف من:

----------


## حامد مصافی

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

   آقای غیبی توی یه تاپیک دیگه گوشش منو کشیدن که اگه تابع تبدیل میلادی به هجری داری بیار بذار اینجا

   آقای غیبی من بازم از شما معذرت میخوام  :wink: 

   اینم لینک اون توابع ، این توابع رو متاسفانه نمی دونم کی نوشته ولی خیلی عالیه  :mrgreen: 

<span dir=ltr>

http://www.barnamenevis.org/download.php?id=2971


</span>

----------


## setarehman

تابع رو به این شکل فراخوانی کنید
Shamsi&#40;, True&#41;

----------


## M-Gheibi

با این کار  فقط تاریخ تبدیل میشه و به شکل فارسی نمایش داده نمیشه

----------


## Fagat_tanhaie

با سلام 

اطلاعات یک برنامه رو با برنامه ای که تو vb نوشتم برداشتم و تو یه فایل متن ذخیره کردم

اطلاعت برنامه فارسی بوده و با فونت azarakhsh10 , parsfix قبلا وارد شده

حالا من این فایلی که ذخیره کرده بودم رو تو vb باز کردم و ریختم تو یک textbox و در ضمن 

فونت textbox  رو هم به فونت مربوطه ست کردم

ولی وقتی با تابع instr جستجو میکنم متن مورد نظر رو پیدا نمیکنه

لطفا راهنمایی کنید.

در ضمن از parsa2001 استفاده میکنم

آیا میشه فونشو به unicode تبدیل کرد ؟ چگونه؟

مرسی

----------


## coral

دوستان! این جا یک نرم افزار فارسی ساز تاریخ ایکس پی را گذاشته اند می خواهید یک سری بزنید:
www.sinapardazeshsoft.com

----------


## hamedv

بهترین کدی که برای تبدیل تاریخ دیدم که میتونه چند نوع تقویم رو به هم تبدیل کنه : عبری، میلادی، هجری شمسی، هجری قمری
میتونه بگه هر روز چند شنبه ست
میتونید باهاش روزای تعطیل رو پیدا کنید ( مثلا 22 بهمن یا 10 محرم )
روشش هم اینه که برای هر تاریخ دو تا تابع داره که یک تابع تاریخ رو به یه عدد تبدیل میکنه و یه تابع عدد رو به تاریخ
اینطوری میتونید بگید که مثلا 32 روز دیگه کی میشه
هیچ گونه ایرادی هم من توش پیدا نکردم

----------


## mostafa313

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

----------


## Hamedm

> بهترین کدی که برای تبدیل تاریخ دیدم که میتونه چند نوع تقویم رو به هم تبدیل کنه : عبری، میلادی، هجری شمسی، هجری قمری 
> میتونه بگه هر روز چند شنبه ست 
> میتونید باهاش روزای تعطیل رو پیدا کنید ( مثلا 22 بهمن یا 10 محرم ) 
> روشش هم اینه که برای هر تاریخ دو تا تابع داره که یک تابع تاریخ رو به یه عدد تبدیل میکنه و یه تابع عدد رو به تاریخ 
> اینطوری میتونید بگید که مثلا 32 روز دیگه کی میشه 
> هیچ گونه ایرادی هم من توش پیدا نکردم


من این برنامه رو قبلا دیده بودم ولی مثل الان مثالی ازش مشاهده نکردن. این برنامه حاوی بیش از 10 تابع است که هر کدوم وظیفه خاصی دارند. که متاسفانه هیچ مثالی از شون نزدید به همین دلیل براحتی نمیتوان دریافت که هر تابع را چگونه میشود فراخوانی کرد و نیز پارامترهای ورودی هر یک چیست. متاسفانه در کد توابع نیز توضیحی داده نشده است.

اگر مثالی در مورد نحوه استفاده این توابع دارید ممنون میشوم در اختیار این جانب نیز بگذارید.

موفق باشید و پرتوان

----------


## hamedv

> اگر مثالی در مورد نحوه استفاده این توابع دارید ممنون میشوم در اختیار این جانب نیز بگذارید.


من خودم از این ماجولها استفاده کردم
فقط اگر توی دات نت بخواهید استفاده کنید باید یکی از توابعش رو که run time error میده رو یه تغییر کوچولو بدید
استفاده کردن ازش خیلی سادست
شما تمام ماجولها رو به برنامه add کن
بعدش میتونی تابعهای زیادی رو صدا بزنی
مثلا :


dim y as integer
dim m as integer
dim d as intger

y=2005
m=2
d=2

call civil_persian&#40;y,m,d&#41;



بعد از اجرای کد توی y عدد 1383 و توی m عدد 11 و توی d عدد 14 خواهد بود
اگر بخواهیم ببینیم که مثلا 10 روز بعد چه روزیه  به جای تبدیل تاریخ civil (میلادی) به شمسی یا شمسی به میلادی میشه تاریخ رو به jdn یا jullian day number تبدیل کرد و اون عدد رو با 10 جمع کرد و دوباره به هر تاریخی که میخواهد تبدیل کنید
تابع هاش اینا هستن :
civil_jdn
jdn_civil
persian_jdn
jdn_persian
 در واقع توی این تابعها هر تاریخی دو تا تابع داره یکی یک روز رو به jdn تبدیل میکنه و دیگری jdn رو به روز و ماه و سال تبدیل میکنه
هر کدوم از تقویمهاش هم کار یه ستاره شناسه
مثلا یه ستاره شناس ایرانی تابعهای persian_jdn و jdn_persian رو نوشته و الخ  :wink: 
اگر باز هم مشکلی هست بهم بگین

----------


## Hamedm

hamedv دستت درد نکنه از توضیحات.  :flower:

----------


## بابک زواری

اینم تقویم

----------


## بابک زواری

این تقویم فقط ایرادش اینه که باید سیستم تاریخ شما به صورت mm/dd/yyyy باشه که این ایراد هم 
بزودی برطرف میشه . 
و اینکه شما امکان کنترل رنگ تمام قسمتها رو پیدا میکنید. 
این مشکلات رو به دیده اغماض بنگرید تا نسخه جدید آماده باشه

----------


## M-Gheibi

_پست زیر رو یکی از کاربران سایت (ehsan707) در بخشی دیگر ارسال کرده بودند که عینا به اینجا منتقل شده :_

این هم یکبار برای همیشه 
این اکتیوایکس رو به پروژه اضافه کنید و 2 متد رو فراخوانی کنید یکی برای قرار دادن تاریخ و یکی برای گرفتن تاریخ
البته برای محاسبه روز هفته میتونید تابع weekday رو در وی بی فراخوانی کنید. 
خودم نوشتمش و تا جایی که تست کردم کاملا دقیقه خیلی هم سریعه ! 
اگر خطا یا اشتباهی دیدین به من میل بزنید ehsan2022002@yahoo.com 
و اگر برای تبدیلات ماهای قمری و یهودی و فارسی به هم نیاز به اکتیو ایکس دارید. 

دانلود
http://ehsan707.topcities.com/pcal.zip
(با تشکر از موناااااا که آدرس سایت برنامه نویس اورگ رو به من داد)  :wink:

----------


## vbadvanced

تابع زیر برای تبدیل اعداد به حروف نوشته شده. میدونم دیگه داره تو این تاپیک یه کم زیاد میشه. اما میتونید با این یکی اعدا شمارشی هم داشته باشید که تو هیچکدوم از قبلیا ندیدم. (مثلا سوم، سی ام. چهل و پنجم و ...)!!
همچنین مثلا -1 رو بصورت «منفی یک» نمایش میده. پشتیبانی از اعداد اعشاری هم بعدا اضافه میکنم و میزارم همینجا .
درضمن کد توی کریستال ریپورتز هم در بخش فرمول نویسی بدرستی کار میکنه(البته باید دو تابع رو در دو Function جدا قرار بدید.)
کد توضیحات کامل هم داره.
اگر مشکلی یا نظری داستید لطفا به این آدرس میل بزنید vbadvanced@gmail.com 



'This Function convert Numbers To Text
Public Function NoToText&#40;eNo As Double, _
                   Optional isCounter As Boolean = False&#41; As String

Dim tStr, tNo, eNumber As String
Dim i, j, k As Double
Dim m_isNeg As Boolean

    'This Number is Negative Or Positive?
    m_isNeg = IIf&#40;Sgn&#40;eNo&#41; = -1, True, False&#41;

    
    If eNo = 0 Then 'This Number is Zero; Don't Continue anymore
        NoToText = IIf&#40;isCounter, "صفرم ", "صفر "&#41;
        Exit Function
    'NOTE&#58; We can delete Following 3 Lines of code to have "یکم" instead of "اول"
    'TODO&#58; we can Make a new optional Argument to ask this from user
    ElseIf &#40;eNo = 1&#41; And isCounter And &#40;Not m_isNeg&#41; Then
        NoToText = "اول "
        Exit Function
    End If

    'TODO&#58; Add Support for decimal Numbers
    'convert input to Absolute value w/o Thousand separators, as a String
    eNumber = Abs&#40;eNo&#41;

    'Add Some Extra Zero at the begining of String
    eNumber = Choose&#40;Len&#40;eNumber&#41; Mod 3, "00", "0"&#41; &amp; eNumber

    tStr = ""
    k = Len&#40;eNumber&#41; / 3

    For i = 1 To Len&#40;eNumber&#41; Step 3
    '
        tNo = Mid&#40;eNumber, i, 3&#41;
        If tNo &lt;> "000" Then
            
            'Convert The First Digit Of Group --> `5`12
            tStr = tStr &amp; _
            DigitToText&#40;Mid&#40;tNo, 1, 1&#41; &amp; "00"&#41;

            'If the Second Digit is &lt;1> Then We Have a number between _
             Ten and Nineteen;
            If Mid&#40;tNo, 2, 1&#41; = "1" Then '--> 5`12`
                tStr = tStr &amp; _
                DigitToText&#40;Mid&#40;tNo, 2, 2&#41;&#41;
            Else 'elsewhere, do normal method
                tStr = tStr &amp; _
                DigitToText&#40;Mid&#40;tNo, 2, 1&#41; &amp; "0"&#41;        '--> 5`2`6
                tStr = tStr &amp; _
                DigitToText&#40;Mid&#40;tNo, 3, 1&#41;&#41;
            End If
            'if u know greater values then >>>>>>>>>>>>>>>>>>>>just Add it below
            tStr = tStr &amp; Choose&#40;k, "", "هزار ", "میلیون ", "میلیارد ", "تریلیون "&#41; '&lt;&lt;&lt; here before `&#41;`
        End If
        k = k - 1
    
    Next i

    'If in Counting Mode then add appropriate Suffixes to end of string
    If isCounter Then
        If Right&#40;eNumber, 1&#41; = "3" Then
            tStr = Left&#40;tStr, Len&#40;tStr&#41; - 2&#41; &amp; "وم" 'is `سهم` true?! ;&#41;
        ElseIf Right&#40;eNumber, 2&#41; = "30" Then
            tStr = Left&#40;tStr, Len&#40;tStr&#41; - 1&#41; &amp; "‌ام" 'and u know `سیم` is wrong! ;&#41;
        Else
            tStr = RTrim&#40;tStr&#41; &amp; "م" 'make countable strings like `دوازدهم`,`پنجم`, etc...
        End If
    End If

    'This is Result!! ;&#41;
    NoToText = IIf&#40;m_isNeg, "منفی ", ""&#41; &amp; Mid&#40;tStr, 3&#41;

End Function


Private Function DigitToText&#40;eNo As String&#41;
Dim tStr As String
Dim tDbl As Double

If eNo = "" Or eNo = "0" Or eNo = "00" Or eNo = "000" Then
    DigitToText = ""
    Exit Function
End If

tDbl = Val&#40;eNo&#41;
Select Case tDbl
    Case Is >= 1000
        tStr = ""
    Case Is >= 900
        tStr = "نهصد"
    Case Is >= 800
        tStr = "هشتصد"
    Case Is >= 700
        tStr = "هفتصد"
    Case Is >= 600
        tStr = "ششصد"
    Case Is >= 500
        tStr = "پانصد"
    Case Is >= 400
        tStr = "چهارصد"
    Case Is >= 300
        tStr = "سیصد"
    Case Is >= 200
        tStr = "دویست"
    Case Is >= 100
        tStr = "صد"
    Case Is >= 90
        tStr = "نود"
    Case Is >= 80
        tStr = "هشتاد"
    Case Is >= 70
        tStr = "هفتاد"
    Case Is >= 60
        tStr = "شصت"
    Case Is >= 50
        tStr = "پنجاه"
    Case Is >= 40
        tStr = "چهل"
    Case Is >= 30
        tStr = "سی"
    Case Is >= 20
        tStr = "بیست"
    Case Is >= 19
        tStr = "نوزده"
    Case Is >= 18
        tStr = "هیجده"
    Case Is >= 17
        tStr = "هفده"
    Case Is >= 16
        tStr = "شانزده"
    Case Is >= 15
        tStr = "پانزده"
    Case Is >= 14
        tStr = "چهارده"
    Case Is >= 13
        tStr = "سیزده"
    Case Is >= 12
        tStr = "دوازده"
    Case Is >= 11
        tStr = "یازده"
    Case Is >= 10
        tStr = "ده"
    Case Is >= 9
        tStr = "نه"
    Case Is >= 8
        tStr = "هشت"
    Case Is >= 7
        tStr = "هفت"
    Case Is >= 6
        tStr = "شش"
    Case Is >= 5
        tStr = "پنج"
    Case Is >= 4
        tStr = "چهار"
    Case Is >= 3
        tStr = "سه"
    Case Is >= 2
        tStr = "دو"
    Case Is >= 1
        tStr = "یک"
    Case Is >= 0
        tStr = ""
End Select
    DigitToText = "و " + tStr + " "
End Function

'ALL RIGHTS RESERVED BY&#58; Mohammad Shiran

----------


## vbadvanced

این هم برای اعداد اعشاری. تابع زیر رو برای تبدیل اعداد اعشاری به متن استفاده کنید و حالشو ببرید.
همین الان تموم شد. داغ داغ، تنوری!!
آرگومان اولش که معلومه. دومیش هم برای تعیین نوع خروجی هست. یعنی مثلا برای 12.5 خروجی بصورت «دوازده و نیم» یا « دوازده ممیز پنج دهم»

Function DecimalToText&#40;eNo As Double, _
                       Optional DecStyle As Boolean = False _
                                                  &#41; As String
                       
    Dim eFixed As String, eDecimal As String
    Dim sResult As String
    
    'return fixed value of given number as string
    eFixed = Fix&#40;eNo&#41;
    
    'if this number has some decimals
    If &#40;Len&#40;CStr&#40;eNo&#41;&#41; - Len&#40;eFixed&#41;&#41; Then
        'get it as a string, Example&#58; return `125` for `12.125`
        eDecimal = Mid&#40;CStr&#40;eNo&#41;, Len&#40;eFixed&#41; + 2&#41;
        'return fixed part as text
        sResult = NoToText&#40;CDbl&#40;eFixed&#41;&#41; &amp; IIf&#40;DecStyle, "و ", "ممیز "&#41;
        'if decimal section is `5` then use `نیم` Instead of `پنج دهم`
        'this is optional, u can remove it if u like
        If eDecimal = 5 Then
            sResult = sResult &amp; "نیم"
        Else
            'convert the decimal part of number to text
            sResult = sResult &amp; _
                      NoToText&#40;CDbl&#40;eDecimal&#41;&#41;
            'add extra suffix at end of string, depending to number of decimal places
            sResult = sResult &amp; _
                      Choose&#40;Len&#40;eDecimal&#41;, "دهم", "صدم", _
                                            "هزارم", "ده هزارم", _
                                            "صد هزارم", "میلیونیم"&#41; ', _
                                             ....
        End If
            
    Else
        'if this number is originally an integer then convert it using normal method
        sResult = NoToText&#40;eNo&#41;
    End If
    'return the result. ;&#41;
    DecimalToText = sResult
    
End Function

----------


## بابک زواری

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

----------


## Hamedm

vbadvanced دستت درد نکنه   :تشویق:  . جالب بود.  :flower:

----------


## M-Gheibi

:flower:

----------


## vbadvanced

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

----------


## 30yavash

من یه سورس برنامه «یا هر چیز دیگه ای که کمکم کنه» ترجیحا به زبان ویژوال بیسیک دات نت می خام که کاربر بدون داشتن صفحه کلید فارسی بتونه فارسی بنویسه.
در واقع می خام یه برنامه بنویسم که نیاز به صفحه کلید فارسی و از این جور چیزا نداشته باشه با فونت مریم یا IPT یا هر فونت دیگه که Unicode نباشه.
خیلی توی این سایت گشتم ولی متاسفانه در این سایت در مورد همه چیز صحبت شده به جز همین مورد.

----------


## M-Gheibi

> متاسفانه در این سایت در مورد همه چیز صحبت شده به جز همین مورد.





> با فونت مریم یا IPT یا هر فونت دیگه که Unicode نباشه.


من کد برای نوشتن با فونت IPT رو داشتم ولی پیدا نمی کنم. اگه مشکل شما یونیکد هست خوب از Iransystem استفاده کنید. کدش هم در همین تاپیک هست.

----------


## بابک زواری

> من کد برای نوشتن با فونت IPT رو داشتم ولی پیدا نمی کنم.


آقای غیبی اگر این کد رو پیدا کردید ممنون میشم اونو به اشتراک بذارید

----------


## vbadvanced

من یک برنامه مشابه این چیزی که شما میخوای داشتم. منتها نه برای IPT
اونو تغییرش میدم و براتون میزارم

----------


## بابک زواری

ممنون اگر لطف کنید

----------


## ghaum

سلام
من وقتی در richeditbox یک متنی را کپی می کنم نقطه آخر خط را اول می آورد
برای حل این مشکل چه باید بکنم؟
در ضمن من آن فایل dll را در فایل سیستمی ویندوز دارم 

خیلی متشکرم

----------


## vbadvanced

وقتی تایپ میکنید یک بار ctrl+shift سمت راست صفحه کلید خودتون رو با هم بزنید. اینکار پاراگراف شما رو بصورت RightToLeft تغییر میده. علت این مشکل شما هم همین هست.

----------


## ghaum

سلام
اما تمام متنها تایپ شده 
آیا راه دیگری وجود ندارد

خیلی متشکرم

----------


## vbadvanced

اگه همه متنهات توی یک فایل هستند اول یک بار ctrl+a رو بزن بعد هم ctrl+shift

----------


## ghaum

خیلی ممنون
الان در دستگاه خودم متنهای فارسی را درست می بینم
ولی وقتی که برنامه را در یک دستگاه که ویندوز 2000 دارد اجرا می کنم متون فارسی به شکل علامت سوال نمایش داده می شوند
دستگاه خودم ویندوز xp دارد البته روی دستگاه دیگری که ویندوز xp دارد هم تست کردم ولی همان مشکل را داشت

----------


## M-Gheibi

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

----------


## hex161

سلام دوستان.
من یه تازه ویژوال دیده ام.
نمیدونم چرا توی فورم گزینه Right To Left همیشه False میشه و True نمیشه
اگه میشه منو راهنمایی کنید

----------


## vbadvanced

از چه سیستم عاملی استفاده میکنید؟
اگر XP یا دوهزار هست. اول امکانات فارسی رو توی اون نصب کنید.

----------


## ghaum

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

لطفا راهنمایی بفرمایید

----------


## M-Gheibi

> نمیدونم چرا توی فورم گزینه Right To Left همیشه False میشه و True نمیشه 
> اگه میشه منو راهنمایی کنید


باید سیستمتون امکانات فارسی را ساپورت کنه.

----------


## ghaum

سلام
من یک برنامه با vb6 نوشتم که اطلاعات را از بانک access فقط می خواند 
اطلاعات نیز با asp در صفحات وب با کدپیج یونیکد واردبانک شده اند
من تمام تنظیماتی که برای فارسی در این تاپیک گفته شده بود را انجام دادم و از آن فایل dll هم استفاده کردم
روی دستگاه خودم هیچ مشکلی ندارم ولی وقتی که برنامه را البته فایلexe آن را در کامپیوتر دیگری که تنظیمات آن مانند دستگاه خودم می باشد کپی می کنم اطلاعات به صورت علامت ؟ نمایش داده می شوند

در صورت توان راهنمایی بفرمایید
خیلی متشکرم

----------


## M-Gheibi

گروه نرم افزاری اوکسین اقدام به طراحی و عرضه ی DLLی نموده است که مشکل برنامه نویسان ایرانی را تا حد زیادی در زمینه تاریخ شمسی حل می‌کند.
این توابع به صورت کاملا دقیق، تاریخ میلادی سیستم را به تاریخ هجری شمسی تبدیل می‌نمایند و همچنین توابع دیگری را برای انجام محاسبات روی این تاریخ در دسترس قرار می‌دهند. یکی از ویژگیهای جالب توجه این کلاس (که بسیاری از کلاسهای مشابه نوشته شده در این زمینه فاقد ان هستند) عملکرد دقیق آنها روی سالهای کبیسه است. همانطور که می‌دانید در سیستم تاریخ شمسی بعضی از سالها کبیسه هستند و در آنها ماه اسفند سی روز می‌باشد. این سالها به صورت متناوب هر چهار سال یکبار تکرار می‌شوند و چون این سالها از سالهای عادی یکروز بیشتر هستند، لذا باید در محاسبات تاریخ این نکته را مدنظر قرار داد، که این توابع به خوبی از آن پشتیبانی می‌کنند.
کلاسهای این توابع به صورت استاندارد تهیه و کامپایل شده است تا تمام برنامه نویسان بتوانند از آنها در زبانهای برنامه نویسی گوناگون مانند دلفی، ویژوال بیسیک، سی شارپ و همه ی زبانهای دیگری که از استاندارد COM پشتیبانی می‌کنند، استفاده کنند.
استفاده از فایل shamsi.dll توسط برنامه نویسان ایرانی در برنامه ها و پروژه های مختلف مجاز می باشد. این برنامه به صورت رایگان است و کاربر برای استفاده از آن مجبور به پرداخت هیچ حق استفاده ای نمی باشد. اما برای پشتیبانی از سازنده ی این برنامه، لطفا افرادی که از آن در برنامه ها یا پروژه های خود استفاده می کنند، با ارسال یک ایمیل به طراح برنامه پشتیبانی خود را اعلام کنند.

تعدادی از قابلیتهای عمده تقویم شمسی و قابلیتهای جدید که در آخرین نگارش به آن اضافه شده اند را مشاهده می کنید:

امکان تبدیل کاملا دقیق تاریخ میلادی به شمسی
عملکرد دقیق روی سالهای کبیسه
انجام عملیاتهای محاسباتی مختلف بر روی تاریخهای شمسی
پشتیبانی از 29/12/1330 تا 29/12/9999 !
رایگان برای استفاده برنامه نویسان و طراحان وب
لینک دانلود فایل : http://files.oxinsoft.com/shamsidll/shamsidll.zip
لینک سایت شرکت نرم افزاری اوکسین : http://www.oxinsoft.com

----------


## ghaum

مشکل من حل شد
باید تنظیمات ویندوز مربوط به فارسی را در دستگاهها دیگر درست می کردم

----------


## M-Gheibi

> باید تنظیمات ویندوز مربوط به فارسی را در دستگاهها دیگر درست می کردم


گفته بودم که :



> باید سیستمتون امکانات فارسی را ساپورت کنه.

----------


## hex161

ویندوز من اکس پی سرویس پک دو هست.
فارسی ساز سینا پک رو هم توش نصب کردم باز هم جواب نمیده
بنظر شما باید کجا رو انگولک کنم؟

----------


## M-Gheibi

> ویندوز من اکس پی سرویس پک دو هست. 
> فارسی ساز سینا پک رو هم توش نصب کردم باز هم جواب نمیده 
> بنظر شما باید کجا رو انگولک کنم؟


1. خوب اأان مشکلتون چیه؟
2. اگه علامت سوال هست باید طبق توضیحات اول این تاپیک عمل کنید.

----------


## ghaum

سلام 
من اطلاعاتم را از بانک داخل richedittextbox k نمایش می دهم
ولی  نقطه آخر خط را اول می آورد 
در صورتی که در داخل بانک درست وارد می شود
و rightoleft متنها صحیح می باشد
برای حل این مشکل چه باید بکنم؟ 

خیلی متشکرم

----------


## hex161

> اگه علامت سوال هست باید طبق توضیحات اول این تاپیک عمل کنید.


نه علامت سوال نیست.
مشکل من اینه که مشخصه Right To Left در فورم همیشه روگزینه false گیر کرده 
و امکان تغییر توش نیست.

----------


## M-Gheibi

دوست عزیز باز هم که زحمت خوندن پست های قبلی رو نکشیدید! 



> برای استفاده از امکان Right to Left در برنامه ها فایل VBAME.DLL موجود در پوشه سیستم را به همراه برنامه خود قرار دهید.


احتمالا این فایل رو ندارید. برنامه رو مجددا نصب کنید اگه درست نشد در وب پیدا میشه.

----------


## ghaum

سلام
این متن را نگاه کنید اینجا هیچ مشکلی ندارد ولی در RICHEDITBOX نقطه ها به اول خط می آیند
آیا راه حلی برای این مشکل وجود دارد؟
متشکرم
محسن در یکی از روزهای زیبای سال 1338 در جمع گرم و صمیمی خانواده دین‌شعاری به دنیا آمد، روزهای پرنشاط کودکی را زیر سایه تعالیم پدر و مادر گرامی و در پناه تعالیم دین اسلام گذراند.او از همان اوایل نوجوانی علاقه عجیبی به اهل‌بیت (ع) داشت و در 13 یا 14 سالگی بود که هیئتی به نام شهدای کربلا تأسیس نمود و خود به تنهایی مسئولیت آن را بر عهده گرفت.با شروع امواج خروشان انقلاب به صف مجاهدین راه حق پیوست و همواره در تظاهرات‌های سال 1357 حضوری فعال داشت در همان ایام به همراه برادرش به خدمت در پزشکی قانونی پرداخت و مدت 6 ماه به صورت شبانه‌روزی در کار جابجایی و تحویل اجساد مطهر شهدا شرکت داشت محسن جزء اولین سربازانی بود که به فرمان امام خمینی (ره) به پادگانها برگشتند و خودشان را معرفی کردند او همواره فریضه مقدس امر به معروف و نهی از منکر را انجام می‌داد و برای سربازان پادگان به خصوص آنهایی که در انجام فرائض تعلل می‌کردند برنامه شناخت ایدئولوژی گذاشته بود.او حدود 5/1 سال در سالهای 57 و 1358 خدمت مقدس سربازی را انجام داد و پس از آن در سال 1360 به خیل سبزپوشان سپاهی پیوست. با شروع جنگ تحمیلی عاشقانه به جبهه‌های نبرد شتافت و به عنوان مسئول گردان تخریب لشگر27 محمدرسول‌الله (ص) مشغول به خدمت شد و در سال 1363 به سفر حج رفت.در عملیات‌های طریق‌القدس و کربلای1 یادآور دلاوریها و رشادت‌های خالصانه او در راه دفاع از میهن است زمانیکه قرار بود برای بار دوم به سفر حج مشرف شود و به خاطر مسئولیت‌هایی که در جبهه داشت از تشرف به حج منصرف شد اما در همان سال در روز پانزدهم مردادماه سال 1366 درست مصادف با روز عید قربان به مسلخ عشق رفت و اسماعیل‌وار جان خویش را در حین خنثی‌سازی مین ضد تانک در قربانگاه سردشت فدای معبود ساخت و نام خویش را برای همیشه در قلب تاریخ زنده نگه داشت مزار مطهر او در قطعه 29 بهشت‌زهرای تهران قرار دارد.

----------


## hadi2345

با تشکر از همه بچه ها . خیلی عالی بود :flower:

----------


## ghaum

سلام
کسی نیست مشکل من را حل کند
این متنی که برایتان فرستادم در برنامه ام طوری نمایش داده می شود که نقطه ها در اول سطر قرار دارند در microsoft Word هیچ مشکلی ندارد
دیگر نمی دانم چه کار کنم
اگر می شود یک راهنمایی کنید

متشکرم

----------


## Nova

ممنون آقای غیبی، کد خیلی خوبی  فرستادین

----------


## بابک زواری

راست به چپ کردن Treeview

Option Explicit 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" &#40;ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long&#41; As Long 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" &#40;ByVal hwnd As Long, ByVal nIndex As Long&#41; As Long 
Private Const WS_EX_LAYOUTRTL = &amp;H400000 
Private Const GWL_EXSTYLE = -20 
' 


Private Sub Form_Load&#40;&#41; 
SetWindowLong TreeView.hwnd, GWL_EXSTYLE, GetWindowLong&#40;TreeView.hwnd, GWL_EXSTYLE&#41; Or WS_EX_LAYOUTRTL 


  Dim nodX As Node 
   Set nodX = TreeView.Nodes.Add&#40;, , "R", "Root"&#41; 
   nodX.Expanded = True 
   Set nodX = TreeView.Nodes.Add&#40;, , "P", "Parent"&#41; 
   nodX.Expanded = True 
   Set nodX = TreeView.Nodes.Add&#40;"R", tvwChild, , "Child 1"&#41; 
   Set nodX = TreeView.Nodes.Add&#40;"R", tvwChild, , "Child 2"&#41; 
   Set nodX = TreeView.Nodes.Add&#40;"R", tvwChild, , "Child 3"&#41; 
   Set nodX = TreeView.Nodes.Add&#40;"P", tvwChild, , "Child 4"&#41; 
   Set nodX = TreeView.Nodes.Add&#40;"P", tvwChild, , "Child 5"&#41; 
   Set nodX = TreeView.Nodes.Add&#40;"P", tvwChild, , "Child 6"&#41; 

End Sub

----------


## بابک زواری

در ضمن دوستان با تستی که انجام دادن مثل اینکه کد فوق برای ListView هم جواب میده

----------


## najafi_1

با سلام 
با اینکه من vb کار نمیکنم ولی از روش شما در همکاری لذت بردم. موفق باشید.

----------


## mahdi_sh

> تاریخ شمسی در xp رو توضیح ندادید.
> 			
> 		
> 
> اگه منظورتون اینه که توی برنامه vb چه جوری تاریخ ها رو شمسی کنیم که باید از یه تابع تبدیل تاریخ تو برنامه استفاده کنید


با سلام

اون تابع چیه ؟

ممنون

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

----------


## نعیم رضاییان

این کد بالا نمی دونم چرا ولی برای list view تمام حروف رو هم برعکس می کنه یعنی از آخر به اول مینویسه

----------


## M-Gheibi

> اون تابع چیه ؟


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

موفق باشید
روز خوش

----------


## نعیم رضاییان

سلام 
اقا  میشه بگی اون فایل dll کع برای راست به چپ کردن بکار میره رو به چه شکل باید ازش استفاده کنیم اون فایل در شاخه system32 هست ولی نمی دونم چه حوری باید ازش استفاده کنم 
مرسی

----------


## M-Gheibi

> اقا میشه بگی اون فایل dll کع برای راست به چپ کردن بکار میره رو به چه شکل باید ازش استفاده کنیم اون فایل در شاخه system32 هست ولی نمی دونم چه حوری باید ازش استفاده کنم


یعنی نمیدونید چطور میشه Right to left رو استفاده کرد؟
برای اینکار در کنترل مورد نظر خاصیت Righttoleft رو True کنید.
توجه کنید که به هنگام ستاپ کردم برنامه باید این فایل رو درون ستاپ قرار دهید تا در پوشه System32 کامپیوتر کاربر کپی بشه.

موفق باشید
روز خوش

----------


## نعیم رضاییان

سلام 
اقا اینو می دونم خوب از این حالت که نمیشه برای list view استفاده کرد

----------


## niloufar

سلام
این آقای naeimflashphp همانطور که از عکسی که در مشخصات خود ثبت کرده اند برمی آمد، در لحن صحبتهایشان (مثل استاد... و پاسخ دادن که سخت نیست و  ...) هم مانند عکس دست به کمر و یه پا در جلو و چپ چپ نگاه کن هستند.   :گیج:  
بی خیال شوخی کردم. همان آقایی که شما استاد صدایش می زنید و ما او را آقا بابک، قبلا در یه تاپیک (ظاهرا تا جایی که یادمه به نام TreeView فارسی بود) پاسخ شما را داده اند. اگر حال دارید بروید و نگاه کنید و اگر نه بگویید تا در همین جا آن را ذکر کنم.

این گل هم برای اینکه ناراحت نشوید:  :flower:

----------


## M-Gheibi

> اقا اینو می دونم خوب از این حالت که نمیشه برای list view استفاده کرد


شما برای اینکار از کد آقای زواری استفاده کنید. همونطور که نیلوفر خانم عرض کردند هم در این تاپیک (صفحه قبل) و هم در یک تاپیک دیگر این کد وجود دارد (البته برای Treeview). کد مربوطه برای ListView هم کاربرد دارد.
برای مثال :
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" &#40;ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long&#41; As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" &#40;ByVal hwnd As Long, ByVal nIndex As Long&#41; As Long
Private Const WS_EX_LAYOUTRTL = &amp;H400000
Private Const GWL_EXSTYLE = -20

Private Sub Form_Load&#40;&#41;
SetWindowLong ListView.hwnd, GWL_EXSTYLE, GetWindowLong&#40;ListView.hwnd, GWL_EXSTYLE&#41; Or WS_EX_LAYOUTRTL

ListView.ListItems.Add.Text = "عبارت فارسی اول"
ListView.ListItems.Add.Text = "عبارت فارسی دوم"
End Sub

----------


## نعیم رضاییان

سلام 
ببین وقتی از این کد برای list view استفاده میشه نوشته های فارسی رو که داخل جدول قرارا میگیره از آخر به اول نشون میده 

اگه میشه یک مثال بزاربد 
مرسی  :flower:

----------


## M-Gheibi

> ببین وقتی از این کد برای list view استفاده میشه نوشته های فارسی رو که داخل جدول قرارا میگیره از آخر به اول نشون میده


من چنین مشکلی ندارم.



> اگه میشه یک مثال بزاربد


در پست قبلیم در همین تاپیک گذاشتم دیگه 

موفق باشید

----------


## niloufar

> ببین وقتی از این کد برای list view استفاده میشه نوشته های فارسی رو که داخل جدول قرارا میگیره از آخر به اول نشون میده


سلام 
من هم این مشکل را ندارم

----------


## نعیم رضاییان

اقا اون کد کل حروف رو بر عکس میکنه این مثال رو ببین

----------


## M-Gheibi

شما از کدپیچ ایران سیستم استفاده کرده اید. من هم با این کدپیج همین مشکل رو در راست به چپ کردن لیست دارم. جناب زواری اگه راه حلی به نظرتون میاد ممنون میشیم بیان کنید. :)

----------


## بابک زواری

اینم اجرا در ویندوز من

----------


## بابک زواری

منم مشکلی ندارم شاید تنظیمات ویندوز شما مشکل داره

----------


## نعیم رضاییان

شاید مشگل از ویندوز باشه من از ویندوز advance server 2000 استفاده می کنم من ویندوز رو دوباره نصب می کنم ببینم مشگل حل میشه 
مرسی

----------


## ASPDeveloper

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

----------


## بابک زواری

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


بله برای اعدادی مثل 30948203948203948203948023984023894023984578 هم کار نمیکنه
اولا این گونه اعداد کم استفاده میشن پس نیازی به هندل کردن اونا ندارید دوما سورس در دسترس 
هستید میتونید طوری گسترش بدید که عددی رو هم که من نوشتم هجی کنه

----------


## jack

با سلام خدمت جناب کد نویس .
متاسفانه من نتونستم از برنامه PFA استفاده کنم . چون موقع قرار دادن کنترل روی صفحه یک ایراد lisence not found  می گیرد .

----------


## حامد مصافی

> شما از کدپیچ ایران سیستم استفاده کرده اید. من هم با این کدپیج همین مشکل رو در راست به چپ کردن لیست دارم. جناب زواری اگه راه حلی به نظرتون میاد ممنون میشیم بیان کنید.


این فونت ها در ظاهر فارسی هستند ولی باطناً چپ به راست هستند. اینگونه فونت ها رو نباید راست به چپ کنید. بهتره از ونت های عمومی مثا Tahoma استفاده کنید

ضمناً کسانی که در راست به چپ کردن نوشته های (header) مشکل دارند (این مشکل در اکس پی بیشتر دیده میشه) می تونن از کدی که در بخش "treeView فارسی" گذاشتم استفاده کنن

----------


## حدیثه

واقعا دست همتون درد نکنه.شما یکی لز بزرگترین معضلات بشریت رو حل کردید. :kaf:

----------


## مهدی ذوقی

با سلام
همانطور که می دونید کنترل date time picker سالهای شمسی را پشتیبانی نمی کنه می خواستم ببینم
آیا کسی یک کنترل داره که مثل date time picker عمل کنه و سالهای شمسی را هم پشتیبانی کنه
البته تقویمش برام مهم نیست بلکه مهم نشان دادن فرمت تاریخ به صورتی که کاربر بتونه روز و ماه و سال را
به راحتی توی اون با دکمه updown تغییر بده مثل حالتی از date time picker که خصوصیت updown آن true
است
با تشکر

----------


## بابک زواری

یکی از دوستان راجع به تبدیل میلادی به شمسی خواسته بود که کدی در اینباره براشون بذارم اینجا البته من تمام تبدیلها رو براشون گذاشتم

تبدیل تاریخ میلادی با فرمت mm/dd/yyyy به شمسی


Public Function Fa_Date&#40;En_Date As String&#41; As String
Dim The_Select As Integer
Dim The_Year As Integer
Dim The_Month As Integer
Dim The_Day As Integer
The_Year = CInt&#40;Mid&#40;En_Date, 7, 4&#41;&#41;
The_Month = CInt&#40;Mid&#40;En_Date, 1, 2&#41;&#41;
The_Day = CInt&#40;Mid&#40;En_Date, 4, 2&#41;&#41;

If &#40;The_Year Mod 4 = 0&#41; Then
    The_Select = 1
Else
    The_Select = 2
End If

If &#40;&#40;The_Year - 1&#41; Mod 4 = 0&#41; Then
    The_Select = 3
End If

If The_Select = 1 Then
'------------------------------------------------------
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 10
    The_Month = 10
    The_Year = The_Year - 622
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 11
    The_Year = The_Year - 622
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 19&#58; The_Day = The_Day + 11
    The_Month = 11
    The_Year = The_Year - 622
    Case 20 To 29&#58; The_Day = The_Day - 19
    The_Month = 12
    The_Year = The_Year - 622
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 19&#58; The_Day = The_Day + 10
    The_Month = 12
    The_Year = The_Year - 622
    Case 20 To 31&#58; The_Day = The_Day - 19
    The_Month = 1
    The_Year = The_Year - 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 19&#58; The_Day = The_Day + 12
    The_Month = 1
    The_Year = The_Year - 621
    Case 20 To 30&#58; The_Day = The_Day - 19
    The_Month = 2
    The_Year = The_Year - 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 11
    The_Month = 2
    The_Year = The_Year - 621
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 3
    The_Year = The_Year - 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 11
    The_Month = 3
    The_Year = The_Year - 621
    Case 21 To 30&#58; The_Day = The_Day - 20
    The_Month = 4
    The_Year = The_Year - 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 4
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 5
    The_Year = The_Year - 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 5
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 6
    The_Year = The_Year - 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 6
    The_Year = The_Year - 621
    Case 22 To 30&#58; The_Day = The_Day - 21
    The_Month = 7
    The_Year = The_Year - 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 9
    The_Month = 7
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 8
    The_Year = The_Year - 621
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 10
    The_Month = 8
    The_Year = The_Year - 621
    Case 21 To 30&#58; The_Day = The_Day - 20
    The_Month = 9
    The_Year = The_Year - 621
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 10
    The_Month = 9
    The_Year = The_Year - 621
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 10
    The_Year = The_Year - 621
    End Select
End Select
'------------------------------------------------------
End If

If The_Select = 2 Then
'------------------------------------------------------
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 10
    The_Month = 10
    The_Year = The_Year - 622
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 11
    The_Year = The_Year - 622
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 19&#58; The_Day = The_Day + 11
    The_Month = 11
    The_Year = The_Year - 622
    Case 19 To 28&#58; The_Day = The_Day - 19
    The_Month = 12
    The_Year = The_Year - 622
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 9
    The_Month = 12
    The_Year = The_Year - 622
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 1
    The_Year = The_Year - 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 11
    The_Month = 1
    The_Year = The_Year - 621
    Case 21 To 30&#58; The_Day = The_Day - 20
    The_Month = 2
    The_Year = The_Year - 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 2
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 3
    The_Year = The_Year - 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 3
    The_Year = The_Year - 621
    Case 22 To 30&#58; The_Day = The_Day - 21
    The_Month = 4
    The_Year = The_Year - 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 4
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 5
    The_Year = The_Year - 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 5
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 6
    The_Year = The_Year - 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 6
    The_Year = The_Year - 621
    Case 23 To 30&#58; The_Day = The_Day - 22
    The_Month = 7
    The_Year = The_Year - 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 8
    The_Month = 7
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 8
    The_Year = The_Year - 621
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 9
    The_Month = 8
    The_Year = The_Year - 621
    Case 22 To 30&#58; The_Day = The_Day - 21
    The_Month = 9
    The_Year = The_Year - 621
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 9
    The_Month = 9
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 10
    The_Year = The_Year - 621
    End Select
End Select
'------------------------------------------------------
End If

If The_Select = 3 Then
'------------------------------------------------------
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 19&#58; The_Day = The_Day + 11
    The_Month = 10
    The_Year = The_Year - 622
    Case 20 To 31&#58; The_Day = The_Day - 19
    The_Month = 11
    The_Year = The_Year - 622
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 18&#58; The_Day = The_Day + 12
    The_Month = 11
    The_Year = The_Year - 622
    Case 19 To 28&#58; The_Day = The_Day - 18
    The_Month = 12
    The_Year = The_Year - 622
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 10
    The_Month = 12
    The_Year = The_Year - 622
    Case 21 To 31&#58; The_Day = The_Day - 20
    The_Month = 1
    The_Year = The_Year - 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 20&#58; The_Day = The_Day + 11
    The_Month = 1
    The_Year = The_Year - 621
    Case 21 To 30&#58; The_Day = The_Day - 20
    The_Month = 2
    The_Year = The_Year - 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 2
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 3
    The_Year = The_Year - 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 10
    The_Month = 3
    The_Year = The_Year - 621
    Case 22 To 30&#58; The_Day = The_Day - 21
    The_Month = 4
    The_Year = The_Year - 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 4
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 5
    The_Year = The_Year - 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 5
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 6
    The_Year = The_Year - 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 9
    The_Month = 6
    The_Year = The_Year - 621
    Case 23 To 30&#58; The_Day = The_Day - 22
    The_Month = 7
    The_Year = The_Year - 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 22&#58; The_Day = The_Day + 8
    The_Month = 7
    The_Year = The_Year - 621
    Case 23 To 31&#58; The_Day = The_Day - 22
    The_Month = 8
    The_Year = The_Year - 621
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 9
    The_Month = 8
    The_Year = The_Year - 621
    Case 22 To 30&#58; The_Day = The_Day - 21
    The_Month = 9
    The_Year = The_Year - 621
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 21&#58; The_Day = The_Day + 9
    The_Month = 9
    The_Year = The_Year - 621
    Case 22 To 31&#58; The_Day = The_Day - 21
    The_Month = 10
    The_Year = The_Year - 621
    End Select
End Select
'------------------------------------------------------
End If

Fa_Date = Format&#40;CStr&#40;The_Year&#41;, "0000"&#41; &amp; "/" &amp; _
         Format&#40;CStr&#40;The_Month&#41;, "00"&#41; &amp; "/" &amp; _
         Format&#40;CStr&#40;The_Day&#41;, "00"&#41;
End Function







تبدیل تاریخ شمسی به میلادی




Public Function En_Date&#40;Fa_Date As String&#41; As String
Dim The_Year As Integer
Dim The_Month As Integer
Dim The_Day As Integer
The_Year = CInt&#40;Mid&#40;Fa_Date, 1, 4&#41;&#41;
The_Month = CInt&#40;Mid&#40;Fa_Date, 6, 2&#41;&#41;
The_Day = CInt&#40;Mid&#40;Fa_Date, 9, 2&#41;&#41;

Dim The_Select As Integer
The_Select = The_Year Mod 4

'------------------------------------------------------------------------------------------------------------------------
If The_Select = 0 Then                'Like &#58; 1360, 1364, 1368, 1372, 1376, 1380, 1384, ...
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 3
    The_Year = The_Year + 621
    Case 12 To 31&#58; The_Day = The_Day - 11
    The_Month = 4
    The_Year = The_Year + 621
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 20
    The_Month = 4
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 5
    The_Year = The_Year + 621
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 5
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 6
    The_Year = The_Year + 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 6
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 7
    The_Year = The_Year + 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 7
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 8
    The_Year = The_Year + 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 8
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 9
    The_Year = The_Year + 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 8&#58; The_Day = The_Day + 22
    The_Month = 9
    The_Year = The_Year + 621
    Case 9 To 30&#58; The_Day = The_Day - 8
    The_Month = 10
    The_Year = The_Year + 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 10
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 11
    The_Year = The_Year + 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 11
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 12
    The_Year = The_Year + 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 12
    The_Year = The_Year + 621
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 1
    The_Year = The_Year + 622
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 1
    The_Year = The_Year + 622
    Case 12 To 30&#58; The_Day = The_Day - 11
    The_Month = 2
    The_Year = The_Year + 622
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 19
    The_Month = 2
    The_Year = The_Year + 622
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 3
    The_Year = The_Year + 622
    End Select
End Select
End If
'------------------------------------------------------------------------------------------------------------------------
If The_Select = 1 Then                'Like &#58; 1361, 1365, 1369, 1373, 1377, 1381, 1385, ...
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 3
    The_Year = The_Year + 621
    Case 12 To 31&#58; The_Day = The_Day - 11
    The_Month = 4
    The_Year = The_Year + 621
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 20
    The_Month = 4
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 5
    The_Year = The_Year + 621
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 22
    The_Month = 5
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 6
    The_Year = The_Year + 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 6
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 7
    The_Year = The_Year + 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 7
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 8
    The_Year = The_Year + 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 8
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 9
    The_Year = The_Year + 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 8&#58; The_Day = The_Day + 22
    The_Month = 9
    The_Year = The_Year + 621
    Case 9 To 30&#58; The_Day = The_Day - 8
    The_Month = 10
    The_Year = The_Year + 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 10
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 11
    The_Year = The_Year + 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 11
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 12
    The_Year = The_Year + 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 12
    The_Year = The_Year + 621
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 1
    The_Year = The_Year + 622
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 1
    The_Year = The_Year + 622
    Case 12 To 30&#58; The_Day = The_Day - 11
    The_Month = 2
    The_Year = The_Year + 622
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 19
    The_Month = 2
    The_Year = The_Year + 622
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 3
    The_Year = The_Year + 622
    End Select
End Select
End If
'------------------------------------------------------------------------------------------------------------------------
If The_Select = 2 Then                'Like &#58; 1362, 1366, 1370, 1374, 1378, 1382, 1386, ...
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 3
    The_Year = The_Year + 621
    Case 12 To 31&#58; The_Day = The_Day - 11
    The_Month = 4
    The_Year = The_Year + 621
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 20
    The_Month = 4
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 5
    The_Year = The_Year + 621
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 5
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 6
    The_Year = The_Year + 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 6
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 7
    The_Year = The_Year + 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 7
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 8
    The_Year = The_Year + 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 8
    The_Year = The_Year + 621
    Case 10 To 31&#58; The_Day = The_Day - 9
    The_Month = 9
    The_Year = The_Year + 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 8&#58; The_Day = The_Day + 22
    The_Month = 9
    The_Year = The_Year + 621
    Case 9 To 30&#58; The_Day = The_Day - 8
    The_Month = 10
    The_Year = The_Year + 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 22
    The_Month = 10
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 11
    The_Year = The_Year + 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 11
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 12
    The_Year = The_Year + 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 12
    The_Year = The_Year + 621
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 1
    The_Year = The_Year + 622
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 1
    The_Year = The_Year + 622
    Case 12 To 30&#58; The_Day = The_Day - 11
    The_Month = 2
    The_Year = The_Year + 622
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 19
    The_Month = 2
    The_Year = The_Year + 622
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 3
    The_Year = The_Year + 622
    End Select
End Select
End If
'------------------------------------------------------------------------------------------------------------------------
If The_Select = 3 Then                'Like &#58; 1363, 1367, 1371, 1375, 1379, 1383, 1387, ...
Select Case The_Month
Case 1&#58; Select Case The_Day
    Case 1 To 12&#58; The_Day = The_Day + 19
    The_Month = 3
    The_Year = The_Year + 621
    Case 13 To 31&#58; The_Day = The_Day - 12
    The_Month = 4
    The_Year = The_Year + 621
    End Select
Case 2&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 19
    The_Month = 4
    The_Year = The_Year + 621
    Case 12 To 31&#58; The_Day = The_Day - 11
    The_Month = 5
    The_Year = The_Year + 621
    End Select
Case 3&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 5
    The_Year = The_Year + 621
    Case 12 To 31&#58; The_Day = The_Day - 11
    The_Month = 6
    The_Year = The_Year + 621
    End Select
Case 4&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 20
    The_Month = 6
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 7
    The_Year = The_Year + 621
    End Select
Case 5&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 7
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 8
    The_Year = The_Year + 621
    End Select
Case 6&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 8
    The_Year = The_Year + 621
    Case 11 To 31&#58; The_Day = The_Day - 10
    The_Month = 9
    The_Year = The_Year + 621
    End Select
Case 7&#58; Select Case The_Day
    Case 1 To 9&#58; The_Day = The_Day + 21
    The_Month = 9
    The_Year = The_Year + 621
    Case 10 To 30&#58; The_Day = The_Day - 9
    The_Month = 10
    The_Year = The_Year + 621
    End Select
Case 8&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 21
    The_Month = 10
    The_Year = The_Year + 621
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 11
    The_Year = The_Year + 621
    End Select
Case 9&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 20
    The_Month = 11
    The_Year = The_Year + 621
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 12
    The_Year = The_Year + 621
    End Select
Case 10&#58; Select Case The_Day
    Case 1 To 11&#58; The_Day = The_Day + 20
    The_Month = 12
    The_Year = The_Year + 621
    Case 12 To 30&#58; The_Day = The_Day - 11
    The_Month = 1
    The_Year = The_Year + 622
    End Select
Case 11&#58; Select Case The_Day
    Case 1 To 12&#58; The_Day = The_Day + 19
    The_Month = 1
    The_Year = The_Year + 622
    Case 13 To 30&#58; The_Day = The_Day - 12
    The_Month = 2
    The_Year = The_Year + 622
    End Select
Case 12&#58; Select Case The_Day
    Case 1 To 10&#58; The_Day = The_Day + 18
    The_Month = 2
    The_Year = The_Year + 622
    Case 11 To 30&#58; The_Day = The_Day - 10
    The_Month = 3
    The_Year = The_Year + 622
    End Select
End Select
End If
'------------------------------------------------------------------------------------------------------------------------
En_Date = Format&#40;CStr&#40;The_Month&#41;, "00"&#41; &amp; "/" &amp; _
                            Format&#40;CStr&#40;The_Day&#41;, "00"&#41; &amp; "/" &amp; _
                                    Format&#40;CStr&#40;The_Year&#41;, "0000"&#41;
End Function

----------


## ab_ba

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


آقای ASPDeveloper من تابعی نوشتم که برای همه اعداد کار میکند و مشکلی ندارد ولی بدلیل اینکه در این تاپیک به حد کافی این تابع آورده شده از آورئن آن صرف نظر میکنم ولی اگر حتما میخواستی پیغام بده
[/img]

----------


## M-Gheibi

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

----------


## ab_ba

اینم کد من

Function harfi&#40;n As Double&#41; As String
Dim s1&#40;10&#41; As String
Dim s2&#40;10&#41; As String
Dim s3&#40;10&#41; As String
Dim s4&#40;10&#41; As String
Dim a&#40;5&#41;, s As String
Dim count As Long
Dim i, j, k, m As Long
Dim b As Integer

s1&#40;1&#41; = "یک"&#58; s1&#40;2&#41; = "دو"&#58; s1&#40;3&#41; = "سه"&#58; s1&#40;4&#41; = "چهار"&#58; s1&#40;5&#41; = "پنج"&#58; s1&#40;6&#41; = "شش"&#58; s1&#40;7&#41; = "هفت"&#58; s1&#40;8&#41; = "هشت"&#58; s1&#40;9&#41; = "نه"&#58; s1&#40;10&#41; = "ده"
s2&#40;1&#41; = "یازده"&#58; s2&#40;2&#41; = "دوازده"&#58; s2&#40;3&#41; = "سیزده"&#58; s2&#40;4&#41; = "چهارده"&#58; s2&#40;5&#41; = "پانزده"&#58; s2&#40;6&#41; = "شانزده"&#58; s2&#40;7&#41; = "هفده"&#58; s2&#40;8&#41; = "هجده"&#58; s2&#40;9&#41; = "نوزده"&#58; s2&#40;10&#41; = "بیست"
s3&#40;1&#41; = "یکصد"&#58; s3&#40;2&#41; = "دویست"&#58; s3&#40;3&#41; = "سیصد"&#58; s3&#40;4&#41; = "چهارصد"&#58; s3&#40;5&#41; = "پانصد"&#58; s3&#40;6&#41; = "ششصد"&#58; s3&#40;7&#41; = "هفتصد"&#58; s3&#40;8&#41; = "هشتصد"&#58; s3&#40;9&#41; = "نهصد"&#58; s3&#40;10&#41; = "هزار"
s4&#40;1&#41; = " "&#58; s4&#40;2&#41; = "هزار"&#58; s4&#40;3&#41; = "میلیون"&#58; s4&#40;4&#41; = "میلیارد"&#58; s4&#40;5&#41; = "تریلیون"&#58; s4&#40;6&#41; = "تریلیارد"

n = Int&#40;n&#41;
s = Str&#40;n&#41;
s = LTrim$&#40;s&#41;
s = RTrim$&#40;s&#41;
k = Len&#40;s&#41;
m = k Mod 3
If m = 0 Then m = 3
j = &#40;k - m&#41; \ 3
a&#40;j + 1&#41; = Mid&#40;s, 1, m&#41;
m = m + 1
For i = j To 1 Step -1
  a&#40;i&#41; = Mid&#40;s, m, 3&#41;
  m = m + 3
Next
count = j + 1
For i = count To 1 Step -1
    b = 0
    If Val&#40;a&#40;i&#41;&#41; > 0 Then
       harfi = harfi &amp; harfi2&#40;Val&#40;a&#40;i&#41;&#41;&#41;
       harfi = harfi &amp; " " &amp; s4&#40;i&#41;
       For j = 1 To i - 1
         If Val&#40;a&#40;j&#41;&#41; > 0 Then b = 1
       Next
       If b = 1 Then harfi = harfi &amp; " و "
    End If
Next
End Function

Function harfi2&#40;n As Double&#41; As String
Dim s1&#40;20&#41; As String
Dim s2&#40;10&#41; As String
Dim s3&#40;10&#41; As String
Dim s4&#40;10&#41; As String
Dim a&#40;5&#41; As Long
Dim b As Integer
  b = 0
  s1&#40;1&#41; = "یک"&#58; s1&#40;2&#41; = "دو"&#58; s1&#40;3&#41; = "سه"&#58; s1&#40;4&#41; = "چهار"&#58; s1&#40;5&#41; = "پنج"&#58; s1&#40;6&#41; = "شش"&#58; s1&#40;7&#41; = "هفت"&#58; s1&#40;8&#41; = "هشت"&#58; s1&#40;9&#41; = "نه"&#58; s1&#40;10&#41; = "ده"
  s1&#40;11&#41; = "یازده"&#58; s1&#40;12&#41; = "دوازده"&#58; s1&#40;13&#41; = "سیزده"&#58; s1&#40;14&#41; = "چهارده"&#58; s1&#40;15&#41; = "پانزده"&#58; s1&#40;16&#41; = "شانزده"&#58; s1&#40;17&#41; = "هفده"&#58; s1&#40;18&#41; = "هجده"&#58; s1&#40;19&#41; = "نوزده"&#58; s1&#40;20&#41; = "بیست"
  s2&#40;1&#41; = "ده"&#58; s2&#40;2&#41; = "بیست"&#58; s2&#40;3&#41; = "سی"&#58; s2&#40;4&#41; = "چهل"&#58; s2&#40;5&#41; = "پنجاه"&#58; s2&#40;6&#41; = "شصت"&#58; s2&#40;7&#41; = "هفتاد"&#58; s2&#40;8&#41; = "هشتاد"&#58; s2&#40;9&#41; = "نود"&#58; s2&#40;10&#41; = "صد"
  s3&#40;1&#41; = "یکصد"&#58; s3&#40;2&#41; = "دویست"&#58; s3&#40;3&#41; = "سیصد"&#58; s3&#40;4&#41; = "چهارصد"&#58; s3&#40;5&#41; = "پانصد"&#58; s3&#40;6&#41; = "ششصد"&#58; s3&#40;7&#41; = "هفتصد"&#58; s3&#40;8&#41; = "هشتصد"&#58; s3&#40;9&#41; = "نهصد"&#58; s3&#40;10&#41; = "هزار"
  s4&#40;1&#41; = "هزار"&#58; s4&#40;2&#41; = "میلیون"&#58; s4&#40;3&#41; = "میلیارد"&#58; s4&#40;4&#41; = "تریلیون"&#58; s4&#40;5&#41; = " تریلیارد"
  a&#40;1&#41; = n \ 100
  a&#40;4&#41; = n Mod 100
  a&#40;2&#41; = a&#40;4&#41; \ 10
  a&#40;3&#41; = a&#40;4&#41; Mod 10
  If &#40;a&#40;1&#41; > 0&#41; Then harfi2 = s3&#40;a&#40;1&#41;&#41;&#58; b = 1
  If &#40;a&#40;4&#41; &lt; 20 And a&#40;4&#41; > 0&#41; Then
         If &#40;b = 1&#41; Then
           harfi2 = harfi2 &amp; " و " &amp; s1&#40;a&#40;4&#41;&#41;
         Else
          harfi2 = s1&#40;a&#40;4&#41;&#41;
         End If
  Else
     If &#40;a&#40;2&#41; > 0&#41; Then
         If &#40;b = 1&#41; Then
            harfi2 = harfi2 &amp; " و " &amp; s2&#40;a&#40;2&#41;&#41;
         Else
             harfi2 = s2&#40;a&#40;2&#41;&#41;
         End If
     End If
     If &#40;a&#40;3&#41; > 0&#41; Then
         If &#40;a&#40;4&#41; > 20&#41; Then b = 1
         If &#40;b = 1&#41; Then
          harfi2 = harfi2 &amp; " و " &amp; s1&#40;a&#40;3&#41;&#41;
         Else
          harfi2 = s1&#40;a&#40;3&#41;&#41;
         End If
     End If
  End If
 End Function

----------


## بابک زواری

ممنون جناب ab_ba کد خوب و مفیدی بود

----------


## ab_ba

قابلی نداشت

----------


## نعیم رضاییان

اقا شرمنده من تمام پست های قبلی رو خوندم ولی مشگلم حل نشد مشگل من اینه 
1- من یک برنامه در windows xp نوشتم رو سیستم خودم مشگلی نداره همه چی درست کار میکنه اما وقتی این برنامه رو رو سیتم دیگه که ویندوز xp داره میزارم دیگه فارسی نشون نمیده هر دو ویندوز هم فارسی هستن یعنی میشه با alt+shift فارسی نوشت نمی دونم مشگل چیه 
2- مشگل right left منو های من هستش من اون فایل dll رو که در تاپیکهای قبلی گفته شده بود رو کپی کردم  ولی مشگلم حل نشد یعنی هیچ تغییری نکرد البته بازم رو سیستم خودم درسته رو کامپیوتر های دیگه امتحان میکنم مشگل داره 

مرسی 
 :flower:

----------


## M-Gheibi

> دیگه فارسی نشون نمیده


به چه شکل نشون میده؟
برای مورد 2 هم تنها دلیل همون فایل dll هست. شما اون رو کجا کپی می کنید؟

----------


## نعیم رضاییان

اقا از جوابتون ممنون 
در مورد فارسی نشون ندادن به صورت یک سری کد نشون میده مثل اینکه اون فون در سیستم نباشه 

در مورد فایل هم حتی بعضی از سیستم ها این فایل رو داشتن و لی من دوباره فایل رو در ساخه sysytem32 کپی کردم

----------


## M-Gheibi

:sorry:  متاسفانه نمیدونم باید چیکار کنید.

----------


## ab_ba

آقای naeimflashphp
من هم مشکل شما را داشتم ولی با تنظیم reginal setting درست شد

----------


## مسعود م

با سلام

برنامه ای نوشته ام با VB6 در WinXP Sp2 و از فونت Tahoma هم استفاده کرده ام .

دو تا Setup یکی با Wise InstallMaster 8.11 (فونت Tahoma را اضافه کرده ام)
و یکی با InstallShield Proffesional 7 for win2kXP

در کامپیوتر هایی که VB6 نصب است مشکلی ندارد ولی :

وقتی در کامپیوترهای دیگر در WinXP نصب می کنم برنامه کامل کار می کند و اکثر جاهایی که فونت Tahoma استفاده شده را براحتی نشان می دهد .
ولی در قسمتهای Titlebar فرمها ( که از داخل برنامه قابل تنظیم نیستند ) و نیز منوها ( // ) و Msgbox ها ( // ) بجای فارسی ، قاطی پاطی نشان می دهد .

در ضمن همه فرمها را هم بجای راست چین ، چپ چین کرده .

مشکل کجاست ؟

با سپاس .

----------


## بابک زواری

فونتها و Msgbox  از فونت غیر tahoma استفاده میکنن

----------


## M-Gheibi

> در ضمن همه فرمها را هم بجای راست چین ، چپ چین کرده .


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



> فونتها و Msgbox از فونت غیر tahoma استفاده میکنن


دقیقا همینطوره فونت این بخشها MS Sans Serif هست.

----------


## مسعود م

ممنون از لطفتون.

کارهایی که گفته بودید انجام دادم :

تنظیمات فارسی در Regional Setting
و کپی Vbame.dll توسط برنامه Setup ساز در پوشه سیستم (System32)

اینکار برای بعضی کامپیوترها (دارای سرویس پک) جواب داد
ولی برای بعضی نه (فاقد سرویس پک)

من با Wise InstallMaster ستاپ سازی کرده ام .
به نظر شما برای Vbame.dll باید Self Register را هم فعال کنم ؟

با سپاس.

----------


## Arash13

در هنگام طراحی برنامه خاصیت right to left فرمها true  نمی شود .
فایل vbame.dll هم در system32 وجود دارد .

----------


## vbsqlhadi

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

----------


## anubis_ir

http://www.hamedbanaei.com/applicati...tem_source.zip

----------


## شاپرک

> با سلام
> همانطور که می دونید کنترل date time picker سالهای شمسی را پشتیبانی نمی کنه می خواستم ببینم
> آیا کسی یک کنترل داره که مثل date time picker عمل کنه و سالهای شمسی را هم پشتیبانی کنه
> البته تقویمش برام مهم نیست بلکه مهم نشان دادن فرمت تاریخ به صورتی که کاربر بتونه روز و ماه و سال را
> به راحتی توی اون با دکمه updown تغییر بده مثل حالتی از date time picker که خصوصیت updown آن true
> است
> با تشکر



من هم همچین چیزی لازم دارم

----------


## hadi2345

با سلام مجدد .
به مشکل بزرگی برخورده ام و تقاضا دارم کمکم کنید . من برا ی تبدیل تاریخ از تابعی که جناب زواری گذاشته بودند استفاده میکنم ولی متاسفانه در بعضی سیستمها به مشکل برخورده ام و تاریخ شمسی را درست نشان نمیدهد مثلا تاریخ دیروز را 0008/20/14 نشان میداد و با دستکاری regional setting هم درست نشد ، لطفا کمکم کنید

----------


## mehran_farid

وقتی توی تکست باکس حروف گ . ژ پ و ک رو مینویسم علامت تقسیم و در کل شر و ور مینویسه . چی کار کنم؟

----------


## mehran_farid

آقا ما توی تکست باکسهامون با گ .پ . ژ . ک مشکل داریم .چه کار کنم؟

----------


## M-Gheibi

سلام
آقا مهران مشکل شما مورد خاصی نیست.
دلیل این ناهماهنگی این است که نحوه چیدمان کاراکترهای یاد شده در کدپیج استاندارد معرفی شده از طرف مایکروسافت بدین شکل است. یعنی حرف پ در این کدپیج همان \ است. حرف ژ همان Shift+C است. حرف گ و چ هم به همان شکل قدیم و بدون مشکل هستند.
اگر مشکل شما از همین ناشی شده باشد می بایست فایل kbdfa.dll ویندوز را با فایلهای تصحیح شده (که در اینترنت موجود است) تعویض کنید.
اگر مشکل شما این نیست کمی بیشتر توضیح دهید.

----------


## ba2003

با عرض سلام و خسته نباشید

بنده می خواهم یک زبان جدید برای ویندوز تعریف کنم یعنی  keyboard layout  جدید چه باید بکنم
در ضمن فونت زبانم را طراحی کردم.

با تشکر

----------


## M-Gheibi

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

----------


## ab_ba

برای رفع مشکل خواندن تاریخ را با تابع فرمت انجام بده مثل
( s = Format(Date, "yyyy/mm/dd"

----------


## حامد مصافی

جناب mehran_farid  در سیستم کی بورد ویندوز 98 حرف پ در روی علامت ` (بالای Tab ) قرار داشت
ولی در ویندوز ایکس پی این حرف به کلید \ (Back Slash ) انتقال یافته
حرف ژ به بالای ز (Shift + ز) انتقال یافته

----------


## vbhamed

سلام

ایم نمونه برنامه تا محدوده تریلیون (999,999,999,999,999) رو می خونه
تازه اگه بیشتر از تریلیونو اسماشو بدونین به راحتی میشه اضافه کرد
یعنی اصلا محدودیت نداره

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

دیگه چی می خواهید ؟؟؟؟؟؟؟؟؟؟


اینم مثال اعداد
Text1 = ReadNum("-45632.25")

و جواب برنامه
منفی چهل و پنج هزار و ششصد و سی و دو و بیست و پنج صدم



مثال تاریخ
Text1 = ReadTarikh(84, 6, 25)

جواب برنامه
بیست و پنجم شهریور ماه سال هشتاد و چهار


مثال ساعت 1
Text1 = ReadClock(17, 31, 0)

جواب برنامه
هفده و سی و یک دقیقه 


مثال ساعت 2
Text1 = ReadClock(17, 31, 1)

جواب برنامه
ساعت هفده و سی و یک دقیقه 







Option Explicit

Public Function ReadNum(ByVal Number As Currency) As String

    On Local Error Resume Next

    Dim Adad1000(4) As String, Ashar(11) As String, Temp As String, x As String
    Dim t As Currency, s As String, i As Integer
    Dim Negative As Byte, AsharRead As String

    Adad1000(1) = "هزار"
    Adad1000(2) = "میلیون"
    Adad1000(3) = "میلیارد"
    Adad1000(4) = "تریلیون"

    Ashar(1) = "دهم"
    Ashar(2) = "صدم"
    Ashar(3) = "هزارم"
    Ashar(4) = "ده هزارم"
    Ashar(5) = "صد هزارم"
    Ashar(6) = "میلیونیوم"
    Ashar(7) = "ده میلیونیوم"
    Ashar(8) = "صد میلیونیوم"
    Ashar(9) = "میلیاردیم"
    Ashar(10) = "ده میلیاردیم"
    Ashar(11) = "صد میلیاردیم"

    If Number < 0 Then
        Negative = 1
        Number = Abs(Number)
    End If

    If Fix(Number) < Number Then
        Dim A As Currency, Index As Integer
        A = Number - Fix(Number)

        AsharRead = Mid$(Str$(A), InStr(Str$(A), ".") + 1)

        If Len(AsharRead) > 11 Then
            AsharRead = Left$(AsharRead, 11)
            Index = 11
        Else
            Index = Len(AsharRead)
        End If

        If Fix(Number) > 0 Then
            AsharRead = " و " & ReadNum(Val(AsharRead)) & " " & Ashar(Index)
        Else
            AsharRead = ReadNum(Val(AsharRead)) & " " & Ashar(Index)
        End If

        AsharRead = ReplaceAll(AsharRead, "پنج دهم", "نیم")

    End If

    Number = Fix(Number)
    If Number < 1000 Then

        If Negative Then
            ReadNum = "منفی " & Read3Digit(Number) & AsharRead
        Else
            ReadNum = Read3Digit(Number) & AsharRead
        End If

        Exit Function

    End If

    Temp = CStr(Number)
    x = Right$(Temp, 3)

    While x <> ""

        t = Val(x)

        If t Then

            If Len(s) Then s = " و " & s
            s = Adad1000(i) & s

            If Len(s) Then s = " " & s
            s = Read3Digit(t) & s
        End If

        If Len(Temp) > 2 Then
            Temp = Left$(Temp, Len(Temp) - 3)
        Else
            Temp = ""
        End If

        If Temp = " " Then Temp = ""

        x = Right$(Temp, 3)
        i = i + 1

    Wend

    s = s & AsharRead

    If Negative Then s = "منفی " & s

    ReplaceAll s, "  ", " "

    ReadNum = s

End Function

Public Function Read3Digit(Number) As String

    On Local Error Resume Next

    Dim Adad(20) As String
    Dim Adad10(9) As String
    Dim Adad100(9) As String
    Dim Yekan As Currency, Dahgan As Currency, Sadgan As Currency, Temp As Currency
    Dim s As String

    Adad(0) = "صفر"
    Adad(1) = "یک"
    Adad(2) = "دو"
    Adad(3) = "سه"
    Adad(4) = "چهار"
    Adad(5) = "پنج"
    Adad(6) = "شش"
    Adad(7) = "هفت"
    Adad(8) = "هشت"
    Adad(9) = "نه"
    Adad(10) = "ده"
    Adad(11) = "یازده"
    Adad(12) = "دوازده"
    Adad(13) = "سیزده"
    Adad(14) = "چهارده"
    Adad(15) = "پانزده"
    Adad(16) = "شانزده"
    Adad(17) = "هفده"
    Adad(18) = "هجده"
    Adad(19) = "نوزده"

    Adad10(0) = "ده"
    Adad10(1) = "بیست"
    Adad10(2) = "سی"
    Adad10(3) = "چهل"
    Adad10(4) = "پنجاه"
    Adad10(5) = "شصت"
    Adad10(6) = "هفتاد"
    Adad10(7) = "هشتاد"
    Adad10(8) = "نود"
    Adad100(0) = "صد"
    Adad100(1) = "دویست"
    Adad100(2) = "سیصد"
    Adad100(3) = "چهار صد"
    Adad100(4) = "پانصد"
    Adad100(5) = "ششصد"
    Adad100(6) = "هفتصد"
    Adad100(7) = "هشتصد"
    Adad100(8) = "نهصد"

    If Number > 999 Then

        Read3Digit = ""
        Exit Function

    End If

    Sadgan = Int(Number / 100)
    Temp = Number Mod 100
    Dahgan = Int(Temp / 10)
    Yekan = Temp Mod 10

    Temp = Dahgan * 10 + Yekan

    If Temp < 20 Then

        If Temp Then

            s = s + Adad(Temp)

            If Sadgan Then s = " و " & s

        End If

        If Sadgan Then s = Adad100(Sadgan - 1) & s

    Else

        If Yekan Then

            s = s + Adad(Yekan)

            If Dahgan Then s = " و " & s

        End If

        If Dahgan Then

            s = Adad10(Dahgan - 1) & s

            If Sadgan Then s = " و " & s

        End If

        If Sadgan Then s = Adad100(Sadgan - 1) & s

    End If

    Read3Digit = s

End Function

Public Function ReadTarikh(yy As Integer, Mm As Integer, Dd As Integer) As String

    On Local Error Resume Next

    Dim DayStr As String, MonthStr As String, YearStr As String, f As Integer
    Dim DateStr(2) As String
    Dim MonthName(12) As String

    MonthName(1) = "فروردین"
    MonthName(2) = "اردیبهشت"
    MonthName(3) = "خرداد"
    MonthName(4) = "تیر"
    MonthName(5) = "مرداد"
    MonthName(6) = "شهریور"
    MonthName(7) = "مهر"
    MonthName(8) = "آبان"
    MonthName(9) = "آذر"
    MonthName(10) = "دی"
    MonthName(11) = "بهمن"
    MonthName(12) = "اسفند"

    DateStr(0) = " روز "
    DateStr(1) = " ماه "
    DateStr(2) = " سال "

    DayStr = ""
    MonthStr = ""
    YearStr = ""

    If Dd <> 0 Then DayStr = ReadNum(Dd) + "م "

    f = InStr(DayStr, "سهم")

    If f Then DayStr = Left$(DayStr, f - 1) + "سوم" + Mid$(DayStr, f + 3)

    If Mm <> 0 Then MonthStr = MonthName(Mm) + DateStr(1)

    If yy <> 0 Then YearStr = DateStr(2) + ReadNum(yy)

    ReadTarikh = DayStr + MonthStr + YearStr
    Dim i%

    For i = 1 To 3
        ReadTarikh = ReplaceAll(ReadTarikh, "  ", " ")

    Next

End Function

Function ReadClock(hh As Byte, Mm As Byte, Optional AddSaatWord As Byte = 1) As String

    On Local Error Resume Next

    Dim MinuteStr As String, HourStr As String

    Dim ZamanName(2) As String

    ZamanName(1) = " ساعت "
    ZamanName(2) = " دقیقه "

    MinuteStr = ""
    HourStr = ""

    If Mm <> 0 Then MinuteStr = ReadNum$(Mm) + ZamanName(2)

    If hh > 0 Then
        If AddSaatWord Then HourStr = ZamanName(1)
        HourStr = HourStr + ReadNum$(hh)
    ElseIf hh = 0 Then
        If AddSaatWord Then HourStr = ZamanName(1)
        HourStr = HourStr + " صفر "
    End If

    If Mm <> 0 And hh >= 0 Then HourStr = HourStr + " و "
    ReadClock = ReplaceAll(HourStr + MinuteStr, "  ", " ")

End Function

Public Function ReplaceAll(ByVal SourceString As String, ReplaceThis As String, Optional WithThis As String = "", Optional Level As Integer = 10) As String

    On Local Error Resume Next

    Dim Temp() As String, i%

    For i = 0 To Level
        Temp = Split(SourceString, ReplaceThis)
        ReplaceAll = Join(Temp, WithThis)
        SourceString = Join(Temp, WithThis)
    Next

    ReplaceAll = SourceString

End Function

----------


## MKOSARI

فونت combobox رااtahoma تعریف کرده ام  در قسمت .text فارسی است ولی در بخش list قاطی پاتی نشون میده چی کار کنم؟

----------


## night11

سلام 
می خواستم بدونم چطوری می تونم از این توابع تبدیل عدد به حروف تو DataReport استفاده کنم ؟ راهی هست ؟

قبلا از همکاریتون ممنون

----------


## vbhamed

سلام

قبلا در برنامه خودتان عدد را به حروف تبدیل نمایید و حاصل را در بانک اطلاعاتی و در جدول مربوطه به صورت فیلد ذخیره نمایید و در datareport  از آن استفاده کنید

----------


## night11

> سلام
> 
> قبلا در برنامه خودتان عدد را به حروف تبدیل نمایید و حاصل را در بانک اطلاعاتی و در جدول مربوطه به صورت فیلد ذخیره نمایید و در datareport  از آن استفاده کنید



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

----------


## vbhamed

سلام

باز هم مشکلی نیست
در واقع شما می توانید اطلاعات فاکتور را در دو جدول جداگانه که شامل لیست فاکتور و سربرگ آن است ذخیره کرده و در برنامه محاسبه نموده و در datareport استفاده  نمایید

استفاده از توابع خوب است
اما به تجربه به من ثابت شده که این روش بهتر می باشد

----------


## night11

مرسی از لطف شما

----------


## mhddns

> با سلام :
> این کد را هم من داشتم جهت تبدیل عدد به حروف :wink:  :oops: 
> 
> 
> Function Cntc(No As Currency) As String
>     If No &lt; 0 Then
>         Exit Function
>     End If
>     
> ...




سلام دوست عزیز ساران سافت
با تشکر از کدهایی که ارائه نمودید
من وقتی ای کد ها را در ویبی paste می کنم چند خط قرمز به معنای خطا در نگارش کد بیسیک دیده می شود و  سوالی که از محضر حضرتعالی دارم اینست که کد  &lt; که مکرر در این قطعه کد آمده است به چه معناست مثلا :
    If N &lt; 10 Then
ممنونم اگر پاسخ دهید.

----------


## mhddns

[QUOTE=vbadvanced]تابع زیر برای تبدیل اعداد به حروف نوشته شده. میدونم دیگه داره تو این تاپیک یه کم زیاد میشه. اما میتونید با این یکی اعدا شمارشی هم داشته باشید که تو هیچکدوم از قبلیا ندیدم. (مثلا سوم، سی ام. چهل و پنجم و ...)!!
........

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

tStr = tStr &amp; _
ممنون

----------


## mhddns

حالشو ببرید

----------


## seyd1061

برای تبدیل تاریخ میلادی به شمسی shamsi.ocx دارم هر کسی مایل بود با من تماس بگیره براش می فرستم
طرز کار:
کامپونت رو به vb6 معرفی کرده
روی فرم پیاده کنید
بعد مثلا Text1 خود را به تاریخ روز تبدیل کنید اینگونه:
Text1=shamsi1.m2s(8,date)
برای نمایش تاریخ هشت مدل دارد که من مدل هشتم را انتخاب کردم
موفق باشید
یا علی

----------


## mhddns

[QUOTE=seyd1061]برای تبدیل تاریخ میلادی به شمسی shamsi.ocx دارم هر کسی مایل بود با من تماس بگیره براش می فرست

سلام سید
برای من لطف کنید بفرستید
ممنون
mohammad.daneshvar@gmail.com

----------


## seyd1061

یادم رفت بگم
به ایمیل نامه بزنید seyd1061@gmail.com

----------


## M-Gheibi

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

----------


## حامد مصافی

> سلام دوست عزیز ساران سافت
> با تشکر از کدهایی که ارائه نمودید
> من وقتی ای کد ها را در ویبی paste می کنم چند خط قرمز به معنای خطا در نگارش کد بیسیک دیده می شود و سوالی که از محضر حضرتعالی دارم اینست که کد &lt; که مکرر در این قطعه کد آمده است به چه معناست مثلا :
>     If N &lt; 10 Then
> ممنونم اگر پاسخ دهید.


سلام
کاراکتر های نام برده را با کاراکتر کوچکتر (>) تعویص کنید

----------


## vahidm

مسعود جان این کد چطوری به کار ببریم 
اگر می تونی جواب را برام به این آدرس بفرست
onlyvahid_m2006@yahoo.com متشکرم

----------


## M-Gheibi

> مسعود جان این کد چطوری به کار ببریم


منظورتون کدام کد هست؟

----------


## vbprogrammerx

از همتون ممنونم
موفق باشید

----------


## vbprogrammerx

آیا می شه توی vb یه برنامه نوشت که همه ی unicode ها را چاپ کرد.؟؟؟؟؟؟؟؟؟؟؟؟
با تشکر

----------


## m-amini

سلام 

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

----------


## khoshraftar

برای ایجاد تاریخ شمسی در vbمی شه بیشتر توضیح بدید.

----------


## meh_secure

نحوه اجرای برنامه در 98 رو توضیح بدین.
سورس کد در ایکس پی نوشته شده است.
پیغام خطا : unicode.dll not found

----------


## m1975b

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

----------


## meh_secure

سلام دوستان.
در ایکس پی بعد از نصب برنامه های که فارسی هستند و right to left  در اونها استفاده شده می خواستم بدونم چطور میشه که کاربر تنظیمات مربوط به regional setting رو انجام نده. در واقع می خواستم با کد نویسی یا نصب فایلهایی که وظیفه انجام این کار را دارند (روش دوم بهتره) می تونیم این کار رو انجام بدیم یا نه. لطفا راهنماییم کنید. خیلی فوری

----------


## meh_secure

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

پستهای قبلی رو خیلی وقته که فرستادم. ولی هنوز جواب نگرفتم

----------


## sarami

--------------------------------------------------------------------------------

http://www.barnamenevis.org/sh...ad.php?t=37686
احساس کردم شاید این تاپیک که در قسمت access وجود داره بدرد خیلی از دوستان که با vb کار میکنن بخوره فایل ضمیمه رو از لینک دانلود کنین که شامل:
یک فانکشن که داخل محیط اکسس نوشته شده با add کردن اون به پروژه های vb هم میتونین ازش استفاده کنین تمام شرایط msgbox رو داره علاوه بر این که vbyes و vbno و همگی فارسی.
اینم کدش برا دوستانی که access برروی desktopشون نصب نیست .

Option Compare Database

Option Explicit

Private Const WH_CBT = 5
Private Const GWL_HINSTANCE = (-6)
Private Const HCBT_ACTIVATE = 5

'UDT for passing data through the hook
Private Type MSGBOX_HOOK_PARAMS
hwndOwner As Long
hHook As Long
End Type

'need this declared at module level as
'it is used in the call and the hook proc
Private MSGHOOK As MSGBOX_HOOK_PARAMS

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

Public Declare Function GetDesktopWindow Lib "user32" () As Long

Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hwnd As Long, _
ByVal nIndex As Long) As Long

Private Declare Function MessageBox Lib "user32" _
Alias "MessageBoxA" _
(ByVal hwnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal wType 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 SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long

Public Function MsgBoxFa(Prompt, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Tiltle = "", Optional HelpFile, Optional Context) As Long

'Wrapper function for the MessageBox API
Dim hwndThreadOwner As Long
Dim frmCurrentForm As Form
Set frmCurrentForm = Screen.ActiveForm

hwndThreadOwner = frmCurrentForm.hwnd

Dim hInstance As Long

Dim hThreadId As Long
Dim hwndOwner As Long
hwndOwner = GetDesktopWindow()
hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE)
hThreadId = GetCurrentThreadId()

With MSGHOOK
.hwndOwner = hwndOwner
.hHook = SetWindowsHookEx(WH_CBT, _
AddressOf MsgBoxHookProc, _
hInstance, hThreadId)
End With



MsgBoxFa = MessageBox(hwndOwner, Prompt, Tiltle, Buttons)

End Function


Public Function MsgBoxHookProc(ByVal uMsg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

If uMsg = HCBT_ACTIVATE Then

SetDlgItemText wParam, vbYes, "&Egrave;&aacute;&aring;"
SetDlgItemText wParam, vbNo, "&Icirc;&iacute;&Ntilde;"
SetDlgItemText wParam, vbIgnore, "&aacute;&Ucirc;&aelig;"
SetDlgItemText wParam, vbOK, "&Ecirc;&Ccedil;&iacute;&iacute;&Iuml;"

UnhookWindowsHookEx MSGHOOK.hHook

End If

MsgBoxHookProc = False

End Function

----------


## Farhani

امیدوارم به درد بخوره

----------


## Milad Mohseny

با سلام و تشکر از شما آقای sarami
باز هم مثل همیشه کارتون درسته

----------


## حامد مصافی

جناب meh_source منظورت اگه راست به چپ کردن پنجره اصلی نرم افزار هاست که باید عرض کنم این تغییرات به کمک Resource Hacker انجام میشه

----------


## Milad Mohseny

با سلام خدمت آقای sarami
من برنامه را دیدم خیلی خیلی عالی بود . لطفاً اگر میشود در مورد Hook به من توضیح دهید البته چون من خیلی مبتدی هستم یه جوری بگید که من بفهمم . و دیگر اینکه برنامه یک مشکل دارد مشکل این است که Message Box حالت Modal ندارد چه طوری میتوان این مشکل را حل کرد ؟

----------


## Milad Mohseny

با با تورو خدا جواب من را بدهید .

----------


## moustafa

تابع adad نوشتن اعداد 15 رقمی به حروف فارسی نوشته اقای حمید ازادی 
' *********** Start of Module ***********

'توابع تبدیل عدد به معادل حروفی آن در زبان فارسی
'برنامه نویس : حمید آزادی اردکانی
'ویرایش اول : اردیبهشت 1380
' پست الکترونیک : azadi1355@yahoo.com
' آدرس وب : http://try.persianblog.com

Function Adad(ByVal Number As Double) As String
If Number = 0 Then
Adad = "صفر"
End If
Dim Flag As Boolean
Dim S As String
Dim I, L As Byte
Dim K(1 To 5) As Double

S = Trim(Str(Number))
L = Len(S)
If L > 15 Then
Adad = "بسیار بزرگ"
Exit Function
End If
For I = 1 To 15 - L
S = "0" & S
Next I
For I = 1 To Int((L / 3) + 0.99)
K(5 - I + 1) = Val(Mid(S, 3 * (5 - I) + 1, 3))
Next I
Flag = False
S = ""
For I = 1 To 5
If K(I) <> 0 Then
Select Case I
Case 1
S = S & Three(K(I)) & " تریلیون"
Flag = True
Case 2
S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " میلیارد"
Flag = True
Case 3
S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " میلیون"
Flag = True
Case 4
S = S & IIf(Flag = True, " و ", "") & Three(K(I)) & " هزار"
Flag = True
Case 5
S = S & IIf(Flag = True, " و ", "") & Three(K(I))
End Select
End If
Next I
Adad = S
End Function


Function Three(ByVal Number As Integer) As String
Dim S As String
Dim I, L As Long
Dim h(1 To 3) As Byte
Dim Flag As Boolean
L = Len(Trim(Str(Number)))
If Number = 0 Then
Three = ""
Exit Function
End If
If Number = 100 Then
Three = "یکصد"
Exit Function
End If

If L = 2 Then h(1) = 0
If L = 1 Then
h(1) = 0
h(2) = 0
End If

For I = 1 To L
h(3 - I + 1) = Mid(Trim(Str(Number)), L - I + 1, 1)
Next I

Select Case h(1)
Case 1
S = "یکصد"
Case 2
S = "دویست"
Case 3
S = "سیصد"
Case 4
S = "چهارصد"
Case 5
S = "پانصد"
Case 6
S = "ششصد"
Case 7
S = "هفتصد"
Case 8
S = "هشتصد"
Case 9
S = "نهصد"
End Select

Select Case h(2)
Case 1
Select Case h(3)
Case 0
S = S & " و " & "ده"
Case 1
S = S & " و " & "یازده"
Case 2
S = S & " و " & "دوازده"
Case 3
S = S & " و " & "سیزده"
Case 4
S = S & " و " & "چهارده"
Case 5
S = S & " و " & "پانزده"
Case 6
S = S & " و " & "شانزده"
Case 7
S = S & " و " & "هفده"
Case 8
S = S & " و " & "هجده"
Case 9
S = S & " و " & "نوزده"
End Select

Case 2
S = S & " و " & "بیست"
Case 3
S = S & " و " & "سی"
Case 4
S = S & " و " & "چهل"
Case 5
S = S & " و " & "پنجاه"
Case 6
S = S & " و " & "شصت"
Case 7
S = S & " و " & "هفتاد"
Case 8
S = S & " و " & "هشتاد"
Case 9
S = S & " و " & "نود"
End Select

If h(2) <> 1 Then
Select Case h(3)
Case 1
S = S & " و " & "یک"
Case 2
S = S & " و " & "دو"
Case 3
S = S & " و " & "سه"
Case 4
S = S & " و " & "چهار"
Case 5
S = S & " و " & "پنج"
Case 6
S = S & " و " & "شش"
Case 7
S = S & " و " & "هفت"
Case 8
S = S & " و " & "هشت"
Case 9
S = S & " و " & "نه"
End Select
End If
S = IIf(L < 3, Right(S, Len(S) - 3), S)
Three = S
End Function

' *********** End Of Module ***********

----------


## moustafa

تاریخ شمسی ایام هفته تبدیل تاریخ سیستم به شمسی و..........
در صورت استفاده از این ماجول ، فیلدهای از نوع تاریخ را باید از نوع Number تعریف کنید. توضیحات بیشتر جهت استفاده از ماجول ، درون خود ماجول نوشته شده است.
برای استفاده از این ماجول ، از دو خط پایین تر تا انتهای متن را در حافظه کپی کرده (Copy) و سپس در یک ماجول جدید در اکسس یا VB قرار دهید (Paste): 

' **************************************************  ***********
' برنامه نویس : حمید آزادی
' Email: azadi1355@yahoo.com
' Web Address: http://try.persianblog.com
' ویرایش سوم : زمستان 1381
' **************************************************  ***********
' 1- تعریف کنید Number(Long) است را بصورت Date فیلدهایی که نوع آنها
' 2- این فیلدها را بصورت 00/00/00 تنظیم کنید InputMask خاصیت
' بدلیل 6 رقمی در نظر گرفتن فیلد تاریخ ، این توابع تا سال 1399 کارایی دارد
' ...
' تاریخ جاری سیستم را به هجری شمسی تبدیل می کند Shamsi() تابع
' بکار ببرید Now() را می توانید در گزارشات بجای تابع Dat() تابع
' :برای جلوگیری از ورود تاریخ غلط به درون یک فیلد بترتیب زیر عمل میکنید
' :بشکل زیر بکار ببرید ValidationRule را در خاصیت ValidDate() تابع
' ValidDate([نام فیلد])=True
' ...
' **************************************************  ***********

'*******************************************
' برنامه نویس : حمید آزادی
' Email: azadi1355@yahoo.com
' Web Address: http://try.persianblog.com
' ویرایش سوم : زمستان 1381
'*******************************************
Public Function Rooz(F_Date As Long) As Byte
'این تابع عدد مربوط به روز یک تاریخ را برمگرداند
Rooz = F_Date Mod 100
End Function
'*******************************************
Function Mah(F_Date As Long) As Byte
'این تابع عدد مربوط به ماه یک تاریخ را برمگرداند
Mah = Int((F_Date Mod 10000) / 100)
End Function
'*******************************************
Public Function Sal(F_Date As Long) As Byte
'این تابع عدد مربوط به سال یک تاریخ را برمگرداند
Sal = Int(F_Date / 10000)
End Function
'*******************************************
Public Function Kabiseh(ByVal OnlySal As Variant) As Byte
'ورودی تابع عدد دورقمی است
'این تابع کبیسه بودن سال را برمیگرداند
'اگر سال کبیسه باشد عدد یک و درغیر اینصورت صفر را بر میگرداند
Kabiseh = 0
If OnlySal >= 75 Then
If (OnlySal - 75) Mod 4 = 0 Then
Kabiseh = 1
Exit Function
End If
ElseIf OnlySal <= 70 Then
If (70 - OnlySal) Mod 4 = 0 Then
Kabiseh = 1
Exit Function
End If
End If

End Function
'*******************************************
Function ValidDate(F_Date As Long) As Boolean
Dim M, S, R As Byte
' این تابع اعتبار یک عدد ورودی را از نظر تاریخ هجری شمسی بررسی می کند
' را برمی گرداند False واگر نامعتبر باشد True اگر تاریخ معتبر باشد
ValidDate = True
S = Sal(F_Date)
M = Mah(F_Date)
R = Rooz(F_Date)
'********
If F_Date < 100101 Then
ValidDate = False
Exit Function
End If

If M > 12 Or M = 0 Or R = 0 Then
ValidDate = False
Exit Function
End If

If R > MahDays(S, M) Then
ValidDate = False
Exit Function
End If
End Function
'*******************************************
Public Function AddDay(ByVal F_Date As Long, ByVal add As Integer) As Long
Dim K, M, S, R, Days As Byte
R = Rooz(F_Date)
M = Mah(F_Date)
S = Sal(F_Date)
K = Kabiseh(S)

'تبدیل روز به عدد 1 جهت ادامه محاسبات و یا اتمام محاسبه
Days = MahDays(S, M)
If add > Days - R Then
add = add - (Days - R + 1)
R = 1
If M < 12 Then
M = M + 1
Else
M = 1
S = S + 1
End If
Else
R = R + add
add = 0
End If

While add > 0
K = Kabiseh(S) 'کبیسه: 1 و غیر کبیسه: 0
Days = MahDays(S, M) 'تعداد روزهای ماه فعلی
Select Case add
Case Is < Days
'اگر تعداد روزهای افزودنی کمتر از یک ماه باشد
R = R + add
add = 0
Case Days To IIf(K = 0, 365, 366) - 1
'اگر تعداد روزهای افزودنی بیشتر از یک ماه و کمتر از یک سال باشد
add = add - Days
If M < 12 Then
M = M + 1
Else
S = S + 1
M = 1
End If
Case Else
'اگر تعداد روزهای افزودنی بیشتر از یک سال باشد
S = S + 1
add = add - IIf(K = 0, 365, 366)
End Select
Wend
AddDay = (S * 10000) + (M * 100) + (R)

End Function

'***********************************************
Public Function Shamsi() As Long
'تاریخ جاری سیستم را به تاریخ هجری شمسی تبدیل می کند
Dim Shamsi_Mabna As Long
Dim Miladi_mabna As Date
Dim Dif As Long
'در اینجا 80/10/11 با 2002/01/01 معادل قرارداده شده
Shamsi_Mabna = 791012
Miladi_mabna = #1/1/01#
Dif = DateDiff("d", Miladi_mabna, Date)
If Dif < 0 Then
MsgBox "تاریخ جاری سیستم شما نادرست است , آنرا اصلاح کنید."
Else
Shamsi = AddDay(Shamsi_Mabna, Dif)
End If
End Function
'***********************************************
Public Function DayWeek(F_Date As Long) As String
Dim a As String
Dim N As Byte
N = DayWeekNo(F_Date)
Select Case N
Case 0
a = "شنبه"
Case 1
a = "یکشنبه"
Case 2
a = "دوشنبه"
Case 3
a = "سه‌شنبه"
Case 4
a = "چهارشنبه"
Case 5
a = "پنج‌شنبه"
Case 6
a = "جمعه"
End Select
DayWeek = a
End Function

'***********************************************
Public Function Dat()
Dim D As Long
D = Shamsi
Dat = DayWeek(D) & " 13" & Sal(D) & "/" & Mah(D) & "/" & Rooz(D)
End Function

'***********************************************
Public Function Diff(ByVal FromDate As Long, ByVal To_Date As Long) As Long
'این تابع تعداد روزهای بین دو تاریخ را ارائه می کند
Dim Tmp As Long
Dim S1, M1, r1, S2, m2, r2 As Integer
Dim Sumation As Single
Dim Flag As Boolean
Flag = False
If FromDate = 0 Or IsNull(FromDate) = True Or To_Date = 0 Or IsNull(To_Date) = True Then
Diff = 0
Exit Function
End If

If FromDate > To_Date Then
'اگر تاریخ شروع از تاریخ پایان بزرگتر باشد آنها موقتا جابجا می شوند
Flag = True
Tmp = FromDate
FromDate = To_Date
To_Date = Tmp
End If
r1 = Rooz(FromDate)
M1 = Mah(FromDate)
S1 = Sal(FromDate)
r2 = Rooz(To_Date)
m2 = Mah(To_Date)
S2 = Sal(To_Date)
Sumation = 0

Do While S1 < S2 - 1 Or (S1 = S2 - 1 And (M1 < m2 Or (M1 = m2 And r1 <= r2)))
'اگر یک سال یا بیشتر اختلاف بود
If Kabiseh((S1)) = 1 Then
If M1 = 12 And r1 = 30 Then
Sumation = Sumation + 365
r1 = 29
Else
Sumation = Sumation + 366
End If
Else
Sumation = Sumation + 365
End If
S1 = S1 + 1
Loop

Do While S1 < S2 Or M1 < m2 - 1 Or (M1 = m2 - 1 And r1 < r2)
'اگر یک ماه یا بیشتر اختلاف بود
Select Case M1
Case 1 To 6
If M1 = 6 And r1 = 31 Then
Sumation = Sumation + 30
r1 = 30
Else
Sumation = Sumation + 31
End If
M1 = M1 + 1
Case 7 To 11
If M1 = 11 And r1 = 30 And Kabiseh(S1) = 0 Then
Sumation = Sumation + 29
r1 = 29
Else
Sumation = Sumation + 30
End If
M1 = M1 + 1
Case 12
If Kabiseh(S1) = 1 Then
Sumation = Sumation + 30
Else
Sumation = Sumation + 29
End If
S1 = S1 + 1
M1 = 1
End Select
Loop

If M1 = m2 Then
Sumation = Sumation + (r2 - r1)
Else
Select Case M1
Case 1 To 6
Sumation = Sumation + (31 - r1) + r2
Case 7 To 11
Sumation = Sumation + (30 - r1) + r2
Case 12
If Kabiseh(S1) = 1 Then
Sumation = Sumation + (30 - r1) + r2
Else
Sumation = Sumation + (29 - r1) + r2
End If
End Select
End If

If Flag = True Then
Sumation = -Sumation
End If
Diff = Sumation
End Function

Public Function DayWeekNo(F_Date As Long) As String
'این تابع یک تاریخ را دریافت کرده و مشخص می کند چه روزی از هفته است
'اگر شنبه باشد عدد 0
'اگر 1شنبه باشد عدد 1
'......
'اگر جمعه باشد عدد 6
Dim day As String
Dim Shmsi_Mabna As Long
Dim Dif As Long
'مبنا 80/10/11
Shmsi_Mabna = 801011
Dif = Diff(Shmsi_Mabna, F_Date)
If Shmsi_Mabna > F_Date Then
Dif = -Dif
End If
'با توجه به اینکه 80/10/11 3شنبه است محاسبه میشود day متغیر
day = (Dif + 3) Mod 7
If day < 0 Then
DayWeekNo = day + 7
Else
DayWeekNo = day
End If
End Function


Function MahName(ByVal Mah_no As Byte) As String
Select Case Mah_no
Case 1
MahName = "فروردین"
Case 2
MahName = "اردیبهشت"
Case 3
MahName = "خرداد"
Case 4
MahName = "تیر"
Case 5
MahName = "مرداد"
Case 6
MahName = "شهریور"
Case 7
MahName = "مهر"
Case 8
MahName = "آبان"
Case 9
MahName = "آذر"
Case 10
MahName = "دی"
Case 11
MahName = "بهمن"
Case 12
MahName = "اسفند"
End Select
End Function

Function SalMah(ByVal F_Date As Long) As Integer
'چهار رقم اول تاریخ که معرف سال و ماه است را برمی گرداند
SalMah = Val(Left$(F_Date, 4))
End Function

Function MahDays(ByVal Sal As Byte, ByVal Mah As Byte) As Byte
'این تابع تعداد روزهای یک ماه را برمی گرداند
Select Case Mah
Case 1 To 6
MahDays = 31
Case 7 To 11
MahDays = 30
Case 12
If Kabiseh(Sal) = 1 Then
MahDays = 30
Else
MahDays = 29
End If
End Select

End Function

Function Make_Date(ByVal F_Date As Long) As String
'یک تاریخ را بصورت یک رشته 10 رقمی با ذکر چهار رقم برای سال ارائه می کند
Dim D As String
D = Trim(Str(F_Date))
If IsNull(F_Date) = True Or F_Date = 0 Then
Make_Date = ""
Else
Make_Date = "13" & Mid(D, 1, 2) & "/" & Mid(D, 3, 2) & "/" & Mid(D, 5, 2)
End If
End Function

Function NextMah(ByVal Sal_Mah As Integer) As Integer
If (Sal_Mah Mod 100) = 12 Then
NextMah = (Int(Sal_Mah / 100) + 1) * 100 + 1
Else
NextMah = Sal_Mah + 1
End If
End Function

Function PreviousMah(ByVal Sal_Mah As Integer) As Integer
If (Sal_Mah Mod 100) = 1 Then
PreviousMah = (Int(Sal_Mah / 100) - 1) * 100 + 12
Else
PreviousMah = Sal_Mah - 1
End If
End Function


Function SubtractDay(ByVal F_Date As Long, ByVal Subtract As Long) As Long
'به تعداد روز معینی از یک تاریخ کم کرده و تاریخ حاصله را ارائه میکند
Dim K, M, S, R, Days As Byte

R = Rooz(F_Date)
M = Mah(F_Date)
S = Sal(F_Date)
K = Kabiseh(S)

'تبدیل روز به عدد 1 جهت ادامه محاسبات و یا اتمام محاسبه
If Subtract >= R - 1 Then
Subtract = Subtract - (R - 1)
R = 1
Else
R = R - Subtract
Subtract = 0
End If

While Subtract > 0
K = Kabiseh(S - 1) 'کبیسه: 1 و غیر کبیسه: 0
Days = MahDays(IIf(M >= 2, S, S - 1), IIf(M >= 2, M - 1, 12)) 'تعداد روزهای ماه قبلی
Select Case Subtract
Case Is < Days
'اگر تعداد روزهای کاهش کمتر از یک ماه باشد
R = Days - Subtract + 1
Subtract = 0
If M >= 2 Then
M = M - 1
Else
S = S - 1
M = 12
End If
Case Days To IIf(K = 0, 365, 366) - 1
'اگر تعداد روزهای کاهش بیشتر از یک ماه و کمتر از یک سال باشد
Subtract = Subtract - Days
If M >= 2 Then
M = M - 1
Else
S = S - 1
M = 12
End If
Case Else
'اگر تعداد روزهای کاهش بیشتر از یک سال باشد
S = S - 1
Subtract = Subtract - IIf(K = 0, 365, 366)
End Select
Wend
SubtractDay = (S * 10000) + (M * 100) + (R)

End Function

----------


## mojtabco

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

----------------------------------------------------------------
کمرنگ ترین نوشته ها از قوی ترین حافظه ها بهتر است
http://www.mojtabco.persianblog.com

----------


## مهران فروردین

ضمن تشکر از جناب آقای مسعود غیبی بخاطر سورس کد تبدیل عدد به حروف،
تبدیل تاریخ میلادی به شمسی و برعکس یک فرمول ساده است که می توان در کد برنامه نوشت فقط باید مراقب سال های کبیسه بود، فارسی کردن صفحه کلید و نصب فونت های فارسی در ویندوز اکس پی هم که با استفاده از ستینگ کنترل پنل ویندوز براحتی امکان پذیر است کافی است در اپشن تنظیمات زبان همه جا زبان را فارسی و کشور را ایران انتخاب کنید، فقط به همکاران گرامی توصیه می کنم اگر می خواهید محصول نرم افزاری خود را تکثیر کرده و بصورت سی دی ارائه نمایید فقط از فوت های Tahoma و Times New Romand استفاده کنید تا اپراتورهای غیر حرفه ائی با مشکلات مربوط به حروف گ پ چ ژ مواجه نشوند این دو فونت در صورتیکه حتی هیچگونه فارسی سازی روی ویندوز نصب نشده باشد تقریبا روی کلیه نگارش های اکس پی بخوبی عمل می کنند ، در مورد راست به چپ بودن فرم ها ، لیبل ها و ... که مشکلی نیست کافی است خاصیت Right to Left فرم، لیبل، کلید و ... را در حالت Ture تنظیم نماید خود به خود همه چیز حل می شود توصیه می کنم قبل از شورع طراحی و قراردادن ابجکت های مورد نیاز روی فرم، به محض ایجاد فرم Right to Left را Ture کنید. مشکل اساسی در ویندوز اکس پی سورت صحیح فارسی است هنگامی که یک لیست را سورت می کنید بدلیل کد حرف    پ  که مقدار درستی ندارد کلیه کلماتی که با    پ    شروع می شوند بجای اینکه بعد از    ب   و قبل از  ت قرار گیرند در آخر لیست قرار می گیرند البته با نصب بعضی فارسی سازها این مشکل حل می شود ولی چطور می توان بدون استفاده از فارسی ساز و نوشتن کد اضافی در سورس برنامه ویندوز را طوری تنظیم کرد که  حرف    پ   را در جای خود بشناسد.

----------


## vbhamed

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

----------


## مهران فروردین

سلام.
دوست عزیز VBHAMED اگر لطف کنید و نسخه اصلاح شده فایل مذکور را، در صورتیکه مشکل سورت صحیح فارسی در ویندوز اکس پی با استفاده از آن  حل می شود، ارسال فرمائید. سپاسگزار شما خواهم بود.
E-Mail:  m09123878011@Yahoo.com

----------


## vbhamed

سلام دوست عزیز

فایل مورد نظر را برایتان فرستادم

توجه نمایید که برای سورت صحیح فارسی اگر از ADO استفاده می کنید حتما باید از JET4.0 به بعد را به کار ببرید
 و اگر از DAO استفاده می کنیدۀ خاصیت Connect آن باید روی ACCESS2000 باشد ولی اگر ACCESS2000 را در لیست نداشت می بایست Service Pack 5.0 را روی ویژوال بیسیک نصب نمایید

----------


## Javad583

دوستان با سلام
2 تا مشکل دارم؛
اول اینکه من قابلیت فارسی سیستم عامل رو فعال کردم (ویندوز XP) ویژوال بیسیک هم کامل نصب شده اما وقتی فارسی تایپ می کنم بصورت ؟؟؟ نمایش داده میشه، اشکال از کجای کار هست؟
دوم اینکه من یه برنامه نوشتم حالا اگه بخام قابلیت XP Style رو بهش اضافه کنم چه کدی رو باید به برنامه اضافه کنم؟ (اون کد xml رو هم دارم ولی نمی دونم کاربردش چیه!)
اگه کسی بتونه کمک کنه واقعا ممون میشم....

----------


## M-Gheibi

برای مشکل فارسی به توصیه های نوشته شده در همین تاپیک عمل کنید.
سوال دومتون با اینکه ربطی به این تاپیک نداره ولی پاسخ میدم. در بخش جستجوی سایت عبارت manifest رو در بخش وی بی سرچ کنید. برای مثال در آدرس زیر به پاسخ سوالتون می رسید : http://www.barnamenevis.org/sh...light=manifest

----------


## محمد آشتیانی

دوستان سلام

با عرض پوزش از اساتید
یه کنترل تاریخ شمسی که خودم نوشتم براتون گذاشتم
تاریخ جاری سیستم رو به شمسی نشون میده ،البته خیلی ساده هستش اما درست کار میکنه امیدوارم به دردتون بخوره

طرز کار:
مثلا برای قرار دادن تاریخ شمسی درون یک textbox 

Text1.text = Miracle1.Shamsi

Miracle اسم کنترل تاریخ هستش و برای سایر استفاده ها مثل database و غیره هم دقیقا مثل بالا عمل میشه.

موفق باشید

----------


## Masoud_VB_Programmer

> دوستان با سلام
> 2 تا مشکل دارم؛
> اول اینکه من قابلیت فارسی سیستم عامل رو فعال کردم (ویندوز XP) ویژوال بیسیک هم کامل نصب شده اما وقتی فارسی تایپ می کنم بصورت ؟؟؟ نمایش داده میشه، اشکال از کجای کار هست؟
> دوم اینکه من یه برنامه نوشتم حالا اگه بخام قابلیت XP Style رو بهش اضافه کنم چه کدی رو باید به برنامه اضافه کنم؟ (اون کد xml رو هم دارم ولی نمی دونم کاربردش چیه!)
> اگه کسی بتونه کمک کنه واقعا ممون میشم....


جواد جان مشکل فارسیت مال برنامه ویژوال بیسیکه
باید به روش زیر عمل کنی
ویژوال بیسیک رو اجرا می کنی=> از منوها Toolsرو انتخاب بعد Options رو میزنی
بعد از تب های بالا  Editor Format رو انتخاب می کنی و تمام خطها رو به Courier New تبدیل می کنی بعد مشکلت حل میشه
در مورد مشکل دومت متاستفم و لی یک ocx هست که تمام اشکال xp رو داره

----------


## marziyeh

من می خواهم ارمنی تایپ کنم چه کنم پروژه دارم کمک کمک کمک کمک

----------


## asfar_nikoo

> ستاپ اضافه شد دریافت کنید


با عرض سلام و  خسته نباشید
لطفا  کد تایپ فارسی در ویندوز بدون تغییر زبان  را برای من نیز بفرستید
زیرا بعضی از کدها دیده نمی شوند
لطفا به تازه واردین نیز نگاهی بیاندازید  :چشمک:  
asfar_nikoo@yahoo.com

----------


## fixer2006

جناب آقای غیبی سلام

ممنونم از راهنمایی و نمونه کدی که برای "تبدیل صفحه کلید به فارسی در VB " گذاشته‌اید. سوالی که من برام پیش اومده اینست که، وقتی وارد برنامه خود می‌شویم کیبورد فارسی می‌شود، حالا چطور میتوان کیبورد رو به حالت Default برگرداند؟؟؟

----------


## M-Gheibi

Fixer2006 عزیز تا اونجایی به یادم میاد اگر در کد مربوطه به جای مقدار 00000429 از 00000409 استفاده کنید، زبان مورد استفاده به انگلیسی تغییر پیدا کند.

----------


## yahya3004

سلام

من می خواستم بدونم چطور میشه treeview رو در VB6 right to left کرد


با تشکر

----------


## M-Gheibi

> من می خواستم بدونم چطور میشه treeview رو در VB6 right to left کرد


اول جستجو کنید بعد سوالتون رو مطرح کنید:
http://www.barnamenevis.org/sh...ad.php?t=19193

----------


## khomar

> برای تبدیل صفحه کلید به فارسی در ویژوال بیسیک 6 :
> ابتدا تابع زیر را تعریف کنید :
> Public Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long
> 
> ویندوز اکس پی  و 2000 که فارسی نصب شده باشد :
>  Dim xx As Long
> xx = LoadKeyboardLayout("00000429", 1)
> 
> 
> ...


من این دو تا کد رو تو یه ماژول کپی کردم درسته؟
اگه درسته ارور می ده ارورش هم از 429 هست مشکلش کجاست؟

----------


## M-Gheibi

نباید اروری بده

----------


## khomar

خوب مال من ارور می ده حالا چیکار کنم؟

----------


## M-Gheibi

دقیقا چه اروری می ده؟ شاید اینطوری بشه فهمید مشکل از کجاست

----------


## khomar

این ارور رو می ده
compile error:
invalid outside procedure

----------


## M-Gheibi

به طور مشخص نمیشه نظری داد ولی در گوگل سرچ کنید شاید به نتیجه ای مورد نظر برسید
http://www.google.com/search?sourcei...e+procedure%22
(البته در این شکی نیست که مشکل از کد تغییر زبان نیست)

----------


## farzad sahraei

خسته نباشی.
مرسی

----------


## تبار

من یک فارسی ساز بزای TextBox دارم ببینید :

Private Sub NameTxt_KeyPress(KeyAscii As Integer)
farsi = "آبپتثجچحخدذرزسشصضطظعغفقک  لمنوهیئءؤ"
latin = "Hhf`je[]ponbvc\sawqxzuytr;'glk,idmM<"
For n = 1 To 36
   If KeyAscii = Asc(Mid(latin, n)) Then
        KeyAscii = Asc(Mid(farsi, n))
        Exit For
    End If
Next n

End Sub

----------


## farid_programmer

سلام دوستان . من به یک مشکل خیلی مهم برخورد کردم . مشکلم اینه که داخل ListBox و Combobox نمی تونم فارسی بنویسم .البته با تکست باکس و لیبل ها مشکلی ندارم ولی مشکل اصلیم همین لیست باکسه . در ضمن از وینذوز ایکس پی هم استفاده می کنم و تو کل این تاپیک هم گشتم ولی متاسفانه چیزی پیدا نکردم . خیلی ممنون میشم جوابمو بدید چون واقعا" نیاز دارم ممنون .

----------


## siamakuk

با سلام .لطفا مرا در مورد این کاراکتر(&lt;)راهنمایی کنید که منظور از (&lt;)در کد
تبدیل عدد به حروف آقای غیبی چیست .با تشکر سیامک

با سلام لطفا مرا در مورد این کاراکتر(&lt;)در کد تبدیل عدد به حروف آقای غیبی
راهنمایی کنید.با سپاس سیامک.

----------


## Youness

کد تون جواب میده فقط تو پنجره کد نویسی به جای حروف فارسی علامت سوال میزنه

----------


## ab_ba

همگی خسته نباشید
برای یک شرکت برنامه ای نوشتم که تحت win98 اطلاعات را وارد کرده اند حال به xp  ارتقا داده ام 
کلماتی که دارای حرف 'ک' هستند در سرچ پیدا نمیشوند و در سورت آخر قرار میگیرند احتمال میدهم کد حرف 'ک' قبلی با 'ک' که در xp  تایپ میشود فرق کند برای رفع مشکل چه باید کرد

----------


## M-Gheibi

> کلماتی که دارای حرف 'ک' هستند در سرچ پیدا نمیشوند و در سورت آخر قرار میگیرند احتمال میدهم کد حرف 'ک' قبلی با 'ک' که در xp تایپ میشود فرق کند برای رفع مشکل چه باید کرد


خب چرا Replace نمیکنید؟

----------


## farzad964

با سلام خدمت اساتید محترم

من به یک مشکل برخورد کردم که به نظرم خیلی عجیبه.

در VBA ACCESS به راحتی فارسی کار می کند اما در VBA EXCEL حتی Caption یک Button رو هم نمی شه فارسی کرد  :متعجب:  اگر میشه منو راهنمایی کنید

با تشکر فراوان

----------


## eagnasio

یه حال اساسی به همه

----------


## alireza_vb

> کد زیر برای تبدیل مقدار عددی به حروف است.
> به این نکته دقت داشته باشید که حداکثر مقدار قابل قبول برای این تابع 999,999,999,999 (نهصد و نود و نه میلیارد و نهصد و نود و نه میلیون و نهصد و نود نه هزار و نهصد و نود و نه) می باشد.
> تابع زیر نوشته جناب آقای بابک بخشایش هست.
> Option Explicit
> Private Const hezar = " هزار"
> Private Const melun = " میلیون"
> Private Const melyard = " میلیارد"
> Private Const va = " و "
>  
> ...


 




فکر نمیکنید خیلی درازه؟
میشه خلاصه اش کرد

----------


## M-Gheibi

@ alireza_vb:



> تابع زیر نوشته جناب آقای بابک بخشایش هست.


در کد آقای بخشایش هیچگونه تغییری داده نشده لذا تغییر در کد و optimize کردن آن به عهده برنامه نویس است.

شب خوش

----------


## saruneh

دوستان من برای وارد کردن  اطلاعات درخواستی برنامه ای که نوشتم، به صورت فارسی،
از همون امکان فارسی win xp میخوام استفاده کنم.منتها حروف "گ" و "ک" بصورت "..." وارد text box هام میشه! مشگل کجاست ؟
از v.b.6(enterprise ) استفاده کردم.

----------


## Hossein Bazyan

از فونت tahoma استفاده کن و script آنرا Arabic انتخاب کن

----------


## amirsadeghi

فقط همون فونت فارسی فکر کنم کفایت کنه

----------


## icarus

> یه حال اساسی به همه


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

----------


## mohsenna30ri

*ببین این راه حل بدردت می خوره فکر کنم بد نباشد : 
https://barnamenevis.org/showthread.php?t=55431
*

----------


## amirfz

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

----------


## Hossein Bazyan

دوستان من در مورد فارسی کردن ویندوز مشکلی دارم اگه کسانی راه جلی بنظرشان میرسه بیان کنند
من ویندوز را هر بار که دوباره نصب میکنم تمام مراحل فارسی سازی را دنبال میکنم و سیستم فارسی هم میشه و Fr در  System try هم ایجاد میشه و در همه برنامه ها هم میتوانم RightToLeft بنویسم اما در وی بی زمانی که خاصیت RightToLeft را میخوام فعال کنم فعال نمیشه و همیشه False  میباشد . 
در ضمن همه گزینه های مربوط به Control Panel و Regional and Language Option را نیز فعال نموده ام.

----------


## amirfz

لطفا اگر کد یا تابعی دارین که یک متن تایپ شده رو از کدپیج فارسی داس به ویندوز تبدیل میکنه برای من بفرستید
amirfz_2000@yahoo.ca

----------


## moslem-visual

ممنون از همه ی دوستانی که اینجا پست دادن و یه منبع کامل رو ترتیب دادن، بازم ممنون.

----------


## sknsphr

> دوستان من در مورد فارسی کردن ویندوز مشکلی دارم اگه کسانی راه جلی بنظرشان میرسه بیان کنند


مشکلتون باید با فارسی ساز حل بشه. که یه نمونه شو Persiansoft داره. یه فایل 28M.

----------


## Hossein Bazyan

> مشکلتون باید با فارسی ساز حل بشه. که یه نمونه شو Persiansoft داره. یه فایل 28M.


دوست عزیز من مشکل فارسی ندارم و راحت فارسی مینویسم و در قسمت زبانها Fr هم آمده و در word و همه برنامه ها هم فارسی مینویسم اما مشکل من اینه که فقط در وی بی گزینه RightToLeft فعال نمیشه و الا در وی بی  هم فارسی مینویسم

----------


## sknsphr

> دوست عزیز من مشکل فارسی ندارم و راحت فارسی مینویسم و در قسمت زبانها Fr هم آمده و در word و همه برنامه ها هم فارسی مینویسم اما مشکل من اینه که فقط در وی بی گزینه RightToLeft فعال نمیشه و الا در وی بی  هم فارسی مینویسم


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

----------


## Hossein Bazyan

مرسی از جواب شما 
اما من هر بار که ویندوزم را نصب کرده ام و مراحل فارسی سازی را طی کردم هیچوقت همچین مشکلی نداشتم و راحت RightToLeft میشد که هر بار هم من همراه نصب ویندوز فارسی ساز را نصب نکرده ام 
اما اینبار نمیدانم چرا ؟

----------


## mjnikbn

> *ببین این راه حل بدردت می خوره فکر کنم بد نباشد : 
> https://barnamenevis.org/showthread.php?t=55431
> *



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

----------


## aslan_ir

f_h1360

من یه convertor  برا خودم نوشتم - اگه دوست داشتی چند رکورد از فایل DBF را  اینجا بذار  تا با برنامم تستش کنم ببینم جواب میده یا نه ؟

----------


## ishafaaty

سلام خسته نباشید
آقا مشکل ما از پایه است :گریه: 
در موقع استفاده از ماجول تبدیل عدد اعشاری به حروف چطور باید فیلدها رو به اون معرفی کرد یعنی مثلا پس از تایپ عدد و فشردن اینتر در فلان فیلد مازول را اجرا کرده ( به حروف ) نمایش دهد؟؟؟
لطفا من را راهنمایی کنید 

با تشکر فراوان 
ایمان آذر  :متفکر:

----------


## joker

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

توی برنامه یک memo دارم که توش تایپ میکنند مثلا :
" بنام خدا امروز *1385/09/28* و تمام "

وقتی با استفاده از OLE توی یک فایل ورد بازش میکنم مینویسه :
" بنام خدا امروز *28/09/1385* و تمام "
انواع و اقسام تغییرات توی Option.Complex Script هم دادم ( ولی شاید اونی که باید تغییر میدادم را ندادم )
اونایی که توی پاراگراف بالا بودن چون از دیتابیس به صورت فیلد مستقل میخوندم میتونستم با یک تابع برعکس بفرستم به ورد تا ظاهرا درست چاپ کنه ، ولی قسمت بدنه اصلی پیام را مشکل دارم !!!
نمونه فایل را ضمیمه میکنم .
چطوری میتونم مشکل را حل کنم ؟?


پیوست » من یک فایل ورد به صورت تملیت دارم که اطلاعات را توش مینویسم.
بنابراین اگه ممکنه راه حلی بگین که ذاتا مشکل را را حل کنه نه نیاز به تغییرات مقطعی در موقع ورود اطلاعات به ورود داشته باشه. :بوس:

----------


## jafardelphi

من یه کدی میخوام که دوتاریخ شمسی رو بگیره و در خروجی تعداد روز های مابینشونو بگه مثلا : 8/9/85  و 10/9/85 = 2 روز

----------


## greenway

> فکر نمیکنید خیلی درازه؟
> میشه خلاصه اش کرد


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

 

privatestring PrintThreeDigit(int Value)
{
string Result="";
int i,Dummy;
i= Value / 100;
if (i!=0)
{
#region Sadgan
switch(i)
{
case 1:
Result += "یکصد ";
break;
case 2:
Result += "دویست ";
break;
case 3:
Result += "سیصد ";
break;
case 4:
Result += "چهارصد ";
break;
case 5:
Result += "پانصد ";
break;
case 6:
Result += "ششصد ";
break;
case 7:
Result += "هفتصد ";
break;
case 8:
Result += "هشتصد ";
break;
case 9:
Result += "نهصد ";
break;
}
#endregion
}
Dummy = Value % 100;
if (Dummy!=0)
{
if (Value / 100 !=0)
{
Result +="و ";
}
if ((Dummy>=10) && (Dummy<20))
{
#region 10Ta19
switch(Dummy)
{
case 10:
Result +="ده ";
break;
case 11:
Result +="یازده ";
break;
case 12:
Result +="دوازده ";
break;
case 13:
Result +="سیزده ";
break;
case 14:
Result +="چهارده ";
break;
case 15:
Result +="پانزده ";
break;
case 16:
Result +="شانزده ";
break;
case 17:
Result +="هفده ";
break;
case 18:
Result +="هجده ";
break;
case 19:
Result +="نوزده ";
break;
}
#endregion
}
else
{
i= Dummy / 10 ;
#region Dahgan
switch(i)
{
case 2:
Result += "بیست ";
break;
case 3:
Result += "سی ";
break;
case 4:
Result += "چهل ";
break;
case 5:
Result += "پنجاه ";
break;
case 6:
Result += "شصت ";
break;
case 7:
Result += "هفتاد ";
break;
case 8:
Result += "هشتاد ";
break;
case 9:
Result += "نود ";
break;
}
#endregion
}
}
if (!((Dummy>=10) && (Dummy<20)))
{
Dummy = Value % 10;
if (Dummy!=0)
{
if (Value>9)
{
Result +="و ";
}
#region Yekan
switch (Dummy)
{
case 1:
Result +="یک ";
break;
case 2:
Result +="دو ";
break;
case 3:
Result +="سه ";
break;
case 4:
Result +="چهار ";
break;
case 5:
Result +="پنج ";
break;
case 6:
Result +="شش ";
break;
case 7:
Result +="هفت ";
break;
case 8:
Result +="هشت ";
break;
case 9:
Result +="نه ";
break;
}
#endregion
}
}
return Result;
}
 
publicstring ConvertIntToCharachterMoney(int Value)
{
string Result="";
string DummyStr = Value.ToString();
int DigitLen = DummyStr.Length;
int i,VavCount=0;
int[] Sections = newint[5];
if (Value==0) 
{
Result="صفر";
}
else
{
if (DigitLen>15)
{
Result="بسیار بزرگ";
}
else
{
DummyStr=Value.ToString("000000000000000"); 
for (i=0;i<5;i++)
{
Sections[i]=Convert.ToInt32(DummyStr.Substring(i*3,3));
if (Sections[i]!=0)
{
VavCount++;
}
}
VavCount--;
for (i=0;i<5;i++)
{
if (Sections[i]!=0)
{
Result += PrintThreeDigit(Sections[i]);
switch(i)
{
case 0 :
Result +="تریلیون ";
break;
case 1 :
Result +="میلیارد ";
break;
case 2 :
Result +="میلیون ";
break;
case 3 : 
Result +="هزار ";
break;
}
if (VavCount>0)
{
Result+= "و ";
VavCount--;
}
}
}
 
}
}
return Result;
}

----------


## ishafaaty

با سلام خدمت شما

من یک سوال در مورد استفاده از ماجول ها  در اکسس داشتم 
الان ماجول های زیادی درباره تبدیل اعداد اعشاری به حروف در اینترنت وجود دارد 
اولا شما کدام را توصیه می کنید
دوما نحوه استفاده آنرا لطفا توضیح دهید ، هدف من ازاستفاده این ماجول در یک برنامه کارنامه ، با قابلیت خواندن عدد به حروف است ولی چطور فیلدها روبه این ماجول ربط بدم دچار مشکلم !

82.75--------< هشتاد و دو هفتاد و پنج صدم 
دقیقا منظور اینه که پس از تایپ عدد ،اتوماتیک در فیلدی دیگری ( به دلخواه) بصورت حروف نوشته شود .

 82.75
هشتاد و دو هفتاد و پنج صدم
 
آیا در ماجول باید فیلدها رو معرفی کرد اگر جواب مثبته چطور؟



با تشکر فراوان- ایمان

----------


## ishafaaty

با سلام خدمت شما

من یک سوال در مورد استفاده از ماجول ها  در اکسس داشتم 
الان ماجول های زیادی درباره تبدیل اعداد اعشاری به حروف در اینترنت وجود دارد 
اولا شما کدام را توصیه می کنید
دوما نحوه استفاده آنرا لطفا توضیح دهید ، هدف من ازاستفاده این ماجول در یک برنامه کارنامه ، با قابلیت خواندن عدد به حروف است ولی چطور فیلدها روبه این ماجول ربط بدم دچار مشکلم !

82.75--------< هشتاد و دو هفتاد و پنج صدم 
دقیقا منظور اینه که پس از تایپ عدد ،اتوماتیک در فیلدی دیگری ( به دلخواه) بصورت حروف نوشته شود .

 82.75
هشتاد و دو هفتاد و پنج صدم
 
آیا در ماجول باید فیلدها رو معرفی کرد اگر جواب مثبته چطور؟



با تشکر فراوان- ایمان

----------


## کامپیوتر

سلام
خسته نباشین دوستان
کد سورس تقویم کامپیوتر رو به زبان vb یا vb.net  یا php میخوام اگه راهنمایی کنید خیلی ممنون میشم.

----------


## یاسی صبوری

> اگه منظورتون اینه که توی برنامه vb چه جوری تاریخ ها رو شمسی کنیم که باید از یه تابع تبدیل تاریخ تو برنامه استفاده کنید


سلام میشه بگید چه تابعی؟ متشکرم

----------


## problem

قبل از اینکه این سوال را مطرح کنم، در تاپیک‌ها جستجو کردم، اما به نتیجه دلخواه نرسیدم. لذا این سوال را مطرح می‌کنم:
*بدون* این که در Control Panel بخش Regional and Language Settings لبه Advanced گزینه مربوط به برنامه‌های «غیر یونیکد» را به فارسی تغییر دهیم، می‌خواهیم برنامه‌ای داشته باشیم، که فقط یک عدد Textbox داشته باشد، که بشود تویش فارسی تایپ کرد، و بعد بتواند به یک دیتابیس (فایل Access) وصل شود، و عین متن تایپ شده را در جدول داخل آن ذخیره کند، به طوری که وقتی خود فایل Access را باز می‌کنیم هم متن را فارسی بنینیم، نه کاراکترهای عجیب و غریب.
توجه داشته باشید که برنامه قرار است *فقط روی ویندوز XP*‌ کار کند، و روی ویندوز ۹۸ و ... لازم نیست اصلاً باز بشود! (لذا من دنبال راه حل‌های مبتنی بر CodePage نیستم.)
توضیح دیگر آن که بنده اصلا سابقه کار با VB6 ندارم، و این سوال را به نیابت از کس دیگری می‌پرسم. لذا تا حد امکان ساده توضیح دهید. اگر به کامپوننت یا تکنیکی که برای شما شناخته شده‌است اشاره می‌کنید، لطف کنید برای من هم لینکی بگذارید که آشنا شوم.
(چیزی که تا الآن به آن پی بردم این است که VB6‌ کنترلهای پیش‌فرضش به صورت ANSI‌ هستند و بنابراین احتمالاً راه حل سوال من یا در گروی استفاده از کنترلهای دیگر است، یا در گروی ارتباط مستقیم برنامه با API‌ ویندوز و تعریف کنترلها از آن طریق.)

----------


## Payam Moradi

یک کنترل قبلا گذاشته بودم:

Dim s As New Payam_ActiveX_lib.Calender
s.DateDifference("1385/01/01", "1386/01/01", pr_DayInterval, pr_Persian)

اینم لینکش
https://barnamenevis.org/showthread.php?t=58091

----------


## INeedHelp

سلام تابع *تبدیل عدد به حروف (Num to Str)* چند تا ایراد داره مثلا عدد 22000258000 رو نمی تونه محاسبه کنه که برای این کار  درقسمت  Case 1000000000 To 999999999999# باید 4 دستور if دیگر وارد بشه

----------


## problem

من هنوز منتظر راهنمایی شما بزرگواران هستم. (درباره *این سوال*)

----------


## yourdkhani

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

----------


## Payam Moradi

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


 یعنی چی بهم ریخته. دقیقتر بگید. مثلا فونت "نازنین" رو ندارید یا به جای ژ، پ میزنه؟

----------


## Payam Moradi

> سلام تابع *تبدیل عدد به حروف (Num to Str)* چند تا ایراد داره مثلا عدد 22000258000 رو نمی تونه محاسبه کنه که برای این کار درقسمت Case 1000000000 To 999999999999# باید 4 دستور if دیگر وارد بشه


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

Dim c As New FarsiConverter
MsgBox c.Conv_NumToText(Text1.Text)

https://barnamenevis.org/showthread.php?t=58091
..
..
..

----------


## Payam Moradi

> با سلام خدمت شما
> 
> من یک سوال در مورد استفاده از ماجول ها در اکسس داشتم 
> الان ماجول های زیادی درباره تبدیل اعداد اعشاری به حروف در اینترنت وجود دارد 
> اولا شما کدام را توصیه می کنید
> دوما نحوه استفاده آنرا لطفا توضیح دهید ، هدف من ازاستفاده این ماجول در یک برنامه کارنامه ، با قابلیت خواندن عدد به حروف است ولی چطور فیلدها روبه این ماجول ربط بدم دچار مشکلم !
> 
> 82.75--------< هشتاد و دو هفتاد و پنج صدم 
> دقیقا منظور اینه که پس از تایپ عدد ،اتوماتیک در فیلدی دیگری ( به دلخواه) بصورت حروف نوشته شود .
> ...


سلام

اکتیوایکس موجود درلینک را دانلود و رجیسترنمایید. و به پروژه اضافه کنید.

https://barnamenevis.org/showthread.php?t=58091

 
Public Function NumToText() As String
    Dim c As New FarsiConverter
    Dim Result As String
    Dim Asli As String
    Dim Ashar As String
    Dim dot_Pos As Integer
 
    dot_Pos = InStr(1, Text1.Text, ".")
 
    If dot_Pos = 0 Then
        Result = c.Conv_NumToText(Text1.Text)
    Else
        Asli = Mid(Text1.Text, 1, dot_Pos - 1)
        Ashar = Mid(Text1.Text, dot_Pos + 1, 2)
        If Ashar = "" Or Val(Ashar) = 0 Then
            Result = c.Conv_NumToText(Asli)
        Else
            If Len(Ashar) = 1 Then Ashar = Ashar & "0"
            Result = c.Conv_NumToText(Asli) & " ممیز " & c.Conv_NumToText(Ashar) & " صدم"
        End If
    End If
 
    If Result = "" Then
        MsgBox "خطا در وارد کردن عدد"
    End If
    MsgBox Result
 
    NumToText = Result
 
End Function
 


.
.
.

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

----------


## problem

من هنوز هم منتظر راهنمایی شما بزرگواران (درباره *این سوال*) هستم.

----------


## SSoleimani

سلام به تمام دوستان 
من از فایل Shamsi.dll استفده کردمولی در هنگام اجرا یک exception رخ میده
 An unhandled exception of type 'System.Runtime.InteropServices.COMException' occurred in Lan.exe
Additional information: COM object with CLSID {C36A6B80-D6A8-4F08-91DD-402E39456FE4} is either not valid or not registered.
کسی میتونه منو راهنمایی کنه که چه کار باید انجام بدم؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟

----------


## AlirezaSaberi

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

----------


## music

salam
man moshkele farsi neveshtan tu vb daram
va tu access
khode windows ba farsi moshkeli nadare 
hatta word ham moshkeli nadare vali ba vb va access injuri mishe
http://www.uploadhut.com/upload/345964.jpg??

----------


## Payam Moradi

> salam
> man moshkele farsi neveshtan tu vb daram
> va tu access
> khode windows ba farsi moshkeli nadare 
> hatta word ham moshkeli nadare vali ba vb va access injuri mishe
> http://www.uploadhut.com/upload/345964.jpg??


 سلام

 از منوی Tools به option و در دیالوگ باز باز شده از بالا لبه Editor Format و گزینه Font را به  
 Courier New (Arabic) تغییر بده.

----------


## Payam Moradi

> دوستانی که درمورد تاریخ قمری صحبت کردند و ذکر کرده بودند کخ برای استفاده گذاشته اند.من نتونستم پیداشون کنم.اگه دوباره لطف کنید ممنون میشم.


 از این لینک هم میتونی برداشت میکنی:
http://www.barnamenevis.org/sh...&postcount=233

----------


## AlirezaSaberi

> بهترین کدی که برای تبدیل تاریخ دیدم که میتونه چند نوع تقویم رو به هم تبدیل کنه : عبری، میلادی، هجری شمسی، هجری قمری
> میتونه بگه هر روز چند شنبه ست
> میتونید باهاش روزای تعطیل رو پیدا کنید ( مثلا 22 بهمن یا 10 محرم )
> روشش هم اینه که برای هر تاریخ دو تا تابع داره که یک تابع تاریخ رو به یه عدد تبدیل میکنه و یه تابع عدد رو به تاریخ
> اینطوری میتونید بگید که مثلا 32 روز دیگه کی میشه
> هیچ گونه ایرادی هم من توش پیدا نکردم





> سلام به همگی دوستان و برنامه نویسان عزیز
> 
> آقای غیبی توی یه تاپیک دیگه گوشش منو کشیدن که اگه تابع تبدیل میلادی به هجری داری بیار بذار اینجا
> 
> آقای غیبی من بازم از شما معذرت میخوام :wink: 
> 
> اینم لینک اون توابع ، این توابع رو متاسفانه نمی دونم کی نوشته ولی خیلی عالیه :mrgreen: 
> 
> <span dir=ltr>
> ...


دوستان اینا رو از از کجا میشه گیر آورد. به نظر میاد از روی سرور پاک شدن؟

----------


## music

in karo kardam vali nashod
man fonte Courier New ro daram vali Courier New arabic ro nadaram
hatman bayad arabic bashe ?
font aye arabice digaro emtehan kardam nashode
:(

----------


## Payam Moradi

> in karo kardam vali nashod
> man fonte Courier New ro daram vali Courier New arabic ro nadaram
> hatman bayad arabic bashe ?
> font aye arabice digaro emtehan kardam nashode
> :(


پس تنها یک راه مونده:

وارد کنترل پنل شده و قسمت Regional And Language Option را باز کنید.
از فرم باز شده لبه بالا و دکمه وسطی به نام Languages را انتخاب کنید. 
در قسمت Supplemental language Support (پایین) گزینه Install Files For Complex script And right-to-left Languages باید تیک خورده باشد. اگر نبود تیک بزنید و Apply نمایید. ممکن است نیاز به سی دی ویندوز داشته باشد.
بعد در لبه های بالا گزینه Advanced را انتخاب نمایید و از لیست زبان فارسی را انتخاب کنید. ممکن است نیاز به راه انداری مجدد سیستم باشد.

پس از راه اندازی تنظیماتی که در پست قبلی گفتم در VB انجام داده (تغییر فونت) و وضعیت را امتحان کنید.

از منوی Tools به option و در دیالوگ باز باز شده از بالا لبه Editor Format و گزینه Font را به 
 Courier New (Arabic) تغییر بده. 
موفق باشید.

----------


## music

mersi
moshkel har shod
Regional And Language Option
advanced
farsi ro englisi kardam
dobar farsi kardam restart kardam hal shod
mersi :)

----------


## حامد مصافی

> سلام به تمام دوستان 
> من از فایل Shamsi.dll استفده کردمولی در هنگام اجرا یک exception رخ میده
> An unhandled exception of type 'System.Runtime.InteropServices.COMException' occurred in Lan.exe
> Additional information: COM object with CLSID {C36A6B80-D6A8-4F08-91DD-402E39456FE4} is either not valid or not registered.
> کسی میتونه منو راهنمایی کنه که چه کار باید انجام بدم؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟؟


 
سلام
شما می خواستید از این dll در دات نت استفاده کنید ولی نشد؟؟؟!!!!
dll هایی که با وی بی تولید شدند در سایر محیط ها این اشکال رو دارند.

----------


## Ramina

وقتی اینا رو کپی میکنم error میده.دقیقا کجا باید تعریف بشن؟

----------


## حامد مصافی

سلام
شما چی رو کپی می کنید؟؟

لطفاً مشخص کنید با کدام کد مشکل دارید

----------


## sknsphr

سلام

من تو یک سیستم انبار تحت DOS  وقتی اطلاعات سیستم رو به dbf تبدیل میکنم، code page اش ایران سیستمه و با مبدل می تونم تبدیلش کنم و تو ویندوز ببینم. ولی وقتی یک گزارش رو فایل میکنم نمی دونم code page اش چیه و با مبدل ایران سیستم نمی تونم تو ویندوز ببینم. کسی میتونه کمک کنه؟ یه نمونه از فایلهاش رو هم میذارم.

----------


## digi_tal

با عرض سلام خدمت اساتید محترم  
می خواستم بدونم میشه وقتی ما یک تکس باکس رو انتخاب می کنیم به طور خود کار زبان صفحه کلید یا همون ویندوز ایکس پی تغییر به فارسی کنه اگه امگان داره برام ایمیل بزنید
shemail.co@gmail.com
ممنون

----------


## noorsoft

اینکه خیلی ساده است فقط با دستور Instr  شما وجود ممیز را در رشته جستجو می کنی و بعد با توجه به اعداد بعد از ممیز اعشار را به رشته اضافه می کنی

----------


## noorsoft

برای تغییر حالت صفحه کلید از APi مربوطه باید استفاده کنی و به ای صورت بنویسی 
در Text1_GotFocus باید با KeyboardLeayout زبان صفحه کلید را عوض کنی

----------


## perfeshnal

سلام

قبلا زیاد در این مورد بحث شده شما باید برای این کار این کد رو بنویسی
Private Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Long

Private Sub Text1_Click()
Dim xx As Long
xx = LoadKeyboardLayout("00000429", 1)
End Sub

----------


## jafaripur

Function IranDate(d As String)
Dim ifday, ifmonth, ifyear, ifdayofyear
Dim iyear, idayofyear
Dim inumdayofyear
Dim aifmonthdays
aifmonthdays = Array(31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29)
inumdayofyear = 365
Calendar = vbCalGreg

iyear = Year(d)
idayofyear = DatePart("y", d)
If isleapyear(iyear - 1) Then
inumdayofyear = 366
aifmonthdays(11) = 30
End If
If (idayofyear > 79) Then
ifyear = iyear - 621
ifdayofyear = idayofyear - 79
Else
ifyear = iyear - 622
ifdayofyear = (inumdayofyear - 79) + idayofyear
End If
ifday = ifdayofyear
While (ifday > aifmonthdays(ifmonth))
ifday = ifday - aifmonthdays(ifmonth)
ifmonth = ifmonth + 1
Wend
ifmonth = ifmonth + 1
If Len(ifmonth) = 1 Then ifmonth = "0" & ifmonth
If Len(ifday) = 1 Then ifday = "0" & ifday
IranDate = ifyear & "/" & ifmonth & "/" & ifday
d = IranDate
End Function
'--------------------------------
Function isleapyear(nyear)
isleapyear = (((nyear Mod 4) = 0 And (nyear Mod 100) <> 0) Or (nyear Mod 400) = 0)
End Function

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

طرز استفاده
Text1.Text = irandate(date)

----------


## CodeMasterX

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

----------


## بهرنگ نوروزی

M-gheibi  می تونی کد صفحه کلید رو برام بفرستی

----------


## ah90sh

دکمه های MSGBOX  را پیدا نکردم بعدش ولی پیدا کردم

----------


## RZ_HAFEZ

مدیر سایت 
m_gheibi
در مورد تبدیل عدد به حروف لطفا توضیح بیشتری بدهید
من این کد را وارد کردم ولی اجرا نمی شود

----------


## M-Gheibi

> مدیر سایت 
> m_gheibi
> در مورد تبدیل عدد به حروف لطفا توضیح بیشتری بدهید
> من این کد را وارد کردم ولی اجرا نمی شود


منظورتون از توضیح، بیان عملکرد خط به خط کدها هست ؟! پیچیده نیست . یکبار بخونید اگر متوجه نشدید بگید کدوم قسمت تا توضیح بدم .
اجرا نمی‌شود یعنی چه ؟ لطف کنید واضح‌تر بگید که چه خطایی مشاهده می‌کنید یا ...

----------


## mobin_co

این هم یک فانکشن برای کار با تاریخ شمسی

----------


## ardvisoor

سلام
من درباره جستجوی شرح فارسی با VB در SQLServer2005 مشکل دارم من یک Query دارم بصورت زیر
SELECT fldUserNo From tblUserDetails where fldLastName like '%تیموری%' and fldFirstName Like '%قاسم%' 

اما وقتی این کد به  Sql Server 2005 میره بصورت زیر در میاد 
SELECT fldUserNo From tblUserDetails where fldLastName like '%ÊíãæÑí%' and fldFirstName Like '%ÞÇÓã%' 
در نتیجه هیچ مقداری رو بر نمی گردونه، برای حروف لاتین و یا در حالت ارتباط با Sql server 2000 مشکلی ندارم اما اینو نمی دونم چکار کنم. 

با تشکر

----------


## khosronejad

دوستان فونت tahoma برای caption ها اگه انتخاب بشه ی را بصورت دو نقطه دار میزنه در حالیکه همین ی در office درست کارمیکنه . چگونه میتوان از ی فارسی یعنی بدون دو نقطه  با فونت Tahoma و  برنامه Vb  استفاده کرد؟

----------


## perfeshnal

سلام

جناب khosronejad اگر جستجو می کردید حتما به جواب می رسیدید.  :ناراحت: 
در تاپیک زیر آقای بابک زواری فونتی به نام TTahoma گذاشتند که حرف "ی" در اون فونت درسته و همچنین اعداد هم فارسی هستند.

https://barnamenevis.org/showth...ghlight=Tahoma

----------


## golihaghighi

> با اجرای کد بالا عبارت "یکصد و پنجاه و شش هزار و چهارصد و هشتاد و نه" در Text1 نمایش داده خواهد شد .


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

----------


## حامد مصافی

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


ممنون خواهم شد اگر برای من بفرستید.
Hamed.Masafi@GMail.com

----------


## golihaghighi

> ممنون خواهم شد اگر برای من بفرستید.
> Hamed.Masafi@GMail.com


باید تو آرشیوم بگردم. به محض پیدا شدن می فرستم البته حجمش زیاده با چندتا مسیج میفرستم.

----------


## hossein-jam

سلام
یه سوال داشتم که اگه جواب بدید ممنون میشم VB
من برنامه ای رو نوشتم که دو تا فرم داره . بر فرض مثال فرم یک و فرم دو   
حالا تو فرم دو یه متغیر تعریف کردیم و درون متغیر یه مقداری وجود داره . میخوام کاری کنم که مقدار موجود درون متقیر فرم دو به یه متقیر دیگه که تو فرم یک وجود داره منتقل بشه . چکار باید بکنم ؟


 :ناراحت:

----------


## aslan_ir

form1.text1.text=form2.text1.text

----------


## alikhalesi

سلام. من یک برنامه وی بی رو به بانک sql وصل کردم و وقتی داده های فارسی رو وارد می کردم همه چی درست بود و فقط داده ها به صورت ؟ می شد. برای حل نوع فیلد رو به nvarchar تغییر دادم این مشکل رفع شد اما وقتی که داده ها رو از طریق برنامم search می کنم هیچ داده ای پیدا نمیکنه( الیته فقط داده های فارسی و با داده های انگلیسی کاری نداره) ممنون میشم جوابمو بدین

----------


## mf_engineer

با سلام من از برنامه کدپیج ایران سیستم  که اقای غیبی نوشتند استفاده کردم ولی نمی تونم فارسی تایپ کنم واینکه اگه خوب این برنامه رو ببینید می بینید یه جاهاییش یه سری علامت داره که از نظر وی بی ناشناخته است
ممنون میشم کمکم کنید

----------


## محمد کریمی ورامین

دوست عزیز من نمی توانیم تصویر گفته در این قسمت را مشاهده کنم . لطفا مرا راهنمائی کنید

----------


## لیلا خیرالهی

سلام و خسته نباشید!
بابت کدهای ارسالی ازتون متشکرم و بهتون تبریک می گم به خاطر سایتتون و بهتره بگم مدیریتتون.
من یک مشکل داشتم واسه جستجوی فیلد های فارسی!
من دارم یه برنامه با vb برای آژانس مسکن می نویسم یکی اینکه فیلد های جستجوم خیلی زیاده و نیاز به select های زیادی داره می خواستم بپرسم راهی بجز select نداره؟
محتوای جدول من همش فارسیه اما vb نمی تونه جستجو رو از توی اونا انجام بده همه ی فونت ها رو هم تو vb tahoma و تو sql هم arabic کردم ولی فایده نداره .
اگه کمکم کنید یه دنیا ممنونتون می شم. :لبخند:  :قلب:

----------


## بهمنی

> سلام و خسته نباشید!
> بابت کدهای ارسالی ازتون متشکرم و بهتون تبریک می گم به خاطر سایتتون و بهتره بگم مدیریتتون.
> من یک مشکل داشتم واسه جستجوی فیلد های فارسی!
> من دارم یه برنامه با vb برای آژانس مسکن می نویسم یکی اینکه فیلد های جستجوم خیلی زیاده و نیاز به select های زیادی داره می خواستم بپرسم راهی بجز select نداره؟
> محتوای جدول من همش فارسیه اما vb نمی تونه جستجو رو از توی اونا انجام بده همه ی فونت ها رو هم تو vb tahoma و تو sql هم arabic کردم ولی فایده نداره .
> اگه کمکم کنید یه دنیا ممنونتون می شم.


1- سرچ کنی! پیدا میکنی
2- نمونه همه درس و مشق های بچه های ICDL و ... توی اغلب تاپیکها ریخته پاشیده است میتونید با سرچ همه رو پیدا کنید.

----------


## بهمنی

> قبل از اینکه این سوال را مطرح کنم، در تاپیک‌ها جستجو کردم، اما به نتیجه دلخواه نرسیدم. لذا این سوال را مطرح می‌کنم:
> *بدون* این که در Control Panel بخش Regional and Language Settings لبه Advanced گزینه مربوط به برنامه‌های «غیر یونیکد» را به فارسی تغییر دهیم، می‌خواهیم برنامه‌ای داشته باشیم، که فقط یک عدد Textbox داشته باشد، که بشود تویش فارسی تایپ کرد، و بعد بتواند به یک دیتابیس (فایل Access) وصل شود، و عین متن تایپ شده را در جدول داخل آن ذخیره کند، به طوری که وقتی خود فایل Access را باز می‌کنیم هم متن را فارسی بنینیم، نه کاراکترهای عجیب و غریب.
> توجه داشته باشید که برنامه قرار است *فقط روی ویندوز XP*‌ کار کند، و روی ویندوز ۹۸ و ... لازم نیست اصلاً باز بشود! (لذا من دنبال راه حل‌های مبتنی بر CodePage نیستم.)
> توضیح دیگر آن که بنده اصلا سابقه کار با VB6 ندارم، و این سوال را به نیابت از کس دیگری می‌پرسم. لذا تا حد امکان ساده توضیح دهید. اگر به کامپوننت یا تکنیکی که برای شما شناخته شده‌است اشاره می‌کنید، لطف کنید برای من هم لینکی بگذارید که آشنا شوم.
> (چیزی که تا الآن به آن پی بردم این است که VB6‌ کنترلهای پیش‌فرضش به صورت ANSI‌ هستند و بنابراین احتمالاً راه حل سوال من یا در گروی استفاده از کنترلهای دیگر است، یا در گروی ارتباط مستقیم برنامه با API‌ ویندوز و تعریف کنترلها از آن طریق.)


 
برای اینکه بتوانید در داخل یک کادر متنی(البته به محض ورود) فارسی تایپ کنید، باید API مربوطه را که در همین تاپیک (صفحات فکر میکنم اول تا دهم) ذکر شده است، در GetFucos بگذارید. دوم شروط استفاده از بانک اطلاعاتی با طول و تفصیل زیاد هستند برای راهنمایی من باید اطلاعات خوبی بهم بدید. سوم اگز با Access ورژنهای بالاتر(مثل2003) کار میکنید، باید از آن فایل مربوطه یک نسخه97 تهیه کنید(از طریق Utility داخل Access) تا موقع باز شدن اجق وجق نبینید. برای ارتباط مناسب هم از انجین مناسب استفاده کنید.(مثلا4.51) چهارم: برای راهنمایی استفاده از API (که فکر میکنم با آن آشنا هستید) یکبار جستجو کنید. از این لینک می‌توانید برنامه آموزش 900 API بیابید و حالشو ببرید.

----------


## لیلا خیرالهی

باسلام این تصاویر به خوبی لود نشده اند اگه میشه یک بار دیگه لودش کنید
این متغیر lt در برنامه چیه و چرا ازش خطا می گیره؟
فونت iransystem رو از کدوم ضمیمه باید دانلود کنم؟
vb تابع xx=loadkey.... رو نمی شناسه اگه می شه یکم داجع بهش توضیح بدین !
lt; یعنی lt=?
ممنون



> همانطور که در تصویر مشاهده می کنید این کنترل یک تقویم شمسی در Combobox باز می کند که با کلیک روی هر روز آن تاریخ آن روز را به شما می دهد.
> <p align="center"></p>
> کاری از محمد تاجیک

----------


## hrj1981

با تشکر فراوان از مدیر کل سایت جناب غیبی
اینهم ocx کد تبدیل عدد به حروف برای راحتی برنامه نویسان
https://barnamenevis.org/showthread.php?t=82233

----------


## saied_hacker

سلام
میشه بگید چه طور می تونم یه فونت معرفی کنم؟
هرچه می نویسم چرت و پرت در می اد...
ممنون

----------


## mc_laren

من مشکل فارسی نویسی در وی بی دارم
در ضمن در بقیه نرم افزارهای ویندوز براحتی فارسی می نویسم
و مشکل از سی دی وی بی نیست چون امتحان کردم.

----------


## اوبالیت به بو

تو این تایپیک من یه سری فونت گذاشتم برو دانلود کن.
https://barnamenevis.org/showthread.php?t=82537

----------


## majidrezaei2007

سلام. اگه میدونید چطوری میشه تو vb نستعلیق تایپ کرد منو راهنمایی کنید . ممنون
majid_fba@yahoo.com

----------


## azimtak110

azimtak110@gmail.com

----------


## azimtak110

دوستان می خوام بدونم کسی در مورد فاکتور چاپ کردن یا در کل طریقه طراحی فاکتور به صورت حرفه ای و زیبا و مهمتر چاپ آن برنامه یا کمکی به من نمی تواند بکند 
اگر کسی این کار را انجام بدهد خیلی بزرگواری در حق من کرده و من مدیونش می شوم 
اگر درون جی میلم این را قرار بده جواب را کهخیلی خیلی بزرگوار و عزیز هست 
فدای همه بچه هابه خصوص آنهای که کمک می کنند به هم نوع خودشان 
azimtak110@gmail.com

----------


## مهدی ویژوال

> ستاپ اضافه شد دریافت کنید


با سلام و تشکر از زحمت شما
اگه میشه برای من به میلم ارسال کنید
ممنونم

----------


## مهدی ویژوال

دوست عزیز sql server را Remove کن و دروباره نصب کن و در زمان نصب حتما زبان را فارسی (عربی) انتخاب کن

----------


## مهدی ویژوال

سلا به بابک عزیز از کجا بردارم داداش

----------


## مهدی ویژوال

> ممنون آقای سیدشریفی از لطف شما
> اینم به افتخار آقای سیدشریفی بااین کدمیتونیدیک منوی قابل قبول باتصویر
> و رنگ دلخواه و چند تا خرت پرت دیگه بسازید.
> سورس ساختن منوهم اینجاست البته اینم بگم که کد برنامه
> زیاد بهینه نیست و ممکنه اشکالاتی ریزی هم داشته باشه.
> اینم اوپن سورس ما هرکس امکانی اضافه کرد یا باگی گرفت
> با ذکر دقیق کار انجام شده و تغییرات صورت گرفته بذاره 
> همین جا بقیه بردارن.
> فقط مشکلات رو برای من PM نزنید چون من تا اینجا آوردم
> بقیه رو دوستان زحمتش رو بکشن.


با سلام دوست عزیر من فکر میکنم که الان این سورس که در بالا آمده یا ان ستاپی که قبلا گفتی پاک شده در صئرت امکان انها را برای من ارسال کنید
قبلا از زحمت شما کما تشکر و قدردانی را دارم
bampoori2002@yahoo..com

----------


## shahab2025

سلام
من از vb.net2005 استفاده میکنم ولی نمیتونم کد تبدیل عدد به حروف را که آقای غیبی دادند استفاده کنم . خطایی در مورد توابع Right و Leftمیده. ممنون میشم کمکم کنید

----------


## mobin_co

> من مشکل فارسی نویسی در وی بی دارم
> در ضمن در بقیه نرم افزارهای ویندوز براحتی فارسی می نویسم
> و مشکل از سی دی وی بی نیست چون امتحان کردم.


توی ویژوال در منوی Tools گزینه Options و Tab{Editor Format} در قسمت Font گزینه Courier New(Arabic) رو انتخاب کنید.

----------


## علی خدایاری

:بامزه: این هم یک جور کد دیگه برای نوشتن عدد به حروف

----------


## chashmak

لطفا کمکم کنید واجبه کسی میدونه در فرم ویژال بیسیک چطوری میتونم فایل pdf رو نشون بدم یا در فرم قرار بدم بهتر بگم نشون بدم

----------


## perfeshnal

شما در سایت جستجو کردید و به جواب نرسیدید !!
یک جستجو انجام بدید قبلا جواب داده شده

----------


## golabam

با سلام خدمت اساتید من یه برنامه دارم که در قسمت جستجو اسم اگر اولین حرف کاف یا گاف باشه نمیتونه پیدا کنه ولی با حروف دیگه مشکل نداره در ضمن از دستور سلکت استفاده کردم راهنمائی کنید ممنونم

----------


## perfeshnal

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

----------


## golabam

آقا من همه جا را گشتم راه حل هارا خواندم ولی مشکل حل نشد من چند تا برنامه دیگه از جمله برنامه سازمان تامین اجتماعی را دارام که تحت وی بی هستش و جستجوش خوب کار میکنه نمودنم مشکل ما از کجاست

----------


## bobrus

مشکل شما تو ویندوزه نه ویژوال بیسیک تو شاخه system32 یه فایل هست به نام kbdfa.dll که وضیفش فارسی نوشتنه و توش حروف گژپچ تعریف نشده نسخه درستش رو واستون آپلود می کنم طبق فایل راهنما عمل کنید درست میشه :متفکر:

----------


## asadegha

سلام خدمت اساتید محترم.
چطور میشه دو جدول از دو پایگاه داده اکسس مجزا رو با هم ادغام کرد، البته هر دو جدول از پایگاه دقیقا یکسان هستند -از نظر نوع ، تعداد و حتی نام فیلد ها- می خوام تو یه دیتا گرید نمایش بدم البته در صورت نیاز کاربر با دستورات sql فیلتر میشن.
خیلی عجله دارم. اگه لطف کنین کمکم کنین ممنون میشم.

----------


## Tiro Pro

از تمام دوستانی که مرا در امر فارسی نویسی در vb کمک کردند و از مدیریت این تاپیک جالب کمال سپاس را دارم.2S

----------


## ata.royalfalcon

> دوستان سلام
> 
> با عرض پوزش از اساتید
> یه کنترل تاریخ شمسی که خودم نوشتم براتون گذاشتم
> تاریخ جاری سیستم رو به شمسی نشون میده ،البته خیلی ساده هستش اما درست کار میکنه امیدوارم به دردتون بخوره
> 
> طرز کار:
> مثلا برای قرار دادن تاریخ شمسی درون یک textbox 
> 
> ...


سلام
من نتونستم تاریخی که انتخاب کردم در یک تکست باکس وارد کنم (در اکسس)و این ارور را میدهد
Run time error '424
object required
چی کاری میبایستی انجام دهم ،راهنمایی کنید
البته این هم بگم که ocx را توسط دستور regsvr32 رجیستر و سپس به رفرنس ها نیز اضافه کردم.

----------


## Aminch.pc

سلام
من هم یک سؤال دارم. اول اجازه بدید که برنامم رو شرح بدم.
برنامه ای در حال ساخت دارم که با بانکهای اطلاعاتی هستش. من چند تکست باکس دارم که می خوام اطلاعات داخل اون فارسی تایپ بشه. همچنین برای این کار از یک فونت فارسی مثلاً titr یا kamran استفاده کردم. حالا وقتی این برنامه رو توی یک کامپیوتر دیگه اجرا می کنم فونت titr چون توی اون سیستم وجود نداره نشون داده نمی شه و به جای اون از یک فونت دیگه استفاده می شه. 
حالا سؤال من  از شما دوستان اینه که چطوری می شه از طریق برنامه نویسی یک فونت رو توی سیستم طرف کپی کرد که این مشکل حل بشه؟

----------


## perfeshnal

اگر شما از برنامه های ستاپ ساز استفاده کنید می تونید به راحتی فونتهای خودتون رو در سیستم دیگه نصب کنید.

----------


## Mbt925

> سلام
> من هم یک سؤال دارم. اول اجازه بدید که برنامم رو شرح بدم.
> برنامه ای در حال ساخت دارم که با بانکهای اطلاعاتی هستش. من چند تکست باکس دارم که می خوام اطلاعات داخل اون فارسی تایپ بشه. همچنین برای این کار از یک فونت فارسی مثلاً titr یا kamran استفاده کردم. حالا وقتی این برنامه رو توی یک کامپیوتر دیگه اجرا می کنم فونت titr چون توی اون سیستم وجود نداره نشون داده نمی شه و به جای اون از یک فونت دیگه استفاده می شه. 
> حالا سؤال من  از شما دوستان اینه که چطوری می شه از طریق برنامه نویسی یک فونت رو توی سیستم طرف کپی کرد که این مشکل حل بشه؟


توی تاپیک زیر آموزش کار با یه Setup سازه خوب قرارداده شده.
ازش استفاده کنید.
https://barnamenevis.org/showthread.php?t=95510&highlight=%D8%A2%D9%85%D9%8  8%D8%B2%D8%B4

----------


## Aminch.pc

> اگر شما از برنامه های ستاپ ساز استفاده کنید می تونید به راحتی فونتهای خودتون رو در سیستم دیگه نصب کنید.


 یعنی اگه فونت ها رو کنار برنامم بذارم و برای کل فایل ها یک ستاپ درست کنم به نتیجه دلخواه می رسم؟

----------


## perfeshnal

شما به تاپیکی که آقا محسن زحمتش رو کشیدند مراجعه کنید اونجا یک آموزش درباره ساخت ستاپ هست. که همه چیز رو به طور کامل توضیح داده



> https://barnamenevis.org/showth...88%D8%B2%D8%B4

----------


## arash_vb

سلام...یه برنامه دارم می نویسم..تا دیروز بعد از دوماه کار همه چی درست بود...دستی هم به ویندوزم نزدم!  یهو دیروز برنامه رو ران کردم دیدم اینپوت باکس و مسیج باکسم  حروف فارسی رو جدا جدا نمایش میدن..!! آخه من به چیزی تو تنظیمات دست نزدم...لطفا راهنمایی کنید.وقتم تنگه!! :افسرده: 
مرسی

----------


## فاطمه وطن دوست

سلام
https://barnamenevis.org/showth...=78376&page=21
کنترلی برای طراحی Msgbox های مختلف

----------


## arash_vb

> سلام
> https://barnamenevis.org/showth...=78376&page=21
> کنترلی برای طراحی Msgbox های مختلف


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

----------


## majjjj

ایا از فونت خاصی استفاده میکنین

----------


## arash_vb

> ایا از فونت خاصی استفاده میکنین


اگه منظورتون در خود ویبی هست ، معمولا تاهوما که بدون مشکل همه جا اجرا میشه..اما به طور کلی خیر...


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

----------


## pesarekhobtar

با سلام ....
دوستان کسی می تونه توضیح بده چه طور می شه حروف را به صورت جدا از هم نوشت ولی به صورت چسبان...
مثلا حرف " ب "  چسبانش می شه " بـ "  و "  ـبـ "  اما این که اینجا نوشتم خودش شد دو تا کاراکتر . میشه یک نفر بگه چه طور میشه این کار را کرد چون اگر که دوتاش کنم  درست می شه ولی من می خوام فقط یک حرف باشه که در این صورت با پاک کردن حرف دوم باز هم به صورت غیرچسبان در میاد :   "  ب  "   و    "    بپ   "

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

----------


## afsoonsoft_co

چرا وقتی انتهای textbox نقطه یاپراتز تایپ میکنیم بعدازذخیره کردن ودوباره لودکردن نقطه یا پرانتز جابجا میشه؟ تو چاپش هم همینجوریه؟
اگه کسی میتونه کمکم کنه ممنون میشم

----------


## perfeshnal

سلام

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

----------


## afsoonsoft_co

سلام

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

----------


## parselearn

کتابچه ای در مورد تنظیمات زبان ویندوز
دریافت

----------


## afsoonsoft_co

منظورمن توactive reporte توروخدایکی راهنمایی کنه

----------


## hrj1981

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

----------


## afsoonsoft_co

باتشکرازراهنماییتون. من اکتیوریپورت 2 روهم نصب کردم ولی بازهم فیلدها خاصیت right to left ندارندومشکل همچنان باقیست

----------


## ashkan23

سلام 
من یه مشکل با Menu Editor وی بی دارم نمی تونم باهاش منوی فارسی از سمت راست درست کنم لطفا کمک کنید ممنون

----------


## mrsalam

سلام
چرا خاصیت right to left فرمم ترو نمیشه؟

----------


## VB.SOS

چون تو سيستمت فارسي نصب نيست. اگه فارسي رو توي ايكس پي نصب كني اين مشكل هم رفع ميشه

----------


## VB.SOS

پيشنهاد ميكنم اين تاپيك جزء تاپيكهاي اعلان بشه تا هميشه مورد استفاده قرار بگيره.

----------


## VB.SOS

> سلام 
> من یه مشکل با Menu Editor وی بی دارم نمی تونم باهاش منوی فارسی از سمت راست درست کنم لطفا کمک کنید ممنون


دوست عزيز از كنترل هايي كه منوساز هستند استفاده كن مثل كنترل OfficeMenu تو سايت زياد هست.

----------


## ابوذر محمودی

مشکل از menu editor نیست .شما right to left  فرمتون رو true کنید .
پیشنهاد می کنم یه سری هم به این تاپیک بزنید . خیلی جالبه . حتما خوشتون می یاد.
واسه گرافیکی کردن برنامه و رها شدن از منوهای وی بی حرف نداره .
https://barnamenevis.org/showpo...&postcount=248

----------


## ابراهیم ب

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

----------


## mohsen_f_b

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

من می خوام بعد از ورود اطلاعات و پرکردن تمام فلیدها یک فایل PDF همره با تمام اطلاعات درون دیتابیس ( Access) ذخیره کنم.
بعد در قسمت جستجو وقتی اون چیزی رو که میخوام جستجو کنم تمتمی اطلاعات همراه با فایل PDF رو به من نشان بده.
مشکل من در قسمت آوردن فایل PDf و ذخیره کردن و نمایش اون تو جستجو .
اگه کسی از دوستان بلده مارو راهنمایی کنه ممنونم.
Microsoft Visual Basic 6.0

----------


## mehdi_7070

سلام
سورس کدی هست که وقتی کاربر "ي" یا "ك" عربی را تایپ می‌کنه به "ی" و "ک" فارسی تبدیل کنه؟

----------


## vahid_d_0101

شاید اگه شما chr ی فارسی و ک فارسی رو بدونید بشه یه کاری کرد.
CHR یه عدد هست که برای تمام حروف فرق داره من الان ببینم می تونم با این کد کاری کنم یا نه.

----------


## r_oscar2007

دوست عزیز اون chr نیست بلکه asc هستش که یک کاراکتر گرغته و کد اسکی آن را به ما میدهد

----------


## vahid_d_0101

من که کد اسکی رو نمیگم شما مثلا این دستورو بنویسید 
Private Sub Form_Load()
Text1.Text = Chr(70)
End Sub
میبینید که حرف F در text1 به نمایش در می اید که تمام حروف و علامت ها و هرچی که می شه تو کامپیوتر تایپ کنند یه عدد مخصوص به خودشو داره حتا حروف کوچیک و بزرگ

----------


## mehdi_7070

خوب این دو تا مقدار را پیدا کردم و با دستور Replace هم جایگزین کردم .
مشکل اینجاست که مثلا "برنامه نویس" را به "برنامه نوىس" تبدیل می‌کنه!!

----------


## aminkk

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

----------


## mehdi_7070

> اين مشكل ويندوز هستش.


نه ، مشکل ویندوز نیست . توی Replace کردن یک مشکلی وجود داره!

----------


## ab1234

از همه دوستان بخاطر همکاریشون ممنونم
من می خوام یه متن فارسی رو از طریق برنامه ای که با VB نوشتم ایمیل کنم...
متن فارسی تو خود برنامه مشکلی نداره. ولی وقتی ارسال میشه تو ایمیل به صورت ؟ در میاد
تو سایت هم جستجو کردم ولی چیزی پیدا نشد
لطفا منو راهنمایی کنید

----------


## r0ot$harp

*




 نوشته شده توسط ab1234


از همه دوستان بخاطر همکاریشون ممنونم
من می خوام یه متن فارسی رو از طریق برنامه ای که با VB نوشتم ایمیل کنم...
متن فارسی تو خود برنامه مشکلی نداره. ولی وقتی ارسال میشه تو ایمیل به صورت ؟ در میاد
تو سایت هم جستجو کردم ولی چیزی پیدا نشد
لطفا منو راهنمایی کنید



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




باتشکر احسان 
*

----------


## ab1234

> *شما باید از URL_Encode استفاده کنید . اگر چیزی پیدا نکردید بگید براتون یه نمونه بزارم .*
> 
> 
> 
> 
> *باتشکر احسان*


ممنون از راهنماییتون ولی من متوجه نشدم :خجالت: 
میشه بیشتر توضیح بدین؟؟
 این چی هست؟؟
چجوری کار میکنه؟؟

من یه *Encoding میشناسم اگه منظورتون اینه که تو محیط ایمیل راست کلیک کنم و Encode .... باید بگم با این هیچ تغییری نمی کنه*

----------


## r0ot$harp

> ممنون از راهنماییتون ولی من متوجه نشدم
> میشه بیشتر توضیح بدین؟؟
>  این چی هست؟؟
> چجوری کار میکنه؟؟
> 
> من یه *Encoding میشناسم اگه منظورتون اینه که تو محیط ایمیل راست کلیک کنم و Encode .... باید بگم با این هیچ تغییری نمی کنه*


*دوست عزیز وقتی شما یه مقداری رو به یه سرور می فرستین یا حتی سرور ها بین خودشون رد و بدل می کنند این رشته ها که ردوبدل می شن با استفاده از Url Encode کد می شن و بین هم فرستاده می شن . 


مثل فرستادن پیغام فارسی در Yahoo Messenger هست که باید حتما رشته قبل از فرستاده شدن به Utf-8 Encode تبدیل بشه و بعد فرستاده بشه و در نت و سرور ها هم باید با استفاده از Url Encode پیام ها رد و بدل بشه . 

در Header هایی که در پروتکل Http 1.1 نوشته می شوند یک مقدار هست که تنظیم کننده ی نوع اطلاعات ارسالی هست به نام : 

Content-Type: application/x-www-form-urlencoded


با استفاده از این خاصیت و مقدار شما به سرور اعلام می کنید که بسته های ارسالی شما به طرف سرور به وسیله Url Encode کد شده اند و اگر اینگونه نباشد هم خطا اعلام می کنه و در بعضی از موارد هم به جای حروف ؟؟؟؟ قرار می دهد .



باتشکر احسان*

----------


## ab1234

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

----------


## r0ot$harp

> متشکرم آقا احسان
> ولی من با متن انگلیسی هیچ مشکلی ندارم . یعنی انگلیسی نیاز به کد شدن نداره؟
> حالا چجوری باید متن رو کد کنم؟؟ اگه ممکنه بیشتر توضیح بدید چون این چیزی که شما می فرماید رو من تا حالا نشنیده بودم
> اگه یه نمونه هم بزارید که حسابی شرمندم کردید دیگه!!
> بازم ممنون


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

دوست عزیز کدهای زیر رو در داخل یه Module کپی کنید .


Option Compare Binary
 
Public sCodePage As Long

Public cnvUni2   As String

Public cnvUni    As String

Public Const CP_ACP = 0

Public Const CP_NONE = 0

Public Const CP_OEMCP = 1

Public Const CP_WINANSI = 1004

Public Const CP_WINUNICODE = 1200

Public Const MB_PRECOMPOSED = &H1

Public Const MB_COMPOSITE = &H2

Public Const MB_USEGLYPHCHARS = &H4

' //Arabic
Public Const CP_AWIN = 101

Public Const CP_709 = 102

Public Const CP_720 = 103

Public Const CP_A708 = 104

Public Const CP_A449 = 105

Public Const CP_TARB = 106

Public Const CP_NAE = 107

Public Const CP_V4 = 108

Public Const CP_MA2 = 109

Public Const CP_I864 = 110

Public Const CP_A437 = 111

Public Const CP_AMAC = 112

' //Hebrew
Public Const CP_HWIN = 201

Public Const CP_862I = 202

Public Const CP_7BIT = 203

Public Const CP_ISO = 204

Public Const CP_H437 = 205

Public Const CP_HMAC = 206

' /**************************************************  ***********************
'    Code Pages
' **************************************************  ***********************/
Public Const CP_OEM_437 = 437

Public Const CP_ARABICDOS = 708

Public Const CP_DOS720 = 720

Public Const CP_IBM850 = 850

Public Const CP_IBM852 = 852

Public Const CP_DOS862 = 862

Public Const CP_IBM866 = 866

Public Const CP_THAI = 874

Public Const CP_JAPAN = 932

Public Const CP_CHINA = 936

Public Const CP_KOREA = 949

Public Const CP_TAIWAN = 950

Public Const CP_EASTEUROPE = 1250

Public Const CP_RUSSIAN = 1251

Public Const CP_WESTEUROPE = 1252

Public Const CP_GREEK = 1253

Public Const CP_TURKISH = 1254

Public Const CP_HEBREW = 1255

Public Const CP_ARABIC = 1256

Public Const CP_BALTIC = 1257

Public Const CP_VIETNAMESE = 1258

Public Const CP_ASCII = 20127

Public Const CP_RUSSIANKOI8R = 20866

Public Const CP_RUSSIANKOI8U = 21866

Public Const CP_ISOLATIN1 = 28591

Public Const CP_ISOEASTEUROPE = 28592

Public Const CP_ISOTURKISH = 28593

Public Const CP_ISOBALTIC = 28594

Public Const CP_ISORUSSIAN = 28595

Public Const CP_ISOARABIC = 28596

Public Const CP_ISOGREEK = 28597

Public Const CP_ISOHEBREW = 28598

Public Const CP_ISOTURKISH2 = 28599

Public Const CP_ISOLATIN9 = 28605

Public Const CP_HEBREWLOG = 38598

Public Const CP_USER = 50000

Public Const CP_AUTOALL = 50001

Public Const CP_JAPANNHK = 50220

Public Const CP_JAPANESC = 50221

Public Const CP_JAPANSIO = 50222

Public Const CP_KOREAISO = 50225

Public Const CP_TAIWANISO = 50227

Public Const CP_CHINAISO = 50229

Public Const CP_AUTOJAPAN = 50932

Public Const CP_AUTOCHINA = 50936

Public Const CP_AUTOKOREA = 50949

Public Const CP_AUTOTAIWAN = 50950

Public Const CP_AUTORUSSIAN = 51251

Public Const CP_AUTOGREEK = 51253

Public Const CP_AUTOARABIC = 51256

Public Const CP_JAPANEUC = 51932

Public Const CP_CHINAEUC = 51936

Public Const CP_KOREAEUC = 51949

Public Const CP_TAIWANEUC = 51950

Public Const CP_CHINAHZ = 52936

Public Const CP_MAC_ROMAN = 10000

Public Const CP_MAC_JAPAN = 10001

Public Const CP_MAC_ARABIC = 10004

Public Const CP_MAC_GREEK = 10006

Public Const CP_MAC_CYRILLIC = 10007

Public Const CP_MAC_LATIN2 = 10029

Public Const CP_MAC_TURKISH = 10081

#If Mac Then

    Public Const CP_DEFAULT = CP_MACCP

#Else

    Public Const CP_DEFAULT = CP_ACP

#End If

Public Const CP_JOHAB = 1361

Public Const CP_SYMBOL = 42

Public Const CP_UTF8 = 65001

Public Const CP_UTF7 = 65000

Public Const CP_UNICODELITTLE = 1200

Public Const CP_UNICODEBIG = 1201

Public Const CP_UNKNOWN = -1

Public Const MB_ERR_INVALID_CHARS = &H8

Public Const WC_DEFAULTCHECK = &H100

Public Const WC_COMPOSITECHECK = &H200

Public Const WC_DISCARDNS = &H10

Public Const WC_SEPCHARS = &H20

Public Const WC_DEFAULTCHAR = &H40

Private Type FONTSIGNATURE

    fsUsb(4) As Long
    fsCsb(2) As Long

End Type

Private Type CHARSETINFO

    ciCharset As Long
    ciACP As Long
    fs As FONTSIGNATURE

End Type

Private Const LOCALE_IDEFAULTCODEPAGE = &HB

Private Const LOCALE_IDEFAULTANSICODEPAGE = &H1004

Private Const TCI_SRCCODEPAGE = 2

Private Declare Function GetACP Lib "Kernel32" () As Long

Private Declare Function GetLocaleInfoA _
                Lib "Kernel32" (ByVal Locale As Long, _
                                ByVal LCType As Long, _
                                ByVal lpLCData As String, _
                                ByVal cchData As Long) As Long

Private Declare Function GetSystemDefaultLCID Lib "Kernel32" () As Long

Private Declare Function IsWindowUnicode Lib "user32" (ByVal hwnd As Long) As Long

Private Declare Function TranslateCharsetInfo _
                Lib "gdi32" (lpSrc As Long, _
                             lpcs As CHARSETINFO, _
                             ByVal dwFlags As Long) As Long
 
Private Declare Function MultiByteToWideChar _
                Lib "Kernel32" (ByVal CodePage As Long, _
                                ByVal dwFlags As Long, _
                                ByVal lpMultiByteStr As Long, _
                                ByVal cchMultiByte As Long, _
                                ByVal lpWideCharStr As Long, _
                                ByVal cchWideChar As Long) As Long

Private Declare Function WideCharToMultiByte _
                Lib "Kernel32" (ByVal CodePage As Long, _
                                ByVal dwFlags As Long, _
                                ByVal lpWideCharStr As Long, _
                                ByVal cchWideChar As Long, _
                                ByVal lpMultiByteStr As Long, _
                                ByVal cchMultiByte As Long, _
                                ByVal lpDefaultChar As Long, _
                                lpUsedDefaultChar As Long) As Long
 
'Private Declare Function MsoCpgFromLid Lib "c:\program files\Microsoft Office 9\office\mso9.dll" Alias "#307" (ByVal lid As Long) As Long
'Private Declare Function MsoCpgFromLid Lib "c:\program files\Microsoft Office 8\office\mso97.dll" Alias "#307" (ByVal lid As Long) As Long
Private Declare Function MsoCpgFromLid _
                Lib "c:\program files\common files\microsoft shared\vba\mso97rt.dll" _
                Alias "#307" (ByVal lid As Long) As Long

'Private Declare Function MsoMultiByteToWideChar Lib "c:\program files\Microsoft Office 9\office\mso9.dll" Alias "#778" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
'Private Declare Function MsoMultiByteToWideChar Lib "c:\program files\Microsoft Office 8\office\mso97.dll" Alias "#778" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Declare Function MsoMultiByteToWideChar _
                Lib "c:\program files\common files\microsoft shared\vba\mso97rt.dll" _
                Alias "#778" (ByVal CodePage As Long, _
                              ByVal dwFlags As Long, _
                              ByVal lpMultiByteStr As Long, _
                              ByVal cchMultiByte As Long, _
                              ByVal lpWideCharStr As Long, _
                              ByVal cchWideChar As Long) As Long

'Private Declare Function MsoWideCharToMultiByte Lib "c:\program files\Microsoft Office 9\office\mso9.dll" Alias "#915" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long
'Private Declare Function MsoWideCharToMultiByte Lib "c:\program files\Microsoft Office 8\office\mso97.dll" Alias "#915" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpDefaultChar As Long, lpUsedDefaultChar As Long) As Long
Private Declare Function MsoWideCharToMultiByte _
                Lib "c:\program files\common files\microsoft shared\vba\mso97rt.dll" _
                Alias "#915" (ByVal CodePage As Long, _
                              ByVal dwFlags As Long, _
                              ByVal lpWideCharStr As Long, _
                              ByVal cchWideChar As Long, _
                              ByVal lpMultiByteStr As Long, _
                              ByVal cchMultiByte As Long, _
                              ByVal lpDefaultChar As Long, _
                              lpUsedDefaultChar As Long) As Long
 
'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Project1
' Procedure  :       ChsFromLocaleEx
' Description:       [type_description_here]
' Created by :       Project Administrator
' Machine    :       EHSAN-AD91DAD44
' Date-Time  :       9/17/2008-16:31:09
'
' Parameters :       lcid (Long)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function ChsFromLocaleEx(lcid As Long) As Long
    ChsFromLocaleEx = MsoCpgFromLid(lcid)
End Function

'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Project1
' Procedure  :       AToW
' Description:       [type_description_here]
' Created by :       Project Administrator
' Machine    :       EHSAN-AD91DAD44
' Date-Time  :       9/17/2008-16:31:09
'
' Parameters :       st (String)
'                    cpg (Long = -1)
'                    lFlags (Long = 0)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function AToW(ByVal st As String, _
                     Optional ByVal cpg As Long = -1, _
                     Optional lFlags As Long = 0) As String

    Dim stBuffer  As String

    Dim cwch      As Long

    Dim pwz       As Long

    Dim pwzBuffer As Long
        
    If cpg = -1 Then cpg = GetACP()
    pwz = StrPtr(st)
    cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, 0&, 0&)
    stBuffer = String$(cwch + 1, vbNullChar)
    pwzBuffer = StrPtr(stBuffer)
    cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer))
    AToW = Left$(stBuffer, cwch - 1)
End Function
 
'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Project1
' Procedure  :       AToWEx
' Description:       [type_description_here]
' Created by :       Project Administrator
' Machine    :       EHSAN-AD91DAD44
' Date-Time  :       9/17/2008-16:31:09
'
' Parameters :       st (String)
'                    lcid (Long = -1)
'                    lFlags (Long = 0)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function AToWEx(ByVal st As String, _
                       Optional ByVal lcid As Long = -1, _
                       Optional lFlags As Long = 0) As String

    Dim cpg               As Long

    Dim lpUsedDefaultChar As Long
 
    If lcid = -1 Then lcid = GetSystemDefaultLCID()
    cpg = ChsFromLocaleEx(lcid)

    AToWEx = AToW(st, cpg, lFlags)
End Function
 
'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Project1
' Procedure  :       WToA
' Description:       [type_description_here]
' Created by :       Project Administrator
' Machine    :       EHSAN-AD91DAD44
' Date-Time  :       9/17/2008-16:31:08
'
' Parameters :       st (String)
'                    cpg (Long = -1)
'                    lFlags (Long = 0)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function WToA(ByVal st As String, _
                     Optional ByVal cpg As Long = -1, _
                     Optional lFlags As Long = 0) As String

    Dim stBuffer          As String

    Dim cwch              As Long

    Dim pwz               As Long

    Dim pwzBuffer         As Long

    Dim lpUsedDefaultChar As Long
    
    If cpg = -1 Then cpg = GetACP()
    pwz = StrPtr(st)
    cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)
    stBuffer = String$(cwch + 1, vbNullChar)
    pwzBuffer = StrPtr(stBuffer)
    cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer), ByVal 0&, ByVal 0&)
    WToA = Left$(stBuffer, cwch - 1)
End Function
 
'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Project1
' Procedure  :       WToAEx
' Description:       [type_description_here]
' Created by :       Project Administrator
' Machine    :       EHSAN-AD91DAD44
' Date-Time  :       9/17/2008-16:31:08
'
' Parameters :       st (String)
'                    lcid (Long = -1)
'                    lFlags (Long = 0)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function WToAEx(ByVal st As String, _
                       Optional ByVal lcid As Long = -1, _
                       Optional lFlags As Long = 0) As String

    Dim cpg               As Long

    Dim lpUsedDefaultChar As Long
 
    If lcid = -1 Then lcid = GetSystemDefaultLCID()
    cpg = ChsFromLocaleEx(lcid)

    WToAEx = WToA(st, cpg, lFlags)
End Function
 
'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Project1
' Procedure  :       FStringInCpg
' Description:       [type_description_here]
' Created by :       Project Administrator
' Machine    :       EHSAN-AD91DAD44
' Date-Time  :       9/17/2008-16:31:08
'
' Parameters :       st (String)
'                    cpg (Long = -1)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function FStringInCpg(ByVal st As String, _
                             Optional ByVal cpg As Long = -1) As Boolean

    Dim cwch              As Long

    Dim lpUsedDefaultChar As Long
   
    If cpg = -1 Then cpg = GetACP()
 
    cwch = MsoWideCharToMultiByte(cpg, 0&, StrPtr(st), -1, 0&, 0&, ByVal 0&, lpUsedDefaultChar)
    FStringInCpg = (CBool(lpUsedDefaultChar) = False)
End Function
 
'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Project1
' Procedure  :       FStringInCpgEx
' Description:       [type_description_here]
' Created by :       Project Administrator
' Machine    :       EHSAN-AD91DAD44
' Date-Time  :       9/17/2008-16:31:08
'
' Parameters :       st (String)
'                    lcid (Long = -1)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function FStringInCpgEx(ByVal st As String, _
                               Optional ByVal lcid As Long = -1) As Boolean

    Dim cwch              As Long

    Dim cpg               As Long

    Dim lpUsedDefaultChar As Long
   
    If lcid = -1 Then lcid = GetSystemDefaultLCID()
    cpg = ChsFromLocaleEx(lcid)
    
    FStringInCpgEx = FStringInCpg(st, cpg)
End Function
 
'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Project1
' Procedure  :       ChsFromLocale
' Description:       [type_description_here]
' Created by :       Project Administrator
' Machine    :       EHSAN-AD91DAD44
' Date-Time  :       9/17/2008-16:31:08
'
' Parameters :       lcid (Long)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function ChsFromLocale(lcid As Long) As Long

    Dim cwc      As Long

    Dim cpg      As Long

    Dim stBuffer As String

    Dim cs       As CHARSETINFO
    
    stBuffer = String$(10, vbNullChar)
    cwc = GetLocaleInfoA(lcid, LOCALE_IDEFAULTANSICODEPAGE, stBuffer, Len(stBuffer))

    If cwc > 0 Then
        cpg = Val(Left$(stBuffer, cwc - 1))
        
        If TranslateCharsetInfo(ByVal cpg, cs, TCI_SRCCODEPAGE) Then
            ChsFromLocale = cs.ciCharset
        End If
    End If

End Function
 
'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Project1
' Procedure  :       DecodeUTF8
' Description:       [type_description_here]
' Created by :       Project Administrator
' Machine    :       EHSAN-AD91DAD44
' Date-Time  :       9/17/2008-16:31:08
'
' Parameters :       cnvUni (String)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function DecodeUTF8(ByVal cnvUni As String)

    If cnvUni = vbNullString Then Exit Function
    cnvUni2 = WToA(cnvUni, CP_ACP)
    DecodeUTF8 = AToW(cnvUni2, CP_UTF8)
End Function

'<CSCM>
'--------------------------------------------------------------------------------
' Project    :       Project1
' Procedure  :       UTF8_Encode
' Description:       [type_description_here]
' Created by :       Project Administrator
' Machine    :       EHSAN-AD91DAD44
' Date-Time  :       9/17/2008-16:31:08
'
' Parameters :       sStr (String)
'--------------------------------------------------------------------------------
'</CSCM>
Public Function UTF8_Encode(ByVal sStr As String)

    For l& = 1 To Len(sStr)
        lChar& = AscW(Mid(sStr, l&, 1))

        If lChar& < 128 Then
            sUtf8$ = sUtf8$ + Mid(sStr, l&, 1)
        ElseIf ((lChar& > 127) And (lChar& < 2048)) Then
            sUtf8$ = sUtf8$ + Chr(((lChar& \ 64) Or 192))
            sUtf8$ = sUtf8$ + Chr(((lChar& And 63) Or 128))
        Else
            sUtf8$ = sUtf8$ + Chr(((lChar& \ 144) Or 234))
            sUtf8$ = sUtf8$ + Chr((((lChar& \ 64) And 63) Or 128))
            sUtf8$ = sUtf8$ + Chr(((lChar& And 63) Or 128))
        End If

    Next l&

    UTF8_Encode = sUtf8$
End Function


و این خط هم برای کد کردن و طرز استفاده از این Module :

*
MsgBox UTF8_Encode("احسان تو دنیا همیشه هست")

*


باتشکر احسان

----------


## ab1234

بازم جواب نگرفتم :ناراحت: 

ببینید یه برنامه ارسال ایمیل ساده رو در نظر بگیرید که از یه SMTP مثل Gmail ایمیل میفرسته
من می خوام متن ایمیلم فارسی باشه
اون کدی رو که دادین تو یه ماژول کپی کردم ولی بازم وقتی ایملی میفرسته متن فارسیش به صورت ؟ و یه سری حروف غیر قابل خوندن در میاد.(اول به UTF8 تبدیلش کردم و بعد ارسال) 
به نظر شما اشکال از کجاس؟؟?

متشکرم

----------


## ab1234

واقا کسی نمی تونه به من کمک کنه!!!؟؟؟ :گریه: 
ببینید من می خوام به یه برنامه مثل این
ایمیل بفرستم ولی متنش فارسی باشه

لطفا راهنمایی کنید
ممنون میشم

----------


## sunyniazi

> *تبدیل صفحه کلید به فارسی در ویژوال بیسیک 6*
> 
> 
> ابتدا تابع زیر را تعریف کنید :
> Public Declare Function LoadKeyboardLayout Lib "user32" Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal flags As Long) As Longویندوز پارسا 99 ، اکس پی و 2000 که فارسی نصب شده باشد :
>  Dim xx As Long
> xx = LoadKeyboardLayout("00000429", 1)ویندوز پارسا 2001 و امثال آن :
> Dim xx As Long
> xx = LoadKeyboardLayout("00000401", 1)کد 401 برای عربی عربستان است که در ویندوز پارسا 2001 به جای فارسی به کار می رود .


 

با تشكر  از دوست عزيز 
در ضمن اين لينك تمامي كدهاي زبانها رو نوشته  
خيلي به درد من خورد گفتم شايد به درد كسي بخوره  :چشمک:  
http://www.microsoft.com/globaldev/r...etup/lcid.mspx

----------

