XProfan

Deutsch

RudiB.

Bastele gerade an einem Grafik-Tool rum, gebracht hat mich P.Specht darauf...ich denke mal Paul oder Peter...vielleicht verrät er es uns mal..

Mein Problem ist das z.B bei Rechtecken oder Kreisen, diese werden wie ein Layer in den Vordergrund gehoben werden, und das Fadenkreuz dahinter verschwindet....ist zwar cool...aber nicht meine Intension.
Ich könnte das zwar umgehen, wenn ich beim Kreis/Ellipse mit Pixel-Berechnug/zeichnen und bei Rechteck mit "line" arbeite...aber....
Hier mal der Quelltext....
Steuerung alles nur über Maustaste Links und Rechts... sollte eigentlich selbsterklärend sein.....
Beginnend startet das Programm mit "Linie".....Click links Startpunkt, Click links...Linie wird gezeichnet....Click Links....Linie wird gezeichnet....bis Endpunkt......oder dann Click rechts.
Rechter Mausclick ruft ein Menue auf.....

Kompilieren Markieren Separieren

Set("ErrorLevel",1)
Set("OnError", 1)
Windowtitle "ZeichenFeld"
Windowstyle 80
Window 0,0-%maxx,%maxy
var color&=rgb(229,229,229)
var x!=%maxx/2
var y!=%maxy/2
Declare a%,b%,c%,alpha%,null_x$,null_y$,null_c$,bild&
Declare Last_mouse_x%,Last_mouse_y%,ax!,ay!
Declare 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("Decimals",0)
Def Setcursorpos(2) !"USER32","SetCursorPos"
MCls %maxx,%maxy
MCopyBMP 0,0-%maxx,%maxy > 0,0;0
TextColor RGB(0,0,0),-1
UseBrush 1,RGB(0,0,255)

REPEAT

    StartPaint -1
    ClS color&
    UsePen 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
    UsePen 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
    UsePen 0,1,0
    TextColor 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(a%+b%)

    If c%<100

        null_c$="0"

    EndIf

    If c%<10

        null_c$="00"

    EndIf

    If c%>99

        null_c$=""

    EndIf

    TextColor RGB(139,0,139),-1

    If (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

    If (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

    If (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

    If (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

    TextColor RGB(255,16,118),-1

    If %mousepressed=2

        Mausmenu ax!,ay!

    EndIf

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

        locate 1,1
        inc zaehler%
        'Print 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

        UsePen 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!
        TextColor 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

    UsePen 0,1,0

    whileloop SizeOf(x1![])-1

        If befehl![&loop-1]=1

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

        EndIf

        If befehl![&loop-1]=2

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

        EndIf

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

    whileloop SizeOf(x1![])-1

        If befehl![&loop-1]=1

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

        EndIf

        If befehl![&loop-1]=2

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

        EndIf

        If befehl![&loop-1]=5

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

        Endif

    EndWhile

    Waitinput
    end

EndProc

Proc Mausmenu

    showcursor 1
    Parameters 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

....noch was vergessen....einfach mal linke Maustaste beim Zeichnen gedrückt halten...... "Freihandzeichnen"....

Noch was vergessen !! ...alle Daten werden werden in ein Array geschrieben ....aber sieht man ja, oder ???
Was mir noch lieber wäre, wenn ich die Zeichenoberflähe mit dem %Hwnd mischen könnte...
Zum Ende wird alles noch mal aufs %Hwnd gezeichnet....

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

18.05.2021 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

p.specht

Einfach p.

Klappt schon recht gut! ArrDel-Funktion findet er nicht, aber sonst OK.
Ach ja, habe abs((a+b)^2) durch sqr(a+b) ersetzt. Quadrieren macht ohnhin immer abs-Werte!
Gruss

Kompilieren Markieren Separieren

Set("ErrorLevel",1)
Set("OnError", 1)
Windowtitle "ZeichenFeld"
Windowstyle 80
Window 0,0-%maxx,%maxy
var color&=rgb(229,229,229)
var x!=%maxx/2
var y!=%maxy/2
Declare a%,b%,c%,alpha%,null_x$,null_y$,null_c$,bild&
Declare Last_mouse_x%,Last_mouse_y%,ax!,ay!
Declare 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("Decimals",0)
Def Setcursorpos(2) !"USER32","SetCursorPos"
MCls %maxx,%maxy
MCopyBMP 0,0-%maxx,%maxy > 0,0;0
TextColor RGB(0,0,0),-1
UseBrush 1,RGB(0,0,255)

REPEAT

    StartPaint -1
    ClS color&
    UsePen 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
    UsePen 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
    UsePen 0,1,0
    TextColor 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(a%+b%)

    If c%<100

        null_c$="0"

    EndIf

    If c%<10

        null_c$="00"

    EndIf

    If c%>99

        null_c$=""

    EndIf

    TextColor RGB(139,0,139),-1

    If (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

    If (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

    If (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

    If (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

    TextColor RGB(255,16,118),-1

    If %mousepressed=2

        Mausmenu ax!,ay!

    EndIf

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

        locate 1,1
        inc zaehler%
        'Print 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

        UsePen 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!
        TextColor 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

    UsePen 0,1,0

    whileloop SizeOf(x1![])-1

        If befehl![&loop-1]=1

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

        EndIf

        If befehl![&loop-1]=2

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

        EndIf

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

    whileloop SizeOf(x1![])-1

        If befehl![&loop-1]=1

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

        EndIf

        If befehl![&loop-1]=2

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

        EndIf

        If befehl![&loop-1]=5

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

        Endif

    EndWhile

    Waitinput
    end

EndProc

Proc Mausmenu

    showcursor 1
    Parameters 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 zitieren Zeilenweise zitieren

RudiB.

Hallo P.

Danke für Deinen Kommentar, Du hast das Waitinput am Ende der Repeat/Until Schleife wieder aktiviert...damit funktioniert das Freihandzeichnen dann aber nicht mehr..
werde jetzt wohl die Kreis und Rechteck-Funktionen anders realisieren. Profan macht es einem zwar einfach...aber warum Einfach wenn´s auch schwer geht.....
Du bist übrigens gerade mein Ideengeber mit Deinen Beiträgen....Danke Dir.

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

19.05.2021 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

RudiB.

Habe es gerade mal gecheckt...das Programm zerrt schon ganz schön an der Leistung...35% CPU Auslastung nicht Fein.....

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

19.05.2021 ▲

Vollständiges Zitat

Absatzweise zitieren Zeilenweise zitieren

RudiB.

Ach ja, habe abs((a+b)^2) durch sqr(a+b) ersetzt. Quadrieren macht ohnhin immer abs-Werte!