English
Source / code snippets

Babyklappe entry

Rätselspiel

 

H.Brill
small Bilderrätsel
Declare lever imageA[6], btn1, btn2, btn3, tx, edit1, Long x, y, end, String colours
Declare lever picbutton[5]
VAR lever Colors[] = $F30003, $04A3FA, $04FF04, $500AA9, $04F6F9, $FDFFF9
end = 0

WhileLoop 0, 5

    MCLs 48, 48, Colors[&LOOP]
    imageA[&LOOP] = Create("hSizedPic", 0, "&MEMBMP", 48, 48, 0)

EndWhile

Window Title "MALERMEISTER PINSEL STREICHT FENSTER"
Window 900, 900
Cls RGB(0, 0, 0)
tx    = Create("Text",   %HWnd, "Bitte 25 Farbcodes prompt !", 200, 430, 220, 25)
edit1 = Create("Edit",   %HWnd, "",      200, 460, 240, 25)
btn1  = Create("Button", %HWnd, "Setze", 200, 500, 60, 25)
btn2  = Create("Button", %HWnd, "New",   300, 500, 60, 25)
btn3  = Create("Button", %HWnd, "Ende",  200, 560, 60, 25)
x = 10
y = 420
DrawText x, y - 60, "FARBEN (too to that Anklicken) "

WhileLoop 0, 4

    picbutton[&LOOP] = Create("PicButton", %HWnd, imageA[&LOOP], x, y, 48, 48)
    DrawText x + 70, y + 20, " = " + Str $(&LOOP)
    Inc y, 60

EndWhile

x = 500
y = 400
DrawHaus(x, y)
housetop()

WhileNot end

    WaitInput

    If Clicked(btn1)

        ' colours settle
        colours = GetText$(edit1)

        If Len(colours) > 1

            SetzeFarben(colours, x, y)

        Else

            Messagebox("Nicht enough\nFarben staid !", "Info", 0)

        EndIf

    ElseIf Clicked(btn2)

        x = 500
        y = 400
        DrawHaus(x, y)
        SetText edit1, ""

    ElseIf Clicked(btn3)

        ' ENDE
        end = 1

    ElseIf Clicked(picbutton[0])

        SetText edit1, GetText$(edit1) + "0"

    ElseIf Clicked(picbutton[1])

        SetText edit1, GetText$(edit1) + "1"

    ElseIf Clicked(picbutton[2])

        SetText edit1, GetText$(edit1) + "2"

    ElseIf Clicked(picbutton[3])

        SetText edit1, GetText$(edit1) + "3"

    ElseIf Clicked(picbutton[4])

        SetText edit1, GetText$(edit1) + "4"

    EndIf

    Case %Key = 2 : end = 1

EndWhile

Proc DrawHaus

    Parameters Long x, y
    DrawText 10, 10, "Malermeister paintbrush has a difficult order adopted."
    DrawText 10, 30, "Ein customer has it gebeten, 25 Window of his Hauses with 5 different colours To streichen."
    DrawText 10, 50, "Jede colour should same often uses go. In eachone waagrechten and senkrechten Fensterreihe"
    DrawText 10, 70, "müssen 2 Window The same colour having. These both Window should then too yet paarweise"
    DrawText 10, 90, "entweder next to each other or übereinander lying."
    DrawText 10, 130, "https://www.raetselstunde.de/motley/denksport-releases/malermeister-paintbrush.html"
    USEP 0, 5, RGB(192, 192, 192)
    RectAngle (x - 10), (y - 10) - (x + 300), (y + 350)

    WhileLoop 0, 4

        WhileLoop 0, 4

            DrawPic imageA[5], x, y; 0
            Inc x, 60

        EndWhile

        x = 500
        Inc y, 60

    EndWhile

    DrawText 550, y + 20, "WWW.raetselstunde.de"

ENDPROC

Proc SetzeFarben

    Parameters String s, Long x, y
    Declare Long p, z
    z = 1

    WhileLoop 0, 4

        WhileLoop 0, 4

            If z <= Len(s)

                p = VAL(Mid$(s, z, 1))

            Else

                p = 5

            EndIf

            DrawPic imageA[p], x, y; 0
            Inc z
            Inc x, 60

        EndWhile

        x = 500
        Inc y, 60

    EndWhile

    If s = "0012301134122344230023441"

        MessageBox("Sie having everything\nrichtig made !", "GLÜCKWUNSCH !!!", 0)

    Else

        MessageBox("Leider are yet\nwelche wrong\noder To little !", "SCHADE !!!", 0)

    EndIf

ENDPROC

Proc housetop

    Declare Long x1, y1, x2, y2
    x1 = 490
    y1 = 380
    x2 = 800
    y2 = 380
    USEP 0, 8, RGB(255, 0, 0)

    WhileLoop 1, 15

        Line x1, y1 - x2, y2
        Inc x1, 3
        Inc x2, 3
        Dec y1, 5
        Dec y2, 5

    EndWhile

    USEP 0, 5, RGB(192, 192, 192)
    Line 485, 380 - 530, 305
    Line 805, 380 - 850, 305

ENDPROC

End
 
Benutze XPROFAN X3 + FREEPROFAN
Wir sind die XProfaner.
Sie werden von uns assimiliert.
Widerstand ist zwecklos!
Wir werden alle ihre Funktionen und Algorithmen den unseren hinzufügen.

Was die Borg können, können wir schon lange.
11/05/17  
 




Georg
Teles
Colles game,
'hab whom code not at all angeschaut, copy & paste & run & grübel, first now see I that since the Solution for the puzzel with drin standing haha
 
XProfan X3
TC-Programming [...] 
XProfan 8.0 - 10.0 - X2 - X3 - X4

11/11/17  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

3.949 Views

Untitledvor 0 min.
Stringray01/05/22
Langer12/30/20
PETER195611/01/20
RudiB.03/29/20
More...

Themeninformationen

this Topic has 2 subscriber:

Georg Teles (1x)
H.Brill (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie