PDA

View Full Version : سوال: سؤال در مورد راست کلیک و تکست



Hassan2500
دوشنبه 22 اسفند 1390, 11:09 صبح
سلام
1- من میخام وقتی روی تکست1 راست کلیک میکنم همه گزینه های راست کلیک حذف شوند و فقط گزینه های گزینه Copy و Paste و Cut و Delete وجود داشته باشند و هنگام راست کلیک روی تکست2 فقط گزینه Copy وجود داشته باشد و هنگام راست کلیک روی تکست3 اصلاً راست کلیک باز نشه و کار نکنه اگه میشه کدش رو کامل برام بنویسید

2- یه سؤال دیگه هم دارم من میخام این کد زیر طوری ویرایش شود که وقتی مولتی لاین تکست1 True بود اگه در تکست1 دو خط (یا بیشتر) بدون زدن دکمه اینتر وجود داشت یعنی هنگام نوشتن ایجاد شد با زدن دکمه پائین کیبورد فوکوس ابتدا از خط یک به خط دو برود بعد اگر خط دیگری زیرش نبود فوکوس به تکست2 برود


Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim a As Boolean: a = True
For i = Text1.SelStart To Len(Text1)
If Mid(Text1, i + 1, 1) = Chr(10) Then a = False
Next
If a = True Then If KeyCode = 40 Then Text2.SetFocus: KeyCode = 0
End Sub

ASedJavad
دوشنبه 22 اسفند 1390, 14:54 عصر
برای سوال یکت همچی کاری ظاهرا نمیشه کرد ولی میتونی کلا منوی پیشفرض روغیرفعال کنی و خودت یک منوی جدید براش بسازی
در کل اینجا رو نگاه کنی بد نیست
http://barnamenevis.org/showthread.php?189224-PopUpMenu-%D8%AF%D8%B1-%D8%AA%DA%A9%D8%B3%D8%AA-%D8%A8%D8%A7%DA%A9%D8%B3

محسن واژدی
دوشنبه 22 اسفند 1390, 22:47 عصر
سلام علیکم
برای سوال دوم، دستورات زیر اساس کار را آسان میکنند، فقط کافیست با کمی دستورالعمل مشخص کنید که اگر caret در فلان خط بود به Text2 پرش کند

Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Const EM_GETLINE As Long = &HC4
Private Const EM_GETLINECOUNT As Long = &HBA
Private Const EM_LINEINDEX As Long = &HBB
Private Const EM_LINELENGTH As Long = &HC1
Private Const EM_LINEFROMCHAR = &HC9

Public Function GetLineCount(tTextBox As TextBox) As Long
GetLineCount = SendMessage(tTextBox.hwnd, EM_GETLINECOUNT, 0, 0)
End Function

Public Function GetCurLineIndex(tTextBox As TextBox) As Long
GetCurLineIndex = SendMessage(tTextBox.hwnd, EM_LINEFROMCHAR, -1, 0) + 1
End Function


Public Sub GoToLine(tTextBox As TextBox, lLineIndex&)
If lLineIndex& > 0 Then
tTextBox.SelStart = SendMessage(tTextBox.hwnd, EM_LINEINDEX, lLineIndex& - 1, ByVal 0)
End If
End Sub


GetLineCount: تعداد خطوط را برمیگرداند، چه خطوطی که با Enter شکسته باشند و چه خطوطی که بواسطه رسیدن به انتهای text-box شکسته باشند؛
GetCurLineIndex: شماره خط فعلی که نشان در آنجا قرار دارد را برمیگرداند، از این میتوانید بمنظور بررسی اینکه آیا نشان در خط دوم قرار دارد یا خیر استفاده کنید؛
GoToLine: به خط تعیین شده پرش میکند.

برای بررسی میتوانید پس از قرار دادن دستورات بالا در مادول، یک Text1 بر روی فرم ایجاد کرده سپس دستور زیر را در مادول فرم کپی و بررسی کنید:

Private Sub Text1_Change()
Caption = "Ln: " & GetLineCount(Text1) & " | CurLn:" & GetCurLineIndex(Text1)
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Text1_Change
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Text1_Change
End Sub


موفق باشید