Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Print KeyCode
End SubPrivate Sub Command1_Click()
Print Asc("a")
End SubPrivate Sub Command1_Click()
Print chr(97)
End Sub
Private Sub Command1_Click()
Dim Pos As Long, Text As String
Text = Text1.Text
For Pos = 1 To Len(Text) + 1 Step 2
Text = Left(Text, Pos) & " " & Mid(Text, Pos + 1)
Next
Text1.Text = Trim(Text)
End SubPrivate Sub Command1_Click()
Dim Pos As Long, Text As String
Text = Text1.Text
For Pos = 1 To Len(Text) + 1 Step 2
Text = Left(Text, Pos) & " " & Mid(Text, Pos + 1)
Next
Text1.Text = [B]Text1.Text & " = " &[/B] Trim(Text)
End Subلطفا از ارسال مکرر تقاضا برای پاسخگویی به سوالات جدا پرهیز کنید، ممکن است به هر دلیلی امکان پاسخگویی سریع
Dim Text As String
Text = [B]ChrW[/B](8531) Dim Text As String
Text = ChrW(8531)
MsgBox [B]AscW[/B](Text) Text1 = ChrW(8531)
MsgBox AscW(Text1)
ُسلام به همه دوستان گل به خصوص مدیر های انجمنلطفا از ارسال مکرر تقاضا برای پاسخگویی به سوالات جدا پرهیز کنید، ممکن است به هر دلیلی امکان پاسخگویی سریع
به سوال شما میسر نباشد.
پردازش و نمایش کاراکتر های فارسی و glyph ها (اشکال مختلف کاراکتر ها) نیازمند سیستم unicode است که برای هر
کاراکتر دو بایت فضا نیاز دارد (نه یک بایت همانند ansi). و متاسفانه توابع ویژوال بیسیک 6 و نسخه های قبل از آن،
بصورت ترکیبی از unicode و ansi هستند. مثلا رشته های string در ویژوال بیسیک unicode اند ولی کنترل هایی نظیر
textbox بر اساس ansi طراحی شده اند.
اجازه دهید که با یک مثال این مساله را نشان دهم، فرض کنید که بخواهیم کاراکتر ⅓ (کاراکتر 1/3) را که کد unicode آن 8531
ده دهی است را در متغیر text ذخیره کنیم، تابع chrw کد کاراکتر را به رشته تبدیل کرده و بر می گرداند :
و با تابع ascw می توانیم کد کاراکتر را مجددا از رشته استخراج کرده و با تابع msgbox اعلام کنیم که به درستی عدد 8531 راکد:dim text as string text = [b]chrw[/b](8531)
اعلام خواهد کرد :
تا اینجای کار ویژوال بیسیک کاملا سیستم unicode را پیاده می کند، اما فرض کنیم که یک کنترل textbox داشته باشیمکد:dim text as string text = chrw(8531) msgbox [b]ascw[/b](text)
با نام text1 و بجای متغیر text از این کنترل text1 استفاده کنیم :
و برخلاف انتظار، بجای عدد 8531، عدد 63 اعلام می شود که کد کاراکتر علامت سوال (?) است و در داخل textbox همکد:text1 = chrw(8531) msgbox ascw(text1)
کاراکتر ? قرار می گیرد. علت این مساله این است که کنترل text1 تنها می تواند کاراکتر های تک بایتی (کد 0 الی 255)
را در خود جای دهد و توانایی نمایش کاراکتری با کد 8531 را ندارد، پس بجای آن کاراکتر ? را درج می کند.
راه حل استفاده از توابع api ویندوز است که مشکل را حل می کنند.
در برنامه ای که نوشتم توابع زیر unicode هستند :
تابع getcharacterplacementw برای استخراج glyph های کاراکتر ها (حالت های چسبان و غیر چسبان حروف فارسی-عربی)
تابع exttextoutw برای نمایش glyph ها
تابع getwindowtextw برای دریافت رشته unicode داخل یک textbox (از مشخصه text کنترل های textbox استفاده نکنید
چون ansi هستند)
تابع getwindowtextlengthw برای دریافت طول رشته unicode داخل یک textbox
تابع setwindowtextw برای ارسال یک متن unicde به داخل یک textbox
این توابع api را درون یک ماژول (module) به نام moduleunicode تعریف کردم و برای استفاده ساده تر از آنها توابعی را با
ویژوال بیسیک ایجاد کردم :
تابع getglyphs مجموعه glyph های یک رشته را درون یک آرایه از نوع integer برمی گرداند، پارامتر hdc بایستی
روی مشخصه hdc یک form یا picturebox یا textbox یا ... تنظیم شود، اینکه در آن کنترل چه فونتی بکار رفته باشد اهمیت
زیادی دارد، زیرا یک کاراکتر ممکن است در دو فونت متفاوت شماره glyph های متفاوتی داشته باشد.
تابع gettext متن unicde داخل یک textbox را بر می گرداند.
تابع settext متن unicode داخل یک textbox را به متن دلخواهی تغییر می دهد.
تابع printglyph یک glyph مشخص را در موقعیت x و y (برحسب pixel) دلخواهی چاپ می کند. پارامتر hdc بایستی
روی مشخصه hdc یک form یا picturebox تنظیم شود، هر فونت و رنگی که در آن فرم یا کنترل فعال باشد برای ترسیم
glyph بکار خواهد رفت. حتما فونتی را بکار ببرید که در هنگام بکارگیری تابع getglyphs بکار برده بودید.
کد کامل برنامه به همراه فایل اجرایی exe ضمیمه این پست می باشد.
Option Explicit
Private Const WM_PASTE As Long = &H302
Private Const GMEM_MOVEABLE As Long = &H2
Private Const CF_UNICODETEXT As Long = 13
Private Declare Function SendMessageW Lib "user32.dll" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Public WithEvents TextBox1 As TextBox
Public WithEvents CmdLoad1 As CommandButton
Public WithEvents CmdSave1 As CommandButton
Public WithEvents CmdInsert As CommandButton
Private Sub Form_Load()
ScaleMode = vbPixels
Set CmdLoad1 = Controls.Add("VB.CommandButton", "CmdLoad1")
Set CmdSave1 = Controls.Add("VB.CommandButton", "CmdSave1")
Set TextBox1 = Controls.Add("VB.TextBox", "TextBox1")
Set CmdInsert = Controls.Add("VB.CommandButton", "CmdInsert")
With TextBox1
.Text = "Use Insert button"
.Font.Name = "Tahoma"
.Font.Size = 10
.Alignment = vbCenter
.RightToLeft = True
.Visible = True
.Move 10, 10, 210, 25
End With
With CmdInsert
.Caption = "Insert (Mohammad)"
.Visible = True
.Move 10, 50, 210, 30
End With
With CmdLoad1
.Caption = "Load (ANSI)"
.Visible = True
.Move 10, 90, 100, 30
End With
With CmdSave1
.Caption = "Save (ANSI)"
.Visible = True
.Move 120, 90, 100, 30
End With
End Sub
Private Sub [B]CmdSave1_Click[/B]()
Open "c:\test.txt" For Output As 1
Print #1, TextBox1.Text
Close #1
End Sub
Private Sub [B]CmdLoad1_Click[/B]()
Dim X As String
TextBox1.Text = ""
Open "c:\test.txt" For Input As 2
Line Input #2, X
Close #2
TextBox1.Text = X
End Sub
Private Sub CmdInsert_Click()
Dim Text As String
Text = ChrW(&HFEE3) & " " & ChrW(&HFEA4) & " " & ChrW(&HFEE4) & " " & ChrW(&HFEA9)
With TextBox1
SetClipboardText Text
.Text = ""
DoEvents
SendMessageW .hWnd, WM_PASTE, 0, ByVal 0&
End With
End Sub
Private Sub SetClipboardText(ByVal Text As String)
Dim Handle As Long, Pointer As Long
Dim Length As Long
On Error GoTo LErr
Length = Len(Text)
If OpenClipboard(0) = 0 Then Exit Sub
If EmptyClipboard = 0 Or Length = 0 Then
CloseClipboard
Exit Sub
End If
Length = Length + 1
Text = Text & vbNullChar
Handle = GlobalAlloc(GMEM_MOVEABLE, Length * 2)
If Handle <> 0 Then
Pointer = GlobalLock(Handle)
If Pointer = 0 Then
GlobalFree Handle
Else
CopyMemory ByVal Pointer, ByVal StrPtr(Text), Length * 2
GlobalUnlock Handle
SetClipboardData CF_UNICODETEXT, Handle
End If
End If
LNext:
CloseClipboard
Exit Sub
LErr:
Resume LNext
End SubPrivate Sub Command1_Click()
Dim Text As String
[COLOR="Blue"]Dim my_str As String[/COLOR]
Dim Glyphs() As Integer
Dim Index As Long
Me.Cls
Text = GetText(Text1)
Glyphs = GetGlyphs(Text, Me.hDC)
For Index = 0 To UBound(Glyphs)
PrintGlyph Glyphs(Index), Me.hDC, 290 - (UBound(Glyphs) - Index) * 20, 70
[COLOR="Blue"] my_str = my_str & ChrW(Glyphs(Index))[/COLOR]
Next
[COLOR="Blue"] SetText Text2, my_str[/COLOR]
End Sub TextBox1.Text = ChrW(&HFEE3) & " " & ChrW(&HFEA4) & " " & ChrW(&HFEE4) & " " & ChrW(&HFEA9)
TextBox2.Text = TextBox1.Text
