Fonte/ Codesnippets | | | | | | - Page 1 - |
|  | | | | | | | |
| | | | | | - Page 2 - |
| |  | | | | | | | |
| | |
KompilierenMarkierenSeparierenSource wurde am 21.08.2009 in die Babyklappe auf XProfan.Com abgelegt:
[QUOTE=p. specht;724806]Hier ein Beispiel, welches unfertige Zeug in dieser Rubrik landen sollte:
[CODE]
Es gibt ja Programme, wo Schaltflächen nicht rechtwinkelig sind,
sondern z.B. Polygone. Diese kann man stets in eine Menge Dreiecke
zerlegen, für die man dann recht einfach INNEN und AUSSEN ermitteln kann.
WindowTitle Maus im Dreieck?:cls
declare x!,y!,x1!,y1!,x2!,y2!,x3!,y3!
x1!=240:y1!=40: x2!=400:y2!=200: x3!=240:y3!=300
proc PTEST:parameters x!,y!:declare fab!,fca!,fbc!
fAB!=(y!-y1!)*(x2!-x1!)-(x!-x1!)*(y2!-y1!)
fCA!=(y!-y3!)*(x1!-x3!)-(x!-x3!)*(y1!-y3!)
fBC!=(y!-y2!)*(x3!-x2!)-(x!-x2!)*(y3!-y2!)
return ((fAB!*fBC!)>0) & ((fBC!*fCA!)>0)
endproc
proc TRIANG:parameters x1!,y1!,x2!,y2!,x3!,y3!
usepen 0,1,@rgb(255,0,0):line x1!,y1!-x2!,y2!
line x2!,y2!-x3!,y3!:line x3!,y3!-x1!,y1!
endproc
triang(x1!,y1!,x2!,y2!,x3!,y3!)Init
print:print ESC beendet.: Print : print Deine Maus ist jetzt...
WHILENOT %Key=27:settimer 100:WaitInput Main
x!=%MouseX:y!=%Mousey
IF PTest(x!,y!):Locate 10,10:Print Innen
ELSE:Locate 10,10:Print Aussen:ENDIF
ENDWHILE Exit
killtimer
End
Also per die Praxis unwichtiges, bereits gelöstes etc., wo´s per den
einen oder anderen noch interessant ist, wie es funktioniert.
Etwa wie ein Computer einen Kreis zeichnet, oder eine Linie.
Aber das ist dann eine weitere Geschichte.
Gruss[/QUOTE]
[/CODE] |
| | | | | | |
| | |
KompilierenMarkierenSeparierenSource wurde am 21.08.2009 in die Babyklappe auf XProfan.Com abgelegt:
[QUOTE=AHT;724944]Kleines Lernproggie, das [B][U]versucht[/U][/B] unter [B]Vista[/B] den eigenen IL zu setzen.
Habs mir mal geschrieben, um einen bestimmten Sachverhalt darzustellen:
[CODE]
###########################################################################################
######### Testquellcode zum Setzen des ILs des eigenen Prozesses von AHT #########
######### Für Windows Vista #########
###########################################################################################
DEF @SetTokenInformation(4) !advapi32,SetTokenInformation
DEF @OpenProcessToken(3) !advapi32,OpenProcessToken Öffnet Einstellprozess.
DEF @LookupAccountName(7) !advapi32,LookupAccountNameA
DEF @GetCurrentProcess(0) !kernel32,GetCurrentProcess Ermittel das Handle des aktiven Prozesses.
DEF @GetLastError(0) !kernel32,GetLastError
DEF @SetLastError(1) !kernel32,SetLastError
DEF @CopyMemory(3) !kernel32,RtlMoveMemory
Declare Fehler&, Token_Handle&,SID#,SIZE_DOMAIN&,SID_SIZE&,F_PROC_Domain#
Declare S_NAME_USE&,SIDA#, Combobox&, Choice$
Proc ChangeIL
Parameters IL$
CLS
Locate 7,0
Color 12,15
Print Versuche IL auf +IL$+ zu setzen...
Print
Color 0,15
SetLastError(0)
LET FEHLER& = @OpenProcessToken(GetCurrentProcess(),$2000000,@addr(Token_Handle&))
Print GetLastError nach OpenProcessToken: +Str$(GetLastError())
Print
Print Rückgabe von OpenProcessToken: +Str$(Fehler&)
Print
IF Fehler&<>0
DIM SID#,1
DIM F_PROC_Domain#,560
LET SID_SIZE&=1
LET SIZE_DOMAIN&=512
LET Fehler&=@LookupAccountName(0,@addr(IL$),SID#,@ADDR(SID_SIZE&),F_PROC_Domain#,@ADDR(SIZE_DOMAIN&),@ADDR(S_NAME_USE&))
Dispose SID#
DIM SID#,int(SID_SIZE&+1)
LET Fehler&=@LookupAccountName(0,@addr(IL$),SID#,@ADDR(SID_SIZE&),F_PROC_Domain#,@ADDR(SIZE_DOMAIN&),@ADDR(S_NAME_USE&))
Print GetLastError nach LookupAccountName: +Str$(GetLastError())
Print
Print Rückgabe von LookupAccountName: +Str$(Fehler&)
Print
IF Fehler&=1
DIM SIDA#,INT(SID_SIZE&+8)
Long SIDA#,0 = int(SIDA#+8)
LONG SIDA#,4 = $40 | $20
Copymemory(int(SIDA#+8),SID#,SID_SIZE&)
LET fehler&=@SetTokenInformation(Token_Handle&,25,SIDA#,SizeOf(SIDA#))
Print GetLastError nach SetTokenInformation: +Str$(GetLastError())
Print
Print Rückgabe von SetTokenInformation: +Str$(Fehler&)
Print
Dispose SIDA#
endif
Dispose F_PROC_Domain#
Dispose SID#
endif
endproc
WindowStyle 31
WindowTitle Eigenen IL einer Anwendung setzen
Window 0,0-640,440
Combobox&=@Create(ChoiceBox,%HWND,,20,20,300,300)
AddChoice(Combobox&,Niedrige Verbindlichkeitsstufe)
AddChoice(Combobox&,Hohe Verbindlichkeitsstufe)
AddChoice(Combobox&,Mittlere Verbindlichkeitsstufe)
AddChoice(Combobox&,Systemverbindlichkeitsstufe)
While 1
Waitinput
If GetText$(Combobox&)<>Choice$
Choice$=@GetText$(Combobox&)
ChangeIL Choice$
endif
wend
[/CODE] |
| | | | | | |
| | |
KompilierenMarkierenSeparierenSource wurde am 21.08.2009 in die Babyklappe auf XProfan.Com abgelegt:
[QUOTE=p. specht;724986]Solang der Müll nicht in Entwicklungsländern verklappt wird, bitteschön.
Leider käselt er furchtbar, wie auch das nachstehende Versatzteil:
[CODE]Windowstyle 31
Windowtitle Bresenham-Circles
Window %maxx*.81,%maxy*.81
Cls @Rgb(231,231,221)
Kreise in Abstand ab%
var r%= sqrt((@width(%hWnd)/2)^2 + (@height(%hWnd)/2)^2 )
var ab%=14
while r%>0
brCircle( @width(%hWnd)/2, @height(%hWnd)/2 , r% ,
@rgb(rnd(100)+155,rnd(155)+100,r% and 255) )
r% = r% - ab%
case %MousePressed : break
endwhile
WaitInput
End
proc brCircle
Bresenham-Algorithmus für einen (Achtel-)Kreis
parameters xmittel%,ymittel%,r%,c%
var x% = r%
var y% = 0
var fehler% = r%
declare dy%,dx%
Gosub DrawPixels JAWOLL, EIN GOSUB! DA STAUNSTE, WAS?
WHILE y% < x%
dy% = y%*2+1 : REM bei Assembler-Implementierung *2 per Shift
inc y%
fehler% = fehler% - dy%
IF fehler%<0
dx% = 1 - x%*2
x% = x% - 1
fehler% = fehler% - dx%
ENDIF
Da es um den Bildschirm und nicht ums Plotten geht,
kann man die anderen Oktanten hier mit abdecken:
Gosub DrawPixels
ENDWHILE
RETURN
DrawPixels:
SETPIXEL xmittel%+x%, ymittel%+y%,c%
SETPIXEL xmittel%-x%, ymittel%+y%,c%
SETPIXEL xmittel%-x%, ymittel%-y%,c%
SETPIXEL xmittel%+x%, ymittel%-y%,c%
SETPIXEL xmittel%+y%, ymittel%+x%,c%
SETPIXEL xmittel%-y%, ymittel%+x%,c%
SETPIXEL xmittel%-y%, ymittel%-x%,c%
SETPIXEL xmittel%+y%, ymittel%-x%,c%
Return
='./../../funcion-referencias/xprofan/endproc/'>EndProc
Wird auch keinen Preis mehr gewinnen.[/QUOTE]
[/CODE] |
| | | | | | |
| | |
KompilierenMarkierenSeparierenSource wurde am 21.08.2009 in die Babyklappe auf XProfan.Com abgelegt:
[QUOTE=p. specht;724945]Jawohl, auch schlecht genug für hier. Danke!
Und weil ichs weiter oben schon angedroht hatte:
[CODE]Windowtitle BRESENHAM-Algorithmus
Windowstyle 31
Window %maxx*.81,%maxy*.81
Cls @Rgb(221,221,221)
var w%=@width(%hWnd)/2
var h%=@height(%hWnd)/2
brline(0,0, 2*w%,2*h%, @rgb(255,0,0))
brline(0,1, w%-1,2*h%, @rgb(0,255,0))
brline(3,0, 2*w%,h%-3, @rgb(0,0,255))
var i%=0
var j!=0
while i%<360
j!=i%*@pi()/180
brline(w%,h%,w%+240*cos(j!),h%+240*sin(j!),46603*i%)
inc i%,1
endwhile
Print OK, mit LINE statt Einzelpixel setzen wär´s schneller gegangen...
WaitInput
End
proc brline
Bresenham-Algorithmus für Linie in beliebigem Oktanten
parameters xstart%,ystart%,xend%,yend%,c%
declare i%,el%,pdx%,pdy%,ddx%,ddy%,es%,fehler%
var x% = xstart%
var y% = ystart%
var dx% = xend%-xstart%
var dy% = yend%-ystart%
var adx% = ABS(dx%)
var ady% = ABS(dy%) Absolutbetraege
var sdx% = int((dx%>0)-(dx%<0)) Signum-Funktion
var sdy% = int((dy%>0)-(dy%<0))
IF adx% > ady%
pdx% = sdx%
pdy% = 0
ddx% = sdx%
ddy% = sdy%
es% = ady%
el% = adx%
ELSE
pdx% = 0
pdy% = sdy%
ddx% = sdx%
ddy% = sdy%
es% = adx%
el% = ady%
ENDIF
fehler% = el%/2 el% gibt auch Anzahl der zu zeichnenden Pixel an
i%=1
while i% <= el%
fehler% = fehler% - es%
IF fehler% < 0
fehler% = fehler% + el%
x% = x% + ddx%
y% = y% + ddy%
ELSE
x% = x% + pdx%
y% = y% + pdy%
ENDIF
SETPIXEL x%,y%, x%*y%*3 oder c%, wäre Punktfarbe
inc i%
end/a>
endproc
Selbst wenn man´s compiliert: Bildschirmschoner wird das keiner mehr...
Aber wie ein Compi Linien zeichnet, zeigt es wenigstens.[/QUOTE]
[/CODE] |
| | | | | | |
| | | | | | | | | |
| | |
KompilierenMarkierenSeparierenSource 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
|
| | | | | | |
| | |
KompilierenMarkierenSeparierenSource 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
}
|
| | | | | | |
| | | | | | | | | |
| | | | | | | | | |
| | | | | | | | | |
| | | | | | | | | |
|
Zum QuelltextTopic-Options | 30.558 Views |
ThemeninformationenDieses Thema hat 3 subscriber: |
|
(774)
Deutsch
English
Français
Español
Italia