Español
Foro

Mover objetos

 

Thomas
Freier
Ayuda, nuevo problema y no me vienen más.

Cuando tengo un texto en vertical editará, EDIT es el único conservado, cuando el derecho de Palabra que empieza con o Botón del ratón y mantenga el cursor se trasladó a EDIT. ¿Cómo puede la resolverse?
KompilierenMarcaSeparación
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%' Nuevo objeto de texto

ENDPROC


35 kB
Hochgeladen:03.07.2010
Ladeanzahl184
Descargar
 
Gruß Thomas
Windows XP SP2, XProfan X2
02.07.2010  
 




Thomas
Freier
vacaciones de verano Real,
Pero todavía estoy buscando una solución para los objetos del texto vertical, Editar de manera que la espalda no es igual termina.
Tiene uno de una idea brillante?
Si la ventana tiene el foco principal, debe darse por concluido, el EDIT. Pero a medida que el cursor después de una Rechtsklick, EDIT de la generada, aún en %HWND está, es probable que al soltar el botón del ratón, consultar la posición del cursor y luego : If GetFocus(%hwnd) verdadero.
Pensé, cuando me inclino ante el EDIT del Enfoque está el problema resuelto. Pero, por desgracia así.
 
Gruß Thomas
Windows XP SP2, XProfan X2
19.07.2010  
 



Hola Tomás,

habs y sobrevoló con unos pocos Los cambios que hay algo:
KompilierenMarcaSeparación
 {$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
- Total válida, pero no como yo Base convocatoria sería.
 
19.07.2010  
 




Thomas
Freier
Hola si,
en mi sistema no puede Diferencia determinar. Sigue siendo el objeto de texto vertical, que un clic derecho en el área de texto "E. " (spätere Editar-Höhe) obtener el campo de edición sigue siendo, Pero cuando uno justo en la zona "Aquarius" de la igualdad Editar destruido se.
 
Gruß Thomas
Windows XP SP2, XProfan X2
20.07.2010  
 



Usted debe vlt. en 1 el interruptor 2 noticias en lugar de moler -
Yo sería el reciente Construir rechazar.

Si hay que registrarse simple HLP.
 
20.07.2010  
 




Thomas
Freier
Agradezco nada mejor Vorschlag.
En la actualidad se celebran cada Los cambios en una tabla y después pondrá fin a nuevos suscrito, sin embargo, debido a XProfan 9 Veces.
Cuando se cambia, Para mover los objetos con el ratón y textos sobre el terreno para Editar, Todavía tengo un montón de problemas.
 
Gruß Thomas
Windows XP SP2, XProfan X2
20.07.2010  
 



Tendré algo producido, Hago el lugar sería.

Esta es mi humilde opinión uno de este sonido La expansión de la base en lugar- y optimizado es.

Ya que estoy actualmente en los programas comunitarios escribir, Tiene la primera como simple que depende de usted de.

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


Descargar


543 kB
Kurzbeschreibung: Projekt con Ver código fuente
Hochgeladen:21.07.2010
Ladeanzahl119
Descargar
11 kB
Hochgeladen:21.07.2010
Ladeanzahl132
Descargar
1.213 kB
Hochgeladen:01.08.2010
Ladeanzahl135
Descargar
 
21.07.2010  
 




Jörg
Sellmeyer
Es muy fresco (excepto por el hecho, que a través de su código no subir de nuevo...)
¿Tengo tiempo para traducir de XPSE dejar. Si usted no puede hacer la comunidad pagar por una opción, daß XPSE-Code se traduce a lo profano?

Si hay doble clic sobre un objeto Por cierto accidente. Aunque sólo, después de que se movía habe.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
21.07.2010  
 



Relacionado con la Haga doble clic en correcto, existe falta un objeto de texto si = típico - Fuente sería sólo amplió voluntad.

>> Profano se traduce se

Tome el código, pero por favor, como él es, el cuerpo que tiene, porque ininteligible?
 
21.07.2010  
 




Jörg
Sellmeyer
Está todo bien - No me volví pensamiento, ahora sí que las variables de lo profano; sabe sin Postfix.
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
21.07.2010  
 




Thomas
Freier
Sí fresco, y tuve grave de alimentos Ala "IFDRW V0.0.1" esperado.
Se me permite, en el korell.exe no Mover objetos. La cruz erscheint, pero no más allá Reacción.
Las caídas más dejó que su falta.
Si yo había puesto en práctica Profancode, Me quito la semana que viene por delante o por Fiesta, si ninguna de estas Laxe aumento de la temperatura del agua.
 
Gruß Thomas
Windows XP SP2, XProfan X2
22.07.2010  
 



Hola Tomás,

Si presenta problemas con ustedes - excepto doble click en algo que no sea de texto - Yo sería sólo el quieren encontrar errores.

Del mismo modo, en caso de los objetos con la Ratón se puede mover con facilidad.

Si no eres tú funzt, Me gustaría saber, por qué o. ¿qué es exactamente va mal.

>> Si "de Profancode se llevó a cabo,

En realidad, yo quería que el trabajo y eliminar el texto que había tambor gepinselt. ^ ^..
 
22.07.2010  
 




Respuesta


Título del Tema, max. 100 Signo.
 

Systemprofile:

Kein Systemprofil creado. [anlegen]

XProfan:

 Contribución  Font  Smilies  ▼ 

Bitte registro en una Contribución a verfassen.
 

Tema opciones

13.667 Views

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

Themeninformationen



Admins  |  AGB  |  Applications  |  Autores  |  Chat  |  Política de Privacidad  |  Descargar  |  Entrance  |  Ayuda  |  Merchantportal  |  Pie de imprenta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Juegos  |  Búsqueda  |  Support

Ein Projekt aller XProfan, el lo son!


Mi XProfan
Privado Noticias
Eigenes Ablageforum
Temas-Merkliste
Eigene Beiträge
Eigene Temas
Zwischenablage
Cancelar
 Deutsch English Français Español Italia
Traducciones

Política de Privacidad


Wir uso Cookies sólo como Session-Cookies wegen el technischen Notwendigkeit y en uns hay no Cookies de Drittanbietern.

Wenn du hier en unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung de Informationen en unseren Cookies en XProfan.Net a.

Weitere Informationen a unseren Cookies y dazu, como du el Kontrolle darüber behältst, findest du en unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Yo möchte no Cookie