XProfan

Def PtInRect(3) !"USER32","PtInRect"

Proc CheckMouse

    Parameters hw&,x%,y%,lang&[onummer&],breit&[onummer&]
    Dim rect#,16
    Dim rectpt#,8
    Long rect#,0=x%
    Long rect#,4=y%
    Long rect#,8=lang&[onummer&]
    Long rect#,12=breit&[onummer&]
    GetCursorPos(rectpt#)
    ScreenToClient(hw&,rectpt#)

    If Neq(PtInRect(rect#,Long(rectpt#,0),Long(rectpt#,4)),0)

        result%=1

    EndIf

    Dispose rect#
    Dispose rectpt#

EndProc

Def @GetCursorPos(1) !"USER32","GetCursorPos"
Def @ScreenToClient(2) !"USER32","ScreenToClient"
Def @Ptinrect(3) !"USER32","PtInRect"
Def @WaitMessage(0) !"USER32","WaitMessage"
Declare Rect#,Rectpt#,Dialog&,Message#
Windowstyle 31
LET Dialog&=@CreateWindow(%Desktop,"Mausklick auf Dialog",30,30,300,300)
Usecursor 0

While %Menuitem<>-2

    @WaitMessage()
    Startpaint Dialog&
    Rectangle 30,30-60,60
    Endpaint

    IF @Checkmouse(Dialog&,30,30,60,60)=1

        IF %Message=514

            @messagebox("Mit linker Maustaste ins schwarze getroffen!","Treffer!",64)

        endif

    endif

    Usecursor 0

wend

Proc Checkmouse

    Parameters Hw&,X%,Y%,Lang&,Breit&
    Declare Result&
    Dim Rect#,16
    Dim Rectpt#,8
    Long Rect#,0=X%
    Long Rect#,4=Y%
    Long Rect#,8=Lang&
    Long Rect#,12=Breit&
    @Getcursorpos(Rectpt#)
    @Screentoclient(Hw&,Rectpt#)
    LET Result&=@Ptinrect(Rect#,@long(Rectpt#,0),@long(Rectpt#,4))
    Dispose Rect#
    Dispose Rectpt#
    Return Result&

Endproc

procedure WAITINPUT;
Begin
ChildMsg := 0;
InWaitInput := True;
MausKnopfR := False;
MausKnopfL := False;
ItemMsg := False;
MenuePunkt := 0;
LastFocus  := 0;
ItemID     := 0;
EvRepaint  := false;
EvTimer    := False;
EvHelp     := False;
ButtonL := False;
ButtonR := False;
Taste := #0;
Scankey := 0;
UMeld := 0;
UWPar := 0;
ULPar := 0;
notified := false;

While Not ScanPressed    And Not MausPressedL And

    Not TastePressed   And Not MausPressedR And
    NOT ButtonPressedL And not ButtonPressedR And
    Not EvRepaint      And Not EvTimer And
    (Menuepunkt = 0)   And (ItemID = 0) AND
    Not UserMessage    AND Not Notified
    Do Begin
    Sleep(1);
    MessageLoop;
    End;
    LastMessage := Meld;
    LastFocus := GetFocus;

    If evHelp Then LastFocus := -LastFocus;

        ch := taste;
        inWaitInput := False;
        clearkeybuffer;
        Ok := True;
        End;

PROCEDURE MessageLoop;
var M:TMsg;
BEGIN

If GetAsyncKeyState(112) = -32767 Then WindowChar(Byte(5));

    WHILE PeekMessage(M,0,0,0,pm_Remove) DO BEGIN

        If (M.Message >= wm_KeyFirst)   And (M.Message <wm_KeyLast>= wm_MouseFirst) And (M.Message <= wm_MouseLast) Then GIS := True;

            IF M.Message = wm_Quit THEN Terminate;

                If TranslateAccelerator(crtwindow,hAccTab,M) = 0 Then Begin

                    If Not IsDialogMessageEx(M) Then Begin

                        IF ((M.Message <> wm_SysKeyDown) And (M.Message <> wm_SysCommand)

                            or (OhneSysKey = False))
                            and ((M.Message <> wm_SysCommand) or (OhneAltF4 = False))
                            Then Begin
                            TranslateMessage(M);
                            DispatchMessage(M);
                            End Else Begin
                            M.Message := wm_Command;
                            M.LParam := 0;
                            M.WParam := M.WParam AND $0000FFFF;
                            TranslateMessage(M);
                            DispatchMessage(M);
                            END;
                            End;
                            END Else Begin
                            DispatchMessage(M);
                            End;
                            END;
                            END;