Страница: 1 |
Страница: 1 |
Вопрос: Помогите заблокировать и покрасить Control'ы
Добавлено: 20.11.07 18:48
Автор вопроса: PVV
1. Как исключить доступ к контролу (аналогично свойству Enabled), но чтобы внешний вид контрола не менялся (фон, цвет и т.д.)
2. Как все-таки изменить цвет фона в DateTimePicker (ну очень хоцца желтенький)
(VB.NET 2005)
Ответы
Всего ответов: 10
Номер ответа: 1
Автор ответа:
BG(Алексей)
Вопросов: 26
Ответов: 295
Профиль | | #1
Добавлено: 21.11.07 05:14
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
 ateTimePicker1.CalendarMonthBackground = Color.Yellow
End Sub
End Class
Номер ответа: 2
Автор ответа:
PVV
Вопросов: 8
Ответов: 21
Профиль | | #2
Добавлено: 21.11.07 08:11
Спасибо. Но это фон выпадающего календаря, а мне нужен цвет фона самого поля со стрелкой, т.е. backColor, про который в MSDN написано, что изменение этого свойства у данного контрола к желаемым последствиям не приводит.
Номер ответа: 3
Автор ответа:
EUGY
Вопросов: 0
Ответов: 454
Профиль | | #3
Добавлено: 21.11.07 11:10
Лень писать пример, тем более на нелюбимом .NET, но теоретически сделал бы так:
Сабкласировать DateTimePicker, в оконной процедуре заблокировать WM_MOUSEACTIVATE и WM_SETFOCUS (исключить доступ к контролу), в WM_PAINT залить клиентскую область окна нужным фоном кроме области кнопки(FillRect), потом DrawText.
Может придется помучиться с highlight частями при разных форматах даты.
Номер ответа: 4
Автор ответа:
EUGY
Вопросов: 0
Ответов: 454
Профиль | | #4
Добавлено: 21.11.07 13:03
Нет, все еще проще:
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim hwnd As Long
hwnd = DateTimePicker1.Handle.ToInt64
SetProp(hwnd, "QWERTY", SetWindowLong(hwnd, GWL_WNDPROC, AddressOf calproc))
End Sub
'----------------------------------------------
Module Module1
Public Const GWL_WNDPROC = (-4)
Public Const SM_CXVSCROLL = 2
Public Const WM_ERASEBKGND = &H14
Public Structure RECT
Dim Left As Integer
Dim Top As Integer
Dim Right As Integer
Dim Bottom As Integer
End Structure
Delegate Function QWERTYDUMMY(ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As QWERTYDUMMY) As Integer
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Integer, ByVal hWnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Public Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal hwnd As Integer, ByVal lpString As String, ByVal hData As Long) As Integer
Public Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal hwnd As Integer, ByVal lpString As String) As Integer
Public Declare Function GetClientRect Lib "user32" Alias "GetClientRect" (ByVal hwnd As Integer, ByRef lpRect As RECT) As Integer
Public Declare Function FillRect Lib "user32" Alias "FillRect" (ByVal hdc As Integer, ByRef lpRect As RECT, ByVal hBrush As Integer) As Integer
Public Declare Function CreateSolidBrush Lib "gdi32" Alias "CreateSolidBrush" (ByVal crColor As Integer) As Integer
Public Declare Function DeleteObject Lib "gdi32" Alias "eleteObject" (ByVal hObject As Integer) As Integer
Public Function calproc(ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
Select Case Msg
Case WM_ERASEBKGND
Dim rccl As RECT
Dim hdc As Integer
Dim hbr As Integer
hdc = wParam
hbr = CreateSolidBrush(RGB(255, 255, 0))
GetClientRect(hwnd, rccl)
FillRect(hdc, rccl, hbr)
 eleteObject(hbr)
Exit Function
Case &H7 ' WM_SETFOCUS
' calproc = 1
'Exit Function
Case &H21 'WM_MOUSEACTIVATE
' calproc = 4 'MA_NOACTIVATEANDEAT
' Exit Function
End Select
calproc = CallWindowProc(GetProp(hwnd, "QWERTY", hwnd, Msg, wParam, lParam)
End Function
End Module
Номер ответа: 5
Автор ответа:
PVV
Вопросов: 8
Ответов: 21
Профиль | | #5
Добавлено: 21.11.07 16:49
Очень спасибо. Доступ к контролу закрыл. Правда на кнопку реагирует. Наверно нужно еще какую-нибудь WM_ку заблокировать (поищу). С красками дела пока хуже: фон нужным цветом залил, но пропала кнопка (появляется только при щелчке мышкой там, где она должна быть, и видна только пока виден выпадающий календарь. Область заливки сделал на 13 п короче длины контрола, как иначе определить, чтобы кнопку не закрашивать, не знаю. И пока не знаю, как сделать текст. Зато понял, куда рыть, еще раз спасибо.
Номер ответа: 6
Автор ответа:
EUGY
Вопросов: 0
Ответов: 454
Профиль | | #6
Добавлено: 21.11.07 16:59
Что-то ты не туда роешь. Приведенный пример не имеет таких проблем.
Номер ответа: 7
Автор ответа:
PVV
Вопросов: 8
Ответов: 21
Профиль | | #7
Добавлено: 21.11.07 18:00
EUGY, это я попробовал по первому посту, а вот то, что во втором... Не знаю, смогу ли вкурить. Я в VB еще только несколько букв освоил, а другого опыта и вовсе не имел... Буду разбираться, спасибо.
Номер ответа: 8
Автор ответа:
PVV
Вопросов: 8
Ответов: 21
Профиль | | #8
Добавлено: 21.11.07 21:13
EUGY, попробовал код из второго поста - выдает ошибку. что-то вроде вызванная функция имеет несбалансированное множество. Понять, что это такое и как должен работать приведенный код, пока не для меня. Хотелось бы обойтись без API функций - ничего вразумительного про них не читал, а вот по сабклассингу с одной статьей ознакомился и смутное представление вроде бы появилось. Попробую поработать с первым вариантом. Блокировка должна получиться, а с фоном - не так уж и важно.
Номер ответа: 9
Автор ответа:
BG(Алексей)
Вопросов: 26
Ответов: 295
Профиль | | #9
Добавлено: 22.11.07 07:32
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim dt As New cDateTimePicker
dt.BackColor = Color.Yellow
Me.Controls.Add(dt)
End Sub
End Class
Public Class cDateTimePicker
Inherits DateTimePicker
Private _BackColor As Color = SystemColors.Window
Public Overloads Overrides Property BackColor() As Color
Get
Return _BackColor
End Get
Set(ByVal value As Color)
_BackColor = value
Invalidate()
End Set
End Property
Protected Overloads Overrides Sub WndProc(ByRef m As Message)
If m.Msg = CInt(20) Then
Dim g As Graphics = Graphics.FromHdc(m.WParam)
g.FillRectangle(New SolidBrush(_BackColor), ClientRectangle)
g.Dispose()
Return
End If
MyBase.WndProc(m)
End Sub
End Class
Номер ответа: 10
Автор ответа:
PVV
Вопросов: 8
Ответов: 21
Профиль | | #10
Добавлено: 22.11.07 08:48
BG(Алексей), спасибо огромное. Все работает.