XProfan

Thomas
Freier

Real Sommerpause,
but I Search still a Solution for senkrechten Textobjekte, so my Edit not same again terminates.
has of/ one a zündende idea?
If the Mainwindow whom Focus has, should the EDIT exits go. there but the Curser to one Rechtsklick, the the EDIT created, yet in the %HWND standing becomes well at release the Mouse button The Curserposition quizzed and then is : If GetFocus(%hwnd) true.
I thought, if I to the loop, the focus there is the EDIT the trouble fixed. But unfortunately not so.

Gruß Thomas
Windows XP SP2, XProfan X2

07/19/10 ▲

Hello Thomas,

habs überflogen and a couple Changes goes it something:
Compile Mark Separation

 {$cleq}
Gemerkt/Separiert von http://xprofan.com/t/?8326
DEF GetSysColor(1) !"USER32","GetSysColor"
Def WindowFromPoint(2)!"USER32","WindowFromPoint"
Def GetCursorPos(1) !"USER32","GetCursorPos"
Declare p#,h&
Dim p#,8
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Def GetTextExtentPoint32(4) !"GDI32","GetTextExtentPoint32A"
Def ReleaseDC(2) !"USER32","ReleaseDC"
Def GetDC(1) !"USER32","GetDC"
declare x%,y%

Proc GetTextExtent

    Parameters _t$,_w%
    declare _size#,_text#,_result&,_hdc&
    dim _text#,Len(_t$) + 1
    dim _size#,8
    String _text#,0 = _t$
    _hdc& = GetDC(GetActiveWindow())
    GetTextExtentPoint32(_hdc&,_text#,Len(_t$),_size#)
    _result& = Long(_size#,4)
    Case _w% : _result& = Long(_size#,0)
    ReleaseDC(GetActiveWindow(),_hdc&)
    dispose _text#
    dispose _size#
    return _result&

EndProc

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Def @Clienttoscreen(2) !"USER32","ClientToScreen"
Def @G2lx(0) @Long(C2sstrc#,0)
Def @G2ly(0) @Long(C2sstrc#,4)

Proc G2l

    Parameters Hdl&
    Clear C2sstrc#
    @Clienttoscreen(%Hwnd,C2sstrc#)
    x%=@G2lx()
    y%=@G2ly()
    Clear C2sstrc#
    @Clienttoscreen(Hdl&,C2sstrc#)
    x%=@G2lx()-x%
    y%=@G2ly()-y%

Endproc

Declare C2sstrc#
Dim C2sstrc#,8
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
windowstyle 8 | 512
Window 1000,600
WindowTitle "Objekte bewegen"
UseFont "Arial",16,0,0,0,0
var LV_Font&=CreateFont("Arial",15,0,0,0,0)
SETDIALOGFONT LV_Font&
Declare b.obj&[],b.x%[],b.x1%[],b.y%[],b.y1%[], b.text$[],b.lage$[]
Declare b.xn%
Declare pic1&
DrawPic "hem.png",0,0;0
DrawText 10,10,"Verschieben nach Doppelklick links; " +
"NEU (Ändern) : Rechtsklick freie Fläche (Text)....  mit RETURN oder Klick ins Fenster übernehmen."
b.xn%=1
b.x%[b.xn%]=720
b.y%[b.xn%]=140
b.text$[b.xn%]="K. Mustermann"
b.lage$[b.xn%]="W"
Boot_obj b.xn%
b.xn%=2
b.x%[b.xn%]=448
b.y%[b.xn%]=320
b.text$[b.xn%]="E. Wassermann"
b.lage$[b.xn%]="S"
Boot_obj b.xn%
b.xn%=2
userMessages 516,16//wm_rButtonDown,wm_close

While 1

    WaitInput

    Whileloop b.xn%

        G2l b.obj&[&loop]
        b.x%[&loop]=x%
        b.y%[&loop]=y%

    EndWhile

    GetCursorPos(p#)
    h&=WindowFromPoint(Long(p#,0),Long(p#,4))
    Locate 0,0

    select %uMessage

        caseof 16//wm_close

        break

        caseof 516// wm_rButtonDown

        x%=1

        Whileloop b.xn% Anzahl der Objekte

            if Mouse(b.x%[&loop],b.y%[&loop] - (b.x%[&loop]+b.x1%[&loop]),(b.y%[&loop]+b.y1%[&loop]))

                ShowWindow(b.obj&[&loop],0)
                Element_Edit  &loop EDIT-Feld

                while %umessage

                    waitinput 1

                wend

                x%=0
                break

            endif

        wend

        if x%=1

            inc b.xn%
            b.x%[b.xn%]=%MouseX
            b.y%[b.xn%]=%MouseY
            b.text$[b.xn%]=""
            b.lage$[b.xn%]="W"
            Element_Edit b.xn%

        endif

    endSelect

    SetFocus(%HWND)

EndWhile

DeleteObject LV_Font&
DeleteObject pic1&
Dispose C2sstrc#
Dispose p#
End

Proc Boot_obj

    Parameters b.xi%
    UseFont "Arial",(16+2),0,0,0,0
    GetTextExtent b.text$[b.xi%],1Textlänge
    b.x1%[b.xi%] = &(0)+0Länge
    GetTextExtent b.text$[b.xi%],0
    b.y1%[b.xi%] = &(0)+4Höhe

    If trim$(b.lage$[b.xi%]="S")Länge+Höhe tauschen bei senkrecht

        x%=b.y1%[b.xi%]
        b.y1%[b.xi%]=b.x1%[b.xi%]
        b.x1%[b.xi%]=x%

    endif

    MCls b.x1%[b.xi%], b.y1%[b.xi%] ,RGB(255,255,255)
    StartPaint -1
    TextColor @RGB(0,0,160), -1

    If trim$(b.lage$[b.xi%]="W")

        Set("Orientation", 0)
        UseFont "Arial",16,0,0,0,0
        DrawText 0, 2, b.text$[b.xi%]

    ElseIf trim$(b.lage$[b.xi%]="S")

        Set("Orientation", 2700)
        UseFont "Arial",(16-1),0,0,0,0
        DrawText b.x1%[b.xi%]-2, 0, b.text$[b.xi%]

    Endif

    Endpaint
    Set("Orientation", 0)
    pic1&=Create("hPic",0,"&MEMBMP" )
    b.obj&[b.xi%]=Control("DIALOG","",$54001100,b.x%[b.xi%], b.y%[b.xi%], b.x1%[b.xi%], b.y1%[b.xi%],%hwnd,0,%hinstance,$0)
    Create("Bitmap",b.obj&[b.xi%], pic1&,0, 0)

Endproc

Proc Element_Edit

    Parameters b.xi%
    var Element&= CreateEdit(%hwnd,b.text$[b.xi%],b.x%[b.xi%], b.y%[b.xi%], 120, 22)
    SetFont Element&,LV_Font&
    var Element1&=Create("GroupBox",%hwnd,"",(b.x%[b.xi%]+124), (b.y%[b.xi%]-8),80,30)
    var e&=CreateText(Element1&,"",2,10,76,18)
    var hor&=Create("RadioButton",%hwnd,"",(b.x%[b.xi%]+126),(b.y%[b.xi%]+5),12,12)
    var t1&=CreateText(Element1&,"0°",18,11,14,16)
    var sen&=Create("RadioButton",%hwnd,"",(b.x%[b.xi%]+166),(b.y%[b.xi%]+5),12,12)
    var t2&=CreateText(Element1&,"90°",56,11,22,16)
    SetFont hor&,LV_Font&
    SetFont t1&,LV_Font&
    SetFont t2&,LV_Font&

    If trim$(b.lage$[b.xi%]="W")

        SetCheck hor&,1

    else

        SetCheck sen&,1

    EndIf

    Setfocus(Element&)
    SendString(Element&,"+({END})")Text Markieren und Cursor ans Ende
    Setfocus(Element&)

    While 1

        GetMessage

        If GetFocus(%hwnd)

            b.text$[b.xi%] = GetText$(Element&)

            If GetCheck(hor&)

                b.lage$[b.xi%]="W"

            Else

                b.lage$[b.xi%]="S"

            EndIf

            BREAK

        Elseif IsKey(13) OR IsKey(27)

            b.text$[b.xi%] = GetText$(Element&)

            If GetCheck(hor&)

                b.lage$[b.xi%]="W"

            Else

                b.lage$[b.xi%]="S"

            EndIf

            BREAK

        endif

    wend

    DestroyWindow(Element&)
    DestroyWindow(Element1&)
    DestroyWindow(hor&)
    DestroyWindow(sen&)
    Boot_obj b.xi% Textobjekt neu

    while %ume

/a> waitinput 1 wend ENDPROC

- altogether I the but not as valide Base bezeichnen would.

07/19/10 ▲

Thomas
Freier

Hello iF,
can on my system, no difference check. its still at senkrechten Textobjekt so, that one Rechtsklick in the Textbereich "E. " (later Edit-Höhe) the Editfeld receive remaining, but with one Rechtsklick in the area "Wassermann" the Edit same again destroy becomes.

Gruß Thomas
Windows XP SP2, XProfan X2

07/20/10 ▲

you should vlt. on 1 instead of 2 Nachrichtenschleifen adjust -
i'd whom recent Konstrukt verwerfen.

If you Hlp benötigst simply report.

07/20/10 ▲

Thomas
Freier

i am pleased over each better suggestion.
Currently erfolgen any Changes over a scheduler and then becomes hold new drawn, because yet from XProfan 9 times.
with the Umstellung, The Objects with the mouse To move and Texts on place and place To edit, have I yet plenty Problems.

Gruß Thomas
Windows XP SP2, XProfan X2

07/20/10 ▲

I Have you something manufactured, How I the sooner make would.

this is imho one of this solid base, the expansion rather- and optimierbar is.

Since I momentarily on the Communityprogramm write, give I the simply first as it is on you ex.

into Cart

no Versandgebühren

Descargar

korell.zip

543 kB

Kurzbeschreibung:

proposition with View source

Hochgeladen:

07/21/10

Downloadcounter:

Download

Zwischenablage01.jpg Preview

11 kB

Hochgeladen:

07/21/10

Downloadcounter:

Download

korell.exe

1.213 kB

Hochgeladen:

08/01/10

Downloadcounter:

Download

Jörg
Sellmeyer

is very calm (except for The fact, that I through your Sourcecode again not durchsteige...)
mandatory I me time of XPSE translate let. can You do not the Community a option give liberally, that XPSE-code to Profan Translated becomes?

Double-clicking on an object there incidentally a crash. though first, after I it moved have.

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

Related to the Double click is correctly., there missing one if objekt= of type Text - View source should only moreover expanded go.

>> Profan Translated becomes

Nimm whom code still Please How he's, which place is because unverständlich?

Jörg
Sellmeyer

is already ok - I Have none dran virtual, that Profan Yes now too variables without Postfix knows.

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

Thomas
Freier

Yes calm, and I had severe food Alà "iFDRW V0.0.1" expects.
I can with the korell.exe no Moving Objects. the Cross appear, but no further reaction.
The Abstürze once außeracht let.
If ego had implemented Profancode, I take the next week before or on vacation, if no Laxe rising water temperatures in these.

Gruß Thomas
Windows XP SP2, XProfan X2

07/22/10 ▲

Hello Thomas,

if it with you crashes - except with Double-click on something other as Text - then would I first The Bug find want.

likewise should the Objects with the mouse can move easily.

If the with you not working, then know I gladly, and so or. what very there schief runs.

>> If ichs in the Profancode umgesetzt have,

really wished I you work take off and having you thatswhy whom Text gepinselt. ^^..

07/22/10 ▲