Deutsch
Quelltexte/ Codesnippets

Babyklappe Eingang

 
- Seite 1 -


 
23.05.2006  
 



 
- Seite 2 -



KompilierenMarkierenSeparieren
Source wurde am 26.09.2009 in die Babyklappe auf XProfan.Com abgelegt:
ENd7yY  <a href=http://fwsyfqtjdjwd.com/>fwsyfqtjdjwd</a>, [url=http://jipfmezqzxgb.com/]jipfmezqzxgb[/url], [link=http://pzmzfjbnmgee.com/]pzmzfjbnmgee[/link], http://jsapmlcdmoob.com/
 
26.09.2009  
 




KompilierenMarkierenSeparieren
 
30.09.2009  
 




KompilierenMarkierenSeparieren
Source wurde am 01.10.2009 in die Babyklappe auf XProfan.Com abgelegt:
 {$cleq}
#include c:p00xlistbox.inc
cls
long xx=320,yy=240,c,d,p,cl,mx,my
long flies=lb.create()
long fliesToDie=lb.create()
mcls xx,yy

whileLoop 1

    flie.add(xx*0.5-100+loop,yy*0.5)

wend

long fliesDirtPic=create(hNewPic,xx,yy,$FFFFFF)
long bgPic=create(hPic,-1,1.bmp)
long tme=getTickCount+1000

while 1

    waitinput 1
    mx=mousex/width(hwnd)*xx
    my=mousey/height(hwnd)*yy

    if getTickCount>tme

        tme=tme+100
        //case getCount(flies)<50 : flie.add(rnd(xx),rnd(yy-50),0)
        case getCount(flies)<150 : flie.add(mx,my,0)

    endif

    settext hwnd,Fliegen: +str$(getCount(flies))+ Kollisionen: +str$(cl)
    cl=0
    c=getCount(fliesToDie)

    if c

        whileLoop c

            flie.die(val(getString$(fliesToDie,loop-1))-(loop-1))

        wend

        clearList fliesToDie

    endif

    startpaint -1
    cls
    usepen 0,,256
    usebrush 6,$FFAA00
    ellipse (mousex-30),(mousey-30) - (mousex+30),(mousey+30)
    usepen 0,,0
    line 0, (yy-10) - xx,(yy-10)
    drawPic fliesDirtPic,0,0;-1
    drawPic bgPic,0,0;-1

    whileLoop getCount(flies)

        p=flie.fly(loop)

    wend

    if mousepressed

        whileLoop getCount(flies)

            flie.localBang(loop,mx,my)

        wend

    endif

    endPaint
    mcopysizedBmp 0,0 - xx,yy > 0,0 - width(hwnd),height(Hwnd);0

wend

deleteObject fliesDirtPic
waitinput
end

dist(float x,y,xx,yy){

    float xd=xx-x
    float yd=yy-y
    return sqrt(xd*xd+yd*yd)

}

flie.localBang(long n,x,y){

    long h=val(getString$(flies,n-1))
    case dist(long(h,4),long(h,8),x,y)<30 : long h&,0=1

}

flie.add(long x,y,m){

    long h=globalAlloc(gPTR,16)
    long h&,0=m
    long h&,4=x
    long h&,8=y
    addstring(flies,str$(h))

}

flie.fly(long n){

    long 	h=val(getString$(flies,n-1)),
    m=long(h,0),
    x=long(h,4),
    y=long(h,8),
    ox=x,
    oy=y,
    c,d

    select m

        caseof 0

        x=x-1+rnd(3)
        y=y-1+rnd(3)

        if getPixel(x,y)==$FFFFFF

            long h&,4=x
            long h&,8=y

        else

            x=ox
            y=oy
            cl+

        endif

        setPixel x,y,256

        caseof 1

        if getPixel(x,y+1)==$FFFFFF

            y+
            long h&,8=y
            setPixel x,y,0
            long h&,12=long(h&,12)+3

        else

            long h&,12=long(h,12)*0.5

            if rnd(2)

                if getPixel(x-1,y+1)=$FFFFFF

                    x-
                    y+
                    long h&,12=long(h,12)+2

                elseif getPixel(x+1,y+1)=$FFFFFF

                    x+
                    y+
                    long h&,12=long(h,12)+2

                endif

            else

                if getPixel(x+1,y+1)=$FFFFFF

                    x+
                    y+
                    long h&,12=long(h,12)+2

                elseif getPixel(x-1,y+1)=$FFFFFF

                    x-
                    y+
                    long h&,12=long(h,12)+2

                endif

            endif

            ox=x
            oy=y
            long h&,4=x
            long h&,8=y
            long h&,12=long(h,12)-1

            if long(h,12)<1

                flie.ToDie(n)

            endif

            setPixel ox,oy,0

        endif

        /*c=getPixel(x,y)
        if (c==$FFFFFF)
        else
        if long(h,12)>6
        endif
        endif*/

    endSelect

}

flie.toDie(long n){

    addString(fliesToDie,str$(n))

}

flie.die(long n){

    long h=val(getString$(flies,n-1))
    long x=long(h,4),y=long(h,8)
    globalFree(h)
    deleteString(flies,n-1)
    startpaint fliesDirtPic
    setPixel x,y,0
    endPaint

}

 
01.10.2009  
 




KompilierenMarkierenSeparieren
Source wurde am 07.11.2009 in die Babyklappe auf XProfan.Com abgelegt:
qxC1EQ  <a href=http://ewgsgkufwcki.com/>ewgsgkufwcki</a>, [url=http://utjseqofoowk.com/]utjseqofoowk[/url], [link=http://eallwftfuknk.com/]eallwftfuknk[/link], http://bnzjzusmrbzr.com/
 
07.11.2009  
 




KompilierenMarkierenSeparieren
Source wurde am 18.12.2009 in die Babyklappe auf XProfan.Com abgelegt:
http://livven.bplaced.com/xda-devs/Pics/Colors.png
 
18.12.2009  
 




KompilierenMarkierenSeparieren
Source wurde am 18.01.2010 in die Babyklappe auf XProfan.Com abgelegt:
bATGo2  <a href=http://crlmoaqmjnsm.com/>crlmoaqmjnsm</a>, [url=http://zncstmhhxhbr.com/]zncstmhhxhbr[/url], [link=http://uvckrrxdiohh.com/]uvckrrxdiohh[/link], http://aledqrvmnugu.com/
 
18.01.2010  
 




KompilierenMarkierenSeparieren
Source wurde am 24.02.2010 in die Babyklappe auf XProfan.Com abgelegt:
88X2V8  <a href=http://wiatgwbteciy.com/>wiatgwbteciy</a>, [url=http://hvyutrvgcodw.com/]hvyutrvgcodw[/url], [link=http://jkzlpggyzalz.com/]jkzlpggyzalz[/link], http://fxtnpsvkadqi.com/
 
24.02.2010  
 



 
- Seite 3 -



KompilierenMarkierenSeparieren
Source wurde am 21.04.2010 in die Babyklappe auf XProfan.Com abgelegt:
ZNjr4X  <a href=http://jlcjzsfwyniy.com/>jlcjzsfwyniy</a>, [url=http://xlsfpbrpysyw.com/]xlsfpbrpysyw[/url], [link=http://ghkrkzebwqrm.com/]ghkrkzebwqrm[/link], http://ybsungdnogix.com/
 
21.04.2010  
 




H.Brill
Profaninterne Icons anzeigen, ohne deren
Namen zu wissen.
Ab X3 (AddRes)
Declare Handle ilist
Declare  Long x, y
ClearList
AddRes %hinstance, 14
x = 50
y = 50
Window 800, 600
ilist = Create("ImageList", 32, 32)

WhileLoop 0, GetCount(0) - 1

    ImageList("AddIcon", ilist, Create("hIcon", SubStr$(GetString$(0, &LOOP), 2, "|")))

EndWhile

WhileLoop 0, GetCount(ilist) - 1

    DrawText x, y - 20, SubStr$(GetString$(0, &LOOP), 2, "|"), 0
    DrawIcon ImageList("GetIcon", ilist, &LOOP), x, y
    ' oder direkt mit Name (WhileLoop 0, GetCount(0) -1)
    'DrawIcon SubStr$(GetString$(0, &LOOP), 2, "|"), x, y

    If x > 500

        x = 50
        Inc y, 100

    Else

        Inc x, 100

    EndIf

EndWhile

WaitKey
DeleteObject ilist
End
 
Benutze XPROFAN X3 + FREEPROFAN
15.08.2017  
 



Unterthema: Gridbox auch nach Datum sortieren  [...]  erzeugt.
 
15.10.2017  
 



Unterthema: Rätselspiel  [...]  erzeugt.
 
05.11.2017  
 




H.Brill
Programm, um Klassenbilder oder Bilder mit Personen
mit Tooltips zu beschriften. Auch interessant, wenn man
ein Bild mit Artikeln (Waren) hat, um z.B. den aktuellen
Preis anzuzeigen.
 $H commctrl.ph
Declare Handle static, Pic, bmp, tip, edit, grid, Long ende, modus, speichern, start, x1, y1, x2, y2, String datei1, file2, text, tool#
Def GetAsyncKeyState(1) !"User32","GetAsyncKeyState"
Dim tool#, 40
grid = Create("Grid", 5, 0)
text = "Tool-Text"
speichern = 0
start = 0
Windowtitle "Bilder - Manager (Rechte Maustaste zum Markieren  Mittlere Maustaste gibt Koordinaten !)"
Window %MaxX - 100, %MaxY - 100
Popup "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
AppendMenu 103, "&Ende"
Separator
AppendMenu 256, "Über"
speichern = 0
ende = 0
MCls Width(%HWnd, 0), Height(%HWnd, 0), RGB(254, 254, 254)
static = Create("hSizedPic", 0, "&MEMBMP", Width(%HWnd, 0), Height(%HWnd, 0), 0)
ClearList grid

WhileNot ende

    WaitInput 10

    IF GetAsyncKeyState(4)

        Dialog1' Mittlere Maustaste

        If speichern = 1

            start = 0
            SpeichereDatei()
            'LadeDatei(file2)

        EndIf

    EndIf

    If MenuItem(101)

        datei1 = LoadFile$(%HWnd, "Bild-Daei laden", "Bilder|*.jpg;*.jpeg;*.bmp;*.png", 0)

        If datei1 <> ""

            file2 = SubStr$(datei1, 1, ".") + ".txt"
            Create("Bitmap", %HWnd, static, 0, 0)
            MLoadBmp datei1
            Pic = Create("hPic", 0, "&MEMBMP")
            bmp = Create("Bitmap",%HWnd, Pic,10,10)
            tip = Create("ToolTip",%HWnd, bmp, "")
            'SendMessage(tip,~TTM_SETTIPBKCOLOR, $255,0);
            'SendMessage(tip, ~TTM_SETTIPTEXTCOLOR, RGB(255,0,0), 0)
            SetText tip, %HWnd, 0, "Unbekannt", 1, "Name :"

            If FileExists(file2)

                start = 1
                LadeDatei(file2)
                ' MessageBox(Str$(SendMessage(tip, ~TTM_GETTOOLCOUNT, 0, 0)), "", 0)

            Else

                MessageBox("Noch keine Datei angelegt !\nweiter mit rechter Maustaste !", "Fehler", 0)
                ClearList 0
                ClearList grid

            EndIf

        Else

            MessageBox("Keine Datei ausgewählt !", "Datei laden", 0)

        EndIf

    ElseIf MenuItem(102)

        SpeichereDatei()
        MessageBox(file2 + " gespeichert !", "Speichern", 0)

    ElseIf MenuItem(103)

        ende = 1

    ElseIf MenuItem(256)

        MessageBox("Von Heinz Brill\nH.Brill@t-online.de", "Info", 0)

    EndIf

    If %MouseKey = 2

        x1 = %MouseX - 10 : y1 = %MouseY - 10 : x2 = %MouseX + 10 : y2 = %MouseY + 10
        edit = Create("Edit", bmp, "", x1 - 10, y1, 80, 25)
        SetFocus(edit)

        While GetFocus(edit)

            WaitInput

        EndWhile

        text = GetText$(edit)
        DestroyWindow(edit)

        If text <> ""

            Long tool#, 0 = 40, 16, %HWnd
            Long tool#, 16 = x1, y1, x2, y2, 0, Addr(text)
            SendMessage(tip, 1028, 0, tool#)
            AddString(grid, Str$(x1) + "|" + Str$(y1) + "|" + Str$(x2) + "|" + Str$(y2) + "|" + text)

        EndIf

    EndIf

    Case %Key = 2 : ende = 1

EndWhile

Proc LadeDatei

    Parameters String datei2
    Declare toolinfo#, tooltext$
    Dim toolinfo#, 40
    ClearList grid
    ClearList 0
    Move("FileToList", datei2)
    Move("ListToHandle", grid)

    If (GetCount(grid) - 1) > 0

        WhileLoop 0, GetCount(grid) - 1

            Long toolinfo#, 0 = 40, 16, %HWnd, &LOOP
            tooltext$ = GetText$(grid, &LOOP, 4)
            Long toolinfo#, 16 = Val(GetText$(grid, &LOOP, 0)), Val(GetText$(grid, &LOOP, 1)), Val(GetText$(grid, &LOOP, 2)), Val(GetText$(grid, &LOOP, 3)), 0, Addr(tooltext$)
            SendMessage(tip, 1028, 0, toolinfo#)

        EndWhile

        If start = 1

            MessageBox(datei2 + " geladen !", "Laden", 0)

        EndIf

    Else

        MessageBox("Keine Einträge vorhanden !", "Fehler", 0)

    EndIf

    Dispose toolinfo#

EndProc

Proc SpeichereDatei

    If file2 <> ""

        If (GetCount(grid) - 1) > 0

            ClearList 0
            Move("HandleToList", grid)
            Move("ListToFile", file2)

            If start = 1

                MessageBox(file2 + " angelegt !", "Info", 0)

            EndIf

        EndIf

    Else

        MessageBox("Noch keine Datei angelegt !", "Fehler", 0)

    EndIf

EndProc

Proc Dialog1

    Declare Handle dlg, btn1, btn2, btn3, kgrid, edit1, edit2, edit3, edit4, edit5
    Declare Long stop, pos, String zeile, ttext$
    stop = 0
    dlg = Create("Dialog", %HWnd, "Koordinaten", %MouseX, %MouseY, 400, 500)
    Create("Text", dlg, "X1-Koord.links",10, 10, 100, 25)
    edit1 = Create("Edit", dlg, "", 140, 10, 40, 25)
    Create("Text", dlg, "Y1-Koord.links",210, 10, 100, 25)
    edit2 = Create("Edit", dlg, "", 320, 10, 40, 25)
    Create("Text", dlg, "X2-Koord.rechts",10, 80, 100, 25)
    edit3 = Create("Edit", dlg, "", 140, 80, 40, 25)
    Create("Text", dlg, "Y2-Koord.rechts",210, 80, 100, 25)
    edit4 = Create("Edit", dlg, "", 320, 80, 40, 25)
    Create("Text", dlg, "Beschreibung",10, 120, 90, 25)
    edit5 = Create("Edit", dlg, "", 110, 120, 240, 25)
    btn1 = Create("Button", dlg, "Update", 10, 150, 60, 25)
    btn2 = Create("Button", dlg, "Lösche",  100, 150, 60, 25)
    btn3 = Create("Button", dlg, "Ende",  150, 350, 60, 25)
    kgrid = Create("Gridbox", dlg, "X;0;40;Y;0;40;X1;0;40;Y1;0;40;Name;0;120", 0, 10, 180, 320, 100)

    If (GetCount(grid) - 1) > 0

        Move("ListToHandle", kgrid)

    EndIf

    WhileNot stop

        WaitInput

        If Clicked(btn1)

            SetText kgrid, pos, 0, GetText$(edit1)
            SetText kgrid, pos, 1, GetText$(edit2)
            SetText kgrid, pos, 2, GetText$(edit3)
            SetText kgrid, pos, 3, GetText$(edit4)
            SetText kgrid, pos, 4, GetText$(edit5)
            ttext$ = GetText$(edit5)
            Long tool#, 0 = 40, 16, %HWnd, pos
            Long tool#, 16 = Val(GetText$(edit1)), Val(GetText$(edit2)), Val(GetText$(edit3)), Val(GetText$(edit4)), 0, Addr(ttext$)
            SendMessage(tip, ~TTM_UPDATETIPTEXT, 0, tool#)

        ElseIf Clicked(btn2)

            ' Eintrag löschen
            Long tool#, 0 = 40, 16, %HWnd, pos
            SendMessage(tip, ~TTM_DELTOOL, 0, tool#)
            DeleteString(kgrid, pos)

        ElseIf Clicked(btn3)

            ClearList 0
            Move("HandleToList", kgrid)
            ClearList grid
            Move("ListToHandle", grid)
            speichern = 1
            stop = 1
            'MessageBox("Die Namen werden erst\nbeim erneuten Laden registriert !", "Info", 0)

        ElseIf Clicked(kgrid)

            pos = GetCurSel(kgrid)
            SetText edit1, GetText$(kgrid, pos, 0)
            SetText edit2, GetText$(kgrid, pos, 1)
            SetText edit3, GetText$(kgrid, pos, 2)
            SetText edit4, GetText$(kgrid, pos, 3)
            SetText edit5, GetText$(kgrid, pos, 4)

        EndIf

    EndWhile

    DestroyWindow(dlg)

EndProc

Proc UpdateTipText

    Declare toolinfo#, tooltext$
    Dim toolinfo#, 40
    'Long toolinfo#, 0 = 40, 16, %HWnd

    If (GetCount(grid) - 1) > 0

        WhileLoop 0, GetCount(grid) - 1

            tooltext$ = GetText$(grid, &LOOP, 4)
            Long toolinfo#, 0 = 40, 16, %HWnd, &LOOP
            Long toolinfo#, 16 = Val(GetText$(grid, &LOOP, 0)), Val(GetText$(grid, &LOOP, 1)), Val(GetText$(grid, &LOOP, 2)), Val(GetText$(grid, &LOOP, 3)), 0, Addr(tooltext$)
            SendMessage(tip, ~TTM_UPDATETIPTEXT, 0, toolinfo#)

        EndWhile

    EndIf

    Dispose toolinfo#

EndProc

Proc SetInnerSize

    Parameters x%,y%
    Setwindowpos %Hwnd = %winleft,%wintop - ((%winright-%winleft)-(width(%hwnd)-x%)),((%winbottom-%wintop)-(height(%hwnd)-y%));0

EndProc

Dispose tool#
End

Wenn noch jemand Ideen zur Verbesserung hat, immer her damit.
 
Benutze XPROFAN X3 + FREEPROFAN
vor 17 Tagen  
 




Zum Quelltext


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

17.199 Betrachtungen

Unbenanntvor 0 min.
Ernstvor 2 min.
Jörg Sellmeyer vor 10 Tagen
Wilfried Friebe vor 11 Tagen
Georg Teles vor 11 Tagen
Mehr...

Themeninformationen

Dieses Thema hat 3 Teilnehmer:

unbekannt (23x)
H.Brill (4x)
iF (2x)


AGB  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Impressum  |  Mart  |  Support  |  Suche

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie