PDA

View Full Version : مبتدی: در خواست راهنمایی در ساختن برنامه حذف کردن enter بین متن



phpphp7
پنج شنبه 01 خرداد 1393, 14:15 عصر
سلام دوستان
قصد دارم یه برنامه ای بسازم که فاصله های enter بین یک متن خاص رو حذف کند
یعنی هیچ فاصله ای بین متن ها نباشه
متشکرم

R2du-soft
پنج شنبه 01 خرداد 1393, 15:48 عصر
اون متن توی textbox هست یا توی فایل؟

اگر توی فایل هست از کد زیر برای جایگزینی استفاده کن:

دقت کن توی این روش تغییر در فایل من فایلی با نام myfile.txt که کنار فایل اجرایی برنامم هست روادیت کردم.



Private Sub Command2_Click()
Dim s As String
s = ReadFile("myfile.txt")
s = Replace(s, vbCrLf, "")
Dim fID As String
fID = FreeFile
Open ("myfile.txt") For Output As #fID
Print #fID, s;
Close #fID

End Sub






Private Function ReadFile(ByVal Path As String) As String
Dim Buffer() As Byte
Dim IDCode As Integer
On Error Resume Next
Open Path For Binary As #1
If LOF(1) > 0 Then
Get #1, 1, IDCode
If IDCode = &HFEFF Then
If LOF(1) > 2 Then
ReDim Buffer(0 To LOF(1) - 3) As Byte
Get #1, 3, Buffer
ReadFile = Buffer
Else
ReadFile = ""
End If
Else
ReDim Buffer(0 To LOF(1) - 1) As Byte
Get #1, 1, Buffer
ReadFile = StrConv(Buffer, vbUnicode)
End If
Else
ReadFile = ""
End If
Close #1
End Function



Private Sub SaveFile(ByVal Path As String, ByVal Text As String, Optional ByVal Unicode As Boolean)
Dim Buffer() As Byte
Dim IDCode As Integer
On Error Resume Next
Open Path For Output As #1
Close #1
Open Path For Binary As #1
If Len(Text) > 0 Then
If Unicode Then
IDCode = &HFEFF
Buffer = Text
Put #1, 1, IDCode
Put #1, 3, Buffer
Else
Buffer = StrConv(Text, vbFromUnicode)
Put #1, 1, Buffer
End If
End If
Close #1
End Sub



اگر توی تکست باکس از کد زیر استفاده کن

Private Sub Command1_Click()
Text1.Text = Replace(Text1.Text, vbCrLf, "")
End Sub

phpphp7
یک شنبه 11 خرداد 1393, 12:12 عصر
سلام
میخوام که توی تکست باکس باشه
این برنامه ای که دادید ، همه رو میچسبونه بهم و متن رو کنار هم میزاره.
اما من میخوام هرچی فاصله بین خطوط هست از بین بره ( منظورم فاصله enter ) هست

vbhamed
یک شنبه 11 خرداد 1393, 12:24 عصر
سلام
Text1.Text = Replace(Text1.Text, vbCrLf & vbCrLf, vbCrLf)
البته بهتره یک نمونه متن قبل و بعد از تغییر دلخواه بزارید تا بهتر بشه راهنمایی کرد

phpphp7
یک شنبه 11 خرداد 1393, 14:45 عصر
سلام
Text1.Text = Replace(Text1.Text, vbCrLf & vbCrLf, vbCrLf)
البته بهتره یک نمونه متن قبل و بعد از تغییر دلخواه بزارید تا بهتر بشه راهنمایی کرد
سلام
خیلی ممنونم
بله فکر کنم همین برنامه باشه
اما نمیدونم چرا تو تکست باکس فارسی ساپورت نمیشه
آیا راه حلی وجود داره ؟

vbhamed
یک شنبه 11 خرداد 1393, 16:44 عصر
سلام
فارسی پشتیبانی میشه
اولا فونت تکست باکس رو روی Tahoma یا فونتهای مشابه بزارید با اسکریپت Arabic (این Script خیلی مهمه)
دوم اینکه اگر متن رو کپی می‌کنید هم هنگام کپی و هم موقع Paste کردن کیبرد روی فارسی باشه

R2du-soft
یک شنبه 11 خرداد 1393, 16:48 عصر
ممنون از vbhamed (http://barnamenevis.org/member.php?10624-vbhamed) عزیز البته اگه از اون دستور در loop استفاده کنید بهتر هست چون فاصله های چند خلی پشت سر هم رو کلا پاک نمیکنه و یکی یکی پاک میکنه! و باید هی کد رو تکرار کنید.
تکست باکس و لیبل و ... از فارسی پشتیبانی میکنن!
برای نوشتن فارسی روی تکست باکست کلیک کن و از قسمت properties گزینه font رو کلیک کن،فونت رو روی arial بزار ، و بعد لیست کشویی script رو باز کن و بزارش روی arabic و بعد اوکی کن.
حالا فارسی ساپورت میشه.
در سیستم هایی که فارسی رو نشون نمیدن باید بری داخل control panel و گزینه region and language و تمامی تب های بالا رو یکی یکی بری و اگه توشون لیسن کشویی داره که روی چیزی غیر از ایران و یا فارسی تنظیم شده ، تغییرش بدی و اگه ایران داره بزاری روی ایران و اگه فارسی داره بزاری روی فارسی. بعد از اولین ریست اون سیستم برنامه ای که قبلا حروفش رو فارسی بود و فارسی نشون نمیداد رو به خوبی نشون میده.