(1.104)  S'inscrire

Français
Forum

Objekte Déplacer

 

Thomas
Freier
Aider, nouveau Problem et je viens pas plus.

si je une vertical Text éditer veux, bleibt cela EDIT seulement conservé, si qui Droit am Exact Match erfolgt ou bien qui Bouton de la souris gehalten et qui Curser ins EDIT gezogen wird. comment peux cela behoben volonté?
KompilierenMarqueSéparation
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
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

SubClassProc

    case  SubClassMessage(h&, $201):    PostMessage(h&, $A1, $2, 0)

Endproc

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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 "Hemmelsdorf.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%
Subclass b.obj&[b.xn%],1
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%
Subclass b.obj&[b.xn%],1
b.xn%=2

While 1

    WaitInput
    Case %key=2:Break

    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

    if %MouseKey=2

        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
                Subclass b.obj&[&loop],1
                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%
            Subclass b.obj&[b.xn%],1

        endif

    endif

    SetFocus(%HWND)

EndWhile

DeleteObject LV_Font&
DeleteObject pic1&

Whileloop b.xn%

    Subclass b.obj&[&loop],0

EndWhile

Dispose C2sstrc#
Dispose p#
End

Proc Boot_obj

    Parameters b.xi%
    UseFont "Arial",(16+2),0,0,0,0
    GetTextExtent b.text$[b.xi%],1'Textlänge
    b.x1%[b.xi%] = &(0)+0'Länge
    GetTextExtent b.text$[b.xi%],0
    b.y1%[b.xi%] = &(0)+4'Hö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)
    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&)
    oyWindow(sen&)
    Boot_obj b.xi%' Texte de l'objet récente

ENDPROC

35 kB
Hochgeladen:03.07.2010
Downloadcounter: 184
Download
 
Gruß Thomas
Windows XP SP2, XProfan X2
02.07.2010  ▲
 




Thomas
Freier
vraie Pause estivale,
mais je cherche toujours une Solution pour qui vertical Les objets texte, avec cela mon Éditer pas juste wieder finissez wird.
Hat einer une allumage concept?
si cela Hauptfenster den Concentrer hat, soll cela EDIT finissez volonté. là mais qui Curser pour einem Droit, qui cela EDIT erzeugt, encore im %HWND steht wird wohl beim Loslassen qui Bouton de la souris qui La position du curseur abgefragt et ensuite ist : Si GetFocus(%hwnd) véritable.
J'ai pensé, si je avant qui Boucle dem EDIT den Concentrer gebe ist cela Problem behoben. Ist mais malheureusement pas so.
 
Gruß Thomas
Windows XP SP2, XProfan X2
19.07.2010  ▲
 



allô Thomas,

habs survolés et un paire Changements ca va quelque chose:
KompilierenMarqueSéparation
 {$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
- en tout je cela mais pas comme valide la base appel serait.
 
19.07.2010  ▲
 




Thomas
Freier
allô iF,
peux sur meinem System keinen Unterschied feststellen. c'est toujours beim vertical Texte de l'objet so, dass un Droit im zone de texte "E. " (plus tard Éditer-Hauteur) cela Modifier le champ de conservé bleibt, mais chez einem Droit im Bereich "Aquarius" cela Éditer juste wieder détruit wird.
 
Gruß Thomas
Windows XP SP2, XProfan X2
20.07.2010  ▲
 



Du devrait vlt. sur 1 statt 2 Nouvelles Loops ajuster -
je serait den bisherigen Construire jeter.

si Du Hlp besoin simple annoncer.
 
20.07.2010  ▲
 




Thomas
Freier
je suis mich sur jeden besseren Vorschlag.
Zur Zeit avoir lieu alle Changements sur une Tabelle et ensuite wird arrêt récente gezeichnet, weil encore aus XProfan 9 Zeiten.
chez qui Commutateur, qui Objekte avec qui souris trop Déplacer et Textes à lieu et Stelle trop éditer, habe je encore reichlich Probleme.
 
Gruß Thomas
Windows XP SP2, XProfan X2
20.07.2010  ▲
 



je hab Dir la fois quoi hergestellt, comment je cela plutôt faire serait.

c'est imho une hierfür solide la base qui assez ausbau- et optimisé ist.

là je momentan am Programme communautaire schreibe, gebe je cela simple erstmal so comme ist à toi ab.

dans den Warenkorb
0,00 €
 Lingua: GER
 Übersetzt: ESP
inkl. MwSt.
no Versandgebühren

Descargar


543 kB
Kurzbeschreibung: projet avec Voir le texte source
Hochgeladen:21.07.2010
Downloadcounter: 119
Download
11 kB
Hochgeladen:21.07.2010
Downloadcounter: 132
Download
1.213 kB
Hochgeladen:01.08.2010
Downloadcounter: 135
Download
 
21.07.2010  ▲
 




Jörg
Sellmeyer
Ist très cool (jusqu'à sur qui Tatsache, qui je par Deinen Code wieder pas montée...)
Doit je mir la fois de XPSE traduire laisser. peux Du pas qui Community une Option spendieren, qui XPSE-Code pour Profan traduit wird?

chez Double-cliquez sur sur un objet gibt es incidemment une Absturz. Allerdings seulement, après que je es déménagé habe.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
21.07.2010  ▲
 



Relatif à la Double-cliquez sur ist richtig, là fehlt un si objet = vom typ text - Voir le texte source devrait seulement plus étendu volonté.

>> Profan traduit wird

prends den Code doch s'il te plaît comment il est, quelle Stelle ist car inintelligible?
 
21.07.2010  ▲
 




Jörg
Sellmeyer
Ist déjà ok - je hab gar pas tour gedacht, qui Profan oui maintenant aussi Variablen sans Postfix kennt.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
21.07.2010  ▲
 




Thomas
Freier
oui cool, et je hatte déjà lourd Nourriture alà "IFDRW V0.0.1" erwartet.
je peux chez qui korell.exe aucun Objekte Déplacer. cela Croix erscheint, mais aucun weitere réaction.
qui Abstürze einmal außeracht gelassen.
si ego im Profancode mise en œuvre habe, nehme je mir cela prochain semaine avant ou bien im Urlaub, si aucun Laxe chez cette températures de l'eau aufsteigen.
 
Gruß Thomas
Windows XP SP2, XProfan X2
22.07.2010  ▲
 



allô Thomas,

si es chez Dir abstürzt - ausser chez Double-cliquez sur sur autre chose comme Text - ensuite serait je seulement qui Bug trouver voulons.

Ebenso devrait sich qui Objekte avec qui souris simple Déplacer laisser.

si cela chez Dir pas funzt, ensuite wüsste je volontiers, weshalb bzw. quoi oui c'est ca là de travers fonctionne.

>> si ego im Profancode mise en œuvre habe,

Eigentlich voulais je Dir travail décroître et hatte Dir tambour den Text peint. ^ ^..
 
22.07.2010  ▲
 



12
►

répondre


Topictitle, max. 100 marque.
 

Systemprofile:

ne...aucune Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

s'il te plaît s'inscrire um une Beitrag trop verfassen.
 

Options du sujet

Unreaded
abonner
La liste de voeux
Notes
guests
Effacer
Permanent
Done

13.651 Views

Untitledvor 0 min.
Thomas Zielinski07.04.2021
Peter Max Müller02.11.2017
RudiB.15.03.2016
ByteAttack05.08.2015
plus...

Themeninformationen

cet Thema hat 3 participant:

iF (9x)
Thomas Freier (8x)
Jörg Sellmeyer (2x)


Admins  |  AGB  |  Applications  |  Auteurs  |  Chat  |  protection des données  |  Télécharger  |  Entrance  |  Aider  |  Merchantportal  |  Empreinte  |  Mart  |  Interfaces  |  SDK  |  Services  |  Jeux  |  cherche  |  Support

un projet aller XProfaner, qui il y a!


Mon XProfan
Privé Nouvelles
Eigenes Ablageforum
Sujets-La liste de voeux
Eigene Posts
Eigene Sujets
Zwischenablage
Annuler
 Deutsch English Français Español Italia
Traductions

protection des données


Wir verwenden Cookies seulement comme Session-Cookies à cause de qui technischen Notwendigkeit et chez uns gibt es aucun Cookies de Drittanbietern.

si du ici sur unsere Webseite klickst ou bien navigierst, stimmst du unserer Erfassung de Informationen dans unseren Cookies sur XProfan.Net trop.

Weitere Informationen trop unseren Cookies et en supplément, comment du qui Kontrolle par-dessus behältst, findest du dans unserer nachfolgenden Datenschutzerklärung.

d'accordDatenschutzerklärung
je voudrais keinen Cookie