|
Доброго времени суток, Посетитель!
|
|
|
|
|
|
|
|
|
вид форума:
|
| |
|
|
| | Суть - юзер получает доступ на редактирование поля - только по нажатию комбинации клавиш, в данном случае Ctrl+Del - им так нравится, но после получения доступа оно (событие Ctrl+Del) продолжает свои стандартные действа и убивает все что лежит с права от курсора -
вопрос - можно ли это запретить делать? | |
| |
| |
| |
|
|
| | А если по умолчанию запретить доступ к полю и сделать блокировку. (Поле.Locked=true, Поле.Enabled=false). А по нажатию этой дивной комбинации дать доступ и разблокировать поле. | |
| |
| |
| |
|
|
| | убедить пользоваться другой комбинацией :)
геморрных пользователей надо воспитывать  | |
| |
| |
| |
|
|
| | +1
не лучшая комбинация клавиш | |
| |
| |
| |
|
|
| | ну это легкий путь - не наш метод.
наш девиз - "только преодолевая трудности ты становишся человеком"
а если серьезно - эсть такая возможность или это происходит на уровне оси??? | |
| |
| |
| |
|
|
| | я смутно помню, что можно переопределить назначение клавиш в макросе с именем AutoKeys, вроде
только не совсем помню, насчет системных клавиш и комбинаций :)
как вариант - "вешать" на клавиатуру hook и обрабатывать ;)
Анатолий(Киев) меня поправит  | |
| |
| |
| |
|
|
| | ясно - проще пристрелить юзеров 
всем спасибо. | |
| |
| |
| |
|
|
| | А msgbox KeyAscii в событии KeyPress что даёт? | |
| |
| |
| |
|
|
| | тут вопрос в другом оно нормально работат, но потом продолжает выполнять прописанные осью действа, а их не нужно в данный исторический момент.  | |
| |
| |
| |
|
|
| | ААААААААААААААААА
Надо подсунуть другую команду...
или она всё равно потом удалит......
А может UNDO - хотя надо дождаться завершения, а потом ундо | |
| |
| |
| |
|
|
| | А если поставить курсор в конец поля - удалять нечего будет... | |
| |
| |
| |
|
|
| | Me!NUMBER.SelStart = Len(Me!NUMBER.Text) | |
| |
| |
| |
|
|
| | как вариант | |
| |
| |
| |
|
|
| | Или там на хвосте написать ненужный символ и передним курсор поставить - пусть его дельтнет - а всё остальное останется
Me!NUMBER = Me!NUMBER & "X"
Me!NUMBER.SelStart = Len(Me!NUMBER.Text)-1 | |
| |
| |
| |
|
|
| |
в данном случае Ctrl+Del - им так нравится
|
А завтра они захотят, чтобы это была кнопка Power на корпусе компа. И ты снова будешь преодолевать трудности, изобретать новую архитектуру ПК  Такие ламерские пожелания надо обходить десятой дорогой. | |
| |
| |
| |
|
|
| |
чтобы это была кнопка Power на корпусе компа
|
да бога ради, не проблема, немного С-4 под кнопку и "Организации требуются сотрудники со своим ПК"
а вообще из спортивного интереса и для общего развития хотелось добить эту ситуёвину.
узнало про Hook дубу пробовать, так что старания наши не напрасны. | |
| |
| | |
| |
|
| |
|
|
| | EBOFOF- - | |
| |
| |
| |
|
|
| | я про hook здесь гдето топик писал :) с примерами... имхо | |
| |
| |
| |
|
|
| | Видимо, это было давно, до "выхода на пенсию". 
Мне, что-то, не попадался. | |
| |
| |
| |
|
|
| | нашел у себя, но это VB
Attribute VB_Name = "riched_hook"
Option Explicit
Public Const WH_KEYBOARD = 2
Public Const VK_ESCAPE = &H1B
Public Const VK_SHIFT = &H10
'-- поиск в ListBox
Private Const LB_FINDSTRING = &H18F
Private Const LB_FINDSTRINGEXACT = &H1A2
Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal ncode As Long, _
ByVal wParam As Long, lParam As Any) As Long
Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
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
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Public hHook As Long
Public Function KeyboardProc(ByVal idHook As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim f As Form
Dim rExp As RegExp
Dim KeybLayoutName$, sSymb$, asci&
Dim ret
'-- if idHook is less than zero, no further processing is required
If idHook < 0 Then
'call the next hook
KeyboardProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
Else
Set f = Forms(0)
'-- нажата ESC
If (GetKeyState(VK_ESCAPE) And &HF0000000) Then 'And wParam = Asc("S")
'-- пошлём ESC и нашему листбоксу
ret = SendMessage(f.List1.hwnd, WM_KEYPRESS, 27, vbNull)
Else
'-- автоподстановка
Dim re&
re = FindWindowEx(GetSpshWnd(f.hwnd), ByVal 0&, "RichEdit20W", vbNullString)
If re <> 0 Then
sSymb = GetText(re)
f.List1.ListIndex = SendMessage(f.List1.hwnd, LB_FINDSTRING, -1, ByVal sSymb)
End If
' '-- пригодиццо обработка других клавиш
' Set rExp = New RegExp
' rExp.IgnoreCase = True
' rExp.Pattern = "."
' sSymb = Chr$(wParam)
' asci = Asc(sSymb)
' '-- обработка странных исключений
' If asci = 219 Or asci = 221 Or asci = 186 Or asci = 222 Or asci = 188 Or asci = 190 Or asci = 191 Then
' sSymb = Switch(asci = 219, Chr("91"), _
' asci = 221, Chr("93"), _
' asci = 186, Chr("59"), _
' asci = 222, Chr("39"), _
' asci = 188, Chr("44"), _
' asci = 190, Chr("46"), _
' asci = 191, Chr("47"))
' End If
' If rExp.Test(sSymb) Then
' '-- шо за раскладка?
' KeybLayoutName = String(9, 0)
' Call GetKeyboardLayoutName(KeybLayoutName)
' KeybLayoutName = CStr(CLng(Left$(KeybLayoutName, _
' InStr(1, KeybLayoutName, Chr(0)) - 1)))
' Select Case KeybLayoutName
' Case "409" '-- английская
' sSymb = sSymb
' Case "419" '-- русская
' sSymb = Eng2Rus(sSymb)
' Case "422" '-- українська
' sSymb = Eng2Ukr(sSymb)
' Case Else ' другая
' sSymb = sSymb
' End Select
' 'sbuff = sbuff & sSymb
' f.StatusBar1.Panels(1).Text = Asc(wParam) & " " & sSymb & " " & KeybLayoutName
' 'ret = SendMessage(f.List1.hwnd, WM_KEYPRESS, wParam, vbNull)
' f.List1.ListIndex = SendMessage(f.List1.hwnd, LB_FINDSTRING, -1, ByVal sSymb)
' 'f.StatusBar1.Panels(1).Text = f.Spreadsheet1.ActiveCell.Value
' End If
' Set rExp = Nothing
End If
'call the next hook
KeyboardProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)
End If
End Function
'-- вызов из формы
' '-- поискать нужный класс
' hwndRichEdit = FindWindowEx(hwndSpreadSheet, ByVal 0&, "RichEdit20W", vbNullString)
' If hwndRichEdit = 0 Then
' If hHook <> 0 Then UnhookWindowsHookEx hHook: hHook = 0
' End If
' If hHook = 0 Then
' hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, App.hInstance, App.ThreadID)
' End If
|
VERSION 5.00
Object = "{0002E558-0000-0000-C000-000000000046}#1.0#0"; "OWC11.DLL"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmMain
Caption = "Tune DWH Light"
ClientHeight = 8265
ClientLeft = 165
ClientTop = 735
ClientWidth = 10710
LinkTopic = "Form1"
ScaleHeight = 8265
ScaleWidth = 10710
StartUpPosition = 3 'Windows Default
Begin VB.Timer Timer1
Interval = 777
Left = 8760
Top = 1680
End
Begin VB.ListBox List1
Appearance = 0 'Flat
BackColor = &H00E0E0E0&
Height = 1590
ItemData = "frmMain.frx":0000
Left = 8760
List = "frmMain.frx":0002
TabIndex = 2
Top = 0
Visible = 0 'False
Width = 1695
End
Begin ComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 375
Left = 0
TabIndex = 0
Top = 7890
Width = 10710
_ExtentX = 18891
_ExtentY = 661
SimpleText = ""
_Version = 327682
BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
NumPanels = 1
BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
Key = ""
Object.Tag = ""
EndProperty
EndProperty
End
Begin OWC11.Spreadsheet Spreadsheet1
Height = 6600
Left = 0
OleObjectBlob = "frmMain.frx":0004
TabIndex = 1
Top = 0
Width = 8565
End
Begin VB.Menu xx
Caption = "xx"
End
Begin VB.Menu m_Treasury
Caption = "ыыыы"
Index = 0
Begin VB.Menu m_stc
Caption = "аааа"
Index = 1
End
Begin VB.Menu m_STC_carm
Caption = "ааааыва"
Index = 2
End
Begin VB.Menu m_stc_original
Caption = "ываыва"
Index = 7
End
End
Begin VB.Menu m_products
Caption = "цав"
Index = 4
Begin VB.Menu m_tune_goods_grp
Caption = "апв"
Index = 5
End
Begin VB.Menu m_goods_ukrup_grp
Caption = "апра"
Index = 6
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type ROWCOLUMN
row As Long
col As Long
End Type
Private Const dsn = ""
Private Const usr = ""
Private Const pwd = ""
Private tgt As OWC11.Range
Private rerc As ROWCOLUMN
'-- флаг наличия листбокса, чтобы не выводить повторно
Private bListVisible As Boolean
'-- дескриптор SpreadSheet
Private hwndSpreadSheet&
Private Sub Form_Load()
StatusBar1.Panels(1).AutoSize = sbrContents
'-- on/off
Me.Spreadsheet1.DisplayOfficeLogo = False
Me.Spreadsheet1.DisplayTitleBar = True
Me.Spreadsheet1.DisplayToolbar = True
Me.Spreadsheet1.Visible = False
'-- определить дескриптор SpreadSheet
hwndSpreadSheet = GetSpshWnd(Me.hwnd)
bListVisible = False
Set tgt = Me.Spreadsheet1.Cells(1, 1)
End Sub
Private Sub Form_Resize()
Dim ct As Control
For Each ct In Me
If TypeName(ct) = "Spreadsheet" Then
With ct
.Width = Me.Width - 500
.Height = Me.Height - 1060
End With
End If
Next
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnhookWindowsHookEx hHook: hHook = 0
End Sub
Private Sub List1_DblClick()
On Error GoTo err3232
'-- если выбранная колонка та, что надо
If Me.Spreadsheet1.ActiveCell.Address = tgt.Address Then
'-- попытка обновить данные на сервере
'ключ - все поля?
'-- если удачно - обновить данные в spsht
tgt.Value = Me.List1.Text
End If
Exit Sub
err3232:
MsgBox Err.Description, vbCritical, "Error#" & Err.Number
Exit Sub
End Sub
Private Sub List1_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then
If hHook <> 0 Then UnhookWindowsHookEx hHook: hHook = 0
Me.List1.Visible = False
bListVisible = Me.List1.Visible
End If
'Me.StatusBar1.Panels(1).Text = KeyAscii
End Sub
Private Sub List1_LostFocus()
If hHook <> 0 Then UnhookWindowsHookEx hHook: hHook = 0
Me.List1.Visible = False
bListVisible = Me.List1.Visible
End Sub
'--
Private Sub m_goods_ukrup_grp_Click(Index As Integer)
On Error GoTo err444
SpreadRequest "select f.* from таблицца f order by 1", "вава"
Exit Sub
err444:
MsgBox Err.Description, vbCritical, "Error#" & Err.Number
Exit Sub
End Sub
'--
Private Sub m_STC_carm_Click(Index As Integer)
On Error GoTo err444
SpreadRequest "select f.* from ещётаблицца f order by 1,2,3,4", "ыввв"
Exit Sub
err444:
MsgBox Err.Description, vbCritical, "Error#" & Err.Number
Exit Sub
End Sub
'--
Private Sub m_STC_Click(Index As Integer)
On Error GoTo err444
SpreadRequest "select f.* from иещё by 1,2,3,4", "ыва"
Exit Sub
err444:
MsgBox Err.Description, vbCritical, "Error#" & Err.Number
Exit Sub
End Sub
'--
Private Sub m_stc_original_Click(Index As Integer)
Dim osht As Object
On Error GoTo err444
SpreadRequest "SELECT * FROM гога a order by 1,2,3", _
"вввв"
Exit Sub
err444:
MsgBox Err.Description, vbCritical, "Error#" & Err.Number
Exit Sub
End Sub
'--
Private Sub m_tune_goods_grp_Click(Index As Integer)
Dim osht As Object
On Error GoTo err444
SpreadRequest "SELECT a.gid, a.description, a.nickname, a.budget_description " & _
"FROM ываыв a", "вввы"
Exit Sub
err444:
MsgBox Err.Description, vbCritical, "Error#" & Err.Number
Exit Sub
End Sub
Private Sub Spreadsheet1_Click()
If tgt.Column <> rerc.col Or tgt.row <> rerc.row Then
Me.List1.Visible = False
bListVisible = Me.List1.Visible
End If
If hHook <> 0 Then UnhookWindowsHookEx hHook: hHook = 0
End Sub
Private Sub Spreadsheet1_MouseOver(ByVal Button As Long, ByVal Shift As Long, ByVal Target As OWC11.Range)
Dim hwndRichEdit&
'-- если активный RichEdit, то не перечитывать!
hwndRichEdit = FindWindowEx(hwndSpreadSheet, ByVal 0&, "RichEdit20W", vbNullString)
If hwndRichEdit = 0 Then
If hHook <> 0 Then UnhookWindowsHookEx hHook: hHook = 0
Set tgt = Target '-- заполняем глобальную структуру
End If
'Me.StatusBar1.Panels(1).Text = hHook
End Sub
'-- таймер ожидания появления RichEdit
'-- хорошо бы еще перехватить его события
Private Sub Timer1_Timer()
Dim hwndRichEdit&
Dim sText$
Dim pt As POINTAPI
Dim rc As RECT, fc As RECT
Dim dx&, dy&
'-- поискать нужный класс
hwndRichEdit = FindWindowEx(hwndSpreadSheet, ByVal 0&, "RichEdit20W", vbNullString)
If hwndRichEdit = 0 Then
If hHook <> 0 Then UnhookWindowsHookEx hHook: hHook = 0
End If
'-- если нужные колонки
Select Case Spreadsheet1.Tag
Case "CLT_TUNE"
If tgt.Column = 4 _
And Me.Spreadsheet1.ActiveCell.Column = 4 _
And tgt.row > 1 Then '-- если колонка та, что нужно ;) D
'-- если RichEdit не загружен - уходим
If hwndRichEdit = 0 Then Exit Sub
'--попытка перехватить события RichEdit
If hHook = 0 Then
hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, App.hInstance, App.ThreadID)
End If
'-- если уже работаем с этим, то и нефик еще раз
If bListVisible = True Then Exit Sub
'-- запомним текущие колонку и строку
rerc.col = tgt.Column: rerc.row = tgt.row
'-- нашли! перепрячем, как сало %)
Me.List1.Visible = False
'-- отпозиционировать и обновить данные в ListBox
'-- считаем координаты окна
Call GetWindowRect(Me.hwnd, fc)
'-- определить координаты контрола
GetWindowRect hwndRichEdit, rc
dx = Me.ScaleX(rc.Left - fc.Left - 5, vbPixels, vbTwips)
dy = Me.ScaleY(rc.Top - fc.Top - 4 - _
(GetSystemMetrics(SM_CYMENUSIZE) + _
GetSystemMetrics(SM_CXBORDER) + _
GetSystemMetrics(SM_CYCAPTION)) + _
(rc.Bottom - rc.Top), vbPixels, vbTwips)
'-- если координаты внизу больше клиентской области, то - отображать вверх
If (dy + Me.List1.Height) > Me.Spreadsheet1.Height Then
dy = Me.ScaleY(rc.Top - fc.Top - 4 - _
(GetSystemMetrics(SM_CYMENUSIZE) + _
GetSystemMetrics(SM_CXBORDER) + _
GetSystemMetrics(SM_CYCAPTION)), vbPixels, vbTwips) _
- Me.List1.Height
End If
ListRequest Me.List1, "select f.description from qwerqwer f order by er"
Me.List1.Left = dx
Me.List1.Top = dy
Me.List1.Width = Me.ScaleX((rc.Right - rc.Left + 2), vbPixels, vbTwips)
Me.List1 = tgt.Value
Me.List1.Visible = True
bListVisible = Me.List1.Visible
Else
Me.List1.Visible = False
bListVisible = Me.List1.Visible
End If
Case Else
Me.List1.Visible = False
bListVisible = Me.List1.Visible
End Select
End Sub
Private Sub xx_Click()
' Dim NewDoc As New Form1
' NewDoc.Show
End Sub
'-- ф-ция загрузки SpreadSheet
'-- 20071005
Private Sub SpreadRequest(ssql$, Optional sResp$ = "")
Dim hg As HourGlass
Dim conn As New Connection, rs As New Recordset, oSheet As Object
On Error GoTo err444
If hHook <> 0 Then UnhookWindowsHookEx hHook: hHook = 0
Spreadsheet1.Visible = False
conn.ConnectionString = "Provider=msdaora;" & _
"Data Source=" & dsn & ";" & _
"User Id=" & usr & ";" & _
"Password=" & pwd & ";"
conn.CommandTimeout = 300
Set hg = New HourGlass '-- показать часики
conn.Open
rs.Source = ssql$
Set rs.ActiveConnection = conn
rs.Open
Set oSheet = Spreadsheet1.Worksheets(1)
oSheet.ConnectionString = conn.ConnectionString
oSheet.CommandText = rs.Source
If rs.State <> 0 Then rs.Close
If conn.State <> 0 Then conn.Close
'-- запомним, кто вызвал
Spreadsheet1.Tag = sResp
'-- и [зачеркнуто]накажем[/зачеркнуто] покажем
Spreadsheet1.Caption = sResp
Spreadsheet1.DisplayTitleBar = True
'-- отобразим
Spreadsheet1.Visible = True
Set hg = Nothing
Exit Sub
err444:
MsgBox Err.Description, vbCritical, "Error#" & Err.Number
If rs.State <> 0 Then rs.Close
If conn.State <> 0 Then conn.Close
Spreadsheet1.Visible = False
Set hg = Nothing
Exit Sub
End Sub
Private Sub ListRequest(lst As ListBox, ssql$)
Dim hg As HourGlass
Dim conn As New Connection, rs As New Recordset, i&, inlist$
On Error GoTo err444
conn.ConnectionString = "Provider=msdaora;" & _
"Data Source=" & dsn & ";" & _
"User Id=" & usr & ";" & _
"Password=" & pwd & ";"
conn.CommandTimeout = 300
Set hg = New HourGlass '-- показать часики
Me.List1.Clear
conn.Open
rs.Source = ssql$
Set rs.ActiveConnection = conn
rs.Open
If Not rs.EOF Then rs.MoveFirst
Do While Not rs.EOF
For i = 0 To rs.Fields.Count - 1
If i = 0 Then
If IsNull(rs.Fields(i)) Then
inlist = " "
Else
inlist = rs.Fields(i)
End If
Else
If IsNull(rs.Fields(i)) Then
inlist = inlist & Chr(9) & " "
Else
inlist = inlist & Chr(9) & _
rs.Fields(i)
End If
End If
Next i
lst.AddItem inlist
lst.ItemData(lst.NewIndex) = i
rs.MoveNext
Loop
If rs.State <> 0 Then rs.Close
If conn.State <> 0 Then conn.Close
Set hg = Nothing
Exit Sub
err444:
MsgBox Err.Description, vbCritical, "Error#" & Err.Number
If rs.State <> 0 Then rs.Close
If conn.State <> 0 Then conn.Close
Set hg = Nothing
Exit Sub
End Sub
|
както так в общем  | |
| |
| |
| |
|
|
| | Силblч - спасибо большое, буду разбираться
/написано после 3-х минутного кручения колесика в разных направления, и беззвучного шевеления губами, вспоминая матушку Б. Гейста/ | |
| |
| |
| |
|
|
| | извините если шо не так | |
| |
| |
| |
|
|
| | а это чё такое???
Хук или .... | |
| |
| |
| |
|
|
| | ...а за испуг - саечка | |
| |
| |
| |
|
|
| | Ага, читали мы про ваши "саечки":
| |
| |
| |
| |
|
|
| | Не нуна мне таких саечек, 
я булочками обойдусь.....  | |
| |
| |
HiProg.com - Технологии программирования
|
