Click to See Complete Forum and Search --> : YOU GUYS MUST BE SMARTER THAN THIS...
TRAUKEN
Dec 10th, 2000, 11:49 AM
iF NONE OF YOU ARE ABLE TO ANSWER THIS QUESTION TELL ME WHERE I CAN GET A HOLD OF SOMEONE WHO CAN.
I AM TRYING TO WRITE SOME CODE THAT IS BASED ON AN API CONTROL EXAMPLE I DOWNLOADED FROM A PROGRAMMING SITE. IF YOU COULD HELP ANSWER THIS, I WOULD GREATLY APPRECIATE IT.
HERE IS WHAT I AM TRYING TO DO...
NewColor = vbRed
' Create Control Window and Show it
gEditHwnd1& = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", Txt, WS_CHILD, m_BoxLeft, m_BoxTop, m_BoxWidth, m_BoxHeight, Me.hwnd, 0&, App.hInstance, 0&)
If (gEditHwnd1& <> 0) Then
Call ShowWindow(gEditHwnd1&, SW_SHOWNORMAL)
'ALL VARIABLES ARE LONG
ehDc& = GetWindowDC(gEditHwnd1&)
CurColor = GetTextColor(ehDc&)
di = SetTextColor(ehDc&, NewColor)
di = TextOut(ehDc&, m_BoxLeft, m_BoxTop, Txt, Len(Txt))
SetTextColor CurColor, CurColor
di = ReleaseDC(gEditHwnd1&, ehDc&)
End If
I NEED TO SET THE FONT AND FONTCOLOR OF THE NEWLY CREATED EDITCONTROL. AM I DOING THIS RIGHT? BECAUSE GETTEXTCOLOR AND SETTEXTCOLOR DO NOT RETURN ANYTHING EXCEPT 0.
IF YOU HAVE A BETTER SOLUTION LET ME KNOW. I ALSO HAVE THE WNDPROC SUB I'VE SET UP TO SUBCLASS THE CONTROL.
THANX
Jop
Dec 10th, 2000, 05:21 PM
Well, it's always a good thing to post the API calls you use with your post, because I don't have a Get/SetTextColor API call in my API viewer (www.allapi.net)
maybe try doing it with the SendMessage API and these constants:
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Const WM_USER = &H400
Const EM_SETBKGNDCOLOR = (WM_USER + 67)
TRAUKEN
Dec 10th, 2000, 07:20 PM
Here are my API Calls:
They are in a .bas module.
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long)
Public Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long)
Public Declare Function GetTextColor Lib "gdi32" (ByVal hdc As Long) As Long
Public Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long)
VB6.0 SP3 Win2000
Aaron Young
Dec 10th, 2000, 08:00 PM
Use the Window Callback function (subclassing the controls parent window, not the control itself.) to capture the "WM_CTLCOLOREDIT" message, which passes in the Device context of the Editbox allowing you to manipulate the colors, i.e.Public Function EditControlWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_CTLCOLOREDIT Then
'Set a random Text Color
Call SetTextColor(wParam, QBColor(Int(Rnd * 15)))
'Create and return the Edit controls Background color brush.
If glBrush Then Call DeleteObject(glBrush)
glBrush = CreateSolidBrush(GetBkColor(wParam))
EditControlWindowProc = glBrush
Else
EditControlWindowProc = CallWindowProc(lHwndProc, hWnd, Msg, wParam, lParam)
End If
End Function
TRAUKEN
Dec 10th, 2000, 09:08 PM
OK, I'M CONFUSED AARON.
BY THE LOOKS OF YOUR CODE YOU ARE SUBCLASSING THE CONTROL NOT THE PARENT WINDOW. AM I WRONG ABOUT THAT? BECAUSE MY SUBCLASS WNDPROC IS FOR THE CONTROL, NOT THE PARENT--BUT LOOKS VERY SIMILAR TO YOURS OUR NAMES ARE ALMOST IDENTICAL--BUT I SEE YOU SAY I SHOLD ALSO SUBCLASS THE PARENT. COULD YOU CLARIFY? I AM TRYING IT NOW BUT ARE YOU SURE I CAN USE THIS MESSAGE TO INTERCEPT AND SET THE FORECOLOR? I AM NOT LOOKING TO SET THE BACKGROUND COLOR--YET. BUT THE FONT AND FORECOLOR SETTINGS ARE URGENT.
THANX, TRAUKEN
Aaron Young
Dec 10th, 2000, 09:13 PM
Yes, I am sure.
You need to subclass the parent form as the control send it the WM_CTLCOLOREDIT message alow with a valid control Device Context and Window Handle which you can use with the SetTextColor() API to set the ForeColor of the control, the return value of the message is the only thing used for setting the "Backcolor" of the control and all I'm doing in my example is sending back the color already used.
I have tried this and it does work.
TRAUKEN
Dec 10th, 2000, 09:21 PM
How should I get a valid DC in this case, GetDC or GetWindowDC? or some other way? I am not sure in the area of subclassing-- only when I do graphics programming with the API.
Aaron Young
Dec 10th, 2000, 10:02 PM
The Valid DC is passed as the "wParam" of the callback function, here's a full working example:
In a Module:Option Explicit
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Const WS_EX_CLIENTEDGE = &H200
Private Const WS_CHILD = &H40000000
Private Const SW_SHOWNORMAL = 1
Private Const GWL_WNDPROC = (-4)
Private Const WM_CTLCOLOREDIT = &H133
Private lFormWndProc As Long
Public Type Editbox
hWnd As Long
ForeColor As Long
BackgroundBrush As Long
Index As Long
End Type
Private tEditBoxes() As Editbox
Private lEditBoxCount As Long
Public Function FormWindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tEditBox As Editbox
If Msg = WM_CTLCOLOREDIT Then
tEditBox = GetEditBox(lParam)
If tEditBox.hWnd Then
With tEditBox
Call SetTextColor(wParam, .ForeColor)
If .BackgroundBrush Then
Call DeleteObject(.BackgroundBrush)
End If
.BackgroundBrush = CreateSolidBrush(GetBkColor(wParam))
FormWindowProc = .BackgroundBrush
End With
Exit Function
End If
End If
FormWindowProc = CallWindowProc(lFormWndProc, hWnd, Msg, wParam, lParam)
End Function
Public Function SubClassForm(ByVal hWnd As Long) As Boolean
If lFormWndProc Then Exit Function
lFormWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf FormWindowProc)
SubClassForm = True
End Function
Public Function RemoveFormSubclassing(ByVal hWnd As Long) As Boolean
If lFormWndProc Then Exit Function
Call SetWindowLong(hWnd, GWL_WNDPROC, lFormWndProc)
RemoveFormSubclassing = True
End Function
Public Function CreateEditbox(ByVal ParentHwnd As Long, ByVal Left As Long, ByVal Top As Long, ByVal Width As Long, ByVal Height As Long) As Editbox
Dim lHwnd As Long
lHwnd = CreateWindowEx(WS_EX_CLIENTEDGE, "Edit", "", WS_CHILD, Left, Top, Width, Height, ParentHwnd, 0&, App.hInstance, 0&)
If lHwnd = 0 Then Exit Function
Call ShowWindow(lHwnd, SW_SHOWNORMAL)
lEditBoxCount = lEditBoxCount + 1
ReDim Preserve tEditBoxes(lEditBoxCount)
tEditBoxes(lEditBoxCount).hWnd = lHwnd
tEditBoxes(lEditBoxCount).ForeColor = vbBlack
tEditBoxes(lEditBoxCount).Index = lEditBoxCount
CreateEditbox = tEditBoxes(lEditBoxCount)
End Function
Public Function GetEditBox(ByVal hWnd As Long) As Editbox
Dim lIndex As Long
For lIndex = 0 To lEditBoxCount
If tEditBoxes(lIndex).hWnd = hWnd Then Exit For
Next
If lIndex <= lEditBoxCount Then
GetEditBox = tEditBoxes(lIndex)
End If
End Function
Public Function SetEditboxForeColor(ByVal Index As Long, ByVal Color As ColorConstants) As ColorConstants
If Index > lEditBoxCount Then Exit Function
tEditBoxes(Index).ForeColor = Color
SetEditboxForeColor = tEditBoxes(Index).ForeColor
End FunctionIn a Form:Option Explicit
Private Sub Form_Load()
Dim tNewEditBox As Editbox
SubClassForm hWnd
tNewEditBox = CreateEditbox(hWnd, 10, 10, 150, 28)
Call SetEditboxForeColor(tNewEditBox.Index, vbRed)
End Sub
Private Sub Form_Unload(Cancel As Integer)
RemoveFormSubclassing hWnd
End Sub
TRAUKEN
Dec 10th, 2000, 10:13 PM
You went way out of your way, But I really appreciate it!!!
I did get your previous example to work but this last code snippet explained the rest of my questions.
YOU GUYS ARE SMARTER THAN THIS!
THANK YOU AGAIN, I WILL LEAVE YOU ALONE TILL NEXT TIME.
Dennis AKA TRAUKEN
vbforums.com
Copyright Internet.com Inc., All Rights Reserved.