XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Hyperlink erstellen (auch mit Google-Suche)
#############################
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