XProfan

Thomas
Freier

Echt Sommerpause,
aber ich suche immer noch eine Lösung für die senkrechten Textobjekte, damit mein Edit nicht gleich wieder beendet wird.
Hat einer eine zündende Idee?
Wenn das Hauptfenster den Focus hat, soll das EDIT beendet werden. Da aber der Curser nach einem Rechtsklick, der das EDIT erzeugt, noch im %HWND steht wird wohl beim Loslassen der Maustaste die Curserposition abgefragt und dann ist : If GetFocus(%hwnd) wahr.
Ich dachte, wenn ich vor der Schleife dem EDIT den Focus gebe ist das Problem behoben. Ist aber leider nicht so.

Gruß Thomas
Windows XP SP2, XProfan X2

19.07.2010 ▲

Hallo Thomas,

habs überflogen und mit ein paar Änderungen geht es etwas:
Kompilieren Markieren Separieren

 {$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 %umessage

        waitinput 1

    wend

EndProc

- insgesamt ich das aber nicht als valide Basis bezeichnen würde.

19.07.2010 ▲

Thomas
Freier

Hallo iF,
kann auf meinem System keinen Unterschied feststellen. Es ist immer noch beim senkrechten Textobjekt so, dass ein Rechtsklick im Textbereich "E. " (spätere Edit-Höhe) das Editfeld erhalten bleibt, aber bei einem Rechtsklick im Bereich "Wassermann" das Edit gleich wieder zerstört wird.

Gruß Thomas
Windows XP SP2, XProfan X2

20.07.2010 ▲

Du solltest vlt. auf 1 statt 2 Nachrichtenschleifen umstellen -
ich würde den bisherigen Konstrukt verwerfen.

Wenn Du Hlp benötigst einfach melden.

20.07.2010 ▲

Thomas
Freier

Ich freue mich über jeden besseren Vorschlag.
Zur Zeit erfolgen alle Änderungen über eine Tabelle und dann wird halt neu gezeichnet, weil noch aus XProfan 9 Zeiten.
Bei der Umstellung, die Objekte mit der Maus zu verschieben und Texte an Ort und Stelle zu editieren, habe ich noch reichlich Probleme.

Gruß Thomas
Windows XP SP2, XProfan X2

20.07.2010 ▲

Ich hab Dir mal was hergestellt, wie ich das eher machen würde.

Das ist imho eine hierfür solide Basis die ziemlich ausbau- und optimierbar ist.

Da ich momentan am Communityprogramm schreibe, gebe ich das einfach erstmal so wie es ist an Dich ab.

In den Warenkorb

no Versandgebühren

Descargar

korell.zip

543 kB

Kurzbeschreibung:

Projekt mit Quelltext

Hochgeladen:

21.07.2010

Ladeanzahl:

Herunterladen

Zwischenablage01.jpg Vorschau

11 kB

Hochgeladen:

21.07.2010

Ladeanzahl:

Herunterladen

korell.exe

1.213 kB

Hochgeladen:

01.08.2010

Ladeanzahl:

Herunterladen

Jörg
Sellmeyer

Ist sehr cool (bis auf die Tatsache, daß ich durch Deinen Code wieder nicht durchsteige...)
Muß ich mir mal von XPSE übersetzen lassen. Kannst Du nicht der Community eine Option spendieren, daß XPSE-Code nach Profan übersetzt wird?

Bei Doppelklick auf ein Objekt gibt es übrigens einen Absturz. Allerdings erst, nachdem ich es verschoben habe.

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

Das mit dem Doppelklick ist richtig, dort fehlt ein if objekt= vom typ text - Quelltext müsste nur weiter ausgebaut werden.

>> Profan übersetzt wird

Nimm den Code doch bitte wie er ist, welche Stelle ist denn unverständlich?

Jörg
Sellmeyer

Ist schon ok - ich hab gar nicht dran gedacht, daß Profan ja jetzt auch Variablen ohne Postfix kennt.

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

Thomas
Freier

Ja cool, und ich hatte schon schwere Kost alà "iFDRW V0.0.1" erwartet.
Ich kann bei der korell.exe keine Objekte verschieben. Das Kreuz erscheint, aber keine weitere Reaktion.
Die Abstürze einmal außeracht gelassen.
Wenn ichs im Profancode umgesetzt habe, nehme ich mir das nächste Woche vor oder im Urlaub, falls keine Laxe bei diesen Wassertemperaturen aufsteigen.

Gruß Thomas
Windows XP SP2, XProfan X2

22.07.2010 ▲

Hallo Thomas,

wenn es bei Dir abstürzt - ausser bei Doppelklick auf etwas anderes als Text - dann würde ich erst die Programmfehler finden wollen.

Ebenso sollten sich die Objekte mit der Maus einfach verschieben lassen.

Wenn das bei Dir nicht funzt, dann wüsste ich gerne, weshalb bzw. was genau da schief läuft.

>> Wenn ichs im Profancode umgesetzt habe,

Eigentlich wollte ich Dir Arbeit abnehmen und hatte Dir drum den Text gepinselt. ^^..

22.07.2010 ▲