VBNet - Форум - Помогите заблокировать и покрасить Control'ы

Вопрос: Помогите заблокировать и покрасить 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
	Public Class Form1 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
	Public Class Form1 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(Алексей), спасибо огромное. Все работает. Ответить

Страница: 1 |