XProfan

Français

RudiB.

Bastele justement à einem Grafik-Tool rum, gebracht hat mich P.Specht puis...je denke la fois Paul ou bien Peter...peut-être verrät il es uns la fois..

mon Problem ist cela z.B chez Rechtecken ou bien Kreisen, cet volonté comment un Layer dans den Vordergrund gehoben volonté, et cela Fadenkreuz derrière elle verschwindet....ist zwar cool...mais pas mon Intension.
je pourrait cela zwar tourner autour de, si je beim Kreis/Ellipse avec Pixel-Berechnug/zeichnen et chez Rechteck avec "line" arbeite...mais....
ici la fois qui Voir le texte source....
Contrôle alles seulement sur Bouton de la souris à gauche et à droite... sollte eigentlich selbsterklärend son.....
Beginnend startet cela Programme avec "Linie".....Click à gauche Startpunkt, Click à gauche...ligne number wird gezeichnet....Click à gauche....ligne number wird gezeichnet....jusqu'à Endpunkt......ou bien ensuite Click à droite.
Rechter Mausclick appelez un Menue sur.....

Kompilieren Marque Séparation

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

Whileloop 5

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

Endwhile

Set("Décimal",0)
Def Setcursorpos(2) !"User32","SetCursorPos"
MCLS %maxx,%maxy
MCopyBMP 0,0-%maxx,%maxy > 0,0;0
Couleur du texte RGB(0,0,0),-1
UseBrush 1,RGB(0,0,255)

REPEAT

    Début de peinture -1
    ClS color&
    USEP 3,1,0
    Rectangle 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

    Si %mousex<30

        ax!=30

    EndIf

    Si %mousex>%maxx-35

        ax!=%maxx-35

    EndIf

    Si %mousey<20

        ay!=20

    EndIf

    Si %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
    Couleur du texte RGB(255,16,118),-1
    Rectangle 0,(ay!) - 28,(ay!+19)
    Rectangle 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(en%+b%)

    Si c%<100

        null_c$="0"

    EndIf

    Si c%<10

        null_c$="00"

    EndIf

    Si c%>99

        null_c$=»

    EndIf

    Couleur du texte RGB(139,0,139),-1

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

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

    EndIf

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

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

    EndIf

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

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

    EndIf

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

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

    EndIf

    Couleur du texte RGB(255,16,118),-1

    Si %mousepressed=2

        Mausmenu ax!,ay!

    EndIf

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

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

    Endif

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

        'sound 3000,5

        Si 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

    Si 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!
        Couleur du texte 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

        Si befehl![&loop-1]=1

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

        EndIf

        Si befehl![&loop-1]=2

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

        EndIf

        Si befehl![&loop-1]=5

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

        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 %clé=27

CLS
waitinput
Fin

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 wird sur 1 gesetzt.
    ArrDel x2![],0,SizeOf(x2![])-1'Arraygrösse wird sur 1 gesetzt.
    ArrDel y1![],0,SizeOf(y1![])-1'Arraygrösse wird sur 1 gesetzt.
    ArrDel y2![],0,SizeOf(y2![])-1'Arraygrösse wird sur 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
    Imprimer zaehler%
    USEP 0,1,0

    whileloop SizeOf(x1![])-1

        Si befehl![&loop-1]=1

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

        EndIf

        Si befehl![&loop-1]=2

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

        EndIf

        Si befehl![&loop-1]=5

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

        Endif

    Endwhile

    Waitinput
    end

ENDPROC

Proc Mausmenu

    showcursor 1
    Paramètres 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%
    Cas MenuItem(220):befehl%=1
    Cas MenuItem(221):befehl%=2
    Cas MenuItem(222):befehl%=3
    Cas MenuItem(223):befehl%=4
    Cas MenuItem(224):befehl%=5
    Cas MenuItem(235):ende
    Cas Menuitem(233):Form_Close
    Cas MenuItem(210):Clear_Screen
    Cas MenuItem(234):Set_StartPunkt
    Cas MenuItem(232)
    showcursor 0

ENDPROC

....encore quoi oublier qc....simple la fois linke Bouton de la souris beim Zeichnen gedrückt tenir...... "Freihandzeichnen"....

encore quoi oublier qc !! ...alle données volonté volonté dans un Array geschrieben ....mais sieht on oui, ou bien ???
quoi mir encore lieber wäre, si je qui Zeichenoberflähe avec dem %Hwnd mischen pourrait...
Zum Ende wird alles encore la fois aufs %Hwnd gezeichnet....

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

18.05.2021 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

p.specht

simple p.

Klappt déjà droite bien! ArrDel-Funktion findet il pas, mais sonst OK.
ah oui, habe abs((a+b)^ 2) par sqr(a+b) ersetzt. Quadrieren pouvoir ohnhin toujours abs-Werte!
Gruss

Kompilieren Marque Séparation

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

Whileloop 5

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

Endwhile

Set("Décimal",0)
Def Setcursorpos(2) !"User32","SetCursorPos"
MCLS %maxx,%maxy
MCopyBMP 0,0-%maxx,%maxy > 0,0;0
Couleur du texte RGB(0,0,0),-1
UseBrush 1,RGB(0,0,255)

REPEAT

    Début de peinture -1
    ClS color&
    USEP 3,1,0
    Rectangle 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

    Si %mousex<30

        ax!=30

    EndIf

    Si %mousex>%maxx-35

        ax!=%maxx-35

    EndIf

    Si %mousey<20

        ay!=20

    EndIf

    Si %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
    Couleur du texte RGB(255,16,118),-1
    Rectangle 0,(ay!) - 28,(ay!+19)
    Rectangle 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(en%+b%)

    Si c%<100

        null_c$="0"

    EndIf

    Si c%<10

        null_c$="00"

    EndIf

    Si c%>99

        null_c$=»

    EndIf

    Couleur du texte RGB(139,0,139),-1

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

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

    EndIf

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

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

    EndIf

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

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

    EndIf

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

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

    EndIf

    Couleur du texte RGB(255,16,118),-1

    Si %mousepressed=2

        Mausmenu ax!,ay!

    EndIf

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

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

    Endif

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

        'sound 3000,5

        Si 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

    Si 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!
        Couleur du texte 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

        Si befehl![&loop-1]=1

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

        EndIf

        Si befehl![&loop-1]=2

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

        EndIf

        Si befehl![&loop-1]=5

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

        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 %clé=27

CLS
waitinput
Fin

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 wird sur 1 gesetzt.
    ArrDel x2![],0,SizeOf(x2![])-1'Arraygrösse wird sur 1 gesetzt.
    ArrDel y1![],0,SizeOf(y1![])-1'Arraygrösse wird sur 1 gesetzt.
    ArrDel y2![],0,SizeOf(y2![])-1'Arraygrösse wird sur 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
    Imprimer zaehler%
    USEP 0,1,0

    whileloop SizeOf(x1![])-1

        Si befehl![&loop-1]=1

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

        EndIf

        Si befehl![&loop-1]=2

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

        EndIf

        Si befehl![&loop-1]=5

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

        Endif

    Endwhile

    Waitinput
    end

ENDPROC

Proc Mausmenu

    showcursor 1
    Paramètres 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%
    Cas MenuItem(220):befehl%=1
    Cas MenuItem(221):befehl%=2
    Cas MenuItem(222):befehl%=3
    Cas MenuItem(223):befehl%=4
    Cas MenuItem(224):befehl%=5
    Cas MenuItem(235):ende
    Cas Menuitem(233):Form_Close
    Cas MenuItem(210):Clear_Screen
    Cas MenuItem(234):Set_StartPunkt
    Cas 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 citation

Absatzweise Citation Zeilenweise Citation

RudiB.

allô P.

merci pour Deinen Kommentar, tu as cela Waitinput am Ende qui Repeat/Until Boucle wieder aktiviert...avec cela funktioniert cela Freihandzeichnen ensuite mais pas plus..
werde maintenant wohl qui Kreis et Rechteck-Funktionen anders realisieren. Profan pouvoir es einem zwar simple...mais pourquoi simple wenn´s aussi schwer allez.....
tu es incidemment justement mon Ideengeber avec Deinen Beiträgen....merci Dir.

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

19.05.2021 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

RudiB.

Habe es justement la fois gecheckt...cela Programme zerrt déjà entier joli à qui Leistung...35% CPU Auslastung pas délicat.....

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

19.05.2021 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

RudiB.

ah oui, habe abs((a+b)^ 2) par sqr(a+b) ersetzt. Quadrieren pouvoir ohnhin toujours abs-Werte!