#############################
XProfan
#############################
Author : Andreas Miethe
Oktober 2003
#############################
Thema : Window-Prozedur
#############################
$H windows.ph
$H structs.ph
$H messages.ph
$H shellapi.ph
Struct Point = ~Point
Declare OldWindowProc&,Button&,Ende&
Declare Hyperlink&,HyperMail&,Google&,GEdit&,hfnormal&,hfmouse&
Declare normalcursor&,mousecursor&
Declare highlighted&,Brush&
Declare Point#
Dim Point#,Point
Def HiWord(1) Div&(&(1),$10000)
Def LoWord(1) And(&(1),$FFFF)
set(FastMode,1)
----------------------------------------------------------------------
benötigte Cursor und Fonts laden
----------------------------------------------------------------------
normalcursor& = ~LoadCursor(0,~IDC_ARROW)normaler Mauszeiger
mousecursor& = ~LoadCursor(0, 32649)Hand
hfnormal& = ~createfont(13,0,0,0,~FW_DONTCARE,0,1,0,0,0,0,0,0,Verdana)normaler Hyperlink-Font
hfmouse& = ~createfont(13,0,0,0,~FW_BOLD,0,1,0,0,0,0,0,0,Verdana)hightlight Hyperlink-Font
----------------------------------------------------------------------
Proc SetColor
----------------------------------------------------------------------
Hintergrundfarbe und Textfarbe für Static-Controls ändern
----------------------------------------------------------------------
Parameters Textcolor&,BackColor&,wParam&
If Brush&
~DeleteObject(Brush&)
Endif
Brush& = ~CreateSolidBrush(BackColor&)
~SetBkMode(wParam&, ~TRANSPARENT)
~SetTextColor(wParam&,Textcolor&)
return Brush&
Endproc
Proc WindowProc
----------------------------------------------------------------------
Fenster-Callback
----------------------------------------------------------------------
Parameters Wnd&, Msg&, wParam&, lParam&
If Msg& = ~WM_LBUTTONDOWN
~GetCursorPos(Point#)Cursorposition ermittel
~MapWindowPoints(0,wnd&,Point#,1)Cursorposition umrechnen auf Fenster-Koordinaten
If ~ChildWindowFromPoint(wnd&,Point#.x&,Point#.Y&) = Hyperlink&ist das Control unter der Maus der Hyperlink ?
ShellExec(http:\www.andreas-miethe.de,open,~SW_SHOWNORMAL)
Return 0
Endif
If ~ChildWindowFromPoint(wnd&,Point#.x&,Point#.Y&) = Hypermail&
ShellExec(mailto: andreas@andreas-miethe.de?Subject=Testmail&body=Superteil,open,~SW_SHOWNORMAL)
Return 0
Endif
If ~ChildWindowFromPoint(wnd&,Point#.x&,Point#.Y&) = Google&
ShellExec(http://www.google.com/search?hl=en&ie=ISO-8859-1&q= + GetText$(GEdit&),open,~SW_SHOWNORMAL)
Return 0
Endif
Endif
If Msg& = ~WM_MOUSEMOVE
~GetCursorPos(Point#)
~MapWindowPoints(%Desktop,wnd&,Point#,1)
If OR(OR(~ChildWindowFromPoint(wnd&,Point#.x&,Point#.Y&) = Hyperlink&,~ChildWindowFromPoint(wnd&,Point#.x&,Point#.Y&) = HyperMail&),
~ChildWindowFromPoint(wnd&,Point#.x&,Point#.Y&) = Google&)
~SetCursor(mousecursor&)
If ~ChildWindowFromPoint(wnd&,Point#.x&,Point#.Y&) = Hyperlink&
If highlighted& = 0
~SendMessage(Hyperlink&,~WM_SETFONT,hfmouse&,1)
highlighted& = 1
Return 0
EndIf
Endif
If ~ChildWindowFromPoint(wnd&,Point#.x&,Point#.Y&) = HyperMail&
If highlighted& = 0
~SendMessage(HyperMail&,~WM_SETFONT,hfmouse&,1)
highlighted& = 1
Return 0
Endif
Endif
If ~ChildWindowFromPoint(wnd&,Point#.x&,Point#.Y&) = Google&
If highlighted& = 0
~SendMessage(Google&,~WM_SETFONT,hfmouse&,1)
highlighted& = 1
Return 0
Endif
Endif
Else
If highlighted& = 1
~SendMessage(Hyperlink&,~WM_SETFONT,hfnormal&,1)
~SendMessage(HyperMail&,~WM_SETFONT,hfnormal&,1)
~SendMessage(Google&,~WM_SETFONT,hfnormal&,1)
~SetCursor(normalcursor&)
highlighted& = 0
Return 0
EndIf
EndIf
Endif
If Msg& = ~WM_CTLCOLORSTATICMuss ein Static neugezeichnet werden ?
If highlighted& = 1
Return SetColor(rgb(128,0,128),~GetSysColor(~COLOR_BTNFACE),wParam&)
Endif
Endif
alle Messages die nicht behandelt wurden an die Original-Prozedur weiterleiten
return ~CallWindowProc(OldWindowProc&,Wnd&, Msg&, WParam&, LParam&)
EndProc
CLS ~GetSysColor(~COLOR_BTNFACE)
----------------------------------------------------------------------
Controls anlegen
----------------------------------------------------------------------
Button& = CreateButton(%hwnd,Ende,10,120,80,24)
Sendmessage(Button&,~WM_SETFONT,~GetStockObject(~DEFAULT_GUI_FONT),1)
Hyperlink& = CreateText(%hwnd,Homepage,10,10,80,20)
Sendmessage(Hyperlink&,~WM_SETFONT,hfnormal&,1)
HyperMail& = CreateText(%hwnd,Mail,10,40,80,20)
Sendmessage(HyperMail&,~WM_SETFONT,hfnormal&,1)
Google& = CreateText(%hwnd,Google-Suche :,10,70,110,20)
Sendmessage(Google&,~WM_SETFONT,hfnormal&,1)
GEdit& = CreateEdit(%hwnd,Profan,130,66,200,20)
Sendmessage(GEdit&,~WM_SETFONT,~GetStockObject(~DEFAULT_GUI_FONT),1)
----------------------------------------------------------------------
----------------------------------------------------------------------
Fenster-Prozedur austauschen
----------------------------------------------------------------------
OldWindowProc& = ~SetWindowLong(%hwnd,~GWL_WNDPROC, ProcAddr(WindowProc,4))
----------------------------------------------------------------------
WhileNot Ende&
WaitInput
If GetFocus(Button&)
~DeleteObject(hfnormal&)
~DeleteObject(hfmouse&)
Dispose Point#
Ende& =s2>= 1
Endif
EndWhile
Salve, iF.