XProfan

Español

RudiB.

Bastele gerade a una Grafik-Tool rum, gebracht ha mich P.Pájaro carpintero darauf...Yo denke veces Paul oder Peter...tal vez verrät él lo uns veces..

Mein Problema es el z.B en Rechtecken oder Kreisen, esta voluntad como una Layer en el Vordergrund gehoben voluntad, y el Fadenkreuz detrás de él verschwindet....Aunque fresco...pero no mi Intension.
Yo podría el zwar umgehen, si yo beim Kreis/Ellipse con Pixel-Berechnug/dibujar y en Rechteck con "line" arbeite...aber....
Hier veces el Ver código fuente....
Steuerung alles sólo encima Botón del ratón Links y Rechts... debería eigentlich selbsterklärend ser.....
Beginnend startet el Programa con "Linie".....Click links Startpunkt, Click links...Linie se suscrito....Click Links....Linie se suscrito....a Endpunkt......oder entonces Click rechts.
Rechter Mausclick ruft una Menue en.....

Kompilieren Marca Separación

Conjunto("ErrorLevel",1)
Conjunto("OnError", 1)
Windowtitle "ZeichenFeld"
Windowstyle 80
Ventana 0,0-%maxx,%maxy
var color&=rgb(229,229,229)
var x!=%maxx/2
var y!=%maxy/2
Declarar a%,b%,c%,alpha%,null_x$,null_y$,null_c$,bild&
Declarar Last_mouse_x%,Last_mouse_y%,ax!,ay!
Declarar befehl![],befehl%,x1![],x2![],y1![],y2![],zaehler%,startpunkt%,start_x!,start_y!,y$
zaehler%=3
befehl%=1

Whileloop 5

    befehl![&bucle]=1'Line
    x1![&bucle]=0
    x2![&bucle]=0
    y1![&bucle]=0
    y2![&bucle]=0

Endwhile

Conjunto("Decimals",0)
Def Setcursorpos(2) !"USER32","SetCursorPos"
MCLS %maxx,%maxy
MCopyBMP 0,0-%maxx,%maxy > 0,0;0
Color del texto RGB(0,0,0),-1
UseBrush 1,RGB(0,0,255)

REPEAT

    StartPaint -1
    ClS color&
    USEP 3,1,0
    Rectángulo 30,20 - %maxx-34,%maxy-49
    usepen 2,1,0
    line x!,20 - x!,%maxy-50
    line 30,y! - %maxx-33,y!
    showcursor 0
    USEP 0,1,RGB(255,0,31)
    ay!=%mousey
    ax!=%mousex

    If %mousex<30

        ax!=30

    EndIf

    If %mousex>%maxx-35

        ax!=%maxx-35

    EndIf

    If %mousey<20

        ay!=20

    EndIf

    If %mousey>%maxy-50

        ay!=%maxy-50

    Endif

    Line 30,ay! - %maxx-35,ay!'horizontale des Fadenkreuzes
    line ax!,20 - ax!,%maxy-50'vertikale des Fadenkreuzes
    USEP 0,1,0
    Color del texto RGB(255,16,118),-1
    Rectángulo 0,(ay!) - 28,(ay!+19)
    Rectángulo ax!,0 - ax!+36,19
    DrawText 2,ay!+2,null_y$+str$(abs(ay!-20))
    DrawText ax!+2,2,null_x$+str$(abs(ax!-30))
    usepen 4,1,RGB(105,100,255)
    Line x!,y! - ax!,ay!
    usepen 0,1,0
    a%=abs((x!-ax!)^2)
    b%=abs((y!-ay!)^2)
    c%=sqrt(a%+b%)

    If c%<100

        null_c$="0"

    EndIf

    If c%<10

        null_c$="00"

    EndIf

    If c%>99

        null_c$=""

    EndIf

    Color del texto RGB(139,0,139),-1

    If (ax!>x!) And (ay!>y!)

        rectangle ax!,ay! - ax!+28, ay!+19
        Rectángulo x!,y! - x!-28,y!-18
        DrawText x!-24,y!-17,"0.0"
        DrawText ax!+2,ay!+2,null_c$+str$(c%)

    EndIf

    If (ax!>x!) And (ay!<y!)

        rectangle ax!,ay! - ax!+28, ay!-19
        Rectángulo x!,y! - x!-28,y!+18
        DrawText x!-24,y!+1,"0.0"
        DrawText ax!+2,ay!-17,null_c$+str$(c%)

    EndIf

    If (ax!<x!) And (ay!<y!)

        rectangle ax!,ay! - ax!-28, ay!-19
        Rectángulo x!,y! - x!+28,y!+18
        DrawText x!+4,y!+1,"0.0"
        DrawText ax!-26,ay!-17,null_c$+str$(c%)

    EndIf

    If (ax!<x!) And (ay!>y!)

        rectangle ax!,ay! - ax!-28, ay!+19
        Rectángulo x!,y! - x!+28,y!-18
        DrawText x!+4,y!-17,"0.0"
        DrawText ax!-26,ay!+2,null_c$+str$(c%)

    EndIf

    Color del texto RGB(255,16,118),-1

    If %mousepressed=2

        Mausmenu ax!,ay!

    EndIf

    If (%mousepressed=1) And (startpunkt%=0)

        locate 1,1
        inc zaehler%
        'Imprimir zaehler%
        sound 5000,5
        startpunkt%=1
        start_x!=ax!
        start_y!=ay!
        Last_mouse_x%=ax!
        Last_mouse_y%=ay!

    Endif

    If (%mousepressed=1) And (startpunkt%=1)

        'sound 3000,5

        If befehl%=1

            befehl![zaehler%]=1

        ElseIf befehl%=2

            befehl![zaehler%]=2

        ElseIf befehl%=3

            befehl![zaehler%]=3

        ElseIf befehl%=4

            befehl![zaehler%]=4

        ElseIf befehl%=5

            befehl![zaehler%]=5

        EndIf

        x1![zaehler%]=ax!
        y1![zaehler%]=ay!
        x2![zaehler%]=Last_mouse_x%
        y2![zaehler%]=Last_mouse_y%
        inc zaehler%
        Last_mouse_x%=ax!
        Last_mouse_y%=ay!

    EndIf

    If startpunkt%=1

        USEP 3,1,RGB(255,0,0)
        Line last_mouse_x%,last_mouse_y% - last_mouse_x%,ay!
        Line last_mouse_x%,ay! - ax!,ay!
        Line ax!,last_mouse_y% - ax!,ay!
        Line last_mouse_x%,last_mouse_y% - ax!,Last_mouse_y%
        Line last_mouse_x%,last_mouse_y%-ax!,ay!
        Color del texto 0,-1
        DrawText 35,730,"Linie : "+str$(last_mouse_x%)+","+str$(last_mouse_y%)+" - "+str$(ax!)+","+str$(ay!)
        SetPixel last_mouse_x%-50,last_mouse_y%-50,0
        SetPixel last_mouse_x%-50,last_mouse_y%-52,0
        SetPixel last_mouse_x%-52,last_mouse_y%-50,0
        SetPixel last_mouse_x%-52,last_mouse_y%-52,0

    Endif

    USEP 0,1,0

    whileloop SizeOf(x1![])-1

        If befehl![&bucle-1]=1

            line x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        EndIf

        If befehl![&bucle-1]=2

            rectangle x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        EndIf

        If befehl![&bucle-1]=5

            ellipse x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        Endif

        'line x1![&loop],y1![&loop]-x2![&loop],y2![&loop]
        'Arc x1![&loop],y1![&loop] - x2![&loop],y2![&loop]; x1![&loop],y1![&loop]; x2![&loop],y2![&loop]
        'Chord x1![&loop],y1![&loop] - x2![&loop],y2![&loop]; x1![&loop],y1![&loop]; x2![&loop],y2![&loop]

    EndWhile

    EndPaint
    MCopyBMP 0,0-%maxx,%maxy > 0,0;0
    'waitinput 5

UNTIL %key=27

CLS
waitinput
End

Proc Form_Close

    sound 1000,5
    x1![zaehler%]=start_x!
    y1![zaehler%]=start_y!
    x2![zaehler%]=Last_mouse_x%
    y2![zaehler%]=Last_mouse_y%
    Inc zaehler%
    startpunkt%=0

ENDPROC

Proc Clear_Screen

    ArrDel x1![],0,SizeOf(x1![])-1'Arraygrösse se en 1 gesetzt.
    ArrDel x2![],0,SizeOf(x2![])-1'Arraygrösse se en 1 gesetzt.
    ArrDel y1![],0,SizeOf(y1![])-1'Arraygrösse se en 1 gesetzt.
    ArrDel y2![],0,SizeOf(y2![])-1'Arraygrösse se en 1 gesetzt.
    MCLS %maxx,%maxy
    Last_mouse_x%=%mousex
    Last_mouse_y%=%mousey
    ax!=%mousex
    ay!=%mousey
    start_x!=ax!
    start_y!=ay!
    startpunkt%=0

ENDPROC

Proc Set_StartPunkt

    Last_mouse_x%=%mousex
    Last_mouse_y%=%mousey
    ax!=%mousex
    ay!=%mousey
    start_x!=ax!
    start_y!=ay!
    startpunkt%=0

ENDPROC

Proc Ende

    Endpaint
    CLS
    Imprimir zaehler%
    USEP 0,1,0

    whileloop SizeOf(x1![])-1

        If befehl![&bucle-1]=1

            line x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        EndIf

        If befehl![&bucle-1]=2

            rectangle x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        EndIf

        If befehl![&bucle-1]=5

            ellipse x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        Endif

    EndWhile

    Waitinput
    end

ENDPROC

Proc Mausmenu

    showcursor 1
    Parámetros x% , y%
    CreateMenu
    AppendMenu 210,"Clear Screen"
    AppendMenu 999,"-"
    AppendMenu 220,"Linie / Freihand"
    AppendMenu 221,"Rechteck"
    'AppendMenu 222,"Parallelogramm"
    'AppendMenu 223,"Trapez"
    'AppendMenu 999,"-"
    AppendMenu 224,"Ellipse / Kreis"
    AppendMenu 999,"-"
    AppendMenu 231,"----------"
    AppendMenu 232,"----------"
    AppendMenu 234,"Neuer StartPunkt"
    AppendMenu 999,"-"
    AppendMenu 233,"Form schliessen"
    AppendMenu 999,"-"
    AppendMenu 235,"Ende"
    TrackMenu x% , y%
    Case MenuItem(220):befehl%=1
    Case MenuItem(221):befehl%=2
    Case MenuItem(222):befehl%=3
    Case MenuItem(223):befehl%=4
    Case MenuItem(224):befehl%=5
    Case MenuItem(235):ende
    Case MenuItem(233):Form_Close
    Case MenuItem(210):Clear_Screen
    Case MenuItem(234):Set_StartPunkt
    Case MenuItem(232)
    showcursor 0

ENDPROC

....todavía qué vergessen....simplemente veces linke Botón del ratón beim Dibujar gedrückt halten...... "Freihandzeichnen"....

Noch qué vergessen !! ...todos Daten voluntad voluntad en una Array geschrieben ....aber sieht uno sí, oder ???
Was me todavía más bien wäre, si yo el Zeichenoberflähe con el %Hwnd mischen podría...
Zum Ende se alles una vez más aufs %Hwnd suscrito....

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

18.05.2021 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

p.specht

Einfach p.

Klappt ya bastante bien! ArrDel-Función findet él no, aber sonst OK.
Ach sí, habe abs((a+b)^2) por sqr(a+b) ersetzt. Quadrieren macht ohnhin siempre abs-Werte!
Gruss

Kompilieren Marca Separación

Conjunto("ErrorLevel",1)
Conjunto("OnError", 1)
Windowtitle "ZeichenFeld"
Windowstyle 80
Ventana 0,0-%maxx,%maxy
var color&=rgb(229,229,229)
var x!=%maxx/2
var y!=%maxy/2
Declarar a%,b%,c%,alpha%,null_x$,null_y$,null_c$,bild&
Declarar Last_mouse_x%,Last_mouse_y%,ax!,ay!
Declarar befehl![],befehl%,x1![],x2![],y1![],y2![],zaehler%,startpunkt%,start_x!,start_y!,y$
zaehler%=3
befehl%=1

Whileloop 5

    befehl![&bucle]=1'Line
    x1![&bucle]=0
    x2![&bucle]=0
    y1![&bucle]=0
    y2![&bucle]=0

Endwhile

Conjunto("Decimals",0)
Def Setcursorpos(2) !"USER32","SetCursorPos"
MCLS %maxx,%maxy
MCopyBMP 0,0-%maxx,%maxy > 0,0;0
Color del texto RGB(0,0,0),-1
UseBrush 1,RGB(0,0,255)

REPEAT

    StartPaint -1
    ClS color&
    USEP 3,1,0
    Rectángulo 30,20 - %maxx-34,%maxy-49
    usepen 2,1,0
    line x!,20 - x!,%maxy-50
    line 30,y! - %maxx-33,y!
    showcursor 0
    USEP 0,1,RGB(255,0,31)
    ay!=%mousey
    ax!=%mousex

    If %mousex<30

        ax!=30

    EndIf

    If %mousex>%maxx-35

        ax!=%maxx-35

    EndIf

    If %mousey<20

        ay!=20

    EndIf

    If %mousey>%maxy-50

        ay!=%maxy-50

    Endif

    Line 30,ay! - %maxx-35,ay!'horizontale des Fadenkreuzes
    line ax!,20 - ax!,%maxy-50'vertikale des Fadenkreuzes
    USEP 0,1,0
    Color del texto RGB(255,16,118),-1
    Rectángulo 0,(ay!) - 28,(ay!+19)
    Rectángulo ax!,0 - ax!+36,19
    DrawText 2,ay!+2,null_y$+str$(abs(ay!-20))
    DrawText ax!+2,2,null_x$+str$(abs(ax!-30))
    usepen 4,1,RGB(105,100,255)
    Line x!,y! - ax!,ay!
    usepen 0,1,0
    a%=sqr(x!-ax!)
    b%=sqr(y!-ay!)
    c%=sqrt(a%+b%)

    If c%<100

        null_c$="0"

    EndIf

    If c%<10

        null_c$="00"

    EndIf

    If c%>99

        null_c$=""

    EndIf

    Color del texto RGB(139,0,139),-1

    If (ax!>x!) And (ay!>y!)

        rectangle ax!,ay! - ax!+28, ay!+19
        Rectángulo x!,y! - x!-28,y!-18
        DrawText x!-24,y!-17,"0.0"
        DrawText ax!+2,ay!+2,null_c$+str$(c%)

    EndIf

    If (ax!>x!) And (ay!<y!)

        rectangle ax!,ay! - ax!+28, ay!-19
        Rectángulo x!,y! - x!-28,y!+18
        DrawText x!-24,y!+1,"0.0"
        DrawText ax!+2,ay!-17,null_c$+str$(c%)

    EndIf

    If (ax!<x!) And (ay!<y!)

        rectangle ax!,ay! - ax!-28, ay!-19
        Rectángulo x!,y! - x!+28,y!+18
        DrawText x!+4,y!+1,"0.0"
        DrawText ax!-26,ay!-17,null_c$+str$(c%)

    EndIf

    If (ax!<x!) And (ay!>y!)

        rectangle ax!,ay! - ax!-28, ay!+19
        Rectángulo x!,y! - x!+28,y!-18
        DrawText x!+4,y!-17,"0.0"
        DrawText ax!-26,ay!+2,null_c$+str$(c%)

    EndIf

    Color del texto RGB(255,16,118),-1

    If %mousepressed=2

        Mausmenu ax!,ay!

    EndIf

    If (%mousepressed=1) And (startpunkt%=0)

        locate 1,1
        inc zaehler%
        'Imprimir zaehler%
        sound 5000,5
        startpunkt%=1
        start_x!=ax!
        start_y!=ay!
        Last_mouse_x%=ax!
        Last_mouse_y%=ay!

    Endif

    If (%mousepressed=1) And (startpunkt%=1)

        'sound 3000,5

        If befehl%=1

            befehl![zaehler%]=1

        ElseIf befehl%=2

            befehl![zaehler%]=2

        ElseIf befehl%=3

            befehl![zaehler%]=3

        ElseIf befehl%=4

            befehl![zaehler%]=4

        ElseIf befehl%=5

            befehl![zaehler%]=5

        EndIf

        x1![zaehler%]=ax!
        y1![zaehler%]=ay!
        x2![zaehler%]=Last_mouse_x%
        y2![zaehler%]=Last_mouse_y%
        inc zaehler%
        Last_mouse_x%=ax!
        Last_mouse_y%=ay!

    EndIf

    If startpunkt%=1

        USEP 3,1,RGB(255,0,0)
        Line last_mouse_x%,last_mouse_y% - last_mouse_x%,ay!
        Line last_mouse_x%,ay! - ax!,ay!
        Line ax!,last_mouse_y% - ax!,ay!
        Line last_mouse_x%,last_mouse_y% - ax!,Last_mouse_y%
        Line last_mouse_x%,last_mouse_y%-ax!,ay!
        Color del texto 0,-1
        DrawText 35,730,"Linie : "+str$(last_mouse_x%)+","+str$(last_mouse_y%)+" - "+str$(ax!)+","+str$(ay!)
        SetPixel last_mouse_x%-50,last_mouse_y%-50,0
        SetPixel last_mouse_x%-50,last_mouse_y%-52,0
        SetPixel last_mouse_x%-52,last_mouse_y%-50,0
        SetPixel last_mouse_x%-52,last_mouse_y%-52,0

    Endif

    USEP 0,1,0

    whileloop SizeOf(x1![])-1

        If befehl![&bucle-1]=1

            line x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        EndIf

        If befehl![&bucle-1]=2

            rectangle x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        EndIf

        If befehl![&bucle-1]=5

            ellipse x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        Endif

        'line x1![&loop],y1![&loop]-x2![&loop],y2![&loop]
        'Arc x1![&loop],y1![&loop] - x2![&loop],y2![&loop]; x1![&loop],y1![&loop]; x2![&loop],y2![&loop]
        'Chord x1![&loop],y1![&loop] - x2![&loop],y2![&loop]; x1![&loop],y1![&loop]; x2![&loop],y2![&loop]

    EndWhile

    EndPaint
    MCopyBMP 0,0-%maxx,%maxy > 0,0;0
    waitinput 1

UNTIL %key=27

CLS
waitinput
End

Proc Form_Close

    sound 1000,5
    x1![zaehler%]=start_x!
    y1![zaehler%]=start_y!
    x2![zaehler%]=Last_mouse_x%
    y2![zaehler%]=Last_mouse_y%
    Inc zaehler%
    startpunkt%=0

ENDPROC

Proc Clear_Screen

    ArrDel x1![],0,SizeOf(x1![])-1'Arraygrösse se en 1 gesetzt.
    ArrDel x2![],0,SizeOf(x2![])-1'Arraygrösse se en 1 gesetzt.
    ArrDel y1![],0,SizeOf(y1![])-1'Arraygrösse se en 1 gesetzt.
    ArrDel y2![],0,SizeOf(y2![])-1'Arraygrösse se en 1 gesetzt.
    MCLS %maxx,%maxy
    Last_mouse_x%=%mousex
    Last_mouse_y%=%mousey
    ax!=%mousex
    ay!=%mousey
    start_x!=ax!
    start_y!=ay!
    startpunkt%=0

ENDPROC

Proc Set_StartPunkt

    Last_mouse_x%=%mousex
    Last_mouse_y%=%mousey
    ax!=%mousex
    ay!=%mousey
    start_x!=ax!
    start_y!=ay!
    startpunkt%=0

ENDPROC

Proc Ende

    Endpaint
    CLS
    Imprimir zaehler%
    USEP 0,1,0

    whileloop SizeOf(x1![])-1

        If befehl![&bucle-1]=1

            line x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        EndIf

        If befehl![&bucle-1]=2

            rectangle x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        EndIf

        If befehl![&bucle-1]=5

            ellipse x1![&bucle],y1![&bucle]-x2![&bucle],y2![&bucle]

        Endif

    EndWhile

    Waitinput
    end

ENDPROC

Proc Mausmenu

    showcursor 1
    Parámetros x% , y%
    CreateMenu
    AppendMenu 210,"Clear Screen"
    AppendMenu 999,"-"
    AppendMenu 220,"Linie / Freihand"
    AppendMenu 221,"Rechteck"
    'AppendMenu 222,"Parallelogramm"
    'AppendMenu 223,"Trapez"
    'AppendMenu 999,"-"
    AppendMenu 224,"Ellipse / Kreis"
    AppendMenu 999,"-"
    AppendMenu 231,"----------"
    AppendMenu 232,"----------"
    AppendMenu 234,"Neuer StartPunkt"
    AppendMenu 999,"-"
    AppendMenu 233,"Form schliessen"
    AppendMenu 999,"-"
    AppendMenu 235,"Ende"
    TrackMenu x% , y%
    Case MenuItem(220):befehl%=1
    Case MenuItem(221):befehl%=2
    Case MenuItem(222):befehl%=3
    Case MenuItem(223):befehl%=4
    Case MenuItem(224):befehl%=5
    Case MenuItem(235):ende
    Case MenuItem(233):Form_Close
    Case MenuItem(210):Clear_Screen
    Case MenuItem(234):Set_StartPunkt
    Case MenuItem(232)
    showcursor 0

ENDPROC

XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...

18.05.2021 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

RudiB.

¡Hola P.

Gracias para Su Kommentar, Usted hast el Waitinput al Ende el Repeat/Until Bucle otra vez aktiviert...así funktioniert el Freihandzeichnen entonces pero no mehr..
voluntad ahora wohl el Kreis y Rechteck-Características anders realisieren. Profano macht lo una zwar simplemente...aber por qué Einfach wenn´s auch schwer va.....
Usted bist de paso gerade mein Ideengeber con Su Beiträgen....Gracias Usted.

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

19.05.2021 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

RudiB.

Posesiones lo gerade veces gecheckt...el Programa zerrt ya bastante schön a el Leistung...35% CPU Auslastung no Fein.....

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

19.05.2021 ▲

Vollständiges Zitat

Absatzweise Cita Zeilenweise Cita

RudiB.

Ach sí, habe abs((a+b)^2) por sqr(a+b) ersetzt. Quadrieren macht ohnhin siempre abs-Werte!