View Full Version : مرجع حل مشکلات زبان فارسی و سورسهای مربوطه
M-Gheibi
یک شنبه 06 دی 1383, 23:18 عصر
با سلام خدمت همه برنامه نویسان عزیز
در این تاپیک راه حل های خود را جهت نمایش صحیح حروف فارسی٬ تایپ فارسی بدون نیاز به ویندوز فارسی٬ استفاده از تاریخ شمسی٬ راست چین کردن نوشته ها در برنامه ها و سایر مطالب مربوط به زبان فارسی در 6 VB را بنویسید (مشابه کاری که در بخش Dot Net صورت گرفته است).
در صورتی که قبلا در تاپیکی در یکی از زمینه های فوق به نتیجه رسیده اید و یا مطلبی هرچند ساده و مشخص در این مورد مشاهده کرده اید٬ مطالب صحیح و بکار رفته در آن تاپیک را با ذکر نام شخص راهنمایی کننده در اینجا بنویسید.
این کار علاوه بر اینکه باعث نظم بیشتر در بخش می شود٬ این تاپیک را به مرجعی برای حل مشکلات زبان فارسی در 6 VB مبدل ساخته٬ از ایجاد تاپیکهای تکراری جلوگیری می کند.
M-Gheibi
یک شنبه 06 دی 1383, 23:23 عصر
فعال نمودن امکان تایپ فارسی در ویندوز 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 کلیک بزنید .
http://www.irinfotech.com/Up-Images/VB-Persian-01.png
6. به برگه‌ی Advanced بروید و در لیست انتخاب زبان٬ زبان Farsi را انتخاب نمایید .
http://www.irinfotech.com/Up-Images/VB-Persian-02.png
7. سپس به برگه‌ی Regional Options بازگردید و در لیست انتخاب زبان ٬ Farsi را انتخاب کنید .
8. در لیست پایینی ٬ کشور Iran را انتخاب کنید .
9. در آخر دکمه Apply و سپس OK را کلیک نمایید .
http://www.irinfotech.com/Up-Images/VB-Persian-03.png
M-Gheibi
یک شنبه 06 دی 1383, 23:25 عصر
برای استفاده از امکان Right to Left در برنامه ها فایل VBAME.DLL موجود در پوشه سیستم را به همراه برنامه خود قرار دهید.
M-Gheibi
یک شنبه 06 دی 1383, 23:30 عصر
تبدیل صفحه کلید به فارسی در ویژوال بیسیک 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
دوشنبه 07 دی 1383, 15:08 عصر
کد زیر برای تبدیل مقدار عددی به حروف است .
به این نکته دقت داشته باشید که حداکثر مقدار قابل قبول برای این تابع 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 <> 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 <> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
If (SS <> 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(SS)
If (SS <> 0 And hh <> 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 <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun
If (SS = 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
If (SS <> 0 And hh <> 0 And mm <> 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 < 20 Then
If (sadgan = 0) Then behooroof = heji(dahgan)
If (sadgan <> 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 <> 0) Then behooroof = heji_dahgan(dahgan / 10) + va + heji(yekan)
If (sadgan <> 0 And yekan = 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10)
If (sadgan <> 0 And yekan <> 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
دوشنبه 07 دی 1383, 15:13 عصر
کد زیر را در ماژول قرار دهید :
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 "&": 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)) < 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)) < 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 <> 0 Then
Text_Object.SelStart = Text_Object.SelStart - 1
End If
If Len(Text_Object) = 1 Then
If Asc(Left(Text_Object, 1)) < 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 < 91 And KeyAscii > 64 Then KeyAscii = KeyAscii + 32
End Sub
برای استفاده از برنامه فوق به فونت با کدپیج ایران سیستم نیاز دارید که در فایل ضمیمه چندتا از اونها رو برای دانلود گذاشتم .
M-Gheibi
دوشنبه 07 دی 1383, 15:27 عصر
همانطور که در تصویر مشاهده می کنید این کنترل یک تقویم شمسی در Combobox باز می کند که با کلیک روی هر روز آن تاریخ آن روز را به شما می دهد.
<p align="center">http://hostedpictures.com/uploads/141068f706.gif</p>
کاری از محمد تاجیک
M-Gheibi
دوشنبه 07 دی 1383, 15:47 عصر
با استفاده از برنامه نومنه زیر که نوشته شده توسط جناب نصیری هست٬ می تونید در ویندوزهای با قابلیت تایپ فارسی بدون تغییر زبان به تایپ فارسی بپردازید. مطابق تصویر زیر:
<p align="center">http://hostedpictures.com/uploads/a630a058b5.gif</p>
M-Gheibi
دوشنبه 07 دی 1383, 16:00 عصر
با استفاده از نمونه کد زیر می تونید کنترلی تهیه کنید که با کدپیج ایران سیستم تایپ فارسی انجام می دهد.
<p align="center">
http://hostedpictures.com/uploads/f3dca56565.gif</p>
برنامه نویس : سید مسعود مازار
vbprogramer
دوشنبه 07 دی 1383, 16:32 عصر
کد زیر برای تبدیل مقدار عددی به حروف است.
به این نکته دقت داشته باشید که حداکثر مقدار قابل قبول برای این تابع 999,999,999,999 (نهصد و نود و نه میلیارد و نهصد و نود و نه میلیون و نهصد و نود نه هزار و نهصد و نود و نه) می باشد.
تابع زیر نوشته جناب آقای بابک بخشایش هست.
سلام آقا مسعود
دست شما درد نکنه خیلی نکات جالبی هستن
ولی راجع به این کدی که گذاشتین می خواستم ببینم که آیا کدی با تبدیل اعشار (تا دو رقم) رو هم شما یا کسی از دوستان دارن یا نه چون من بهش احتیاج داشتم
یعنی مثلا 10.5 رو بنویسه ده و نیم
ممنون از شما و همه دوستان :oops:
:thnx:
بابک زواری
دوشنبه 07 دی 1383, 17:40 عصر
کد زیر هم برای تقویم درست شده هرچند ممکنه که بطور بهینه کار نشده باشه
امامطمئن باشید که درست کار میکنه چند جایی که از اون استفاده میشه عبارتند از
معاونت مهندسی شهرداری ؛ بیمه آسیا ؛ بیمه دانا و چند شرکت بزرگ و معتبر که
مسائل تقویمی رو با این کدها حل و فصل کردن
Public Function Fa_Day(En_Date As String) As String
Select Case Weekday(En_Date)
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(En_Date As String) 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(Mid(En_Date, 7, 4))
The_Month = CInt(Mid(En_Date, 1, 2))
The_Day = CInt(Mid(En_Date, 4, 2))
If (The_Year Mod 4 = 0) Then
The_Select = 1
Else
The_Select = 2
End If
If ((The_Year - 1) Mod 4 = 0) Then
The_Select = 3
End If
If The_Select = 1 Then
'------------------------------------------------------
Select Case The_Month
Case 1: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 10
The_Month = 10
The_Year = The_Year - 622
Case 21 To 31: The_Day = The_Day - 20
The_Month = 11
The_Year = The_Year - 622
End Select
Case 2: Select Case The_Day
Case 1 To 19: The_Day = The_Day + 11
The_Month = 11
The_Year = The_Year - 622
Case 20 To 29: The_Day = The_Day - 19
The_Month = 12
The_Year = The_Year - 622
End Select
Case 3: Select Case The_Day
Case 1 To 19: The_Day = The_Day + 10
The_Month = 12
The_Year = The_Year - 622
Case 20 To 31: The_Day = The_Day - 19
The_Month = 1
The_Year = The_Year - 621
End Select
Case 4: Select Case The_Day
Case 1 To 19: The_Day = The_Day + 12
The_Month = 1
The_Year = The_Year - 621
Case 20 To 30: The_Day = The_Day - 19
The_Month = 2
The_Year = The_Year - 621
End Select
Case 5: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 11
The_Month = 2
The_Year = The_Year - 621
Case 21 To 31: The_Day = The_Day - 20
The_Month = 3
The_Year = The_Year - 621
End Select
Case 6: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 11
The_Month = 3
The_Year = The_Year - 621
Case 21 To 30: The_Day = The_Day - 20
The_Month = 4
The_Year = The_Year - 621
End Select
Case 7: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 4
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 5
The_Year = The_Year - 621
End Select
Case 8: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 5
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 6
The_Year = The_Year - 621
End Select
Case 9: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 6
The_Year = The_Year - 621
Case 22 To 30: The_Day = The_Day - 21
The_Month = 7
The_Year = The_Year - 621
End Select
Case 10: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 9
The_Month = 7
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 8
The_Year = The_Year - 621
End Select
Case 11: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 10
The_Month = 8
The_Year = The_Year - 621
Case 21 To 30: The_Day = The_Day - 20
The_Month = 9
The_Year = The_Year - 621
End Select
Case 12: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 10
The_Month = 9
The_Year = The_Year - 621
Case 21 To 31: 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: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 10
The_Month = 10
The_Year = The_Year - 622
Case 21 To 31: The_Day = The_Day - 20
The_Month = 11
The_Year = The_Year - 622
End Select
Case 2: Select Case The_Day
Case 1 To 19: The_Day = The_Day + 11
The_Month = 11
The_Year = The_Year - 622
Case 19 To 28: The_Day = The_Day - 19
The_Month = 12
The_Year = The_Year - 622
End Select
Case 3: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 9
The_Month = 12
The_Year = The_Year - 622
Case 21 To 31: The_Day = The_Day - 20
The_Month = 1
The_Year = The_Year - 621
End Select
Case 4: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 11
The_Month = 1
The_Year = The_Year - 621
Case 21 To 30: The_Day = The_Day - 20
The_Month = 2
The_Year = The_Year - 621
End Select
Case 5: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 2
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 3
The_Year = The_Year - 621
End Select
Case 6: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 3
The_Year = The_Year - 621
Case 22 To 30: The_Day = The_Day - 21
The_Month = 4
The_Year = The_Year - 621
End Select
Case 7: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 4
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 5
The_Year = The_Year - 621
End Select
Case 8: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 5
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 6
The_Year = The_Year - 621
End Select
Case 9: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 6
The_Year = The_Year - 621
Case 23 To 30: The_Day = The_Day - 22
The_Month = 7
The_Year = The_Year - 621
End Select
Case 10: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 8
The_Month = 7
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 8
The_Year = The_Year - 621
End Select
Case 11: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 9
The_Month = 8
The_Year = The_Year - 621
Case 22 To 30: The_Day = The_Day - 21
The_Month = 9
The_Year = The_Year - 621
End Select
Case 12: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 9
The_Month = 9
The_Year = The_Year - 621
Case 22 To 31: 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: Select Case The_Day
Case 1 To 19: The_Day = The_Day + 11
The_Month = 10
The_Year = The_Year - 622
Case 20 To 31: The_Day = The_Day - 19
The_Month = 11
The_Year = The_Year - 622
End Select
Case 2: Select Case The_Day
Case 1 To 18: The_Day = The_Day + 12
The_Month = 11
The_Year = The_Year - 622
Case 19 To 28: The_Day = The_Day - 18
The_Month = 12
The_Year = The_Year - 622
End Select
Case 3: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 10
The_Month = 12
The_Year = The_Year - 622
Case 21 To 31: The_Day = The_Day - 20
The_Month = 1
The_Year = The_Year - 621
End Select
Case 4: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 11
The_Month = 1
The_Year = The_Year - 621
Case 21 To 30: The_Day = The_Day - 20
The_Month = 2
The_Year = The_Year - 621
End Select
Case 5: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 2
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 3
The_Year = The_Year - 621
End Select
Case 6: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 3
The_Year = The_Year - 621
Case 22 To 30: The_Day = The_Day - 21
The_Month = 4
The_Year = The_Year - 621
End Select
Case 7: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 4
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 5
The_Year = The_Year - 621
End Select
Case 8: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 5
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 6
The_Year = The_Year - 621
End Select
Case 9: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 6
The_Year = The_Year - 621
Case 23 To 30: The_Day = The_Day - 22
The_Month = 7
The_Year = The_Year - 621
End Select
Case 10: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 8
The_Month = 7
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 8
The_Year = The_Year - 621
End Select
Case 11: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 9
The_Month = 8
The_Year = The_Year - 621
Case 22 To 30: The_Day = The_Day - 21
The_Month = 9
The_Year = The_Year - 621
End Select
Case 12: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 9
The_Month = 9
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 10
The_Year = The_Year - 621
End Select
End Select
'------------------------------------------------------
End If
Fa_Date = Format(CStr(The_Year), "0000") & "/" & _
Format(CStr(The_Month), "00") & "/" & _
Format(CStr(The_Day), "00")
End Function
Public Function En_Date(Fa_Date As String) As String
Dim The_Year As Integer
Dim The_Month As Integer
Dim The_Day As Integer
The_Year = CInt(Mid(Fa_Date, 1, 4))
The_Month = CInt(Mid(Fa_Date, 6, 2))
The_Day = CInt(Mid(Fa_Date, 9, 2))
Dim The_Select As Integer
The_Select = The_Year Mod 4
'------------------------------------------------------------------------------------------------------------------------
If The_Select = 0 Then 'Like : 1360, 1364, 1368, 1372, 1376, 1380, 1384, ...
Select Case The_Month
Case 1: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 3
The_Year = The_Year + 621
Case 12 To 31: The_Day = The_Day - 11
The_Month = 4
The_Year = The_Year + 621
End Select
Case 2: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 20
The_Month = 4
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 5
The_Year = The_Year + 621
End Select
Case 3: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 5
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 6
The_Year = The_Year + 621
End Select
Case 4: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 6
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 7
The_Year = The_Year + 621
End Select
Case 5: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 7
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 8
The_Year = The_Year + 621
End Select
Case 6: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 8
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 9
The_Year = The_Year + 621
End Select
Case 7: Select Case The_Day
Case 1 To 8: The_Day = The_Day + 22
The_Month = 9
The_Year = The_Year + 621
Case 9 To 30: The_Day = The_Day - 8
The_Month = 10
The_Year = The_Year + 621
End Select
Case 8: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 10
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 11
The_Year = The_Year + 621
End Select
Case 9: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 11
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 12
The_Year = The_Year + 621
End Select
Case 10: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 12
The_Year = The_Year + 621
Case 11 To 30: The_Day = The_Day - 10
The_Month = 1
The_Year = The_Year + 622
End Select
Case 11: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 1
The_Year = The_Year + 622
Case 12 To 30: The_Day = The_Day - 11
The_Month = 2
The_Year = The_Year + 622
End Select
Case 12: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 19
The_Month = 2
The_Year = The_Year + 622
Case 10 To 30: 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 : 1361, 1365, 1369, 1373, 1377, 1381, 1385, ...
Select Case The_Month
Case 1: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 3
The_Year = The_Year + 621
Case 12 To 31: The_Day = The_Day - 11
The_Month = 4
The_Year = The_Year + 621
End Select
Case 2: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 20
The_Month = 4
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 5
The_Year = The_Year + 621
End Select
Case 3: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 22
The_Month = 5
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 6
The_Year = The_Year + 621
End Select
Case 4: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 6
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 7
The_Year = The_Year + 621
End Select
Case 5: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 7
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 8
The_Year = The_Year + 621
End Select
Case 6: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 8
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 9
The_Year = The_Year + 621
End Select
Case 7: Select Case The_Day
Case 1 To 8: The_Day = The_Day + 22
The_Month = 9
The_Year = The_Year + 621
Case 9 To 30: The_Day = The_Day - 8
The_Month = 10
The_Year = The_Year + 621
End Select
Case 8: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 10
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 11
The_Year = The_Year + 621
End Select
Case 9: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 11
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 12
The_Year = The_Year + 621
End Select
Case 10: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 12
The_Year = The_Year + 621
Case 11 To 30: The_Day = The_Day - 10
The_Month = 1
The_Year = The_Year + 622
End Select
Case 11: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 1
The_Year = The_Year + 622
Case 12 To 30: The_Day = The_Day - 11
The_Month = 2
The_Year = The_Year + 622
End Select
Case 12: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 19
The_Month = 2
The_Year = The_Year + 622
Case 10 To 30: 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 : 1362, 1366, 1370, 1374, 1378, 1382, 1386, ...
Select Case The_Month
Case 1: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 3
The_Year = The_Year + 621
Case 12 To 31: The_Day = The_Day - 11
The_Month = 4
The_Year = The_Year + 621
End Select
Case 2: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 20
The_Month = 4
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 5
The_Year = The_Year + 621
End Select
Case 3: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 5
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 6
The_Year = The_Year + 621
End Select
Case 4: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 6
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 7
The_Year = The_Year + 621
End Select
Case 5: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 7
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 8
The_Year = The_Year + 621
End Select
Case 6: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 8
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 9
The_Year = The_Year + 621
End Select
Case 7: Select Case The_Day
Case 1 To 8: The_Day = The_Day + 22
The_Month = 9
The_Year = The_Year + 621
Case 9 To 30: The_Day = The_Day - 8
The_Month = 10
The_Year = The_Year + 621
End Select
Case 8: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 10
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 11
The_Year = The_Year + 621
End Select
Case 9: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 11
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 12
The_Year = The_Year + 621
End Select
Case 10: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 12
The_Year = The_Year + 621
Case 11 To 30: The_Day = The_Day - 10
The_Month = 1
The_Year = The_Year + 622
End Select
Case 11: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 1
The_Year = The_Year + 622
Case 12 To 30: The_Day = The_Day - 11
The_Month = 2
The_Year = The_Year + 622
End Select
Case 12: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 19
The_Month = 2
The_Year = The_Year + 622
Case 11 To 30: 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 : 1363, 1367, 1371, 1375, 1379, 1383, 1387, ...
Select Case The_Month
Case 1: Select Case The_Day
Case 1 To 12: The_Day = The_Day + 19
The_Month = 3
The_Year = The_Year + 621
Case 13 To 31: The_Day = The_Day - 12
The_Month = 4
The_Year = The_Year + 621
End Select
Case 2: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 19
The_Month = 4
The_Year = The_Year + 621
Case 12 To 31: The_Day = The_Day - 11
The_Month = 5
The_Year = The_Year + 621
End Select
Case 3: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 5
The_Year = The_Year + 621
Case 12 To 31: The_Day = The_Day - 11
The_Month = 6
The_Year = The_Year + 621
End Select
Case 4: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 20
The_Month = 6
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 7
The_Year = The_Year + 621
End Select
Case 5: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 7
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 8
The_Year = The_Year + 621
End Select
Case 6: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 8
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 9
The_Year = The_Year + 621
End Select
Case 7: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 9
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 10
The_Year = The_Year + 621
End Select
Case 8: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 10
The_Year = The_Year + 621
Case 11 To 30: The_Day = The_Day - 10
The_Month = 11
The_Year = The_Year + 621
End Select
Case 9: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 20
The_Month = 11
The_Year = The_Year + 621
Case 11 To 30: The_Day = The_Day - 10
The_Month = 12
The_Year = The_Year + 621
End Select
Case 10: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 12
The_Year = The_Year + 621
Case 12 To 30: The_Day = The_Day - 11
The_Month = 1
The_Year = The_Year + 622
End Select
Case 11: Select Case The_Day
Case 1 To 12: The_Day = The_Day + 19
The_Month = 1
The_Year = The_Year + 622
Case 13 To 30: The_Day = The_Day - 12
The_Month = 2
The_Year = The_Year + 622
End Select
Case 12: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 18
The_Month = 2
The_Year = The_Year + 622
Case 11 To 30: The_Day = The_Day - 10
The_Month = 3
The_Year = The_Year + 622
End Select
End Select
End If
'------------------------------------------------------------------------------------------------------------------------
En_Date = Format(CStr(The_Month), "00") & "/" & _
Format(CStr(The_Day), "00") & "/" & _
Format(CStr(The_Year), "0000")
End Function
بابک زواری
دوشنبه 07 دی 1383, 17:51 عصر
فونت فارسی tahoma با این تفاوت که نمایش اعداد هم به شکل فارسی است
vbprogramer
دوشنبه 07 دی 1383, 20:06 عصر
ممنون بابک جان :flower:
عالی بود :thnx:
مخصوصاْ فونت
M-Gheibi
سه شنبه 08 دی 1383, 15:15 عصر
با سلام خدمت همه دوستان مخصوصا جناب کد نویس که به من در این تاپیک کمک می کنند. بقیه که ...
خب بگذریم
آقای VBProgrammer من دفعه پیش که پست شما رو دیدم (اعشاری) فکر کردم تنها کد تبدیل اعشاری رو می خواید واسه همین فقط همون رو نوشتم. البته خودتون می تونید این کد را با کد قبلی با هم استفاده کنید و به نتیجه ای که می خواید برسید. اگه نتونستید همینجا بگید. :) :wink:
Option Explicit
Private Const dahom = "دهم"
Private Const sadom = "صدم"
Private Function Meghdar(Addad)
Dim ziredah(9) As String
Dim dahtabist(19) As String
Dim dahi(9) As String
Dim Dot, Ashar, Yekan, Dahgan
ziredah(1) = "یک": ziredah(2) = "دو": ziredah(3) = "سه": ziredah(4) = "چهار": ziredah(5) = "پنج"
ziredah(6) = "شش": ziredah(7) = "هفت": ziredah(8) = "هشت": ziredah(9) = "نه"
dahtabist(11) = "یازده": dahtabist(12) = "دوازده": dahtabist(13) = "سیزده": dahtabist(14) = "چهارده": dahtabist(15) = "پانزده"
dahtabist(16) = "شانزده": dahtabist(17) = "هفده": dahtabist(18) = "هیجده": dahtabist(19) = "نوزده"
dahi(2) = "بیست": dahi(3) = "سی": dahi(4) = "چهل": dahi(5) = "پنجاه"
dahi(6) = "شصت": dahi(7) = "هفتاد": dahi(8) = "هشتاد": dahi(9) = "نود"
Dot = InStr(1, Addad, ".", vbTextCompare)
If Dot <> 0 Then
Ashar = Mid(Addad, Dot + 1, 2)
Select Case Len(Ashar)
Case Is = 2
If Mid(Ashar, 1, 1) = 0 And Mid(Ashar, 2, 2) <> 0 Then Meghdar = ziredah(Mid(Ashar, 2, 2)) & " " & sadom
If Ashar Mod 10 = 0 And Mid(Ashar, 2, 2) = 0 Then Meghdar = ziredah(Mid(Ashar, 1, 1)) & " " & dahom
If Ashar Mod 10 <> 0 And Mid(Ashar, 1, 1) <> 0 Then Meghdar = dahi(Mid(Ashar, 1, 1)) & " &aelig; " & ziredah(Mid(Ashar, 2, 2)) & " " & sadom
If Mid(Ashar, 1, 1) = 0 And Mid(Ashar, 2, 2) = 0 Then Meghdar = "بدون اعشار"
If Ashar > 10 And Ashar < 20 Then Meghdar = dahtabist(Ashar) & " " & sadom
Case Is = 1
If Mid(Ashar, 1, 1) = 0 Then Meghdar = "بدون اعشار"
If Mid(Ashar, 1, 1) <> 0 Then Meghdar = ziredah(Mid(Ashar, 1, 1)) & " " & dahom
Case Is = 0
Meghdar = "بدون اعشار"
End Select
Else
Meghdar = "بدون اعشار"
End If
End Function
برنامه نویس : مسعود غیبی
دیگر دوستان هم اگه کمک کنند و این تاپیک رو پربار کنند ممنون میشم.
ساران سافت
سه شنبه 08 دی 1383, 21:12 عصر
با سلام :
این کد را هم من داشتم جهت تبدیل عدد به حروف :wink: :oops:
Function Cntc(No As Currency) As String
If No < 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(NN / 10 ^ (Ten * 3))
NN = NN - N * 10 ^ (Ten * 3)
SS = Msntc(N)
If SS <> "" 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(S) = "" Then '0 rials
S = " صفر "
End If
Cntc = S
End Function
Private Function Msntc(N As Integer) As String
If N = 0 Then Exit Function
If N < 10 Then
Msntc = Choose(N, "یک", "دو", "سه", "چهار", "پنج", "شش", "هفت", "هشت", "نه")
ElseIf N < 20 Then
Msntc = Choose(N - 9, "ده", "یازده", "دوازده", "سیزده", "چهارده", "پانزده", "شانزده", "هفده", "هجده", "نوزده")
ElseIf N < 100 Then
If (N Mod 10) > 0 Then
Msntc = Msntc((N \ 10) * 10) + " و " + Msntc(N Mod 10)
End If
If Int(N / 10 - 1) = (N / 10 - 1) Then Msntc = Choose(N / 10 - 1, "بیست", "سی", "چهل", "پنجاه", "شصت", "هفتاد", "هشتاد", "نود")
ElseIf N < 1000 Then
If (N Mod 100) > 0 Then
Msntc = Msntc((N \ 100) * 100) + " و " + Msntc(N Mod 100)
End If
If Int(N / 100) = (N / 100) Then Msntc = Choose(N / 100, "یکصد", "دویست", "سیصد", "چهارصد", "پانصد", "ششصد", "هفتصد", "هشتصد", "نهصد")
End If
End Function
M-Gheibi
سه شنبه 08 دی 1383, 21:59 عصر
دوست عزیز از کدی که ارسال کردید ممنون
حسنی کد قبلی به این مد داره٬ قابلیت برگرداندن مقدار عددی ماکزیمم 999999999999 هست. در صورتی که این کد تا 999 بیشتر قابلیت نداره.
:wink:
بابک زواری
سه شنبه 08 دی 1383, 22:11 عصر
امشب میخواستم یه برنامه بهتون هدیه بدم که بدون نیاز به محیط و ویندوز
فارسی یا عربی میتونه فارسی تایپ کنه و اونو به پنج کدپیج مختلف هم
تبدیل کنه اما دیدم اگر اونو به شکل setup و مرتب شده با چند فونت اصافه
بدم بهتره .
الان هم نشستم دارم setup میسازم تا فردا براتون بذارم همین جا .
منتظر باشید
Hamedm
چهارشنبه 09 دی 1383, 07:01 صبح
سلام
کد زیر تبدیل تاریخ میلادی به شمسی است. البته این کد از کد آقای کدنویس کمتره اما مطمئن باشید که درست کار میکنه چون خودم توی تمام روزهای سال تستش کردم.
Public Const Gregorian = ISO_8601
Public Function FarsiDate(intYear As Integer, intMonth As Integer, intDay As Integer, YMD)
Call jdn_persian(civil_jdn(intYear, intMonth, intDay), intYear, intMonth, intDay)
iShamsiYear = CStr(intYear)
iShamsiMonth = CStr(intMonth)
iShamsiDay = CStr(intDay)
If Len(iShamsiMonth) = 1 Then iShamsiMonth = "0" & iShamsiMonth
If Len(iShamsiDay) = 1 Then iShamsiDay = "0" & iShamsiDay
Select Case UCase(Trim(YMD))
Case "Y"
FarsiDate = iShamsiYear
Case "M"
FarsiDate = iShamsiMonth
Case "D"
FarsiDate = iShamsiDay
End Select
End Function
Function julian_jdn(iYear As Integer, _
iMonth As Integer, _
iDay As Integer) As Long
Dim lYear As Long
Dim lMonth As Long
Dim lDay As Long
lYear = CLng(iYear)
lMonth = CLng(iMonth)
lDay = CLng(iDay)
julian_jdn = 367 * lYear - _
((7 * (lYear + 5001 + ((lMonth - 9) \ 7))) \ 4) _
+ ((275 * lMonth) \ 9) + lDay + 1729777
End Function
Function civil_jdn(iYear As Integer, _
iMonth As Integer, _
iDay As Integer, _
Optional CalendarType As Integer = Gregorian) As Long
Dim lYear As Long
Dim lMonth As Long
Dim lDay As Long
If CalendarType = Gregorian And ((iYear > 1582) Or _
((iYear = 1582) And (iMonth > 10)) Or _
((iYear = 1582) And (iMonth = 10) And (iDay > 14))) _
Then
lYear = CLng(iYear)
lMonth = CLng(iMonth)
lDay = CLng(iDay)
civil_jdn = ((1461 * (lYear + 4800 + ((lMonth - 14) \ 12))) \ 4) _
+ ((367 * (lMonth - 2 - 12 * (((lMonth - 14) \ 12)))) \ 12) _
- ((3 * (((lYear + 4900 + ((lMonth - 14) \ 12)) \ 100))) \ 4) _
+ lDay - 32075
Else
civil_jdn = julian_jdn(iYear, iMonth, iDay)
End If
End Function
Function persian_jdn(iYear As Integer, _
iMonth As Integer, _
iDay As Integer) 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 + (epbase Mod 2820)
If iMonth <= 7 Then
mdays = (CLng(iMonth) - 1) * 31
Else
mdays = (CLng(iMonth) - 1) * 30 + 6
End If
persian_jdn = CLng(iDay) _
+ mdays _
+ Fix(((epyear * 682) - 110) / 2816) _
+ (epyear - 1) * 365 _
+ Fix(epbase / 2820) * 1029983 _
+ (PERSIAN_EPOCH - 1)
End Function
Sub jdn_persian(jdn As Long, _
ByRef iYear As Integer, _
ByRef iMonth As Integer, _
ByRef iDay As Integer)
Dim depoch
Dim cycle
Dim cyear
Dim ycycle
Dim aux1, aux2
Dim yday
depoch = jdn - persian_jdn(475, 1, 1)
cycle = Fix(depoch / 1029983)
cyear = depoch Mod 1029983
If cyear = 1029982 Then
ycycle = 2820
Else
aux1 = Fix(cyear / 366)
aux2 = cyear Mod 366
ycycle = Int(((2134 * aux1) + (2816 * aux2) + 2815) / 1028522) + aux1 + 1
End If
iYear = ycycle + (2820 * cycle) + 474
If iYear <= 0 Then
iYear = iYear - 1
End If
yday = (jdn - persian_jdn(iYear, 1, 1)) + 1
If yday <= 186 Then
iMonth = Ceil(yday / 31)
Else
iMonth = Ceil((yday - 6) / 30)
End If
iDay = (jdn - persian_jdn(iYear, iMonth, 1)) + 1
End Sub
Private Function Ceil(number As Single) As Long
Ceil = -Sgn(number) * Int(-Abs(number))
End Function
در ورودی آخر اگر "y" را وارد کنید سال و یا اگر "m" را وارد نمایید ماه و اگر "d" را وارد نمایید روز میلادی را به عنوان خروجی میدهید.
M-Gheibi
چهارشنبه 09 دی 1383, 08:54 صبح
کد زیر تبدیل تاریخ میلادی به شمسی است. البته این کد از کد آقای کدنویس کمتره اما مطمئن باشید که درست کار میکنه چون خودم توی تمام روزهای سال تستش کردم.
دوست عزیز من که نتونستم ازش استفاده کنم. ارور زیر را می دهد (ایراد از خط اول):
http://hostedpictures.com/uploads/8295fa51bc.jpg
بابک زواری
چهارشنبه 09 دی 1383, 12:20 عصر
حال برنامه ایی دارید که در هر ویندوز راست به چپ رو داره . فارسی هم مینویسه و
ار طریق منوی اون میتونید نوشته خودتون رو به چند کد پیج تبدیل کنید.
تو نسخه بعدی امکانات پیشرفته تری مثل تبدیل از داس و .... خواهیم داشت
فعلا نسخه محدود تک خطی رو داشته باشید تا بعد.
setup اضافه شد
بابک زواری
چهارشنبه 09 دی 1383, 12:26 عصر
ستاپ اضافه شد دریافت کنید
M-Gheibi
چهارشنبه 09 دی 1383, 14:15 عصر
برناش که عالی بود ولی:
اگر نتونستید استفاده کنید چاره ایی نداریم جز آپلود ستاپ برنامه
فکر کنم باید همین کار را کرد چون --->
http://hostedpictures.com/uploads/6568ef83a0.jpg
بابک زواری
چهارشنبه 09 دی 1383, 15:20 عصر
بله activex قفل داره و من منظورم استفاده از خود برنامه بوده
vbprogramer
چهارشنبه 09 دی 1383, 21:01 عصر
آقا مسعود خیلی ممنون از برنامه تبدیل اعداد اعشار به حروف :تشویق:
با هم ترکیبشون کردم درست شد
مرسی :wise1:
جناب کد نویس از شما هم متشکر ( راستی می تونم بپرسم ستاپش رو با چه نرم افزاری درست کردین ؟ ):wink:
عجب تاپیک پر محتوایی شده دست همه درد نکنه :تشویق:
H_r_m
چهارشنبه 09 دی 1383, 21:37 عصر
:تشویق: :تشویق: :تشویق: :thnx:
(سیدشریفی)
پنج شنبه 10 دی 1383, 09:30 صبح
آقای کد نویس امر شما اطاعت میشود .
:flower:
:sorry:
mr_esmaily
شنبه 12 دی 1383, 21:44 عصر
سلام
البته منو بخشید که پا برهنه پریدم وسط !
در صورتی که قبلا در تاپیکی در یکی از زمینه های فوق به نتیجه رسیده اید و یا مطلبی هرچند ساده و مشخص در این مورد مشاهده کرده اید٬ مطالب صحیح و بکار رفته در آن تاپیک را با ذکر نام شخص راهنمایی کننده در اینجا بنویسید.
شما که خودتون اینو گفیتن چرا؟
البته جسارته منو ببخشید.
Spate
یک شنبه 13 دی 1383, 01:56 صبح
سلام
بازم طبق معمول همیشه من کمک می خوام
در مورد سرچ کردن فارسی تو دیتابیس اکسس
وقتی سرچ می کنم قاتی پاتی میشه و خلاصه فارسی نمی ساپورته :گیج:
M-Gheibi
یک شنبه 13 دی 1383, 08:06 صبح
شما که خودتون اینو گفیتن چرا؟
البته جسارته منو ببخشید.
خواهش می کنم ولی متاسفانه منظورتون رو متوجه نمیشم.
به نظرم اومد که شاید منظورتون نام نویسنده باشه که خب من هر کردوم رو می دونستم نوشتم. ولی با این اگه کسی به نظرش اومد اسم کسی رو نبردم بگه. من قصدی ندارم.
وقتی سرچ می کنم قاتی پاتی میشه و خلاصه فارسی نمی ساپورته
دلایل معمول:
1. تنظیمات زبان فارسی را مطابق پست دوم همین تاپیک انتخاب نکرده اید (که برای حل مشکل این کار را بکنید)
2. فونت نمایش اطلاعات در برنامتون زبان فارسی رو پشتیبانی نمیکنه.
3. کدپیج مورد استفاده در زمان ثبت اطلاعات با کدپیج فعلی متفاوت است.
اگه این موارد نبود٬ تصویری از برنامتون (قسمت نمایش اطلاعات) رو اینجا بذارید تا ببینیم.
ممنون
mr_esmaily
یک شنبه 13 دی 1383, 18:51 عصر
سلام
وقتی کد چند صفه پیش آقای غیبی در مورد تبدیل مقدار عددی به حروف رو داخل یه ماژول کپی می کنم بصورت زیر میشه.
چرا؟
بابک زواری
یک شنبه 13 دی 1383, 22:50 عصر
ممنون آقای سیدشریفی از لطف شما
اینم به افتخار آقای سیدشریفی بااین کدمیتونیدیک منوی قابل قبول باتصویر
و رنگ دلخواه و چند تا خرت پرت دیگه بسازید.
سورس ساختن منوهم اینجاست البته اینم بگم که کد برنامه
زیاد بهینه نیست و ممکنه اشکالاتی ریزی هم داشته باشه.
اینم اوپن سورس ما هرکس امکانی اضافه کرد یا باگی گرفت
با ذکر دقیق کار انجام شده و تغییرات صورت گرفته بذاره
همین جا بقیه بردارن.
فقط مشکلات رو برای من PM نزنید چون من تا اینجا آوردم
بقیه رو دوستان زحمتش رو بکشن.
coral
دوشنبه 14 دی 1383, 08:27 صبح
آقای اسماعیلی آیا شما تنظیمات farsi ویندوز ایکس پی خود را ست کرده اید؟چون معمولا علامت سوال را وقتی می دهد که آن ها تنظیم نشده باشند.
mr_esmaily
دوشنبه 14 دی 1383, 11:03 صبح
سلام
آره ست شدن.
البته مشکله بالا درصورتیکه که کپی پِیست کنم اگه خودم دستی فارسی تایپ کنم مشکلی ندار.
coral
دوشنبه 14 دی 1383, 11:12 صبح
دوستان برای من یک اشکال در رابطه باright to left در وی بی پیش اومده یعنی وقتی من برنامه وی بی را به یک ویندوز ایکس پی خام می برم که نه office دارد و نه وی بی ، تمام right to left هایم به هم می خورد.یعنی منوهایم از چپ به راست چیده می شوندو تمام text box هایم هم دچار مشکل شده اند و مثلا اگر من نوشته باشم
1- روش کنترل
شده:
روش کنترل 1-
که البته اعداد هم انگلیسی می زند و : را می برد سرخط....
این مشکل را چگونه باید حل نمود؟
vbprogramer
دوشنبه 14 دی 1383, 14:57 عصر
فکر می کنم مشکل شما فایل vbame.dll باشه که جناب غیبی در چند پست قبل در همین تاپیک ذکر کردند :wink:
coral
دوشنبه 14 دی 1383, 14:59 عصر
اتفاقا من هم اون پست را دیدم اما نمی دانم چطور باید از اون dll استفاده کرد وچگونه باید اونو به ستاپ برنامه اضافه کرد.
M-Gheibi
دوشنبه 14 دی 1383, 15:27 عصر
اتفاقا من هم اون پست را دیدم اما نمی دانم چطور باید از اون dll استفاده کرد وچگونه باید اونو به ستاپ برنامه اضافه کرد.
نحوه استفادش که راحته. باید اون رو به همراه ستاپ برنامه داشته باشید. در همه برنامه های ستاپ ساز قسمتی برای تعریف فایلهای اضافی مورد نیاز برنامه هست (حتی برنامه Package & Deployment Wizard موجود در سی دی نصب ویژوال بیسیک). این فایل رو باید به پوشه سیستم دستگاه کپی کنید.
setarehman
سه شنبه 15 دی 1383, 07:41 صبح
برای اینکه آقای غیبی عصبانی نشن من تابع تبدیل تاریخ رو اینجا میذارم هم ساده هست و هم کوتاه
Function Shamsi(Optional date1 As String, Optional SmallDate1 As Boolean) As String
'================================================= ===
Dim d, P, w, mon, mm, ym, u, v, rp, X, i, ys, ms, dm, p1, d1, ds, DateShamsi
d = Array(20, 19, 20, 20, 21, 21, 22, 22, 22, 22, 21, 21)
P = Array(11, 12, 10, 12, 11, 11, 10, 10, 10, 9, 10, 10)
w = Array("یکشنبه","دوشنبه","سه شنبه","چهارشنبه","پنج شنبه","جمعه","شنبه")
If SmallDate1 = True Then
mon = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
Else
mon = Array("اسفند", "بهمن", "دی", "آذر", "آبان", "مهر", "شهریور", "مرداد", "تیر", "خرداد", "اردیبهشت", "فروردین")
End If
If date1 = "" Then date1 = DateAdd("d", 1, Date)
dm = Day(date1)
mm = Month(date1)
ym = Year(date1)
u = 0
rp = 0
If (ym Mod 4) = 0 Then u = 1
If ((ym Mod 100) = 0 And (ym Mod 400) <> 0) Then u = 0
ys = ym - 622
X = ys - 22
X = X Mod 33
If ((X Mod 4) = 0 And X <> 32) Then rp = 1
i = Not (rp - 2) + Not (u - 2) * 2
X = 0
If (i = 0 And mm = 3) Then X = 1
If i = 0 Then i = 3
ms = (9 + mm) Mod 13
If ms < 10 Then ms = ms + 1
d1 = d(mm - 1)
If (i = 1 And mm > 2) Then d1 = d1 - 1
If (i = 2 And mm < 3) Then d1 = d1 - 1
p1 = P(mm - 1)
If (i = 1 And mm > 2) Then p1 = p1 + 1
If (i = 2 And mm < 4) Then p1 = p1 + 1
If (dm > 0 And dm <= d1) 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 ((mm = 3 And X = 2) Or mm > 3) Then ys = ys + 1
ds = Str(ds)
If Len(Trim(ds)) = 1 Then ds = "0" + Trim(ds)
If SmallDate1 = True Then
' اگر سال به صورت دو کارکتری میخواهید خط زیر را از حالت کامنت در آورید
' Shamsi = Mid(Trim(Str(Ys)), 3, 2) + "/" + Trim(mon(Ms - 1)) + "/" + Trim(Ds)
' اگر سال به صورت چهار کارکتری میخواهید خط زیر را از حالت کامنت در آورید
Shamsi = Trim(Str(ys)) + "/" + Trim(mon(ms - 1)) + "/" + Trim(ds)
Else
Shamsi = w(Weekday(Date) - 1) + " " + Str(ds) + " " + mon(ms - 1) + " " + Str(ys)
End If
End Function
coral
سه شنبه 15 دی 1383, 09:45 صبح
من اون vbame.dll را در قسمت سیستم کپ کردم ومشکلم حل شد.باتشکر از آقای غیبی و وی بی پروگرمر عزیز.
M-Gheibi
سه شنبه 15 دی 1383, 11:25 صبح
برای اینکه آقای غیبی عصبانی نشن من تابع تبدیل تاریخ رو اینجا میذارم هم ساده هست و هم کوتاه
ممنون از کمکتون
فقط به نطر این تابع مشکل داره. خروجی که امروز به من داد اینه : سه شنبه 15 خرداد 1383 البته این در صورتیه که از تابع به این شکل استفاده بشه :
Shamsi()
اگه کد زیر باشه خروجی اینه : سه شنبه 14 خرداد 1383
Shamsi(Date)
اگه میتونید تصحیحش کنید.
من اون vbame.dll را در قسمت سیستم کپ کردم ومشکلم حل شد.باتشکر از آقای غیبی و وی بی پروگرمر عزیز.
:موفق:
coral
سه شنبه 15 دی 1383, 11:33 صبح
سوال
من مطالب جدولم را در محیط وی بی و در Textbox ها و در ویندوز ایکس پی تایپ کرده ام هنگام نمایش تکست ها در هیچ ویندوزی مشکلی ندارد.اما من با کمک دیتاریپورت از این ها ریپورت ساختم.حالا مشکل این است: هنگام پیش نمایش چاپ برای بعضی از تکست ها حروف رادرهم برهم و خرچنگ و قورباغه می زند. جالب این جا است که 3 خط اون درسته و مثلا 1 خط خراب است. این اشکال در ویندوز ایکس پی من وجود دارد.
قابل ذکر است که هنگام چاپ حروف را درست چاپ میکند.
چکار کنم که پیش نمایش چاپم هم درست بشه؟
MM_Mofidi
سه شنبه 15 دی 1383, 11:41 صبح
راه حل
بجای خط
If date1 = "" Then date1 = DateAdd("d", 1, Date)
بنویسید
If date1 = "" Then
date1 = DateAdd("d", 1, Date)
Else
date1 = DateAdd("d", 1, date1)
End If
البته علت اضافه کردن 1 روز به تاریخ را برای انجتم محاسبه نمیدانم :sad2:
vbprogramer
سه شنبه 15 دی 1383, 14:01 عصر
سوال
من مطالب جدولم را در محیط وی بی و در Textbox ها و در ویندوز ایکس پی تایپ کرده ام هنگام نمایش تکست ها در هیچ ویندوزی مشکلی ندارد.اما من با کمک دیتاریپورت از این ها ریپورت ساختم.حالا مشکل این است: هنگام پیش نمایش چاپ برای بعضی از تکست ها حروف رادرهم برهم و خرچنگ و قورباغه می زند. جالب این جا است که 3 خط اون درسته و مثلا 1 خط خراب است. این اشکال در ویندوز ایکس پی من وجود دارد.
قابل ذکر است که هنگام چاپ حروف را درست چاپ میکند.
چکار کنم که پیش نمایش چاپم هم درست بشه؟
بله من هم این مشکل را دیدم
البته اگر zoom را بالا ببریم خوب دیده میشن ولی درحالت معمولی عجق وجق دیده میشن :sad2:
coral
سه شنبه 15 دی 1383, 14:48 عصر
من zoom را تا 200 درصد افزایش دادم اما فایدهای نداشت این هم تصویر حروف من:
حامد مصافی
چهارشنبه 16 دی 1383, 00:50 صبح
سلام به همگی دوستان و برنامه نویسان عزیز
آقای غیبی توی یه تاپیک دیگه گوشش منو کشیدن که اگه تابع تبدیل میلادی به هجری داری بیار بذار اینجا
آقای غیبی من بازم از شما معذرت میخوام :wink:
اینم لینک اون توابع ، این توابع رو متاسفانه نمی دونم کی نوشته ولی خیلی عالیه :mrgreen:
<span dir=ltr>
http://www.barnamenevis.org/forum/download.php?id=2971
</span>
setarehman
چهارشنبه 16 دی 1383, 06:59 صبح
تابع رو به این شکل فراخوانی کنید
Shamsi(, True)
M-Gheibi
چهارشنبه 16 دی 1383, 08:28 صبح
با این کار فقط تاریخ تبدیل میشه و به شکل فارسی نمایش داده نمیشه
Fagat_tanhaie
چهارشنبه 16 دی 1383, 14:12 عصر
با سلام
اطلاعات یک برنامه رو با برنامه ای که تو vb نوشتم برداشتم و تو یه فایل متن ذخیره کردم
اطلاعت برنامه فارسی بوده و با فونت azarakhsh10 , parsfix قبلا وارد شده
حالا من این فایلی که ذخیره کرده بودم رو تو vb باز کردم و ریختم تو یک textbox و در ضمن
فونت textbox رو هم به فونت مربوطه ست کردم
ولی وقتی با تابع instr جستجو میکنم متن مورد نظر رو پیدا نمیکنه
لطفا راهنمایی کنید.
در ضمن از parsa2001 استفاده میکنم
آیا میشه فونشو به unicode تبدیل کرد ؟ چگونه؟
مرسی
coral
یک شنبه 27 دی 1383, 09:27 صبح
دوستان! این جا یک نرم افزار فارسی ساز تاریخ ایکس پی را گذاشته اند می خواهید یک سری بزنید:
www.sinapardazeshsoft.com
hamedv
دوشنبه 12 بهمن 1383, 14:07 عصر
بهترین کدی که برای تبدیل تاریخ دیدم که میتونه چند نوع تقویم رو به هم تبدیل کنه : عبری، میلادی، هجری شمسی، هجری قمری
میتونه بگه هر روز چند شنبه ست
میتونید باهاش روزای تعطیل رو پیدا کنید ( مثلا 22 بهمن یا 10 محرم )
روشش هم اینه که برای هر تاریخ دو تا تابع داره که یک تابع تاریخ رو به یه عدد تبدیل میکنه و یه تابع عدد رو به تاریخ
اینطوری میتونید بگید که مثلا 32 روز دیگه کی میشه
هیچ گونه ایرادی هم من توش پیدا نکردم
mostafa313
سه شنبه 13 بهمن 1383, 05:35 صبح
حامد جان اگه این طوری که گفتی باشه که خیلی عالیه!
ممنون! :موفق:
Hamedm
چهارشنبه 14 بهمن 1383, 08:01 صبح
بهترین کدی که برای تبدیل تاریخ دیدم که میتونه چند نوع تقویم رو به هم تبدیل کنه : عبری، میلادی، هجری شمسی، هجری قمری
میتونه بگه هر روز چند شنبه ست
میتونید باهاش روزای تعطیل رو پیدا کنید ( مثلا 22 بهمن یا 10 محرم )
روشش هم اینه که برای هر تاریخ دو تا تابع داره که یک تابع تاریخ رو به یه عدد تبدیل میکنه و یه تابع عدد رو به تاریخ
اینطوری میتونید بگید که مثلا 32 روز دیگه کی میشه
هیچ گونه ایرادی هم من توش پیدا نکردم
من این برنامه رو قبلا دیده بودم ولی مثل الان مثالی ازش مشاهده نکردن. این برنامه حاوی بیش از 10 تابع است که هر کدوم وظیفه خاصی دارند. که متاسفانه هیچ مثالی از شون نزدید به همین دلیل براحتی نمیتوان دریافت که هر تابع را چگونه میشود فراخوانی کرد و نیز پارامترهای ورودی هر یک چیست. متاسفانه در کد توابع نیز توضیحی داده نشده است.
اگر مثالی در مورد نحوه استفاده این توابع دارید ممنون میشوم در اختیار این جانب نیز بگذارید.
موفق باشید و پرتوان
hamedv
چهارشنبه 14 بهمن 1383, 14:41 عصر
اگر مثالی در مورد نحوه استفاده این توابع دارید ممنون میشوم در اختیار این جانب نیز بگذارید.
من خودم از این ماجولها استفاده کردم
فقط اگر توی دات نت بخواهید استفاده کنید باید یکی از توابعش رو که 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(y,m,d)
بعد از اجرای کد توی 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
چهارشنبه 14 بهمن 1383, 15:14 عصر
hamedv دستت درد نکنه از توضیحات. :flower:
بابک زواری
پنج شنبه 22 بهمن 1383, 14:00 عصر
اینم تقویم
بابک زواری
یک شنبه 25 بهمن 1383, 14:35 عصر
این تقویم فقط ایرادش اینه که باید سیستم تاریخ شما به صورت mm/dd/yyyy باشه که این ایراد هم
بزودی برطرف میشه .
و اینکه شما امکان کنترل رنگ تمام قسمتها رو پیدا میکنید.
این مشکلات رو به دیده اغماض بنگرید تا نسخه جدید آماده باشه
M-Gheibi
دوشنبه 26 بهمن 1383, 09:24 صبح
پست زیر رو یکی از کاربران سایت (ehsan707) در بخشی دیگر ارسال کرده بودند که عینا به اینجا منتقل شده :
این هم یکبار برای همیشه
این اکتیوایکس رو به پروژه اضافه کنید و 2 متد رو فراخوانی کنید یکی برای قرار دادن تاریخ و یکی برای گرفتن تاریخ
البته برای محاسبه روز هفته میتونید تابع weekday رو در وی بی فراخوانی کنید.
خودم نوشتمش و تا جایی که تست کردم کاملا دقیقه خیلی هم سریعه !
اگر خطا یا اشتباهی دیدین به من میل بزنید ehsan2022002@yahoo.com
و اگر برای تبدیلات ماهای قمری و یهودی و فارسی به هم نیاز به اکتیو ایکس دارید.
دانلود
http://ehsan707.topcities.com/pcal.zip
(با تشکر از موناااااا که آدرس سایت برنامه نویس اورگ رو به من داد) :wink:
vbadvanced
شنبه 01 اسفند 1383, 03:02 صبح
تابع زیر برای تبدیل اعداد به حروف نوشته شده. میدونم دیگه داره تو این تاپیک یه کم زیاد میشه. اما میتونید با این یکی اعدا شمارشی هم داشته باشید که تو هیچکدوم از قبلیا ندیدم. (مثلا سوم، سی ام. چهل و پنجم و ...)!!
همچنین مثلا -1 رو بصورت «منفی یک» نمایش میده. پشتیبانی از اعداد اعشاری هم بعدا اضافه میکنم و میزارم همینجا .
درضمن کد توی کریستال ریپورتز هم در بخش فرمول نویسی بدرستی کار میکنه(البته باید دو تابع رو در دو Function جدا قرار بدید.)
کد توضیحات کامل هم داره.
اگر مشکلی یا نظری داستید لطفا به این آدرس میل بزنید vbadvanced@gmail.com
'This Function convert Numbers To Text
Public Function NoToText(eNo As Double, _
Optional isCounter As Boolean = False) 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(Sgn(eNo) = -1, True, False)
If eNo = 0 Then 'This Number is Zero; Don't Continue anymore
NoToText = IIf(isCounter, "صفرم ", "صفر ")
Exit Function
'NOTE: We can delete Following 3 Lines of code to have "یکم" instead of "اول"
'TODO: we can Make a new optional Argument to ask this from user
ElseIf (eNo = 1) And isCounter And (Not m_isNeg) Then
NoToText = "اول "
Exit Function
End If
'TODO: Add Support for decimal Numbers
'convert input to Absolute value w/o Thousand separators, as a String
eNumber = Abs(eNo)
'Add Some Extra Zero at the begining of String
eNumber = Choose(Len(eNumber) Mod 3, "00", "0") & eNumber
tStr = ""
k = Len(eNumber) / 3
For i = 1 To Len(eNumber) Step 3
'
tNo = Mid(eNumber, i, 3)
If tNo <> "000" Then
'Convert The First Digit Of Group --> `5`12
tStr = tStr & _
DigitToText(Mid(tNo, 1, 1) & "00")
'If the Second Digit is <1> Then We Have a number between _
Ten and Nineteen;
If Mid(tNo, 2, 1) = "1" Then '--> 5`12`
tStr = tStr & _
DigitToText(Mid(tNo, 2, 2))
Else 'elsewhere, do normal method
tStr = tStr & _
DigitToText(Mid(tNo, 2, 1) & "0") '--> 5`2`6
tStr = tStr & _
DigitToText(Mid(tNo, 3, 1))
End If
'if u know greater values then >>>>>>>>>>>>>>>>>>>>just Add it below
tStr = tStr & Choose(k, "", "هزار ", "میلیون ", "میلیارد ", "تریلیون ") '<<< here before `)`
End If
k = k - 1
Next i
'If in Counting Mode then add appropriate Suffixes to end of string
If isCounter Then
If Right(eNumber, 1) = "3" Then
tStr = Left(tStr, Len(tStr) - 2) & "وم" 'is `سهم` true?! ;)
ElseIf Right(eNumber, 2) = "30" Then
tStr = Left(tStr, Len(tStr) - 1) & "ام" 'and u know `سیم` is wrong! ;)
Else
tStr = RTrim(tStr) & "م" 'make countable strings like `دوازدهم`,`پنجم`, etc...
End If
End If
'This is Result!! ;)
NoToText = IIf(m_isNeg, "منفی ", "") & Mid(tStr, 3)
End Function
Private Function DigitToText(eNo As String)
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(eNo)
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: Mohammad Shiran
vbadvanced
شنبه 01 اسفند 1383, 04:26 صبح
این هم برای اعداد اعشاری. تابع زیر رو برای تبدیل اعداد اعشاری به متن استفاده کنید و حالشو ببرید.
همین الان تموم شد. داغ داغ، تنوری!!
آرگومان اولش که معلومه. دومیش هم برای تعیین نوع خروجی هست. یعنی مثلا برای 12.5 خروجی بصورت «دوازده و نیم» یا « دوازده ممیز پنج دهم»
Function DecimalToText(eNo As Double, _
Optional DecStyle As Boolean = False _
) As String
Dim eFixed As String, eDecimal As String
Dim sResult As String
'return fixed value of given number as string
eFixed = Fix(eNo)
'if this number has some decimals
If (Len(CStr(eNo)) - Len(eFixed)) Then
'get it as a string, Example: return `125` for `12.125`
eDecimal = Mid(CStr(eNo), Len(eFixed) + 2)
'return fixed part as text
sResult = NoToText(CDbl(eFixed)) & IIf(DecStyle, "و ", "ممیز ")
'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 & "نیم"
Else
'convert the decimal part of number to text
sResult = sResult & _
NoToText(CDbl(eDecimal))
'add extra suffix at end of string, depending to number of decimal places
sResult = sResult & _
Choose(Len(eDecimal), "دهم", "صدم", _
"هزارم", "ده هزارم", _
"صد هزارم", "میلیونیم") ', _
....
End If
Else
'if this number is originally an integer then convert it using normal method
sResult = NoToText(eNo)
End If
'return the result. ;)
DecimalToText = sResult
End Function
بابک زواری
شنبه 01 اسفند 1383, 07:04 صبح
دوست عزیز vbadvanced دستت درد نکنه سورس کد شما هم
نکات خاص خودش رو داشت .
بهر حال ممنون
Hamedm
شنبه 01 اسفند 1383, 07:17 صبح
vbadvanced دستت درد نکنه :تشویق: . جالب بود. :flower:
M-Gheibi
شنبه 01 اسفند 1383, 19:34 عصر
:flower:
vbadvanced
یک شنبه 02 اسفند 1383, 03:47 صبح
من هم ممنونم. مسلما بدون نقص هم نیست. اگه مشکلی داشت خوشحال میشم منم در جریان بزارید.
درضمن بخش عمده کد توضیحات اضافیه که برای قابل فهم تر شدن کد گذاشتم
اگه دوست داشتید میتونید اونا رو حذف کنید
30yavash
یک شنبه 02 اسفند 1383, 17:22 عصر
من یه سورس برنامه «یا هر چیز دیگه ای که کمکم کنه» ترجیحا به زبان ویژوال بیسیک دات نت می خام که کاربر بدون داشتن صفحه کلید فارسی بتونه فارسی بنویسه.
در واقع می خام یه برنامه بنویسم که نیاز به صفحه کلید فارسی و از این جور چیزا نداشته باشه با فونت مریم یا IPT یا هر فونت دیگه که Unicode نباشه.
خیلی توی این سایت گشتم ولی متاسفانه در این سایت در مورد همه چیز صحبت شده به جز همین مورد.
M-Gheibi
دوشنبه 03 اسفند 1383, 13:18 عصر
متاسفانه در این سایت در مورد همه چیز صحبت شده به جز همین مورد.
با فونت مریم یا IPT یا هر فونت دیگه که Unicode نباشه.
من کد برای نوشتن با فونت IPT رو داشتم ولی پیدا نمی کنم. اگه مشکل شما یونیکد هست خوب از Iransystem استفاده کنید. کدش هم در همین تاپیک هست.
بابک زواری
دوشنبه 03 اسفند 1383, 20:29 عصر
من کد برای نوشتن با فونت IPT رو داشتم ولی پیدا نمی کنم.
آقای غیبی اگر این کد رو پیدا کردید ممنون میشم اونو به اشتراک بذارید
vbadvanced
پنج شنبه 13 اسفند 1383, 11:14 صبح
من یک برنامه مشابه این چیزی که شما میخوای داشتم. منتها نه برای IPT
اونو تغییرش میدم و براتون میزارم
بابک زواری
پنج شنبه 13 اسفند 1383, 17:21 عصر
ممنون اگر لطف کنید
ghaum
یک شنبه 16 اسفند 1383, 07:56 صبح
سلام
من وقتی در richeditbox یک متنی را کپی می کنم نقطه آخر خط را اول می آورد
برای حل این مشکل چه باید بکنم؟
در ضمن من آن فایل dll را در فایل سیستمی ویندوز دارم
خیلی متشکرم
vbadvanced
دوشنبه 17 اسفند 1383, 02:51 صبح
وقتی تایپ میکنید یک بار ctrl+shift سمت راست صفحه کلید خودتون رو با هم بزنید. اینکار پاراگراف شما رو بصورت RightToLeft تغییر میده. علت این مشکل شما هم همین هست.
ghaum
دوشنبه 17 اسفند 1383, 07:39 صبح
سلام
اما تمام متنها تایپ شده
آیا راه دیگری وجود ندارد
خیلی متشکرم
vbadvanced
سه شنبه 18 اسفند 1383, 03:39 صبح
اگه همه متنهات توی یک فایل هستند اول یک بار ctrl+a رو بزن بعد هم ctrl+shift
ghaum
سه شنبه 18 اسفند 1383, 08:58 صبح
خیلی ممنون
الان در دستگاه خودم متنهای فارسی را درست می بینم
ولی وقتی که برنامه را در یک دستگاه که ویندوز 2000 دارد اجرا می کنم متون فارسی به شکل علامت سوال نمایش داده می شوند
دستگاه خودم ویندوز xp دارد البته روی دستگاه دیگری که ویندوز xp دارد هم تست کردم ولی همان مشکل را داشت
M-Gheibi
سه شنبه 18 اسفند 1383, 14:46 عصر
مشکل علامت سوال رو با پستهایی که در اوایل همین تاپیک ارسال کردم حل کنید.
hex161
چهارشنبه 19 اسفند 1383, 00:17 صبح
سلام دوستان.
من یه تازه ویژوال دیده ام.
نمیدونم چرا توی فورم گزینه Right To Left همیشه False میشه و True نمیشه
اگه میشه منو راهنمایی کنید
vbadvanced
چهارشنبه 19 اسفند 1383, 03:59 صبح
از چه سیستم عاملی استفاده میکنید؟
اگر XP یا دوهزار هست. اول امکانات فارسی رو توی اون نصب کنید.
ghaum
چهارشنبه 19 اسفند 1383, 08:12 صبح
سلام
من تمام مطالب این تاپیک را خواندم و تمام چیزهایی که گفته شده بود را انجام دادم
از جمله ست کردن فارسی در ویندوز و استفاده از فایل dll
ولی هنوز این مشکل را دارم
لطفا راهنمایی بفرمایید
M-Gheibi
چهارشنبه 19 اسفند 1383, 10:47 صبح
نمیدونم چرا توی فورم گزینه Right To Left همیشه False میشه و True نمیشه
اگه میشه منو راهنمایی کنید
باید سیستمتون امکانات فارسی را ساپورت کنه.
ghaum
شنبه 22 اسفند 1383, 07:48 صبح
سلام
من یک برنامه با vb6 نوشتم که اطلاعات را از بانک access فقط می خواند
اطلاعات نیز با asp در صفحات وب با کدپیج یونیکد واردبانک شده اند
من تمام تنظیماتی که برای فارسی در این تاپیک گفته شده بود را انجام دادم و از آن فایل dll هم استفاده کردم
روی دستگاه خودم هیچ مشکلی ندارم ولی وقتی که برنامه را البته فایلexe آن را در کامپیوتر دیگری که تنظیمات آن مانند دستگاه خودم می باشد کپی می کنم اطلاعات به صورت علامت ؟ نمایش داده می شوند
در صورت توان راهنمایی بفرمایید
خیلی متشکرم
M-Gheibi
یک شنبه 23 اسفند 1383, 11:24 صبح
http://www.oxinsoft.com/img/shamsidll_pack02.jpg
گروه نرم افزاری اوکسین اقدام به طراحی و عرضه ی DLLی نموده است که مشکل برنامه نویسان ایرانی را تا حد زیادی در زمینه تاریخ شمسی حل میکند.
این توابع به صورت کاملا دقیق، تاریخ میلادی سیستم را به تاریخ هجری شمسی تبدیل می‌نمایند و همچنین توابع دیگری را برای انجام محاسبات روی این تاریخ در دسترس قرار می‌دهند. یکی از ویژگیهای جالب توجه این کلاس (که بسیاری از کلاسهای مشابه نوشته شده در این زمینه فاقد ان هستند) عملکرد دقیق آنها روی سالهای کبیسه است. همانطور که می‌دانید در سیستم تاریخ شمسی بعضی از سالها کبیسه هستند و در آنها ماه اسفند سی روز میباشد. این سالها به صورت متناوب هر چهار سال یکبار تکرار می‌شوند و چون این سالها از سالهای عادی یکروز بیشتر هستند، لذا باید در محاسبات تاریخ این نکته را مدنظر قرار داد، که این توابع به خوبی از آن پشتیبانی میکنند.
کلاسهای این توابع به صورت استاندارد تهیه و کامپایل شده است تا تمام برنامه نویسان بتوانند از آنها در زبانهای برنامه نویسی گوناگون مانند دلفی، ویژوال بیسیک، سی شارپ و همه ی زبانهای دیگری که از استاندارد COM پشتیبانی میکنند، استفاده کنند.
استفاده از فایل shamsi.dll توسط برنامه نویسان ایرانی در برنامه ها و پروژه های مختلف مجاز می باشد. این برنامه به صورت رایگان است و کاربر برای استفاده از آن مجبور به پرداخت هیچ حق استفاده ای نمی باشد. اما برای پشتیبانی از سازنده ی این برنامه، لطفا افرادی که از آن در برنامه ها یا پروژه های خود استفاده می کنند، با ارسال یک ایمیل به طراح برنامه پشتیبانی خود را اعلام کنند.
تعدادی از قابلیتهای عمده تقویم شمسی و قابلیتهای جدید که در آخرین نگارش به آن اضافه شده اند را مشاهده می کنید:
امکان تبدیل کاملا دقیق تاریخ میلادی به شمسی
عملکرد دقیق روی سالهای کبیسه
انجام عملیاتهای محاسباتی مختلف بر روی تاریخهای شمسی
پشتیبانی از 29/12/1330 تا 29/12/9999 !
رایگان برای استفاده برنامه نویسان و طراحان وب
لینک دانلود فایل : http://files.oxinsoft.com/shamsidll/shamsidll.zip
لینک سایت شرکت نرم افزاری اوکسین : http://www.oxinsoft.com
ghaum
دوشنبه 24 اسفند 1383, 10:42 صبح
مشکل من حل شد
باید تنظیمات ویندوز مربوط به فارسی را در دستگاهها دیگر درست می کردم
M-Gheibi
دوشنبه 24 اسفند 1383, 16:25 عصر
باید تنظیمات ویندوز مربوط به فارسی را در دستگاهها دیگر درست می کردم
گفته بودم که :
باید سیستمتون امکانات فارسی را ساپورت کنه.
hex161
سه شنبه 25 اسفند 1383, 02:42 صبح
ویندوز من اکس پی سرویس پک دو هست.
فارسی ساز سینا پک رو هم توش نصب کردم باز هم جواب نمیده
بنظر شما باید کجا رو انگولک کنم؟
M-Gheibi
سه شنبه 25 اسفند 1383, 09:02 صبح
ویندوز من اکس پی سرویس پک دو هست.
فارسی ساز سینا پک رو هم توش نصب کردم باز هم جواب نمیده
بنظر شما باید کجا رو انگولک کنم؟
1. خوب اأان مشکلتون چیه؟
2. اگه علامت سوال هست باید طبق توضیحات اول این تاپیک عمل کنید.
ghaum
سه شنبه 25 اسفند 1383, 09:13 صبح
سلام
من اطلاعاتم را از بانک داخل richedittextbox k نمایش می دهم
ولی نقطه آخر خط را اول می آورد
در صورتی که در داخل بانک درست وارد می شود
و rightoleft متنها صحیح می باشد
برای حل این مشکل چه باید بکنم؟
خیلی متشکرم
hex161
پنج شنبه 27 اسفند 1383, 01:18 صبح
اگه علامت سوال هست باید طبق توضیحات اول این تاپیک عمل کنید.
نه علامت سوال نیست.
مشکل من اینه که مشخصه Right To Left در فورم همیشه روگزینه false گیر کرده
و امکان تغییر توش نیست.
M-Gheibi
پنج شنبه 27 اسفند 1383, 09:21 صبح
دوست عزیز باز هم که زحمت خوندن پست های قبلی رو نکشیدید!
برای استفاده از امکان Right to Left در برنامه ها فایل VBAME.DLL موجود در پوشه سیستم را به همراه برنامه خود قرار دهید.
احتمالا این فایل رو ندارید. برنامه رو مجددا نصب کنید اگه درست نشد در وب پیدا میشه.
ghaum
شنبه 06 فروردین 1384, 09:55 صبح
سلام
این متن را نگاه کنید اینجا هیچ مشکلی ندارد ولی در RICHEDITBOX نقطه ها به اول خط می آیند
آیا راه حلی برای این مشکل وجود دارد؟
متشکرم
محسن در یکی از روزهای زیبای سال 1338 در جمع گرم و صمیمی خانواده دین‌شعاری به دنیا آمد، روزهای پرنشاط کودکی را زیر سایه تعالیم پدر و مادر گرامی و در پناه تعالیم دین اسلام گذراند.او از همان اوایل نوجوانی علاقه عجیبی به اهل‌بیت (ع) داشت و در 13 یا 14 سالگی بود که هیئتی به نام شهدای کربلا تأسیس نمود و خود به تنهایی مسئولیت آن را بر عهده گرفت.با شروع امواج خروشان انقلاب به صف مجاهدین راه حق پیوست و همواره در تظاهرات‌های سال 1357 حضوری فعال داشت در همان ایام به همراه برادرش به خدمت در پزشکی قانونی پرداخت و مدت 6 ماه به صورت شبانه‌روزی در کار جابجایی و تحویل اجساد مطهر شهدا شرکت داشت محسن جزء اولین سربازانی بود که به فرمان امام خمینی (ره) به پادگانها برگشتند و خودشان را معرفی کردند او همواره فریضه مقدس امر به معروف و نهی از منکر را انجام میداد و برای سربازان پادگان به خصوص آنهایی که در انجام فرائض تعلل می‌کردند برنامه شناخت ایدئولوژی گذاشته بود.او حدود 5/1 سال در سالهای 57 و 1358 خدمت مقدس سربازی را انجام داد و پس از آن در سال 1360 به خیل سبزپوشان سپاهی پیوست. با شروع جنگ تحمیلی عاشقانه به جبهه‌های نبرد شتافت و به عنوان مسئول گردان تخریب لشگر27 محمدرسول‌الله (ص) مشغول به خدمت شد و در سال 1363 به سفر حج رفت.در عملیاتهای طریق‌القدس و کربلای1 یادآور دلاوریها و رشادت‌های خالصانه او در راه دفاع از میهن است زمانیکه قرار بود برای بار دوم به سفر حج مشرف شود و به خاطر مسئولیت‌هایی که در جبهه داشت از تشرف به حج منصرف شد اما در همان سال در روز پانزدهم مردادماه سال 1366 درست مصادف با روز عید قربان به مسلخ عشق رفت و اسماعیل‌وار جان خویش را در حین خنثی‌سازی مین ضد تانک در قربانگاه سردشت فدای معبود ساخت و نام خویش را برای همیشه در قلب تاریخ زنده نگه داشت مزار مطهر او در قطعه 29 بهشت‌زهرای تهران قرار دارد.
hadi2345
دوشنبه 08 فروردین 1384, 20:03 عصر
با تشکر از همه بچه ها . خیلی عالی بود :flower:
ghaum
چهارشنبه 10 فروردین 1384, 17:56 عصر
سلام
کسی نیست مشکل من را حل کند
این متنی که برایتان فرستادم در برنامه ام طوری نمایش داده می شود که نقطه ها در اول سطر قرار دارند در microsoft Word هیچ مشکلی ندارد
دیگر نمی دانم چه کار کنم
اگر می شود یک راهنمایی کنید
متشکرم
Nova
پنج شنبه 18 فروردین 1384, 01:17 صبح
ممنون آقای غیبی، کد خیلی خوبی فرستادین
بابک زواری
شنبه 27 فروردین 1384, 08:44 صبح
راست به چپ کردن Treeview
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const WS_EX_LAYOUTRTL = &H400000
Private Const GWL_EXSTYLE = -20
'
Private Sub Form_Load()
SetWindowLong TreeView.hwnd, GWL_EXSTYLE, GetWindowLong(TreeView.hwnd, GWL_EXSTYLE) Or WS_EX_LAYOUTRTL
Dim nodX As Node
Set nodX = TreeView.Nodes.Add(, , "R", "Root")
nodX.Expanded = True
Set nodX = TreeView.Nodes.Add(, , "P", "Parent")
nodX.Expanded = True
Set nodX = TreeView.Nodes.Add("R", tvwChild, , "Child 1")
Set nodX = TreeView.Nodes.Add("R", tvwChild, , "Child 2")
Set nodX = TreeView.Nodes.Add("R", tvwChild, , "Child 3")
Set nodX = TreeView.Nodes.Add("P", tvwChild, , "Child 4")
Set nodX = TreeView.Nodes.Add("P", tvwChild, , "Child 5")
Set nodX = TreeView.Nodes.Add("P", tvwChild, , "Child 6")
End Sub
بابک زواری
شنبه 27 فروردین 1384, 08:53 صبح
در ضمن دوستان با تستی که انجام دادن مثل اینکه کد فوق برای ListView هم جواب میده
najafi_1
شنبه 27 فروردین 1384, 08:55 صبح
با سلام
با اینکه من vb کار نمیکنم ولی از روش شما در همکاری لذت بردم. موفق باشید.
mahdi_sh
یک شنبه 28 فروردین 1384, 09:22 صبح
تاریخ شمسی در xp رو توضیح ندادید.
اگه منظورتون اینه که توی برنامه vb چه جوری تاریخ ها رو شمسی کنیم که باید از یه تابع تبدیل تاریخ تو برنامه استفاده کنید
با سلام
اون تابع چیه ؟
ممنون
مهدی شهابی پور
نعیم رضاییان
یک شنبه 28 فروردین 1384, 09:53 صبح
این کد بالا نمی دونم چرا ولی برای list view تمام حروف رو هم برعکس می کنه یعنی از آخر به اول مینویسه
M-Gheibi
یک شنبه 28 فروردین 1384, 11:21 صبح
اون تابع چیه ؟
سلام
دوست عزیز فکر کنم این سومین باریه که شما این سوال رو پرسیدید.
صفحات قبل همین تاپیک رو مورد مطالعه قرار دهید.
موفق باشید
روز خوش
نعیم رضاییان
یک شنبه 28 فروردین 1384, 12:32 عصر
سلام
اقا میشه بگی اون فایل dll کع برای راست به چپ کردن بکار میره رو به چه شکل باید ازش استفاده کنیم اون فایل در شاخه system32 هست ولی نمی دونم چه حوری باید ازش استفاده کنم
مرسی
M-Gheibi
یک شنبه 28 فروردین 1384, 15:25 عصر
اقا میشه بگی اون فایل dll کع برای راست به چپ کردن بکار میره رو به چه شکل باید ازش استفاده کنیم اون فایل در شاخه system32 هست ولی نمی دونم چه حوری باید ازش استفاده کنم
یعنی نمیدونید چطور میشه Right to left رو استفاده کرد؟
برای اینکار در کنترل مورد نظر خاصیت Righttoleft رو True کنید.
توجه کنید که به هنگام ستاپ کردم برنامه باید این فایل رو درون ستاپ قرار دهید تا در پوشه System32 کامپیوتر کاربر کپی بشه.
موفق باشید
روز خوش
نعیم رضاییان
یک شنبه 28 فروردین 1384, 17:00 عصر
سلام
اقا اینو می دونم خوب از این حالت که نمیشه برای list view استفاده کرد
niloufar
دوشنبه 29 فروردین 1384, 09:27 صبح
سلام
این آقای naeimflashphp همانطور که از عکسی که در مشخصات خود ثبت کرده اند برمی آمد، در لحن صحبتهایشان (مثل استاد... و پاسخ دادن که سخت نیست و ...) هم مانند عکس دست به کمر و یه پا در جلو و چپ چپ نگاه کن هستند. :گیج:
بی خیال شوخی کردم. همان آقایی که شما استاد صدایش می زنید و ما او را آقا بابک، قبلا در یه تاپیک (ظاهرا تا جایی که یادمه به نام TreeView فارسی بود) پاسخ شما را داده اند. اگر حال دارید بروید و نگاه کنید و اگر نه بگویید تا در همین جا آن را ذکر کنم.
این گل هم برای اینکه ناراحت نشوید: :flower:
M-Gheibi
دوشنبه 29 فروردین 1384, 10:44 صبح
اقا اینو می دونم خوب از این حالت که نمیشه برای list view استفاده کرد
شما برای اینکار از کد آقای زواری استفاده کنید. همونطور که نیلوفر خانم عرض کردند هم در این تاپیک (صفحه قبل) و هم در یک تاپیک دیگر این کد وجود دارد (البته برای Treeview). کد مربوطه برای ListView هم کاربرد دارد.
برای مثال :
Option Explicit
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Const WS_EX_LAYOUTRTL = &H400000
Private Const GWL_EXSTYLE = -20
Private Sub Form_Load()
SetWindowLong ListView.hwnd, GWL_EXSTYLE, GetWindowLong(ListView.hwnd, GWL_EXSTYLE) Or WS_EX_LAYOUTRTL
ListView.ListItems.Add.Text = "عبارت فارسی اول"
ListView.ListItems.Add.Text = "عبارت فارسی دوم"
End Sub
نعیم رضاییان
چهارشنبه 31 فروردین 1384, 15:34 عصر
سلام
ببین وقتی از این کد برای list view استفاده میشه نوشته های فارسی رو که داخل جدول قرارا میگیره از آخر به اول نشون میده
اگه میشه یک مثال بزاربد
مرسی :flower:
M-Gheibi
چهارشنبه 31 فروردین 1384, 19:41 عصر
ببین وقتی از این کد برای list view استفاده میشه نوشته های فارسی رو که داخل جدول قرارا میگیره از آخر به اول نشون میده
من چنین مشکلی ندارم.
اگه میشه یک مثال بزاربد
در پست قبلیم در همین تاپیک گذاشتم دیگه
موفق باشید
niloufar
پنج شنبه 01 اردیبهشت 1384, 12:10 عصر
ببین وقتی از این کد برای list view استفاده میشه نوشته های فارسی رو که داخل جدول قرارا میگیره از آخر به اول نشون میده
سلام
من هم این مشکل را ندارم
نعیم رضاییان
جمعه 02 اردیبهشت 1384, 14:14 عصر
اقا اون کد کل حروف رو بر عکس میکنه این مثال رو ببین
M-Gheibi
جمعه 02 اردیبهشت 1384, 20:07 عصر
شما از کدپیچ ایران سیستم استفاده کرده اید. من هم با این کدپیج همین مشکل رو در راست به چپ کردن لیست دارم. جناب زواری اگه راه حلی به نظرتون میاد ممنون میشیم بیان کنید. :)
بابک زواری
شنبه 03 اردیبهشت 1384, 00:09 صبح
اینم اجرا در ویندوز من
بابک زواری
شنبه 03 اردیبهشت 1384, 00:16 صبح
منم مشکلی ندارم شاید تنظیمات ویندوز شما مشکل داره
نعیم رضاییان
یک شنبه 04 اردیبهشت 1384, 11:49 صبح
شاید مشگل از ویندوز باشه من از ویندوز advance server 2000 استفاده می کنم من ویندوز رو دوباره نصب می کنم ببینم مشگل حل میشه
مرسی
ASPDeveloper
چهارشنبه 14 اردیبهشت 1384, 19:05 عصر
دوست عزیز از کد تبدیل به حروف ممنون اما برای اعداد مثل 10000000001 کار نمیکند
بابک زواری
چهارشنبه 14 اردیبهشت 1384, 21:51 عصر
دوست عزیز از کد تبدیل به حروف ممنون اما برای اعداد مثل 10000000001 کار نمیکند
بله برای اعدادی مثل 30948203948203948203948023984023894023984578 هم کار نمیکنه
اولا این گونه اعداد کم استفاده میشن پس نیازی به هندل کردن اونا ندارید دوما سورس در دسترس
هستید میتونید طوری گسترش بدید که عددی رو هم که من نوشتم هجی کنه
jack
جمعه 16 اردیبهشت 1384, 16:03 عصر
با سلام خدمت جناب کد نویس .
متاسفانه من نتونستم از برنامه PFA استفاده کنم . چون موقع قرار دادن کنترل روی صفحه یک ایراد lisence not found می گیرد .
حامد مصافی
دوشنبه 19 اردیبهشت 1384, 17:42 عصر
شما از کدپیچ ایران سیستم استفاده کرده اید. من هم با این کدپیج همین مشکل رو در راست به چپ کردن لیست دارم. جناب زواری اگه راه حلی به نظرتون میاد ممنون میشیم بیان کنید.
این فونت ها در ظاهر فارسی هستند ولی باطناً چپ به راست هستند. اینگونه فونت ها رو نباید راست به چپ کنید. بهتره از ونت های عمومی مثا Tahoma استفاده کنید
ضمناً کسانی که در راست به چپ کردن نوشته های (header) مشکل دارند (این مشکل در اکس پی بیشتر دیده میشه) می تونن از کدی که در بخش "treeView فارسی" گذاشتم استفاده کنن
حدیثه
چهارشنبه 21 اردیبهشت 1384, 13:19 عصر
واقعا دست همتون درد نکنه.شما یکی لز بزرگترین معضلات بشریت رو حل کردید. :kaf:
مهدی ذوقی
جمعه 06 خرداد 1384, 10:40 صبح
با سلام
همانطور که می دونید کنترل date time picker سالهای شمسی را پشتیبانی نمی کنه می خواستم ببینم
آیا کسی یک کنترل داره که مثل date time picker عمل کنه و سالهای شمسی را هم پشتیبانی کنه
البته تقویمش برام مهم نیست بلکه مهم نشان دادن فرمت تاریخ به صورتی که کاربر بتونه روز و ماه و سال را
به راحتی توی اون با دکمه updown تغییر بده مثل حالتی از date time picker که خصوصیت updown آن true
است
با تشکر
بابک زواری
سه شنبه 10 خرداد 1384, 16:19 عصر
یکی از دوستان راجع به تبدیل میلادی به شمسی خواسته بود که کدی در اینباره براشون بذارم اینجا البته من تمام تبدیلها رو براشون گذاشتم
تبدیل تاریخ میلادی با فرمت mm/dd/yyyy به شمسی
Public Function Fa_Date(En_Date As String) 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(Mid(En_Date, 7, 4))
The_Month = CInt(Mid(En_Date, 1, 2))
The_Day = CInt(Mid(En_Date, 4, 2))
If (The_Year Mod 4 = 0) Then
The_Select = 1
Else
The_Select = 2
End If
If ((The_Year - 1) Mod 4 = 0) Then
The_Select = 3
End If
If The_Select = 1 Then
'------------------------------------------------------
Select Case The_Month
Case 1: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 10
The_Month = 10
The_Year = The_Year - 622
Case 21 To 31: The_Day = The_Day - 20
The_Month = 11
The_Year = The_Year - 622
End Select
Case 2: Select Case The_Day
Case 1 To 19: The_Day = The_Day + 11
The_Month = 11
The_Year = The_Year - 622
Case 20 To 29: The_Day = The_Day - 19
The_Month = 12
The_Year = The_Year - 622
End Select
Case 3: Select Case The_Day
Case 1 To 19: The_Day = The_Day + 10
The_Month = 12
The_Year = The_Year - 622
Case 20 To 31: The_Day = The_Day - 19
The_Month = 1
The_Year = The_Year - 621
End Select
Case 4: Select Case The_Day
Case 1 To 19: The_Day = The_Day + 12
The_Month = 1
The_Year = The_Year - 621
Case 20 To 30: The_Day = The_Day - 19
The_Month = 2
The_Year = The_Year - 621
End Select
Case 5: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 11
The_Month = 2
The_Year = The_Year - 621
Case 21 To 31: The_Day = The_Day - 20
The_Month = 3
The_Year = The_Year - 621
End Select
Case 6: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 11
The_Month = 3
The_Year = The_Year - 621
Case 21 To 30: The_Day = The_Day - 20
The_Month = 4
The_Year = The_Year - 621
End Select
Case 7: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 4
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 5
The_Year = The_Year - 621
End Select
Case 8: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 5
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 6
The_Year = The_Year - 621
End Select
Case 9: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 6
The_Year = The_Year - 621
Case 22 To 30: The_Day = The_Day - 21
The_Month = 7
The_Year = The_Year - 621
End Select
Case 10: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 9
The_Month = 7
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 8
The_Year = The_Year - 621
End Select
Case 11: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 10
The_Month = 8
The_Year = The_Year - 621
Case 21 To 30: The_Day = The_Day - 20
The_Month = 9
The_Year = The_Year - 621
End Select
Case 12: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 10
The_Month = 9
The_Year = The_Year - 621
Case 21 To 31: 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: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 10
The_Month = 10
The_Year = The_Year - 622
Case 21 To 31: The_Day = The_Day - 20
The_Month = 11
The_Year = The_Year - 622
End Select
Case 2: Select Case The_Day
Case 1 To 19: The_Day = The_Day + 11
The_Month = 11
The_Year = The_Year - 622
Case 19 To 28: The_Day = The_Day - 19
The_Month = 12
The_Year = The_Year - 622
End Select
Case 3: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 9
The_Month = 12
The_Year = The_Year - 622
Case 21 To 31: The_Day = The_Day - 20
The_Month = 1
The_Year = The_Year - 621
End Select
Case 4: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 11
The_Month = 1
The_Year = The_Year - 621
Case 21 To 30: The_Day = The_Day - 20
The_Month = 2
The_Year = The_Year - 621
End Select
Case 5: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 2
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 3
The_Year = The_Year - 621
End Select
Case 6: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 3
The_Year = The_Year - 621
Case 22 To 30: The_Day = The_Day - 21
The_Month = 4
The_Year = The_Year - 621
End Select
Case 7: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 4
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 5
The_Year = The_Year - 621
End Select
Case 8: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 5
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 6
The_Year = The_Year - 621
End Select
Case 9: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 6
The_Year = The_Year - 621
Case 23 To 30: The_Day = The_Day - 22
The_Month = 7
The_Year = The_Year - 621
End Select
Case 10: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 8
The_Month = 7
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 8
The_Year = The_Year - 621
End Select
Case 11: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 9
The_Month = 8
The_Year = The_Year - 621
Case 22 To 30: The_Day = The_Day - 21
The_Month = 9
The_Year = The_Year - 621
End Select
Case 12: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 9
The_Month = 9
The_Year = The_Year - 621
Case 22 To 31: 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: Select Case The_Day
Case 1 To 19: The_Day = The_Day + 11
The_Month = 10
The_Year = The_Year - 622
Case 20 To 31: The_Day = The_Day - 19
The_Month = 11
The_Year = The_Year - 622
End Select
Case 2: Select Case The_Day
Case 1 To 18: The_Day = The_Day + 12
The_Month = 11
The_Year = The_Year - 622
Case 19 To 28: The_Day = The_Day - 18
The_Month = 12
The_Year = The_Year - 622
End Select
Case 3: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 10
The_Month = 12
The_Year = The_Year - 622
Case 21 To 31: The_Day = The_Day - 20
The_Month = 1
The_Year = The_Year - 621
End Select
Case 4: Select Case The_Day
Case 1 To 20: The_Day = The_Day + 11
The_Month = 1
The_Year = The_Year - 621
Case 21 To 30: The_Day = The_Day - 20
The_Month = 2
The_Year = The_Year - 621
End Select
Case 5: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 2
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 3
The_Year = The_Year - 621
End Select
Case 6: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 10
The_Month = 3
The_Year = The_Year - 621
Case 22 To 30: The_Day = The_Day - 21
The_Month = 4
The_Year = The_Year - 621
End Select
Case 7: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 4
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 5
The_Year = The_Year - 621
End Select
Case 8: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 5
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 6
The_Year = The_Year - 621
End Select
Case 9: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 9
The_Month = 6
The_Year = The_Year - 621
Case 23 To 30: The_Day = The_Day - 22
The_Month = 7
The_Year = The_Year - 621
End Select
Case 10: Select Case The_Day
Case 1 To 22: The_Day = The_Day + 8
The_Month = 7
The_Year = The_Year - 621
Case 23 To 31: The_Day = The_Day - 22
The_Month = 8
The_Year = The_Year - 621
End Select
Case 11: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 9
The_Month = 8
The_Year = The_Year - 621
Case 22 To 30: The_Day = The_Day - 21
The_Month = 9
The_Year = The_Year - 621
End Select
Case 12: Select Case The_Day
Case 1 To 21: The_Day = The_Day + 9
The_Month = 9
The_Year = The_Year - 621
Case 22 To 31: The_Day = The_Day - 21
The_Month = 10
The_Year = The_Year - 621
End Select
End Select
'------------------------------------------------------
End If
Fa_Date = Format(CStr(The_Year), "0000") & "/" & _
Format(CStr(The_Month), "00") & "/" & _
Format(CStr(The_Day), "00")
End Function
تبدیل تاریخ شمسی به میلادی
Public Function En_Date(Fa_Date As String) As String
Dim The_Year As Integer
Dim The_Month As Integer
Dim The_Day As Integer
The_Year = CInt(Mid(Fa_Date, 1, 4))
The_Month = CInt(Mid(Fa_Date, 6, 2))
The_Day = CInt(Mid(Fa_Date, 9, 2))
Dim The_Select As Integer
The_Select = The_Year Mod 4
'------------------------------------------------------------------------------------------------------------------------
If The_Select = 0 Then 'Like : 1360, 1364, 1368, 1372, 1376, 1380, 1384, ...
Select Case The_Month
Case 1: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 3
The_Year = The_Year + 621
Case 12 To 31: The_Day = The_Day - 11
The_Month = 4
The_Year = The_Year + 621
End Select
Case 2: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 20
The_Month = 4
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 5
The_Year = The_Year + 621
End Select
Case 3: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 5
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 6
The_Year = The_Year + 621
End Select
Case 4: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 6
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 7
The_Year = The_Year + 621
End Select
Case 5: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 7
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 8
The_Year = The_Year + 621
End Select
Case 6: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 8
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 9
The_Year = The_Year + 621
End Select
Case 7: Select Case The_Day
Case 1 To 8: The_Day = The_Day + 22
The_Month = 9
The_Year = The_Year + 621
Case 9 To 30: The_Day = The_Day - 8
The_Month = 10
The_Year = The_Year + 621
End Select
Case 8: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 10
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 11
The_Year = The_Year + 621
End Select
Case 9: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 11
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 12
The_Year = The_Year + 621
End Select
Case 10: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 12
The_Year = The_Year + 621
Case 11 To 30: The_Day = The_Day - 10
The_Month = 1
The_Year = The_Year + 622
End Select
Case 11: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 1
The_Year = The_Year + 622
Case 12 To 30: The_Day = The_Day - 11
The_Month = 2
The_Year = The_Year + 622
End Select
Case 12: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 19
The_Month = 2
The_Year = The_Year + 622
Case 10 To 30: 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 : 1361, 1365, 1369, 1373, 1377, 1381, 1385, ...
Select Case The_Month
Case 1: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 3
The_Year = The_Year + 621
Case 12 To 31: The_Day = The_Day - 11
The_Month = 4
The_Year = The_Year + 621
End Select
Case 2: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 20
The_Month = 4
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 5
The_Year = The_Year + 621
End Select
Case 3: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 22
The_Month = 5
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 6
The_Year = The_Year + 621
End Select
Case 4: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 6
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 7
The_Year = The_Year + 621
End Select
Case 5: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 7
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 8
The_Year = The_Year + 621
End Select
Case 6: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 8
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 9
The_Year = The_Year + 621
End Select
Case 7: Select Case The_Day
Case 1 To 8: The_Day = The_Day + 22
The_Month = 9
The_Year = The_Year + 621
Case 9 To 30: The_Day = The_Day - 8
The_Month = 10
The_Year = The_Year + 621
End Select
Case 8: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 10
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 11
The_Year = The_Year + 621
End Select
Case 9: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 11
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 12
The_Year = The_Year + 621
End Select
Case 10: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 12
The_Year = The_Year + 621
Case 11 To 30: The_Day = The_Day - 10
The_Month = 1
The_Year = The_Year + 622
End Select
Case 11: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 1
The_Year = The_Year + 622
Case 12 To 30: The_Day = The_Day - 11
The_Month = 2
The_Year = The_Year + 622
End Select
Case 12: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 19
The_Month = 2
The_Year = The_Year + 622
Case 10 To 30: 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 : 1362, 1366, 1370, 1374, 1378, 1382, 1386, ...
Select Case The_Month
Case 1: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 3
The_Year = The_Year + 621
Case 12 To 31: The_Day = The_Day - 11
The_Month = 4
The_Year = The_Year + 621
End Select
Case 2: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 20
The_Month = 4
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 5
The_Year = The_Year + 621
End Select
Case 3: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 5
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 6
The_Year = The_Year + 621
End Select
Case 4: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 6
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 7
The_Year = The_Year + 621
End Select
Case 5: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 7
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 8
The_Year = The_Year + 621
End Select
Case 6: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 8
The_Year = The_Year + 621
Case 10 To 31: The_Day = The_Day - 9
The_Month = 9
The_Year = The_Year + 621
End Select
Case 7: Select Case The_Day
Case 1 To 8: The_Day = The_Day + 22
The_Month = 9
The_Year = The_Year + 621
Case 9 To 30: The_Day = The_Day - 8
The_Month = 10
The_Year = The_Year + 621
End Select
Case 8: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 22
The_Month = 10
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 11
The_Year = The_Year + 621
End Select
Case 9: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 11
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 12
The_Year = The_Year + 621
End Select
Case 10: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 12
The_Year = The_Year + 621
Case 11 To 30: The_Day = The_Day - 10
The_Month = 1
The_Year = The_Year + 622
End Select
Case 11: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 1
The_Year = The_Year + 622
Case 12 To 30: The_Day = The_Day - 11
The_Month = 2
The_Year = The_Year + 622
End Select
Case 12: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 19
The_Month = 2
The_Year = The_Year + 622
Case 11 To 30: 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 : 1363, 1367, 1371, 1375, 1379, 1383, 1387, ...
Select Case The_Month
Case 1: Select Case The_Day
Case 1 To 12: The_Day = The_Day + 19
The_Month = 3
The_Year = The_Year + 621
Case 13 To 31: The_Day = The_Day - 12
The_Month = 4
The_Year = The_Year + 621
End Select
Case 2: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 19
The_Month = 4
The_Year = The_Year + 621
Case 12 To 31: The_Day = The_Day - 11
The_Month = 5
The_Year = The_Year + 621
End Select
Case 3: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 5
The_Year = The_Year + 621
Case 12 To 31: The_Day = The_Day - 11
The_Month = 6
The_Year = The_Year + 621
End Select
Case 4: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 20
The_Month = 6
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 7
The_Year = The_Year + 621
End Select
Case 5: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 7
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 8
The_Year = The_Year + 621
End Select
Case 6: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 8
The_Year = The_Year + 621
Case 11 To 31: The_Day = The_Day - 10
The_Month = 9
The_Year = The_Year + 621
End Select
Case 7: Select Case The_Day
Case 1 To 9: The_Day = The_Day + 21
The_Month = 9
The_Year = The_Year + 621
Case 10 To 30: The_Day = The_Day - 9
The_Month = 10
The_Year = The_Year + 621
End Select
Case 8: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 21
The_Month = 10
The_Year = The_Year + 621
Case 11 To 30: The_Day = The_Day - 10
The_Month = 11
The_Year = The_Year + 621
End Select
Case 9: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 20
The_Month = 11
The_Year = The_Year + 621
Case 11 To 30: The_Day = The_Day - 10
The_Month = 12
The_Year = The_Year + 621
End Select
Case 10: Select Case The_Day
Case 1 To 11: The_Day = The_Day + 20
The_Month = 12
The_Year = The_Year + 621
Case 12 To 30: The_Day = The_Day - 11
The_Month = 1
The_Year = The_Year + 622
End Select
Case 11: Select Case The_Day
Case 1 To 12: The_Day = The_Day + 19
The_Month = 1
The_Year = The_Year + 622
Case 13 To 30: The_Day = The_Day - 12
The_Month = 2
The_Year = The_Year + 622
End Select
Case 12: Select Case The_Day
Case 1 To 10: The_Day = The_Day + 18
The_Month = 2
The_Year = The_Year + 622
Case 11 To 30: The_Day = The_Day - 10
The_Month = 3
The_Year = The_Year + 622
End Select
End Select
End If
'------------------------------------------------------------------------------------------------------------------------
En_Date = Format(CStr(The_Month), "00") & "/" & _
Format(CStr(The_Day), "00") & "/" & _
Format(CStr(The_Year), "0000")
End Function
ab_ba
چهارشنبه 25 خرداد 1384, 08:10 صبح
دوست عزیز از کد تبدیل به حروف ممنون اما برای اعداد مثل 10000000001 کار نمیکند
آقای ASPDeveloper من تابعی نوشتم که برای همه اعداد کار میکند و مشکلی ندارد ولی بدلیل اینکه در این تاپیک به حد کافی این تابع آورده شده از آورئن آن صرف نظر میکنم ولی اگر حتما میخواستی پیغام بده
[/img]
M-Gheibi
چهارشنبه 25 خرداد 1384, 09:23 صبح
سلام
ab_ba خب شما هم اون تابع رو اینجا بنویسید. مشکلی نیست.
ab_ba
پنج شنبه 26 خرداد 1384, 07:35 صبح
اینم کد من
Function harfi(n As Double) As String
Dim s1(10) As String
Dim s2(10) As String
Dim s3(10) As String
Dim s4(10) As String
Dim a(5), s As String
Dim count As Long
Dim i, j, k, m As Long
Dim b As Integer
s1(1) = "یک": s1(2) = "دو": s1(3) = "سه": s1(4) = "چهار": s1(5) = "پنج": s1(6) = "شش": s1(7) = "هفت": s1(8) = "هشت": s1(9) = "نه": s1(10) = "ده"
s2(1) = "یازده": s2(2) = "دوازده": s2(3) = "سیزده": s2(4) = "چهارده": s2(5) = "پانزده": s2(6) = "شانزده": s2(7) = "هفده": s2(8) = "هجده": s2(9) = "نوزده": s2(10) = "بیست"
s3(1) = "یکصد": s3(2) = "دویست": s3(3) = "سیصد": s3(4) = "چهارصد": s3(5) = "پانصد": s3(6) = "ششصد": s3(7) = "هفتصد": s3(8) = "هشتصد": s3(9) = "نهصد": s3(10) = "هزار"
s4(1) = " ": s4(2) = "هزار": s4(3) = "میلیون": s4(4) = "میلیارد": s4(5) = "تریلیون": s4(6) = "تریلیارد"
n = Int(n)
s = Str(n)
s = LTrim$(s)
s = RTrim$(s)
k = Len(s)
m = k Mod 3
If m = 0 Then m = 3
j = (k - m) \ 3
a(j + 1) = Mid(s, 1, m)
m = m + 1
For i = j To 1 Step -1
a(i) = Mid(s, m, 3)
m = m + 3
Next
count = j + 1
For i = count To 1 Step -1
b = 0
If Val(a(i)) > 0 Then
harfi = harfi & harfi2(Val(a(i)))
harfi = harfi & " " & s4(i)
For j = 1 To i - 1
If Val(a(j)) > 0 Then b = 1
Next
If b = 1 Then harfi = harfi & " و "
End If
Next
End Function
Function harfi2(n As Double) As String
Dim s1(20) As String
Dim s2(10) As String
Dim s3(10) As String
Dim s4(10) As String
Dim a(5) As Long
Dim b As Integer
b = 0
s1(1) = "یک": s1(2) = "دو": s1(3) = "سه": s1(4) = "چهار": s1(5) = "پنج": s1(6) = "شش": s1(7) = "هفت": s1(8) = "هشت": s1(9) = "نه": s1(10) = "ده"
s1(11) = "یازده": s1(12) = "دوازده": s1(13) = "سیزده": s1(14) = "چهارده": s1(15) = "پانزده": s1(16) = "شانزده": s1(17) = "هفده": s1(18) = "هجده": s1(19) = "نوزده": s1(20) = "بیست"
s2(1) = "ده": s2(2) = "بیست": s2(3) = "سی": s2(4) = "چهل": s2(5) = "پنجاه": s2(6) = "شصت": s2(7) = "هفتاد": s2(8) = "هشتاد": s2(9) = "نود": s2(10) = "صد"
s3(1) = "یکصد": s3(2) = "دویست": s3(3) = "سیصد": s3(4) = "چهارصد": s3(5) = "پانصد": s3(6) = "ششصد": s3(7) = "هفتصد": s3(8) = "هشتصد": s3(9) = "نهصد": s3(10) = "هزار"
s4(1) = "هزار": s4(2) = "میلیون": s4(3) = "میلیارد": s4(4) = "تریلیون": s4(5) = " تریلیارد"
a(1) = n \ 100
a(4) = n Mod 100
a(2) = a(4) \ 10
a(3) = a(4) Mod 10
If (a(1) > 0) Then harfi2 = s3(a(1)): b = 1
If (a(4) < 20 And a(4) > 0) Then
If (b = 1) Then
harfi2 = harfi2 & " و " & s1(a(4))
Else
harfi2 = s1(a(4))
End If
Else
If (a(2) > 0) Then
If (b = 1) Then
harfi2 = harfi2 & " و " & s2(a(2))
Else
harfi2 = s2(a(2))
End If
End If
If (a(3) > 0) Then
If (a(4) > 20) Then b = 1
If (b = 1) Then
harfi2 = harfi2 & " و " & s1(a(3))
Else
harfi2 = s1(a(3))
End If
End If
End If
End Function
بابک زواری
جمعه 27 خرداد 1384, 23:00 عصر
ممنون جناب ab_ba کد خوب و مفیدی بود
ab_ba
شنبه 28 خرداد 1384, 07:44 صبح
قابلی نداشت
نعیم رضاییان
دوشنبه 30 خرداد 1384, 08:35 صبح
اقا شرمنده من تمام پست های قبلی رو خوندم ولی مشگلم حل نشد مشگل من اینه
1- من یک برنامه در windows xp نوشتم رو سیستم خودم مشگلی نداره همه چی درست کار میکنه اما وقتی این برنامه رو رو سیتم دیگه که ویندوز xp داره میزارم دیگه فارسی نشون نمیده هر دو ویندوز هم فارسی هستن یعنی میشه با alt+shift فارسی نوشت نمی دونم مشگل چیه
2- مشگل right left منو های من هستش من اون فایل dll رو که در تاپیکهای قبلی گفته شده بود رو کپی کردم ولی مشگلم حل نشد یعنی هیچ تغییری نکرد البته بازم رو سیستم خودم درسته رو کامپیوتر های دیگه امتحان میکنم مشگل داره
مرسی
:flower:
M-Gheibi
دوشنبه 30 خرداد 1384, 08:56 صبح
دیگه فارسی نشون نمیده
به چه شکل نشون میده؟
برای مورد 2 هم تنها دلیل همون فایل dll هست. شما اون رو کجا کپی می کنید؟
نعیم رضاییان
دوشنبه 30 خرداد 1384, 17:36 عصر
اقا از جوابتون ممنون
در مورد فارسی نشون ندادن به صورت یک سری کد نشون میده مثل اینکه اون فون در سیستم نباشه
در مورد فایل هم حتی بعضی از سیستم ها این فایل رو داشتن و لی من دوباره فایل رو در ساخه sysytem32 کپی کردم
M-Gheibi
دوشنبه 30 خرداد 1384, 19:29 عصر
:sorry: متاسفانه نمیدونم باید چیکار کنید.
ab_ba
سه شنبه 31 خرداد 1384, 08:18 صبح
آقای naeimflashphp
من هم مشکل شما را داشتم ولی با تنظیم reginal setting درست شد
مسعود م
شنبه 04 تیر 1384, 21:20 عصر
با سلام
برنامه ای نوشته ام با VB6 در WinXP Sp2 و از فونت Tahoma هم استفاده کرده ام .
دو تا Setup یکی با Wise InstallMaster 8.11 (فونت Tahoma را اضافه کرده ام)
و یکی با InstallShield Proffesional 7 for win2kXP
در کامپیوتر هایی که VB6 نصب است مشکلی ندارد ولی :
وقتی در کامپیوترهای دیگر در WinXP نصب می کنم برنامه کامل کار می کند و اکثر جاهایی که فونت Tahoma استفاده شده را براحتی نشان می دهد .
ولی در قسمتهای Titlebar فرمها ( که از داخل برنامه قابل تنظیم نیستند ) و نیز منوها ( // ) و Msgbox ها ( // ) بجای فارسی ، قاطی پاطی نشان می دهد .
در ضمن همه فرمها را هم بجای راست چین ، چپ چین کرده .
مشکل کجاست ؟
با سپاس .
بابک زواری
شنبه 04 تیر 1384, 23:06 عصر
فونتها و Msgbox از فونت غیر tahoma استفاده میکنن
M-Gheibi
یک شنبه 05 تیر 1384, 07:47 صبح
در ضمن همه فرمها را هم بجای راست چین ، چپ چین کرده .
همونطور که قبلا گقته شده باید فایل VBAME.DLL را به همراه برنامه کپی کنید. به علاوه تنظیمات فارسی ویندوز را به طور صحیح انتخاب کنید.
فونتها و Msgbox از فونت غیر tahoma استفاده میکنن
دقیقا همینطوره فونت این بخشها MS Sans Serif هست.
مسعود م
پنج شنبه 09 تیر 1384, 07:35 صبح
ممنون از لطفتون.
کارهایی که گفته بودید انجام دادم :
تنظیمات فارسی در Regional Setting
و کپی Vbame.dll توسط برنامه Setup ساز در پوشه سیستم (System32)
اینکار برای بعضی کامپیوترها (دارای سرویس پک) جواب داد
ولی برای بعضی نه (فاقد سرویس پک)
من با Wise InstallMaster ستاپ سازی کرده ام .
به نظر شما برای Vbame.dll باید Self Register را هم فعال کنم ؟
با سپاس.
Arash13
یک شنبه 26 تیر 1384, 10:06 صبح
در هنگام طراحی برنامه خاصیت right to left فرمها true نمی شود .
فایل vbame.dll هم در system32 وجود دارد .
vbsqlhadi
چهارشنبه 05 مرداد 1384, 16:45 عصر
دوستان عزیز سلام
با تشکر از تمام کسانیکه در این سایت فعالیت میکنند خیلی سایت خوب و پور محتوایی دارید اگر من را هم قابل بدانید از این یه یعد به شما مقاله خواهم فرستاد ولی اگر ممکن باشه در مورد مشکل زیر مرا یاری دهید
یک متن فارسی در ویندوز 2000 دارم که در نوت پد نوشته شده است من میخواهم آن را به فارسی با فونت ایران سیستم تبدیل بکنم به طوری که بتوان در ویرایشگر داس آن را بخوانم خواهش میکنم اگر در مورد این موضوع اطلاعاتی دارید به من کمک کنید
anubis_ir
جمعه 07 مرداد 1384, 09:54 صبح
http://www.hamedbanaei.com/application/iran_system_source.zip
شاپرک
شنبه 15 مرداد 1384, 14:49 عصر
با سلام
همانطور که می دونید کنترل date time picker سالهای شمسی را پشتیبانی نمی کنه می خواستم ببینم
آیا کسی یک کنترل داره که مثل date time picker عمل کنه و سالهای شمسی را هم پشتیبانی کنه
البته تقویمش برام مهم نیست بلکه مهم نشان دادن فرمت تاریخ به صورتی که کاربر بتونه روز و ماه و سال را
به راحتی توی اون با دکمه updown تغییر بده مثل حالتی از date time picker که خصوصیت updown آن true
است
با تشکر
من هم همچین چیزی لازم دارم
hadi2345
دوشنبه 24 مرداد 1384, 18:01 عصر
با سلام مجدد .
به مشکل بزرگی برخورده ام و تقاضا دارم کمکم کنید . من برا ی تبدیل تاریخ از تابعی که جناب زواری گذاشته بودند استفاده میکنم ولی متاسفانه در بعضی سیستمها به مشکل برخورده ام و تاریخ شمسی را درست نشان نمیدهد مثلا تاریخ دیروز را 0008/20/14 نشان میداد و با دستکاری regional setting هم درست نشد ، لطفا کمکم کنید
mehran_farid
دوشنبه 07 شهریور 1384, 09:31 صبح
وقتی توی تکست باکس حروف گ . ژ پ و ک رو مینویسم علامت تقسیم و در کل شر و ور مینویسه . چی کار کنم؟
mehran_farid
دوشنبه 07 شهریور 1384, 09:33 صبح
آقا ما توی تکست باکسهامون با گ .پ . ژ . ک مشکل داریم .چه کار کنم؟
M-Gheibi
دوشنبه 07 شهریور 1384, 20:20 عصر
سلام
آقا مهران مشکل شما مورد خاصی نیست.
دلیل این ناهماهنگی این است که نحوه چیدمان کاراکترهای یاد شده در کدپیج استاندارد معرفی شده از طرف مایکروسافت بدین شکل است. یعنی حرف پ در این کدپیج همان \ است. حرف ژ همان Shift+C است. حرف گ و چ هم به همان شکل قدیم و بدون مشکل هستند.
اگر مشکل شما از همین ناشی شده باشد می بایست فایل kbdfa.dll ویندوز را با فایلهای تصحیح شده (که در اینترنت موجود است) تعویض کنید.
اگر مشکل شما این نیست کمی بیشتر توضیح دهید.
ba2003
شنبه 12 شهریور 1384, 19:18 عصر
با عرض سلام و خسته نباشید
بنده می خواهم یک زبان جدید برای ویندوز تعریف کنم یعنی keyboard layout جدید چه باید بکنم
در ضمن فونت زبانم را طراحی کردم.
با تشکر
M-Gheibi
شنبه 12 شهریور 1384, 19:47 عصر
دوست عزیز بهتر هست این سوال رو به صورت جداگانه در همین بخش مطرح کنید.
ab_ba
یک شنبه 13 شهریور 1384, 08:04 صبح
برای رفع مشکل خواندن تاریخ را با تابع فرمت انجام بده مثل
( s = Format(Date, "yyyy/mm/dd"
حامد مصافی
یک شنبه 13 شهریور 1384, 12:51 عصر
جناب mehran_farid (http://member.php?u=12168) در سیستم کی بورد ویندوز 98 حرف پ در روی علامت ` (بالای Tab ) قرار داشت
ولی در ویندوز ایکس پی این حرف به کلید \ (Back Slash ) انتقال یافته
حرف ژ به بالای ز (Shift + ز) انتقال یافته
vbhamed
پنج شنبه 24 شهریور 1384, 08:20 صبح
سلام
ایم نمونه برنامه تا محدوده تریلیون (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
پنج شنبه 31 شهریور 1384, 05:06 صبح
فونت combobox رااtahoma تعریف کرده ام در قسمت .text فارسی است ولی در بخش list قاطی پاتی نشون میده چی کار کنم؟
night11
چهارشنبه 13 مهر 1384, 20:20 عصر
سلام
می خواستم بدونم چطوری می تونم از این توابع تبدیل عدد به حروف تو DataReport استفاده کنم ؟ راهی هست ؟
قبلا از همکاریتون ممنون
vbhamed
یک شنبه 17 مهر 1384, 10:10 صبح
سلام
قبلا در برنامه خودتان عدد را به حروف تبدیل نمایید و حاصل را در بانک اطلاعاتی و در جدول مربوطه به صورت فیلد ذخیره نمایید و در datareport از آن استفاده کنید
night11
یک شنبه 17 مهر 1384, 19:08 عصر
سلام
قبلا در برنامه خودتان عدد را به حروف تبدیل نمایید و حاصل را در بانک اطلاعاتی و در جدول مربوطه به صورت فیلد ذخیره نمایید و در datareport از آن استفاده کنید
سلام
ممنونم از لطف شما
اما من اطلاعات چند ستون را با استفاده از توابع DataReport جمع کرده ام در واقع گزارش من مربوت به یک فاکتور می باشد
vbhamed
یک شنبه 17 مهر 1384, 20:55 عصر
سلام
باز هم مشکلی نیست
در واقع شما می توانید اطلاعات فاکتور را در دو جدول جداگانه که شامل لیست فاکتور و سربرگ آن است ذخیره کرده و در برنامه محاسبه نموده و در datareport استفاده نمایید
استفاده از توابع خوب است
اما به تجربه به من ثابت شده که این روش بهتر می باشد
night11
دوشنبه 18 مهر 1384, 13:30 عصر
مرسی از لطف شما
mhddns
یک شنبه 01 آبان 1384, 21:02 عصر
با سلام :
این کد را هم من داشتم جهت تبدیل عدد به حروف :wink: :oops:
Function Cntc(No As Currency) As String
If No < 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(NN / 10 ^ (Ten * 3))
NN = NN - N * 10 ^ (Ten * 3)
SS = Msntc(N)
If SS <> "" 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(S) = "" Then '0 rials
S = " صفر "
End If
Cntc = S
End Function
Private Function Msntc(N As Integer) As String
If N = 0 Then Exit Function
If N < 10 Then
Msntc = Choose(N, "یک", "دو", "سه", "چهار", "پنج", "شش", "هفت", "هشت", "نه")
ElseIf N < 20 Then
Msntc = Choose(N - 9, "ده", "یازده", "دوازده", "سیزده", "چهارده", "پانزده", "شانزده", "هفده", "هجده", "نوزده")
ElseIf N < 100 Then
If (N Mod 10) > 0 Then
Msntc = Msntc((N \ 10) * 10) + " و " + Msntc(N Mod 10)
End If
If Int(N / 10 - 1) = (N / 10 - 1) Then Msntc = Choose(N / 10 - 1, "بیست", "سی", "چهل", "پنجاه", "شصت", "هفتاد", "هشتاد", "نود")
ElseIf N < 1000 Then
If (N Mod 100) > 0 Then
Msntc = Msntc((N \ 100) * 100) + " و " + Msntc(N Mod 100)
End If
If Int(N / 100) = (N / 100) Then Msntc = Choose(N / 100, "یکصد", "دویست", "سیصد", "چهارصد", "پانصد", "ششصد", "هفتصد", "هشتصد", "نهصد")
End If
End Function
سلام دوست عزیز ساران سافت
با تشکر از کدهایی که ارائه نمودید
من وقتی ای کد ها را در ویبی paste می کنم چند خط قرمز به معنای خطا در نگارش کد بیسیک دیده می شود و سوالی که از محضر حضرتعالی دارم اینست که کد < که مکرر در این قطعه کد آمده است به چه معناست مثلا :
If N < 10 Then
ممنونم اگر پاسخ دهید.
mhddns
یک شنبه 01 آبان 1384, 21:19 عصر
[QUOTE=vbadvanced]تابع زیر برای تبدیل اعداد به حروف نوشته شده. میدونم دیگه داره تو این تاپیک یه کم زیاد میشه. اما میتونید با این یکی اعدا شمارشی هم داشته باشید که تو هیچکدوم از قبلیا ندیدم. (مثلا سوم، سی ام. چهل و پنجم و ...)!!
........
دوست عزیز سلام
من پس از پیست کردن کد خطا به شکل زیر می دهد:
tStr = tStr & _
ممنون
mhddns
یک شنبه 01 آبان 1384, 21:50 عصر
حالشو ببرید
seyd1061
دوشنبه 02 آبان 1384, 08:52 صبح
برای تبدیل تاریخ میلادی به شمسی shamsi.ocx دارم هر کسی مایل بود با من تماس بگیره براش می فرستم
طرز کار:
کامپونت رو به vb6 معرفی کرده
روی فرم پیاده کنید
بعد مثلا Text1 خود را به تاریخ روز تبدیل کنید اینگونه:
Text1=shamsi1.m2s(8,date)
برای نمایش تاریخ هشت مدل دارد که من مدل هشتم را انتخاب کردم
موفق باشید
یا علی
mhddns
دوشنبه 02 آبان 1384, 08:58 صبح
[QUOTE=seyd1061]برای تبدیل تاریخ میلادی به شمسی shamsi.ocx دارم هر کسی مایل بود با من تماس بگیره براش می فرست
سلام سید
برای من لطف کنید بفرستید
ممنون
mohammad.daneshvar@gmail.com
seyd1061
دوشنبه 02 آبان 1384, 09:13 صبح
یادم رفت بگم
به ایمیل نامه بزنید seyd1061@gmail.com
M-Gheibi
شنبه 07 آبان 1384, 13:48 عصر
دوست عزیز seyd1061 اگر مایلید به دیگران کمک کنید فایل مورد اشاره رو همینجا آپلود کنید. ممنون از همکاریتون
حامد مصافی
چهارشنبه 11 آبان 1384, 19:18 عصر
سلام دوست عزیز ساران سافت
با تشکر از کدهایی که ارائه نمودید
من وقتی ای کد ها را در ویبی paste می کنم چند خط قرمز به معنای خطا در نگارش کد بیسیک دیده می شود و سوالی که از محضر حضرتعالی دارم اینست که کد < که مکرر در این قطعه کد آمده است به چه معناست مثلا :
If N < 10 Then
ممنونم اگر پاسخ دهید.
سلام
کاراکتر های نام برده را با کاراکتر کوچکتر (>) تعویص کنید
vahidm
شنبه 21 آبان 1384, 20:48 عصر
مسعود جان این کد چطوری به کار ببریم
اگر می تونی جواب را برام به این آدرس بفرست
onlyvahid_m2006@yahoo.com متشکرم
M-Gheibi
شنبه 21 آبان 1384, 20:57 عصر
مسعود جان این کد چطوری به کار ببریم
منظورتون کدام کد هست؟
vbprogrammerx
چهارشنبه 02 آذر 1384, 21:34 عصر
از همتون ممنونم
موفق باشید
vbprogrammerx
چهارشنبه 02 آذر 1384, 21:38 عصر
آیا می شه توی vb یه برنامه نوشت که همه ی unicode ها را چاپ کرد.؟؟؟؟؟؟؟؟؟؟؟؟
با تشکر
m-amini
یک شنبه 06 آذر 1384, 14:04 عصر
سلام
یه Dll می زارم که تاریخ جاری سیستم رو به تاریخ شمسی تبدیل می کنه.
khoshraftar
سه شنبه 22 آذر 1384, 23:16 عصر
برای ایجاد تاریخ شمسی در vbمی شه بیشتر توضیح بدید.
meh_secure
شنبه 03 دی 1384, 12:57 عصر
نحوه اجرای برنامه در 98 رو توضیح بدین.
سورس کد در ایکس پی نوشته شده است.
پیغام خطا : unicode.dll not found
m1975b
شنبه 03 دی 1384, 14:09 عصر
مطالب عالیست ولی بعضی از کدها در HTML درست دیده نمیشوند.
با تشکر
meh_secure
چهارشنبه 07 دی 1384, 20:51 عصر
سلام دوستان.
در ایکس پی بعد از نصب برنامه های که فارسی هستند و right to left در اونها استفاده شده می خواستم بدونم چطور میشه که کاربر تنظیمات مربوط به regional setting رو انجام نده. در واقع می خواستم با کد نویسی یا نصب فایلهایی که وظیفه انجام این کار را دارند (روش دوم بهتره) می تونیم این کار رو انجام بدیم یا نه. لطفا راهنماییم کنید. خیلی فوری
meh_secure
چهارشنبه 07 دی 1384, 20:53 عصر
بابا یکی نیست جواب ما رو بده ؟؟
پستهای قبلی رو خیلی وقته که فرستادم. ولی هنوز جواب نگرفتم
sarami
پنج شنبه 13 بهمن 1384, 19:07 عصر
--------------------------------------------------------------------------------
http://www.barnamenevis.org/forum/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, "Èáå"
SetDlgItemText wParam, vbNo, "뒄"
SetDlgItemText wParam, vbIgnore, "áÛæ"
SetDlgItemText wParam, vbOK, "ÊÇííÏ"
UnhookWindowsHookEx MSGHOOK.hHook
End If
MsgBoxHookProc = False
End Function
Farhani
پنج شنبه 13 بهمن 1384, 21:09 عصر
امیدوارم به درد بخوره
Milad Mohseny
جمعه 14 بهمن 1384, 01:22 صبح
با سلام و تشکر از شما آقای sarami
باز هم مثل همیشه کارتون درسته
حامد مصافی
جمعه 14 بهمن 1384, 02:03 صبح
جناب meh_source منظورت اگه راست به چپ کردن پنجره اصلی نرم افزار هاست که باید عرض کنم این تغییرات به کمک Resource Hacker انجام میشه
Milad Mohseny
شنبه 15 بهمن 1384, 00:58 صبح
با سلام خدمت آقای sarami
من برنامه را دیدم خیلی خیلی عالی بود . لطفاً اگر میشود در مورد Hook به من توضیح دهید البته چون من خیلی مبتدی هستم یه جوری بگید که من بفهمم . و دیگر اینکه برنامه یک مشکل دارد مشکل این است که Message Box حالت Modal ندارد چه طوری میتوان این مشکل را حل کرد ؟
Milad Mohseny
یک شنبه 16 بهمن 1384, 17:50 عصر
با با تورو خدا جواب من را بدهید .
moustafa
دوشنبه 17 بهمن 1384, 03:04 صبح
تابع 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
دوشنبه 17 بهمن 1384, 03:12 صبح
تاریخ شمسی ایام هفته تبدیل تاریخ سیستم به شمسی و..........
در صورت استفاده از این ماجول ، فیلدهای از نوع تاریخ را باید از نوع 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
چهارشنبه 19 بهمن 1384, 02:25 صبح
تکس باکس فارسی
همراه سورسش این برنامه
----------------------------------------------------------------
کمرنگ ترین نوشته ها از قوی ترین حافظه ها بهتر است
http://www.mojtabco.persianblog.com
مهران فروردین
جمعه 21 بهمن 1384, 06:55 صبح
ضمن تشکر از جناب آقای مسعود غیبی بخاطر سورس کد تبدیل عدد به حروف،
تبدیل تاریخ میلادی به شمسی و برعکس یک فرمول ساده است که می توان در کد برنامه نوشت فقط باید مراقب سال های کبیسه بود، فارسی کردن صفحه کلید و نصب فونت های فارسی در ویندوز اکس پی هم که با استفاده از ستینگ کنترل پنل ویندوز براحتی امکان پذیر است کافی است در اپشن تنظیمات زبان همه جا زبان را فارسی و کشور را ایران انتخاب کنید، فقط به همکاران گرامی توصیه می کنم اگر می خواهید محصول نرم افزاری خود را تکثیر کرده و بصورت سی دی ارائه نمایید فقط از فوت های Tahoma و Times New Romand استفاده کنید تا اپراتورهای غیر حرفه ائی با مشکلات مربوط به حروف گ پ چ ژ مواجه نشوند این دو فونت در صورتیکه حتی هیچگونه فارسی سازی روی ویندوز نصب نشده باشد تقریبا روی کلیه نگارش های اکس پی بخوبی عمل می کنند ، در مورد راست به چپ بودن فرم ها ، لیبل ها و ... که مشکلی نیست کافی است خاصیت Right to Left فرم، لیبل، کلید و ... را در حالت Ture تنظیم نماید خود به خود همه چیز حل می شود توصیه می کنم قبل از شورع طراحی و قراردادن ابجکت های مورد نیاز روی فرم، به محض ایجاد فرم Right to Left را Ture کنید. مشکل اساسی در ویندوز اکس پی سورت صحیح فارسی است هنگامی که یک لیست را سورت می کنید بدلیل کد حرف پ که مقدار درستی ندارد کلیه کلماتی که با پ شروع می شوند بجای اینکه بعد از ب و قبل از ت قرار گیرند در آخر لیست قرار می گیرند البته با نصب بعضی فارسی سازها این مشکل حل می شود ولی چطور می توان بدون استفاده از فارسی ساز و نوشتن کد اضافی در سورس برنامه ویندوز را طوری تنظیم کرد که حرف پ را در جای خود بشناسد.
vbhamed
جمعه 28 بهمن 1384, 10:19 صبح
دوست عزیز
شما می توانید با استفاده از یک فایل به نام kbdfa.dll که آرایش صحیح حروف فارسی را در خود جای داده این مشکل را حل کنید
گفتنی است این فایل در خود ویندوز موجود است اما شما باید نسخه تصحیح شده آن را استفاده نمایید
اگر به این فایل نیاز داشتید اعلام کنید تا برایتان بفرستم
مهران فروردین
شنبه 29 بهمن 1384, 04:16 صبح
سلام.
دوست عزیز VBHAMED اگر لطف کنید و نسخه اصلاح شده فایل مذکور را، در صورتیکه مشکل سورت صحیح فارسی در ویندوز اکس پی با استفاده از آن حل می شود، ارسال فرمائید. سپاسگزار شما خواهم بود.
E-Mail: m09123878011@Yahoo.com
vbhamed
شنبه 29 بهمن 1384, 05:34 صبح
سلام دوست عزیز
فایل مورد نظر را برایتان فرستادم
توجه نمایید که برای سورت صحیح فارسی اگر از ADO استفاده می کنید حتما باید از JET4.0 به بعد را به کار ببرید
و اگر از DAO استفاده می کنیدۀ خاصیت Connect آن باید روی ACCESS2000 باشد ولی اگر ACCESS2000 را در لیست نداشت می بایست Service Pack 5.0 را روی ویژوال بیسیک نصب نمایید
Javad583
شنبه 20 اسفند 1384, 11:15 صبح
دوستان با سلام
2 تا مشکل دارم؛
اول اینکه من قابلیت فارسی سیستم عامل رو فعال کردم (ویندوز XP) ویژوال بیسیک هم کامل نصب شده اما وقتی فارسی تایپ می کنم بصورت ؟؟؟ نمایش داده میشه، اشکال از کجای کار هست؟
دوم اینکه من یه برنامه نوشتم حالا اگه بخام قابلیت XP Style رو بهش اضافه کنم چه کدی رو باید به برنامه اضافه کنم؟ (اون کد xml رو هم دارم ولی نمی دونم کاربردش چیه!)
اگه کسی بتونه کمک کنه واقعا ممون میشم....
M-Gheibi
شنبه 20 اسفند 1384, 14:38 عصر
برای مشکل فارسی به توصیه های نوشته شده در همین تاپیک عمل کنید.
سوال دومتون با اینکه ربطی به این تاپیک نداره ولی پاسخ میدم. در بخش جستجوی سایت عبارت manifest رو در بخش وی بی سرچ کنید. برای مثال در آدرس زیر به پاسخ سوالتون می رسید : http://www.barnamenevis.org/forum/showthread.php?t=4528&highlight=manifest
محمد آشتیانی
سه شنبه 23 اسفند 1384, 12:50 عصر
دوستان سلام
با عرض پوزش از اساتید
یه کنترل تاریخ شمسی که خودم نوشتم براتون گذاشتم
تاریخ جاری سیستم رو به شمسی نشون میده ،البته خیلی ساده هستش اما درست کار میکنه امیدوارم به دردتون بخوره
طرز کار:
مثلا برای قرار دادن تاریخ شمسی درون یک textbox
Text1.text = Miracle1.Shamsi
Miracle اسم کنترل تاریخ هستش و برای سایر استفاده ها مثل database و غیره هم دقیقا مثل بالا عمل میشه.
موفق باشید
Masoud_VB_Programmer
پنج شنبه 25 اسفند 1384, 17:37 عصر
دوستان با سلام
2 تا مشکل دارم؛
اول اینکه من قابلیت فارسی سیستم عامل رو فعال کردم (ویندوز XP) ویژوال بیسیک هم کامل نصب شده اما وقتی فارسی تایپ می کنم بصورت ؟؟؟ نمایش داده میشه، اشکال از کجای کار هست؟
دوم اینکه من یه برنامه نوشتم حالا اگه بخام قابلیت XP Style رو بهش اضافه کنم چه کدی رو باید به برنامه اضافه کنم؟ (اون کد xml رو هم دارم ولی نمی دونم کاربردش چیه!)
اگه کسی بتونه کمک کنه واقعا ممون میشم....
جواد جان مشکل فارسیت مال برنامه ویژوال بیسیکه
باید به روش زیر عمل کنی
ویژوال بیسیک رو اجرا می کنی=> از منوها Toolsرو انتخاب بعد Options رو میزنی
بعد از تب های بالا Editor Format رو انتخاب می کنی و تمام خطها رو به Courier New تبدیل می کنی بعد مشکلت حل میشه
در مورد مشکل دومت متاستفم و لی یک ocx هست که تمام اشکال xp رو داره
marziyeh
شنبه 27 اسفند 1384, 21:07 عصر
من می خواهم ارمنی تایپ کنم چه کنم پروژه دارم کمک کمک کمک کمک
asfar_nikoo
جمعه 04 فروردین 1385, 14:55 عصر
ستاپ اضافه شد دریافت کنید
با عرض سلام و خسته نباشید
لطفا کد تایپ فارسی در ویندوز بدون تغییر زبان را برای من نیز بفرستید
زیرا بعضی از کدها دیده نمی شوند
لطفا به تازه واردین نیز نگاهی بیاندازید :چشمک:
asfar_nikoo@yahoo.com
fixer2006
جمعه 01 اردیبهشت 1385, 23:57 عصر
جناب آقای غیبی سلام
ممنونم از راهنمایی و نمونه کدی که برای "تبدیل صفحه کلید به فارسی در VB " گذاشته‌اید. سوالی که من برام پیش اومده اینست که، وقتی وارد برنامه خود می‌شویم کیبورد فارسی میشود، حالا چطور میتوان کیبورد رو به حالت Default برگرداند؟؟؟
M-Gheibi
شنبه 02 اردیبهشت 1385, 05:52 صبح
Fixer2006 عزیز تا اونجایی به یادم میاد اگر در کد مربوطه به جای مقدار 00000429 از 00000409 استفاده کنید، زبان مورد استفاده به انگلیسی تغییر پیدا کند.
yahya3004
پنج شنبه 07 اردیبهشت 1385, 17:48 عصر
سلام
من می خواستم بدونم چطور میشه treeview رو در VB6 right to left کرد
با تشکر
M-Gheibi
جمعه 08 اردیبهشت 1385, 11:47 صبح
من می خواستم بدونم چطور میشه treeview رو در VB6 right to left کرد
اول جستجو کنید بعد سوالتون رو مطرح کنید:
http://www.barnamenevis.org/forum/showthread.php?t=19193
khomar
جمعه 08 اردیبهشت 1385, 23:50 عصر
برای تبدیل صفحه کلید به فارسی در ویژوال بیسیک 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
شنبه 09 اردیبهشت 1385, 05:51 صبح
نباید اروری بده
khomar
شنبه 09 اردیبهشت 1385, 23:51 عصر
خوب مال من ارور می ده حالا چیکار کنم؟
M-Gheibi
یک شنبه 10 اردیبهشت 1385, 05:29 صبح
دقیقا چه اروری می ده؟ شاید اینطوری بشه فهمید مشکل از کجاست
khomar
دوشنبه 11 اردیبهشت 1385, 23:57 عصر
این ارور رو می ده
compile error:
invalid outside procedure
M-Gheibi
سه شنبه 12 اردیبهشت 1385, 07:52 صبح
به طور مشخص نمیشه نظری داد ولی در گوگل سرچ کنید شاید به نتیجه ای مورد نظر برسید
http://www.google.com/search?sourceid=navclient-ff&ie=UTF-8&rls=GGGL,GGGL:2006-10,GGGL:en&q=%22invalid+outside+procedure%22
(البته در این شکی نیست که مشکل از کد تغییر زبان نیست)
farzad sahraei
دوشنبه 25 اردیبهشت 1385, 18:33 عصر
خسته نباشی.
مرسی
تبار
سه شنبه 26 اردیبهشت 1385, 00:42 صبح
من یک فارسی ساز بزای 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
سه شنبه 16 خرداد 1385, 15:17 عصر
سلام دوستان . من به یک مشکل خیلی مهم برخورد کردم . مشکلم اینه که داخل ListBox و Combobox نمی تونم فارسی بنویسم .البته با تکست باکس و لیبل ها مشکلی ندارم ولی مشکل اصلیم همین لیست باکسه . در ضمن از وینذوز ایکس پی هم استفاده می کنم و تو کل این تاپیک هم گشتم ولی متاسفانه چیزی پیدا نکردم . خیلی ممنون میشم جوابمو بدید چون واقعا" نیاز دارم ممنون .
siamakuk
چهارشنبه 17 خرداد 1385, 21:19 عصر
با سلام .لطفا مرا در مورد این کاراکتر(<)راهنمایی کنید که منظور از (<)در کد
تبدیل عدد به حروف آقای غیبی چیست .با تشکر سیامک
با سلام لطفا مرا در مورد این کاراکتر(<)در کد تبدیل عدد به حروف آقای غیبی
راهنمایی کنید.با سپاس سیامک.
Youness
چهارشنبه 21 تیر 1385, 10:26 صبح
کد تون جواب میده فقط تو پنجره کد نویسی به جای حروف فارسی علامت سوال میزنه
ab_ba
چهارشنبه 25 مرداد 1385, 10:09 صبح
همگی خسته نباشید
برای یک شرکت برنامه ای نوشتم که تحت win98 اطلاعات را وارد کرده اند حال به xp ارتقا داده ام
کلماتی که دارای حرف 'ک' هستند در سرچ پیدا نمیشوند و در سورت آخر قرار میگیرند احتمال میدهم کد حرف 'ک' قبلی با 'ک' که در xp تایپ میشود فرق کند برای رفع مشکل چه باید کرد
M-Gheibi
چهارشنبه 25 مرداد 1385, 13:01 عصر
کلماتی که دارای حرف 'ک' هستند در سرچ پیدا نمیشوند و در سورت آخر قرار میگیرند احتمال میدهم کد حرف 'ک' قبلی با 'ک' که در xp تایپ میشود فرق کند برای رفع مشکل چه باید کردخب چرا Replace نمیکنید؟
farzad964
پنج شنبه 02 شهریور 1385, 09:49 صبح
با سلام خدمت اساتید محترم
من به یک مشکل برخورد کردم که به نظرم خیلی عجیبه.
در VBA ACCESS به راحتی فارسی کار می کند اما در VBA EXCEL حتی Caption یک Button رو هم نمی شه فارسی کرد :متعجب: اگر میشه منو راهنمایی کنید
با تشکر فراوان
eagnasio
شنبه 04 شهریور 1385, 15:51 عصر
یه حال اساسی به همه
alireza_vb
پنج شنبه 16 شهریور 1385, 19:43 عصر
کد زیر برای تبدیل مقدار عددی به حروف است.
به این نکته دقت داشته باشید که حداکثر مقدار قابل قبول برای این تابع 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 <> 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 <> 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
If (SS <> 0 And hh = 0) Then hooroof = Adad_Heji(mm) + melun + va + Adad_Heji(SS)
If (SS <> 0 And hh <> 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 <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun
If (SS = 0 And hh <> 0 And mm <> 0) Then hooroof = Adad_Heji(yy) + melyard + va + Adad_Heji(mm) + melun + va + Adad_Heji(hh) + hezar
If (SS <> 0 And hh <> 0 And mm <> 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 < 20 Then
If (sadgan = 0) Then behooroof = heji(dahgan)
If (sadgan <> 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 <> 0) Then behooroof = heji_dahgan(dahgan / 10) + va + heji(yekan)
If (sadgan <> 0 And yekan = 0) Then behooroof = heji_sadgan(sadgan) + va + heji_dahgan(dahgan / 10)
If (sadgan <> 0 And yekan <> 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 نمایش داده خواهد شد.
:) :wink:
فکر نمیکنید خیلی درازه؟
میشه خلاصه اش کرد
M-Gheibi
پنج شنبه 16 شهریور 1385, 19:49 عصر
@ alireza_vb:
تابع زیر نوشته جناب آقای بابک بخشایش هست.
در کد آقای بخشایش هیچگونه تغییری داده نشده لذا تغییر در کد و optimize کردن آن به عهده برنامه نویس است.
شب خوش
saruneh
شنبه 22 مهر 1385, 01:29 صبح
دوستان من برای وارد کردن اطلاعات درخواستی برنامه ای که نوشتم، به صورت فارسی،
از همون امکان فارسی win xp میخوام استفاده کنم.منتها حروف "گ" و "ک" بصورت "..." وارد text box هام میشه! مشگل کجاست ؟
از v.b.6(enterprise ) استفاده کردم.
Hossein Bazyan
شنبه 22 مهر 1385, 06:49 صبح
از فونت tahoma استفاده کن و script آنرا Arabic انتخاب کن
amirsadeghi
یک شنبه 30 مهر 1385, 08:36 صبح
فقط همون فونت فارسی فکر کنم کفایت کنه
icarus
پنج شنبه 04 آبان 1385, 10:46 صبح
یه حال اساسی به همه
دوست عزیز میشه لطف کنی بگی چطور این فایلو میشه استفاده کرد ؟
mohsenna30ri
شنبه 13 آبان 1385, 09:38 صبح
ببین این راه حل بدردت می خوره فکر کنم بد نباشد :
http://barnamenevis.org/forum/showthread.php?t=55431
amirfz
جمعه 26 آبان 1385, 14:03 عصر
با تشکر قبلی
من دنبال یک تابع هستم که متن فارسی رو از ویندوز به کدپیچ فارسی در داس تبدیل کنه.
Hossein Bazyan
جمعه 26 آبان 1385, 16:27 عصر
دوستان من در مورد فارسی کردن ویندوز مشکلی دارم اگه کسانی راه جلی بنظرشان میرسه بیان کنند
من ویندوز را هر بار که دوباره نصب میکنم تمام مراحل فارسی سازی را دنبال میکنم و سیستم فارسی هم میشه و Fr در System try هم ایجاد میشه و در همه برنامه ها هم میتوانم RightToLeft بنویسم اما در وی بی زمانی که خاصیت RightToLeft را میخوام فعال کنم فعال نمیشه و همیشه False میباشد .
در ضمن همه گزینه های مربوط به Control Panel و Regional and Language Option را نیز فعال نموده ام.
amirfz
شنبه 27 آبان 1385, 09:04 صبح
لطفا اگر کد یا تابعی دارین که یک متن تایپ شده رو از کدپیج فارسی داس به ویندوز تبدیل میکنه برای من بفرستید
amirfz_2000@yahoo.ca
moslem-visual
دوشنبه 29 آبان 1385, 20:11 عصر
ممنون از همه ی دوستانی که اینجا پست دادن و یه منبع کامل رو ترتیب دادن، بازم ممنون.
sknsphr
سه شنبه 30 آبان 1385, 09:50 صبح
دوستان من در مورد فارسی کردن ویندوز مشکلی دارم اگه کسانی راه جلی بنظرشان میرسه بیان کنند
مشکلتون باید با فارسی ساز حل بشه. که یه نمونه شو Persiansoft داره. یه فایل 28M.
Hossein Bazyan
سه شنبه 30 آبان 1385, 11:44 صبح
مشکلتون باید با فارسی ساز حل بشه. که یه نمونه شو Persiansoft داره. یه فایل 28M.
دوست عزیز من مشکل فارسی ندارم و راحت فارسی مینویسم و در قسمت زبانها Fr هم آمده و در word و همه برنامه ها هم فارسی مینویسم اما مشکل من اینه که فقط در وی بی گزینه RightToLeft فعال نمیشه و الا در وی بی هم فارسی مینویسم
sknsphr
چهارشنبه 01 آذر 1385, 09:01 صبح
دوست عزیز من مشکل فارسی ندارم و راحت فارسی مینویسم و در قسمت زبانها Fr هم آمده و در word و همه برنامه ها هم فارسی مینویسم اما مشکل من اینه که فقط در وی بی گزینه RightToLeft فعال نمیشه و الا در وی بی هم فارسی مینویسم
درسته. میدونم. فارسی سازها هم فقط زبان فارسی رو add نمیکنن. این که به قول شما کاری نداره. تا اونجا که یادمه من هم خیلی وقت پیش این مشکلو داشتم. یادم نمیاد به غیر از نصب فارسی ساز کار دیگه ای انجام داده باشم. حالا شما یه امتحانی بکن.
Hossein Bazyan
چهارشنبه 01 آذر 1385, 11:36 صبح
مرسی از جواب شما
اما من هر بار که ویندوزم را نصب کرده ام و مراحل فارسی سازی را طی کردم هیچوقت همچین مشکلی نداشتم و راحت RightToLeft میشد که هر بار هم من همراه نصب ویندوز فارسی ساز را نصب نکرده ام
اما اینبار نمیدانم چرا ؟
mjnikbn
سه شنبه 07 آذر 1385, 17:35 عصر
ببین این راه حل بدردت می خوره فکر کنم بد نباشد :
http://barnamenevis.org/forum/showthread.php?t=55431
خیلی ببخشیدها
فکر کنم آدرسش تو هواست
aslan_ir
پنج شنبه 16 آذر 1385, 21:05 عصر
f_h1360
من یه convertor برا خودم نوشتم - اگه دوست داشتی چند رکورد از فایل DBF را اینجا بذار تا با برنامم تستش کنم ببینم جواب میده یا نه ؟
ishafaaty
سه شنبه 28 آذر 1385, 15:31 عصر
سلام خسته نباشید
آقا مشکل ما از پایه است:گریه:
در موقع استفاده از ماجول تبدیل عدد اعشاری به حروف چطور باید فیلدها رو به اون معرفی کرد یعنی مثلا پس از تایپ عدد و فشردن اینتر در فلان فیلد مازول را اجرا کرده ( به حروف ) نمایش دهد؟؟؟
لطفا من را راهنمایی کنید
با تشکر فراوان
ایمان آذر :متفکر:
joker
سه شنبه 28 آذر 1385, 16:37 عصر
من یک مشکلی دارن اونم اعداد در ورد هست
توی برنامه یک memo دارم که توش تایپ میکنند مثلا :
" بنام خدا امروز 1385/09/28 و تمام "
وقتی با استفاده از OLE توی یک فایل ورد بازش میکنم مینویسه :
" بنام خدا امروز 28/09/1385 و تمام "
انواع و اقسام تغییرات توی Option.Complex Script هم دادم ( ولی شاید اونی که باید تغییر میدادم را ندادم )
اونایی که توی پاراگراف بالا بودن چون از دیتابیس به صورت فیلد مستقل میخوندم میتونستم با یک تابع برعکس بفرستم به ورد تا ظاهرا درست چاپ کنه ، ولی قسمت بدنه اصلی پیام را مشکل دارم !!!
نمونه فایل را ضمیمه میکنم .
چطوری میتونم مشکل را حل کنم ؟?
پیوست » من یک فایل ورد به صورت تملیت دارم که اطلاعات را توش مینویسم.
بنابراین اگه ممکنه راه حلی بگین که ذاتا مشکل را را حل کنه نه نیاز به تغییرات مقطعی در موقع ورود اطلاعات به ورود داشته باشه.:بوس:
jafardelphi
چهارشنبه 29 آذر 1385, 00:49 صبح
من یه کدی میخوام که دوتاریخ شمسی رو بگیره و در خروجی تعداد روز های مابینشونو بگه مثلا : 8/9/85 و 10/9/85 = 2 روز
greenway
چهارشنبه 29 آذر 1385, 11:21 صبح
فکر نمیکنید خیلی درازه؟
میشه خلاصه اش کرد
من یک جایی یک نمونه سی شارپش رو لازم داشتم مجبور شدم اینو بنویسم ، شاید بدرد کسی خورد.
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
دوشنبه 04 دی 1385, 17:32 عصر
با سلام خدمت شما
من یک سوال در مورد استفاده از ماجول ها در اکسس داشتم
الان ماجول های زیادی درباره تبدیل اعداد اعشاری به حروف در اینترنت وجود دارد
اولا شما کدام را توصیه می کنید
دوما نحوه استفاده آنرا لطفا توضیح دهید ، هدف من ازاستفاده این ماجول در یک برنامه کارنامه ، با قابلیت خواندن عدد به حروف است ولی چطور فیلدها روبه این ماجول ربط بدم دچار مشکلم !
82.75--------< هشتاد و دو هفتاد و پنج صدم
دقیقا منظور اینه که پس از تایپ عدد ،اتوماتیک در فیلدی دیگری ( به دلخواه) بصورت حروف نوشته شود .
82.75
هشتاد و دو هفتاد و پنج صدم
آیا در ماجول باید فیلدها رو معرفی کرد اگر جواب مثبته چطور؟
با تشکر فراوان- ایمان
ishafaaty
دوشنبه 04 دی 1385, 17:40 عصر
با سلام خدمت شما
من یک سوال در مورد استفاده از ماجول ها در اکسس داشتم
الان ماجول های زیادی درباره تبدیل اعداد اعشاری به حروف در اینترنت وجود دارد
اولا شما کدام را توصیه می کنید
دوما نحوه استفاده آنرا لطفا توضیح دهید ، هدف من ازاستفاده این ماجول در یک برنامه کارنامه ، با قابلیت خواندن عدد به حروف است ولی چطور فیلدها روبه این ماجول ربط بدم دچار مشکلم !
82.75--------< هشتاد و دو هفتاد و پنج صدم
دقیقا منظور اینه که پس از تایپ عدد ،اتوماتیک در فیلدی دیگری ( به دلخواه) بصورت حروف نوشته شود .
82.75
هشتاد و دو هفتاد و پنج صدم
آیا در ماجول باید فیلدها رو معرفی کرد اگر جواب مثبته چطور؟
با تشکر فراوان- ایمان
کامپیوتر
چهارشنبه 13 دی 1385, 17:22 عصر
سلام
خسته نباشین دوستان
کد سورس تقویم کامپیوتر رو به زبان vb یا vb.net یا php میخوام اگه راهنمایی کنید خیلی ممنون میشم.
یاسی صبوری
شنبه 23 دی 1385, 09:47 صبح
اگه منظورتون اینه که توی برنامه vb چه جوری تاریخ ها رو شمسی کنیم که باید از یه تابع تبدیل تاریخ تو برنامه استفاده کنید
سلام میشه بگید چه تابعی؟ متشکرم
problem
شنبه 23 دی 1385, 21:05 عصر
قبل از اینکه این سوال را مطرح کنم، در تاپیک‌ها جستجو کردم، اما به نتیجه دلخواه نرسیدم. لذا این سوال را مطرح میکنم:
بدون این که در Control Panel بخش Regional and Language Settings لبه Advanced گزینه مربوط به برنامه‌های «غیر یونیکد» را به فارسی تغییر دهیم، می‌خواهیم برنامه‌ای داشته باشیم، که فقط یک عدد Textbox داشته باشد، که بشود تویش فارسی تایپ کرد، و بعد بتواند به یک دیتابیس (فایل Access) وصل شود، و عین متن تایپ شده را در جدول داخل آن ذخیره کند، به طوری که وقتی خود فایل Access را باز میکنیم هم متن را فارسی بنینیم، نه کاراکترهای عجیب و غریب.
توجه داشته باشید که برنامه قرار است فقط روی ویندوز XP کار کند، و روی ویندوز ۹۸ و ... لازم نیست اصلاً باز بشود! (لذا من دنبال راه حل‌های مبتنی بر CodePage نیستم.)
توضیح دیگر آن که بنده اصلا سابقه کار با VB6 ندارم، و این سوال را به نیابت از کس دیگری می‌پرسم. لذا تا حد امکان ساده توضیح دهید. اگر به کامپوننت یا تکنیکی که برای شما شناخته شده‌است اشاره میکنید، لطف کنید برای من هم لینکی بگذارید که آشنا شوم.
(چیزی که تا الآن به آن پی بردم این است که VB6 کنترلهای پیش‌فرضش به صورت ANSI هستند و بنابراین احتمالاً راه حل سوال من یا در گروی استفاده از کنترلهای دیگر است، یا در گروی ارتباط مستقیم برنامه با API ویندوز و تعریف کنترلها از آن طریق.)
Payam Moradi
یک شنبه 24 دی 1385, 11:29 صبح
یک کنترل قبلا گذاشته بودم:
Dim s As New Payam_ActiveX_lib.Calender
s.DateDifference("1385/01/01", "1386/01/01", pr_DayInterval, pr_Persian)
اینم لینکش
http://barnamenevis.org/forum/showthread.php?t=58091
INeedHelp
دوشنبه 25 دی 1385, 20:15 عصر
سلام تابع تبدیل عدد به حروف (Num to Str) چند تا ایراد داره مثلا عدد 22000258000 رو نمی تونه محاسبه کنه که برای این کار درقسمت Case 1000000000 To 999999999999# باید 4 دستور if دیگر وارد بشه
problem
سه شنبه 26 دی 1385, 10:35 صبح
من هنوز منتظر راهنمایی شما بزرگواران هستم. (درباره این سوال (http://barnamenevis.org/forum/showpost.php?p=297490&postcount=232))
yourdkhani
پنج شنبه 05 بهمن 1385, 18:48 عصر
من ویندوزمو 2 بار عوض کردم اما فونت های فارسیم به هم ریخته چی کارکنم
Payam Moradi
پنج شنبه 05 بهمن 1385, 21:57 عصر
من ویندوزمو 2 بار عوض کردم اما فونت های فارسیم به هم ریخته چی کارکنم
یعنی چی بهم ریخته. دقیقتر بگید. مثلا فونت "نازنین" رو ندارید یا به جای ژ، پ میزنه؟
Payam Moradi
پنج شنبه 05 بهمن 1385, 22:02 عصر
سلام تابع تبدیل عدد به حروف (Num to Str) چند تا ایراد داره مثلا عدد 22000258000 رو نمی تونه محاسبه کنه که برای این کار درقسمت Case 1000000000 To 999999999999# باید 4 دستور if دیگر وارد بشه
اکه با وی بی کار میکنید اکتیوایکس موجود درلینک را دانلود و رجیسترنمایید. و از این کد استفاده نمایید تا 15 رقم محاسبه میکنه.
Dim c As New FarsiConverter
MsgBox c.Conv_NumToText(Text1.Text)
http://barnamenevis.org/forum/showthread.php?t=58091
..
..
..
Payam Moradi
پنج شنبه 05 بهمن 1385, 22:17 عصر
با سلام خدمت شما
من یک سوال در مورد استفاده از ماجول ها در اکسس داشتم
الان ماجول های زیادی درباره تبدیل اعداد اعشاری به حروف در اینترنت وجود دارد
اولا شما کدام را توصیه می کنید
دوما نحوه استفاده آنرا لطفا توضیح دهید ، هدف من ازاستفاده این ماجول در یک برنامه کارنامه ، با قابلیت خواندن عدد به حروف است ولی چطور فیلدها روبه این ماجول ربط بدم دچار مشکلم !
82.75--------< هشتاد و دو هفتاد و پنج صدم
دقیقا منظور اینه که پس از تایپ عدد ،اتوماتیک در فیلدی دیگری ( به دلخواه) بصورت حروف نوشته شود .
82.75
هشتاد و دو هفتاد و پنج صدم
آیا در ماجول باید فیلدها رو معرفی کرد اگر جواب مثبته چطور؟
با تشکر فراوان- ایمان
سلام
اکتیوایکس موجود درلینک را دانلود و رجیسترنمایید. و به پروژه اضافه کنید.
http://barnamenevis.org/forum/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
پنج شنبه 05 بهمن 1385, 22:40 عصر
من هنوز هم منتظر راهنمایی شما بزرگواران (درباره این سوال (http://barnamenevis.org/forum/showpost.php?p=297490&postcount=232)) هستم.
SSoleimani
جمعه 06 بهمن 1385, 11:41 صبح
سلام به تمام دوستان
من از فایل 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
سه شنبه 10 بهمن 1385, 18:07 عصر
دوستانی که درمورد تاریخ قمری صحبت کردند و ذکر کرده بودند کخ برای استفاده گذاشته اند.من نتونستم پیداشون کنم.اگه دوباره لطف کنید ممنون میشم.
music
چهارشنبه 11 بهمن 1385, 00:22 صبح
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
چهارشنبه 11 بهمن 1385, 08:26 صبح
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
چهارشنبه 11 بهمن 1385, 08:29 صبح
دوستانی که درمورد تاریخ قمری صحبت کردند و ذکر کرده بودند کخ برای استفاده گذاشته اند.من نتونستم پیداشون کنم.اگه دوباره لطف کنید ممنون میشم.
از این لینک هم میتونی برداشت میکنی:
http://www.barnamenevis.org/forum/showpost.php?p=297738&postcount=233
AlirezaSaberi
چهارشنبه 11 بهمن 1385, 13:11 عصر
بهترین کدی که برای تبدیل تاریخ دیدم که میتونه چند نوع تقویم رو به هم تبدیل کنه : عبری، میلادی، هجری شمسی، هجری قمری
میتونه بگه هر روز چند شنبه ست
میتونید باهاش روزای تعطیل رو پیدا کنید ( مثلا 22 بهمن یا 10 محرم )
روشش هم اینه که برای هر تاریخ دو تا تابع داره که یک تابع تاریخ رو به یه عدد تبدیل میکنه و یه تابع عدد رو به تاریخ
اینطوری میتونید بگید که مثلا 32 روز دیگه کی میشه
هیچ گونه ایرادی هم من توش پیدا نکردم
سلام به همگی دوستان و برنامه نویسان عزیز
آقای غیبی توی یه تاپیک دیگه گوشش منو کشیدن که اگه تابع تبدیل میلادی به هجری داری بیار بذار اینجا
آقای غیبی من بازم از شما معذرت میخوام :wink:
اینم لینک اون توابع ، این توابع رو متاسفانه نمی دونم کی نوشته ولی خیلی عالیه :mrgreen:
<span dir=ltr>
http://www.barnamenevis.org/forum/download.php?id=2971
</span>
دوستان اینا رو از از کجا میشه گیر آورد. به نظر میاد از روی سرور پاک شدن؟
music
چهارشنبه 11 بهمن 1385, 13:22 عصر
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
چهارشنبه 11 بهمن 1385, 14:04 عصر
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
چهارشنبه 11 بهمن 1385, 16:51 عصر
mersi
moshkel har shod
Regional And Language Option
advanced
farsi ro englisi kardam
dobar farsi kardam restart kardam hal shod
mersi :)
حامد مصافی
چهارشنبه 11 بهمن 1385, 17:58 عصر
سلام به تمام دوستان
من از فایل 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 هایی که با وی بی تولید شدند در سایر محیط ها این اشکال رو دارند.
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.