XProfan

English

RudiB.

Bastele straight in a graphic-Tool rum, brought has me P.woodpecker hereon...i think time Paul or Peter...Perhaps verrät it it us time..

my trouble is the z.B with Rechtecken or orbit, these go like a Layer into Vordergrund lifted go, and the Fadenkreuz behind it disappears....Although calm...but not my Intension.
I could the of course bypass, when I when circle/ellipsis with Pixel-Berechnug/draw and with rectangle with "line" work...but....
here time the View source....
Control everything only over Mouse button left and right... ought to really selbsterklärend his.....
Beginnend launch the program with "Linie".....Click left Startpunkt, Click left...line becomes drawn....Click left....line becomes drawn....To Endpunkt......or then Click right.
right Mausclick calls one Menue on.....

Compile Mark Separation

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 commands![],commands%,x1![],x2![],y1![],y2![],zaehler%,startpunkt%,start_x!,start_y!,y$
zaehler%=3
befehl%=1

Whileloop 5

    commands![&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
Text Color RGB(0,0,0),-1
UseBrush 1,RGB(0,0,255)

REPEAT

    StartPaint -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

    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 the Fadenkreuzes
    line ax!,20 - ax!,%maxy-50'vertikale the Fadenkreuzes
    USEP 0,1,0
    Text Color RGB(255,16,118),-1
    Rectangle 0,(ay!) - 28,(ay!+19)
    Rectangle ax!,0 - ax!+36,19
    DrawText 2,ay!+2,null_y$+st$(abs(ay!-20))
    DrawText ax!+2,2,null_x$+st$(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

    Text Color 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$+st$(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$+st$(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$+st$(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$+st$(c%)

    EndIf

    Text Color 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 commands%=1

            commands![zaehler%]=1

        ElseIf commands%=2

            commands![zaehler%]=2

        ElseIf commands%=3

            commands![zaehler%]=3

        ElseIf commands%=4

            commands![zaehler%]=4

        ElseIf commands%=5

            commands![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!
        Text Color 0,-1
        DrawText 35,730,"Linie : "+st$(last_mouse_x%)+","+st$(last_mouse_y%)+" - "+st$(ax!)+","+st$(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 commands![&loop-1]=1

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

        EndIf

        If commands![&loop-1]=2

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

        EndIf

        If commands![&loop-1]=5

            ellipsis 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 becomes on 1 staid.
    ArrDel x2![],0,SizeOf(x2![])-1'Arraygrösse becomes on 1 staid.
    ArrDel y1![],0,SizeOf(y1![])-1'Arraygrösse becomes on 1 staid.
    ArrDel y2![],0,SizeOf(y2![])-1'Arraygrösse becomes on 1 staid.
    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 end

    Endpaint
    CLS
    Print zaehler%
    USEP 0,1,0

    whileloop SizeOf(x1![])-1

        If commands![&loop-1]=1

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

        EndIf

        If commands![&loop-1]=2

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

        EndIf

        If commands![&loop-1]=5

            ellipsis 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):commands%=1
    Case MenuItem(221):commands%=2
    Case MenuItem(222):commands%=3
    Case MenuItem(223):commands%=4
    Case MenuItem(224):commands%=5
    Case MenuItem(235):end
    Case Menuitem(233):Form_Close
    Case MenuItem(210):Clear_Screen
    Case MenuItem(234):Set_StartPunkt
    Case MenuItem(232)
    showcursor 0

ENDPROC

....yet what forget....simply time left Mouse button at draw pressed hold...... "Freihandzeichnen"....

yet what forget !! ...any data go go into aray written ....but sees one Yes, or ???
what me yet rather would, if I The Zeichenoberflähe with the %Hwnd mix could...
to that end becomes everything once more aufs %Hwnd drawn....

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

05/18/21 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

p.specht

simply p.

Klappt already right well! ArrDel-function finds it not, but otherwise OK.
alas Yes, have abs((a+b)^2) through sqr(a+b) supplant. Quadrieren power ohnhin always abs-values!
greeting

Compile Mark Separation

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 commands![],commands%,x1![],x2![],y1![],y2![],zaehler%,startpunkt%,start_x!,start_y!,y$
zaehler%=3
befehl%=1

Whileloop 5

    commands![&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
Text Color RGB(0,0,0),-1
UseBrush 1,RGB(0,0,255)

REPEAT

    StartPaint -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

    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 the Fadenkreuzes
    line ax!,20 - ax!,%maxy-50'vertikale the Fadenkreuzes
    USEP 0,1,0
    Text Color RGB(255,16,118),-1
    Rectangle 0,(ay!) - 28,(ay!+19)
    Rectangle ax!,0 - ax!+36,19
    DrawText 2,ay!+2,null_y$+st$(abs(ay!-20))
    DrawText ax!+2,2,null_x$+st$(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

    Text Color 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$+st$(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$+st$(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$+st$(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$+st$(c%)

    EndIf

    Text Color 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 commands%=1

            commands![zaehler%]=1

        ElseIf commands%=2

            commands![zaehler%]=2

        ElseIf commands%=3

            commands![zaehler%]=3

        ElseIf commands%=4

            commands![zaehler%]=4

        ElseIf commands%=5

            commands![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!
        Text Color 0,-1
        DrawText 35,730,"Linie : "+st$(last_mouse_x%)+","+st$(last_mouse_y%)+" - "+st$(ax!)+","+st$(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 commands![&loop-1]=1

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

        EndIf

        If commands![&loop-1]=2

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

        EndIf

        If commands![&loop-1]=5

            ellipsis 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 becomes on 1 staid.
    ArrDel x2![],0,SizeOf(x2![])-1'Arraygrösse becomes on 1 staid.
    ArrDel y1![],0,SizeOf(y1![])-1'Arraygrösse becomes on 1 staid.
    ArrDel y2![],0,SizeOf(y2![])-1'Arraygrösse becomes on 1 staid.
    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 end

    Endpaint
    CLS
    Print zaehler%
    USEP 0,1,0

    whileloop SizeOf(x1![])-1

        If commands![&loop-1]=1

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

        EndIf

        If commands![&loop-1]=2

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

        EndIf

        If commands![&loop-1]=5

            ellipsis 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):commands%=1
    Case MenuItem(221):commands%=2
    Case MenuItem(222):commands%=3
    Case MenuItem(223):commands%=4
    Case MenuItem(224):commands%=5
    Case MenuItem(235):end
    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'...

05/18/21 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

RudiB.

Hello P.

thanks for your comment, you have the Waitinput end the Repeat/Until Loop again activate...so functions the Freihandzeichnen then but not any more..
will be now probably the circle and rectangle-functions differently release. Profan power it one of course simply...but Why simply wenn´s too heavy goes.....
you are incidentally straight my Ideengeber with your Posts....thanks you.

XProfan X4
Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

05/19/21 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

RudiB.

have it straight time gecheckt...the program zerrt already integrally beautiful on the performance...35% CPU Auslastung not nice.....

Xprofan X4
Rudolf Beske / München

Hardware: NB Intel I9 - 16GByte RAM

05/19/21 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

RudiB.

alas Yes, have abs((a+b)^2) through sqr(a+b) supplant. Quadrieren power ohnhin always abs-values!