'#############################
'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_CTLCOLORSTATIC'Muss 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& = 1
   Endif
EndWhile