Source/ Codesnippets | | | | - page 1 - |
|  | | | | | |
| | | | | - page 2 - |
|  | | | | | |
| |  | KompilierenMarqueSéparationSource wurde am 30.09.2009 in die Babyklappe auf XProfan.Com abgelegt:
{$cleq}
longs x,y
cls
long xx=width(hwnd),yy=height(hwnd),c
mcls xx,yy
whileLoop 0,200
x[loop]=xx*0.5
y[loop]=yy*0.5
wend
while 1
startpaint -1
cls
usebrush 6,$FFAA00
ellipse (mousex-30),(mousey-30) - (mousex+30),(mousey+30)
whileLoop 0,sizeOf(x)-1
x[loop]=x[loop]-2+rnd(5)
y[loop]=y[loop]-2+rnd(5)
setPixel x[loop]-cos(getTickCount*0.001)*30,y[loop]-sin(getTickCount*0.001)*30,loop
wend
endPaint
mcopyBmp 0,0 - xx,yy > 0,0;0
wend
waitinput
end
|
| | | | |
| |  | KompilierenMarqueSéparationSource 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
}
|
| | | | |
| |  | | | | | |
| |  | | | | | |
| |  | | | | | |
| |  | | | | | |
| | | | - page 3 - |
| |  | | | | | |
| |  H.Brill | Profaninterne Icônes Montrer, sans en Namen trop savons. Ab X3 (AddRes)
Déclarer Handle ilist
Déclarer Long x, y
ClearList
AddRes %HINSTANCE, 14
x = 50
y = 50
Fenêtre 800, 600
ilist = Créer("ImageList", 32, 32)
WhileLoop 0, GetCount(0) - 1
ImageList("AddIcon", ilist, Créer("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
' ou bien direct avec nom (WhileLoop 0, GetCount(0) -1)
'DrawIcon Substr$(GetString$(0, &LOOP), 2, "|"), x, y
Si x > 500
x = 50
Inc y, 100
D'autre
Inc x, 100
EndIf
Endwhile
WaitKey
DeleteObject ilist
Fin
|
| | | 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. | 15.08.2017 ▲ |
| |
| | Unterthema: Gridbox aussi pour date sortieren [...]  erzeugt. |
| | | | |
| | Unterthema: Rätselspiel [...]  erzeugt. |
| | | | |
| |  H.Brill | Programme, um Klassenbilder ou bien Bilder avec Personen avec Tooltips trop beschriften. aussi intéressant, si on un Bild avec Artikeln (étions) hat, um z.B. den aktuellen Preis anzuzeigen.
$H commctrl.ph
Déclarer Handle static, Pic, bmp, tip, edit, grid, Long ende, modus, Sauver, start, x1, y1, x2, y2, String fichier1, file2, text, tool#
Def GetAsyncKeyState(1) !"User32","GetAsyncKeyState"
Faible tool#, 40
grid = Créer("Grid", 5, 0)
text = "Tool-Text"
Sauver = 0
start = 0
Windowtitle "Bilder - Manager (Rechte Bouton de la souris zum Marque Mittlere Bouton de la souris gibt Koordinaten !)"
Fenêtre %MaxX - 100, %MaxY - 100
Popup "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
AppendMenu 103, "&Ende"
Séparateur
AppendMenu 256, "Über"
Sauver = 0
ende = 0
MCLS Width(%HWnd, 0), Height(%HWnd, 0), RGB(254, 254, 254)
static = Créer("hSizedPic", 0, "& MEMBMP", Width(%HWnd, 0), Height(%HWnd, 0), 0)
ClearList grid
WhileNot ende
WaitInput 10
IF GetAsyncKeyState(4)
Dialog1' Mittlere Bouton de la souris
Si Sauver = 1
start = 0
SpeichereDatei()
'LadeDatei(file2)
EndIf
EndIf
Si MenuItem(101)
fichier1 = LoadFile$(%HWnd, "Bild-Daei laden", "Bilder|*.jpg;*.jpeg;*.bmp;*.png", 0)
Si fichier1 <> »
file2 = $ Substr(fichier1, 1, ".") + ".txt"
Créer("Bitmap", %HWnd, static, 0, 0)
MLoadBmp fichier1
Pic = Créer(«PCSI», 0, "& MEMBMP")
bmp = Créer("Bitmap",%HWnd, Pic,10,10)
tip = Créer("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 :"
Si FileExists(file2)
start = 1
LadeDatei(file2)
' MessageBox(Str$(SendMessage(tip, ~TTM_GETTOOLCOUNT, 0, 0)), », 0)
D'autre
MessageBox("Noch aucun Dossier angelegt !\nweiter avec rechter Bouton de la souris !", "Fehler", 0)
ClearList 0
ClearList grid
EndIf
D'autre
MessageBox("Keine Dossier 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
Si %MouseKey = 2
x1 = %MouseX - 10 : y1 = %MouseY - 10 : x2 = %MouseX + 10 : y2 = %MouseY + 10
edit = Créer("Edit", bmp, », x1 - 10, y1, 80, 25)
SetFocus(edit)
Tandis que GetFocus(edit)
WaitInput
Endwhile
text = GetText $(edit)
DestroyWindow(edit)
Si text <> »
Long tool#, 0 = 40, 16, %HWnd
Long tool#, 16 = x1, y1, x2, y2, 0, Addr(text)
SendMessage(tip, 1028, 0, tool#)
AddStrings(grid, Str$(x1) + "|" + Str$(y1) + "|" + Str$(x2) + "|" + Str$(y2) + "|" + text)
EndIf
EndIf
Cas %Key = 2 : ende = 1
Endwhile
Proc LadeDatei
Paramètres String fichier2
Déclarer toolinfo#, tooltext$
Faible toolinfo#, 40
ClearList grid
ClearList 0
Move("FileToList", fichier2)
Move("ListToHandle", grid)
Si (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
Si start = 1
MessageBox(fichier2 + " geladen !", "Laden", 0)
EndIf
D'autre
MessageBox("Keine Einträge vorhanden !", "Fehler", 0)
EndIf
Dispose toolinfo#
ENDPROC
Proc SpeichereDatei
Si file2 <> »
Si (GetCount(grid) - 1) > 0
ClearList 0
Move("HandleToList", grid)
Move("ListToFile", file2)
Si start = 1
MessageBox(file2 + " angelegt !", "Info", 0)
EndIf
EndIf
D'autre
MessageBox("Noch aucun Dossier angelegt !", "Fehler", 0)
EndIf
ENDPROC
Proc Dialog1
Déclarer Handle dlg, btn1, btn2, btn3, kgrid, edit1, edit2, edit3, edit4, edit5
Déclarer Long stop, pos, String la ligne, ttext$
stop = 0
dlg = Créer("Dialog", %HWnd, "Koordinaten", %MouseX, %MouseY, 400, 500)
Créer("Text", dlg, "X1-Koord.links",10, 10, 100, 25)
edit1 = Créer("Edit", dlg, », 140, 10, 40, 25)
Créer("Text", dlg, "Y1-Koord.links",210, 10, 100, 25)
edit2 = Créer("Edit", dlg, », 320, 10, 40, 25)
Créer("Text", dlg, "X2-Koord.rechts",10, 80, 100, 25)
edit3 = Créer("Edit", dlg, », 140, 80, 40, 25)
Créer("Text", dlg, "Y2-Koord.rechts",210, 80, 100, 25)
edit4 = Créer("Edit", dlg, », 320, 80, 40, 25)
Créer("Text", dlg, "Beschreibung",10, 120, 90, 25)
edit5 = Créer("Edit", dlg, », 110, 120, 240, 25)
btn1 = Créer("Button", dlg, "Update", 10, 150, 60, 25)
btn2 = Créer("Button", dlg, "Lösche", 100, 150, 60, 25)
btn3 = Créer("Button", dlg, "Ende", 150, 350, 60, 25)
kgrid = Créer("Gridbox", dlg, "X;0;40;Y;0;40;X1;0;40;Y1;0;40;Name;0;120", 0, 10, 180, 320, 100)
Si (GetCount(grid) - 1) > 0
Move("ListToHandle", kgrid)
EndIf
WhileNot stop
WaitInput
Si 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 effacer
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)
Sauver = 1
stop = 1
'MessageBox("Die Namen volonté seulement\nbeim erneuten magasin 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
Déclarer toolinfo#, tooltext$
Faible toolinfo#, 40
'Long toolinfo#, 0 = 40, 16, %HWnd
Si (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
Paramètres x%,y%
Setwindowpos %Hwnd = %winleft,%wintop - ((%winright-%winleft)-(width(%hwnd)-x%)),((%winbottom-%wintop)-(height(%hwnd)-Y%));0
ENDPROC
Dispose tool#
Fin
si encore quelqu'un idées zur amélioration hat, toujours her avec cela.  |
| | | 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. | 06.01.2019 ▲ |
| |
|
Zum QuelltextOptions du sujet | 31.278 Views |
Themeninformationencet Thema hat 3 participant: |
|