Source / code snippets | | | | - Page 1 - |
|  | | | | | |
| | | | | - Page 2 - |
|  | | | | | |
| |  | CompileMarkSeparationSource 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
|
| | | | |
| |  | CompileMarkSeparationSource 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 Icons Show, without its names to know. ex X3 (AddRes)
Declare lever 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
' or directly with 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 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. | 08/15/17 ▲ |
| |
| | Sub-Topic: GridBOX too to date sort [...]  created. |
| | | | |
| | Sub-Topic: Rätselspiel [...]  created. |
| | | | |
| |  H.Brill | Program, circa Klassenbilder or Images with Personen with Tooltips To beschriften. too interestingly, if one one Image with Artikeln (were) has, circa z.B. whom actually Price view.
$H commctrl.ph
Declare lever static, Pic, bmp, hint, edit, grid, Long end, mode, Save, start, x1, y1, x2, y2, String File1, file2, Text, tool#
Def GetAsyncKeyState(1) !"User32","GetAsyncKeyState"
Dim tool#, 40
grid = Create("Grid", 5, 0)
Text = "Tool-Text"
Save = 0
start = 0
Windowtitle "Bilder - manager (rights Mouse button to that Mark Mittlere Mouse button gives Coordinates !)"
Window %MaxX - 100, %MaxY - 100
Pop "&Datei"
AppendMenu 101, "&Laden"
AppendMenu 102, "&Speichern"
AppendMenu 103, "&Ende"
Separator
AppendMenu 256, "Über"
Save = 0
end = 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 end
WaitInput 10
IF GetAsyncKeyState(4)
dialog1' Mittlere Mouse button
If Save = 1
start = 0
SpeichereDatei()
'LadeDatei(file2)
EndIf
EndIf
If MenuItem(101)
File1 = LoadFile $(%HWnd, "Bild-Daei laden", "Bilder|*.jpg;*.jpeg;*.bmp;*.png", 0)
If File1 <> ""
file2 = SubStr$(File1, 1, ".") + ".txt"
Create("Bitmap", %HWnd, static, 0, 0)
MLoadBmp File1
Pic = Create("HPIC", 0, "&MEMBMP")
bmp = Create("Bitmap",%HWnd, Pic,10,10)
hint = Create("ToolTip",%HWnd, bmp, "")
'SendMessage(hint,~TTM_SETTIPBKCOLOR, $255,0);
'SendMessage(hint, ~TTM_SETTIPTEXTCOLOR, RGB(255,0,0), 0)
SetText hint, %HWnd, 0, "Unbekannt", 1, "Name :"
If FileExists(file2)
start = 1
LadeDatei(file2)
' MessageBox(Str$(SendMessage(hint, ~TTM_GETTOOLCOUNT, 0, 0)), "", 0)
Else
MessageBox("Noch no File laid out !\nweiter with right Mouse button !", "Fehler", 0)
ClearList 0
ClearList grid
EndIf
Else
MessageBox("Keine File select !", "Datei laden", 0)
EndIf
ElseIf MenuItem(102)
SpeichereDatei()
MessageBox(file2 + " stored !", "Speichern", 0)
ElseIf MenuItem(103)
end = 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(hint, 1028, 0, tool#)
AddStrings(grid, Str $(x1) + "|" + Str $(y1) + "|" + Str $(x2) + "|" + Str $(y2) + "|" + Text)
EndIf
EndIf
Case %Key = 2 : end = 1
EndWhile
Proc LadeDatei
Parameters String File2
Declare toolinfo#, tooltext$
Dim toolinfo#, 40
ClearList grid
ClearList 0
Move("FileToList", File2)
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(hint, 1028, 0, toolinfo#)
EndWhile
If start = 1
MessageBox(File2 + " loaded !", "Laden", 0)
EndIf
Else
MessageBox("Keine Entries present !", "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 + " laid out !", "Info", 0)
EndIf
EndIf
Else
MessageBox("Noch no File laid out !", "Fehler", 0)
EndIf
ENDPROC
Proc dialog1
Declare lever dlg, btn1, btn2, btn3, kgrid, edit1, edit2, edit3, edit4, edit5
Declare Long stop, pos, String row, 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(hint, ~TTM_UPDATETIPTEXT, 0, tool#)
ElseIf Clicked(btn2)
' entry delete
Long tool#, 0 = 40, 16, %HWnd, pos
SendMessage(hint, ~TTM_DELTOOL, 0, tool#)
DeleteString(kgrid, pos)
ElseIf Clicked(btn3)
ClearList 0
Move("HandleToList", kgrid)
ClearList grid
Move("ListToHandle", grid)
Save = 1
stop = 1
'MessageBox("Die names go first\nbeim renewed loading registered !", "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(hint, ~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
If yet someone ideas to improvement has, always since so.  |
| | | 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. | 01/06/19 ▲ |
| |
|
Zum QuelltextTopic-Options | 31.300 Views |
Themeninformationenthis Topic has 3 subscriber: |