Fuente/ Codesnippets | | | | - Página 1 - |
|  | | | | | |
| | | | | - Página 2 - |
|  | | | | | |
| |  | KompilierenMarcaSeparaciónSource 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
|
| | | | |
| |  | KompilierenMarcaSeparaciónSource 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
}
|
| | | | |
| |  | | | | | |
| |  | | | | | |
| |  | | | | | |
| |  | | | | | |
| | | | - Página 3 - |
| |  | | | | | |
| |  H.Brill | Profaninterne Icons Mostrar, sin deren Namen a wissen. Ab X3 (AddRes)
Declarar Handle ilist
Declarar Largo x, y
ClearList
AddRes %hInstance, 14
x = 50
y = 50
Ventana 800, 600
ilist = Crear("ImageList", 32, 32)
WhileLoop 0, GetCount(0) - 1
ImageList("AddIcon", ilist, Crear("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 con Name (WhileLoop 0, GetCount(0) -1)
'DrawIcon Substr$(GetString$(0, &LOOP), 2, "|"), x, y
If x > 500
x = 50
Inc y, 100
Más
Inc x, 100
EndIf
EndWhile
WaitKey
DeleteObject ilist
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. | 15.08.2017 ▲ |
| |
| | Unterthema: Gridbox auch después de Datum sortieren [...]  producido. |
| | | | |
| | Unterthema: Rätselspiel [...]  producido. |
| | | | |
| |  H.Brill | Programa, en Klassenbilder oder Bilder con Personen con Tooltips a beschriften. Auch interessant, si uno una Bild con Artikeln (Waren) ha, en z.B. el aktuellen Preis anzuzeigen.
$H commctrl.ph
Declarar Handle static, Pic, bmp, tip, edit, grid, Largo ende, modus, speichern, start, x1, y1, x2, y2, String datei1, file2, texto, tool#
Def GetAsyncKeyState(1) !"User32","GetAsyncKeyState"
Dim tool#, 40
grid = Crear("Grid", 5, 0)
texto = "Tool-Text"
speichern = 0
start = 0
Windowtitle "Bilder - Manager (Rechte Botón del ratón para Marca Mittlere Botón del ratón son Koordinaten !)"
Ventana %MaxX - 100, %MaxY - 100
Popup "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
AppendMenu 103, "&Ende"
Separador
AppendMenu 256, "Über"
speichern = 0
ende = 0
MCLS Width(%HWnd, 0), Height(%HWnd, 0), RGB(254, 254, 254)
static = Crear("hSizedPic", 0, "& MEMBMP", Width(%HWnd, 0), Height(%HWnd, 0), 0)
ClearList grid
Sinestar encargado ende
WaitInput 10
IF GetAsyncKeyState(4)
Diálogo1' Mittlere Botón del ratón
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"
Crear("Mapa de bits", %HWnd, static, 0, 0)
MLoadBmp datei1
Pic = Crear("HPIC", 0, "& MEMBMP")
bmp = Crear("Mapa de bits",%HWnd, Pic,10,10)
tip = Crear("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)
Más
MessageBox("Noch no Expediente creado !\nweiter con rechter Botón del ratón !", "Fehler", 0)
ClearList 0
ClearList grid
EndIf
Más
MessageBox("Keine Expediente 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 = Crear("Edit", bmp, "", x1 - 10, y1, 80, 25)
SetFocus(edit)
Mientras que GetFocus(edit)
WaitInput
EndWhile
texto = GetText $(edit)
DestroyWindow(edit)
If texto <> ""
Largo tool#, 0 = 40, 16, %HWnd
Largo tool#, 16 = x1, y1, x2, y2, 0, Addr(texto)
SendMessage(tip, 1028, 0, tool#)
AddStrings(grid, Str$(x1) + "|" + Str$(y1) + "|" + Str$(x2) + "|" + Str$(y2) + "|" + texto)
EndIf
EndIf
Case %Key = 2 : ende = 1
EndWhile
Proc LadeDatei
Parámetros String datei2
Declarar 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
Largo toolinfo#, 0 = 40, 16, %HWnd, &LOOP
tooltext$ = GetText $(grid, &LOOP, 4)
Largo 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
Más
MessageBox("Keine Einträge disponible !", "Fehler", 0)
EndIf
Disponer toolinfo#
ENDPROC
Proc SpeichereDatei
If file2 <> ""
If (GetCount(grid) - 1) > 0
ClearList 0
Move("HandleToList", grid)
Move("ListToFile", file2)
If start = 1
MessageBox(file2 + " creado !", "Info", 0)
EndIf
EndIf
Más
MessageBox("Noch no Expediente creado !", "Fehler", 0)
EndIf
ENDPROC
Proc Diálogo1
Declarar Handle dlg, btn1, btn2, btn3, kgrid, edit1, edit2, edit3, edit4, edit5
Declarar Largo stop, pos, String zeile, ttext$
stop = 0
dlg = Crear("Dialog", %HWnd, "Koordinaten", %MouseX, %MouseY, 400, 500)
Crear("Text", dlg, "X1-Koord.links",10, 10, 100, 25)
edit1 = Crear("Edit", dlg, "", 140, 10, 40, 25)
Crear("Text", dlg, "Y1-Koord.links",210, 10, 100, 25)
edit2 = Crear("Edit", dlg, "", 320, 10, 40, 25)
Crear("Text", dlg, "X2-Koord.rechts",10, 80, 100, 25)
edit3 = Crear("Edit", dlg, "", 140, 80, 40, 25)
Crear("Text", dlg, "Y2-Koord.rechts",210, 80, 100, 25)
edit4 = Crear("Edit", dlg, "", 320, 80, 40, 25)
Crear("Text", dlg, "Beschreibung",10, 120, 90, 25)
edit5 = Crear("Edit", dlg, "", 110, 120, 240, 25)
btn1 = Crear("Button", dlg, "Update", 10, 150, 60, 25)
btn2 = Crear("Button", dlg, "Lösche", 100, 150, 60, 25)
btn3 = Crear("Button", dlg, "Ende", 150, 350, 60, 25)
kgrid = Crear("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
Sinestar encargado 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)
Largo tool#, 0 = 40, 16, %HWnd, pos
Largo 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
Largo 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 voluntad sólo\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
Declarar toolinfo#, tooltext$
Dim toolinfo#, 40
'Largo toolinfo#, 0 = 40, 16, %HWnd
If (GetCount(grid) - 1) > 0
WhileLoop 0, GetCount(grid) - 1
tooltext$ = GetText $(grid, &LOOP, 4)
Largo toolinfo#, 0 = 40, 16, %HWnd, &LOOP
Largo 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
Disponer toolinfo#
ENDPROC
Proc SetInnerSize
Parámetros x%,y%
Setwindowpos %Hwnd = %winleft,%wintop - ((%winright-%winleft)-(width(%hwnd)-x%)),((%winbottom-%wintop)-(height(%hwnd)-y%));0
ENDPROC
Disponer tool#
End
Wenn todavía alguien Ideen a Verbesserung ha, siempre her así.  |
| | | 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 QuelltextTema opciones | 31.279 Views |
ThemeninformationenDieses Thema ha 3 subscriber: |