XProfan

English

Dialogue with Text

Thomas
Freier

I wanted to gladly Move images and text coveres can. unfortunately I get always only the first lend a hand with.
How could to the solve or there another Solution?
Compile Mark Separation

DECLARE hButt&[22],hText&[22]
Def GetSysColor(1) !"user32","GetSysColor"
Def @Getwindowrect(2) !"USER32", "GetWindowRect"
Def @Screentoclient(2) !"USER32","ScreenToClient"
DEF mouseposx(0) long(mousepos#,0)
DEF mouseposy(0) long(mousepos#,4)
Def Getcursorpos(1) !"USER32","GetCursorPos"
declare mousepos#,HT_Info#
DIM MousePos#,10
DIM HT_Info#,16
Cls GetSysColor(15)
Windowtitle "Linke Maustaste = verschieben, rechte Maustaste = Texteingabe"
Window 800,600
UserMessages $204
var bild.w&=%hWnd
var x%=1
var bmp1&=Create("hNewPic", 300, 202,rgb(0,0,218))
hButt&[x%] = Control("DIALOG","B",$54001100, 0, 30, 300, 210,bild.w&,0,%hinstance,$0)
Create("Bitmap", hButt&[x%], Bmp1&, 0, 0)
Create("text",hButt&[x%],"Boot Nr. 66",0,170,300,20)
hText&[x%] =  Create("text",hButt&[x%],"",0,190,300,20)
SetText hText&[x%],"Bitte Standort prüfen"
Subclass hButt&[x%],1
x%=2
bmp1&=Create("hNewPic", 300, 202,rgb(218,0,0))
hButt&[x%] = Control("DIALOG","",$54001100, 0, 330, 300, 210,bild.w&,0,%hinstance,$0)
Create("Bitmap", hButt&[x%], Bmp1&, 0, 0)
Create("text",hButt&[x%],"Boot Nr. 60",0,170,300,20)
hText&[x%] =  Create("text",hButt&[x%],"",0,190,300,20)
SetText hText&[x%],"Bitte benachrichtigen"
Subclass hButt&[x%],1
Declare B#,x1%,x2%,y1%,y2%,Element&
Dim B#,16

While 1

    WaitInput
    Case %key=2: BREAK

    if %umessage=$204

        if GetActiveWindow(hButt&[1])

            x%=1
            BILD_POS
            BILD_EDIT

        Elseif GetActiveWindow(hButt&[2])

            x%=2
            BILD_POS
            BILD_EDIT

        endif

    endif

EndWhile

DeleteObject bmp1&
Subclass hButt&[1],0
Subclass hButt&[2],0
dispose b#
Dispose MousePos#
Dispose HT_Info#
End

Proc BILD_EDIT

    Element&=Create("Edit",%hwnd,"",(x1%-244),(y1%+36),x2%,21)

    While 1

        SetFocus(Element&)
        GetMessage
        case iskey(27):BREAK
        CursorPos

        If (mouseposx(0)<(x1%-244))

            OR (mouseposy(0)>(y1%+80))
            OR (mouseposx(0)>(x1%-244+x2%))
            OR (mouseposy(0)<(y1%-80))
            SetText hText&[x%],GetText$(Element&)
            BREAK

        endif

        If iskey(13)Speichern Enter gedrückt

            SetText hText&[x%],GetText$(Element&)
            BREAK

        endif

    wend

    DestroyWindow(Element&)

EndProc

Proc BILD_POS

    Dim B#,16
    Getwindowrect(hButt&[x%],B#)
    x1%=Long(B#,0)
    y1%=Long(B#,4)
    Screentoclient(hButt&[x%],B# + 8)
    x2%=Long(B#,8)
    Dispose B#

EndProc

Proc CursorPos

    getcursorpos(mousepos#)                                    Mausposition ermitteln
    ScreenToClient(%hwnd,mousepos#)                       In Bildirmkoordinaten umrechen
    Long Ht_info#,0=Long(mousepos#,0)
    Long Ht_info#,4=Long(mousepos#,4)
    Long Ht_info#,8=0
    Long Ht_info#,12=0

Endproc

SubClassProc

    If  SubClassMessage(hButt&[1], $200)

        PostMessage(hButt&[1], $A1, $2, 0)
        Set("WinProc", 0)

    ElseIf  SubClassMessage(hButt&[2], $200)

        PostMessage(hButt&[2], $A1, $2, 0)
        Set("WinProc", 0)

    ='./../../Function-References/XProfan/endif/'>EndIf

Endproc

Gruß Thomas
Windows XP SP2, XProfan X2

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jörg
Sellmeyer

Mh - what mean You so. I can both Images "anfassen" and move.

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Dieter
Zornow

means by me can I both Images move, if I draufklicke and the mouse move, functions even lovely.

Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

Yes, with the the move goes, but How ermittel I, on welchem "Bild" one Rechtsklick results is.
Dass the with Image1 goes, and then the Edit prepares becomes, is well random.

Gruß Thomas
Windows XP SP2, XProfan X2

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Thomas
Freier

is of course not optimal, but It's all right How virtual:
Compile Mark Separation

Declare W1&,W2&
Declare C2sstrc#
Def @Clienttoscreen(2) !"USER32","ClientToScreen"
Def @G2lx(0) @Long(C2sstrc#,0)
Def @G2ly(0) @Long(C2sstrc#,4)

Proc G2l

    Parameters Hdl&
    Clear C2sstrc#
    Clienttoscreen(Hdl&,C2sstrc#)

Endproc

Dim C2sstrc#,8
Def GetSysColor(1) !"user32","GetSysColor"
Def Getwindowrect(2) !"USER32", "GetWindowRect"
Def Screentoclient(2) !"USER32","ScreenToClient"
DEF GetCursorPos(1) !"USER32","GetCursorPos"
DEF WindowFromPoint(2) !"USER32","WindowFromPoint"
Def GetWindowText(3) !"USER32","GetWindowTextA"
DEF mouseposx(0) long(mousepos#,0)
DEF mouseposy(0) long(mousepos#,4)
declare mousepos#,HT_Info#
DIM MousePos#,10
DIM HT_Info#,16
Declare bereich#,be#,erg&,x&,y&,text$
Dim be#,8
Dim bereich#,1024
DECLARE hButt&[22],hText&[22]
Cls GetSysColor(15)
Windowtitle "Linke Maustaste = verschieben, rechte Maustaste = Texteingabe"
Window 800,600
UserMessages $204
var bild.w&=%hWnd
var x%=1
var bmp1&=Create("hNewPic", 300, 202,rgb(0,0,218))
hButt&[x%] = Control("DIALOG",str$(x%),$54001100, 0, 30, 300, 210,bild.w&,0,%hinstance,$0)
Create("Bitmap", hButt&[x%], Bmp1&, 0, 0)
Create("text",hButt&[x%],"Boot Nr. 66",0,170,300,20)
hText&[x%] =  Create("text",hButt&[x%],"",0,190,300,20)
SetText hText&[x%],"Bitte Standort prüfen"
Subclass hButt&[x%],1
x%=2
bmp1&=Create("hNewPic", 300, 202,rgb(218,0,0))
hButt&[x%] = Control("DIALOG",str$(x%),$54001100, 0, 330, 300, 210,bild.w&,0,%hinstance,$0)
Create("Bitmap", hButt&[x%], Bmp1&, 0, 0)
Create("text",hButt&[x%],"Boot Nr. 60",0,170,300,20)
hText&[x%] =  Create("text",hButt&[x%],"",0,190,300,20)
SetText hText&[x%],"Bitte benachrichtigen"
Subclass hButt&[x%],1
Declare B#,x1%,x2%,y1%,y2%,Element&,hx%,hy%
Dim B#,16

While 1

    WaitInput
    Case %key=2: BREAK

    if %umessage=$204

        GetCursorPos(be#)
        x&=Long(be#,0)
        y&=Long(be#,4)
        erg&=@WindowFromPoint(x&,y&)
        GetWindowText(erg&,bereich#,128)
        text$=String$(bereich#,0)

        if text$="1"

            x%=1
            BILD_EDIT

        Elseif text$="2"

            x%=2
            BILD_EDIT

        endif

    endif

EndWhile

DeleteObject bmp1&
Subclass hButt&[1],0
Subclass hButt&[2],0
Dim be#
Dim bereich#
Dispose b#
Dispose MousePos#
Dispose HT_Info#
End

Proc BILD_EDIT

    G2l bild.w&
    hx%=G2lx()
    hy%=G2ly()
    G2l hText&[x%]
    x1%=G2lx()-hx%
    y1%=G2ly()-hy%
    Element&=Create("Edit",%hwnd,"",x1%,y1%,300,21)

    While 1

        SetFocus(Element&)
        GetMessage
        case iskey(27):BREAK
        CursorPos

        If (mouseposx(0)<x1%)  OR (mouseposx(0)>(x1%+300))       Speichern wenn Maus aus dem Bereich

            SetText hText&[x%],GetText$(Element&)
            BREAK

        ElseIf (mouseposy(0)>(y1%+20)) OR (mouseposy(0)<(y1%-200))

            SetText hText&[x%],GetText$(Element&)
            BREAK

        ElseIf (iskey(13))                                         Speichern Enter

            SetText hText&[x%],GetText$(Element&)
            BREAK

        endif

    wend

    DestroyWindow(Element&)

EndProc

Proc CursorPos

    getcursorpos(mousepos#)                                    Mausposition ermitteln
    ScreenToClient(%hwnd,mousepos#)                       In Bildirmkoordinaten umrechen
    Long Ht_info#,0=Long(mousepos#,0)
    Long Ht_info#,4=Long(mousepos#,4)
    Long Ht_info#,8=0
    Long Ht_info#,12=0

Endproc

SubClassProc

    If  SubClassMessage(hButt&[1], $200)

        PostMessage(hButt&[1], $A1, $2, 0)
        Set("WinProc", 0)

    ElseIf  SubClassMessage(hButt&[2], $200)

        PostMessage(hButt&[2], $A1, $2, 0)
        Set("WinProc", 0)
    EndIf

Endproc

and to that closing-time yet ne round [...]

Gruß Thomas
Windows XP SP2, XProfan X2

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Answer

Topic-Options

Unreaded
subscribe
Remember-List
Notes
guests
Delete
Permanent
Done

2.136 Views

Untitled	vor 0 min.
H.Brill	07/10/18
Ernst	05/17/16
Setharial	02/06/13
Frank Vorholzer	05/24/12
More...

Themeninformationen

this Topic has 3 subscriber:

Thomas Freier (3x)

Dieter Zornow (1x)

Jörg Sellmeyer (1x)

Admins | AGB | Applications | Authors | Chat | Privacy Policy | Download | Entrance | Help | Merchantportal | Imprint | Mart | Interfaces | SDK | Services | Games | Search | Support

One proposition all XProfan, The there's!

Private Messages

Own Storage Forum

Topics-Remember-List

Privacy Policy

we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.

all right Datenschutzerklärung
i want none Cookie