'(BlitzMax 1.16) 'Perspektiven Korrektur zu Texture , (C) Markus Rauch 2006 'Der Quelltext ist frei , jedoch möchte ich nicht das daraus 'ein kommerzielles Produkt gemacht wird ! 'Also mit diesem Quelltext meine ich , was ihr mit den Texturen macht ist mir egal ;-) 'Foto(perspective correction) to Texture , (C) M.Rauch 2006 'the source is free but you are not permitted to make 'a commercially product from it ! 'but you can do anything with your own created textures ;-) 'History: ' 4.7.2005 adding Bezier Interpolation (Hardcore:) ' 8.7.2005 Adding Vector Functions ' 9.7.2005 faster and better GUI with direct Zone access '10.7.2005 little fix that read all pixel in bezier area :) '10.7.2005 Fit big Images (loaded Pixmap) to Screen with correct Ratio 'MR 10.07.2005 Strict Const dirsep:String="\" AppTitle="Foto (perspective correction) to Texture , M.Rauch 2006 , BlitzMax V1.16" Local a$,b$ Local width:Int=800,height:Int=600,depth:Int=0,herz:Int=72,gl=0 'Programm Command Line width 1280 height 1024 gl 1 For a$=EachIn AppArgs If b$="width" Then width=Int(a$) If b$="height" Then height=Int(a$) If b$="depth" Then depth=Int(a$) If b$="herz" Then herz=Int(a$) If b$="gl" Then gl=True b$=a$ Next If gl Then SetGraphicsDriver GLMax2DDriver() If GraphicsModeExists(width,height,depth,herz)=True Then Graphics width,height,depth,herz Else Graphics 640,480 EndIf 'Local mfont:TImageFont=LoadImageFont("TAHOMA.TTF",14) ':-( 'Local mfont:TImageFont=LoadImageFont("C:\WINDOWS\Fonts\TAHOMA.TTF",14) '!? 'SetImageFont mfont SetMaskColor(255,0,255) Global fy=16 '---------------------------------------------------------------------- 'Zones Type TZone Field Mode:Int 'Wo die Zone angezeigt werden soll , 0=immer anzeigen Field Caption$ Field img:TImage Field Visible:Int Field x1:Int 'Pos Field y1:Int Field w:Int 'Breite Field h:Int 'Höhe Field Tag:String Field TagFloat:Float 'Zum merken von Werten Field Checkbox:Int '0 1 Field Checked:Int '0 1 Field SliderX:Int '0 1 Field SliderXValue:Float Field SliderXMin:Float Field SliderXMax:Float Field SliderY:Int '0 1 Field SliderYValue:Float Field SliderYMin:Float Field SliderYMax:Float Field wi:Int 'Winkel für blinkende Farbe Function Create:TZone() Local I:TZone=New TZone Return I End Function End Type Global Zonen:TList=CreateList() Const cZoneModeAll:Int=0 Const cZoneModeNormal:Int=1 Const cZoneModeTextureSize:Int=2 Const cZoneModeSelectPoints:Int=3 Const cZoneModeSelectPointsBez:Int=4 Const cZoneModeBlend:Int=5 Global ZoneMode:Int=cZoneModeAll Global cZoneWeiter:TZone Global cZoneZurueck:TZone Global cZoneTextureSizeX:TZone Global cZoneTextureSizeY:TZone Global cZoneSelectScale1:TZone Global cZoneSelectScale2:TZone Global cZoneSelectScale3:TZone Global cZoneSelectScale4:TZone Global cZoneBlendX:TZone Global cZoneBlendY:TZone Global cZoneBlendRange1:TZone Global cZoneBlendRange2:TZone Global cZoneBlendRange3:TZone Global cZoneBlendRange4:TZone Global cZoneBlendRange5:TZone Global cZoneBlendRange6:TZone Global cZoneFlipX:TZone Global cZoneFlipY:TZone Global cZoneImageTurn:TZone Local ox,oy,oxx,oyy,osp,oxm,oym osp=4 oyy=32 ox=0 oy=0 oxx=32 'Incbin "Images\PfeilL.bmp" 'Incbin "Images\PfeilR.bmp" '--- All cZoneZurueck=ZoneNew(cZoneModeAll,"<<<","Incbin::Images\PfeilL.bmp",ox,oy,oxx,oyy) ox=ox+oxx+osp cZoneWeiter=ZoneNew(cZoneModeAll,">>>","Incbin::Images\PfeilR.bmp",ox,oy,oxx,oyy) ox=ox+oxx+osp oxm=ox '--- SelectPoints ox=oxm cZoneSelectScale1=ZoneNew(cZoneModeSelectPoints,"1x","",ox,oy,oxx,oyy) ox=ox+oxx+osp cZoneSelectScale2=ZoneNew(cZoneModeSelectPoints,"2x","",ox,oy,oxx,oyy) ox=ox+oxx+osp cZoneSelectScale3=ZoneNew(cZoneModeSelectPoints,"3x","",ox,oy,oxx,oyy) ox=ox+oxx+osp cZoneSelectScale4=ZoneNew(cZoneModeSelectPoints,"4x","",ox,oy,oxx,oyy) ox=ox+oxx+osp '--- TextureSize ox=oxm cZoneTextureSizeX=ZoneNew(cZoneModeTextureSize,"X","",ox,oy,oxx,oyy) ox=ox+oxx+osp cZoneTextureSizeY=ZoneNew(cZoneModeTextureSize,"Y","",ox,oy,oxx,oyy) ox=ox+oxx+osp '--- Blend ox=oxm cZoneBlendX=ZoneNew(cZoneModeBlend,"X","",ox,oy,oxx,oyy) ZoneAsCheckbox cZoneBlendX ox=ox+oxx+osp cZoneBlendY=ZoneNew(cZoneModeBlend,"Y","",ox,oy,oxx,oyy) ZoneAsCheckbox cZoneBlendY ox=ox+oxx+osp cZoneBlendRange1=ZoneNew(cZoneModeBlend,"R1","",ox,oy,oxx,oyy) ZoneAsCheckbox cZoneBlendRange1 ox=ox+oxx+osp cZoneBlendRange2=ZoneNew(cZoneModeBlend,"R2","",ox,oy,oxx,oyy) ZoneAsCheckbox cZoneBlendRange2,1 ox=ox+oxx+osp cZoneBlendRange3=ZoneNew(cZoneModeBlend,"R3","",ox,oy,oxx,oyy) ZoneAsCheckbox cZoneBlendRange3 ox=ox+oxx+osp cZoneBlendRange4=ZoneNew(cZoneModeBlend,"R4","",ox,oy,oxx,oyy) ZoneAsCheckbox cZoneBlendRange4 ox=ox+oxx+osp cZoneBlendRange5=ZoneNew(cZoneModeBlend,"R5","",ox,oy,oxx,oyy) ZoneAsCheckbox cZoneBlendRange5 ox=ox+oxx+osp cZoneBlendRange6=ZoneNew(cZoneModeBlend,"R6","",ox,oy,oxx,oyy) ZoneAsCheckbox cZoneBlendRange6 ox=ox+oxx+osp cZoneFlipX=ZoneNew(cZoneModeBlend,"-X","",ox,oy,oxx,oyy) ox=ox+oxx+osp cZoneFlipY=ZoneNew(cZoneModeBlend,"-Y","",ox,oy,oxx,oyy) ox=ox+oxx+osp cZoneImageTurn=ZoneNew(cZoneModeBlend,"Rot","",ox,oy,oxx,oyy) ox=ox+oxx+osp cZoneBlendRange1.TagFloat=0.01 cZoneBlendRange2.TagFloat=0.025 cZoneBlendRange3.TagFloat=0.05 cZoneBlendRange4.TagFloat=0.10 cZoneBlendRange5.TagFloat=0.25 cZoneBlendRange6.TagFloat=0.50 '---------------------------------------------------------------------- Type TV3D Field x:Float Field y:Float Field z:Float Function Create:TV3D() Local T:TV3D=New TV3D Return T End Function Method Set(x:Float,y:Float,z:Float=0) self.x=x self.y=y self.z=z End Method Method Clr() self.x=0 self.y=0 self.z=0 End Method End Type Global mx:Float[4,4] 'Matrix Global mx1:Float[4,4] 'Matrix1 Global mx2:Float[4,4] 'Matrix2 '---------------------------------------------------------------------- MainLoop EndGraphics() End '---------------------------------------------------------------------- Function MainLoop() '------------------------- '1.DateiDialog '2.Bild Laden '3.Bild Zeigen , mit der Maus 4 Punkte markieren und als Linien anzeigen mit Alpha '4.Texture Größe wählen '5.Bild umrechnen '6.Bild anzeigen als Tile '7.Bild anzeigen als Tile zum überblenden '8.Bild speichern '9.Bild nochmal zeigen '------------------------- Const mode_LoadImageDialog =1 Const mode_LoadImage =2 Const mode_SelectPoints =3 Const mode_SelectPointsBez =4 Const mode_TextureSize =5 Const mode_TransformImage =6 Const mode_ShowTiledImage =7 Const mode_ShowBlend =8 Const mode_SaveAsDialog =9 Const mode_ShowAfterSave =10 DebugLog "FUNC MainLoop" SetClsColor 0,0,0 SetBlend ALPHABLEND 'SetLineWidth 3 Local mode=mode_LoadImageDialog Local pix:TPixmap Local pix2:TImage Local pix3:TImage 'für Blend Local filename:String Local filenamesave:String Local p:TV3D=TV3D.Create() 'für Plot der Bezier Splines Local p1:TV3D=TV3D.Create() Local p2:TV3D=TV3D.Create() Local p3:TV3D=TV3D.Create() Local p4:TV3D=TV3D.Create() 'Zwichenpunkte für Bezier4 Local p1a:TV3D=TV3D.Create() Local p1b:TV3D=TV3D.Create() Local p2a:TV3D=TV3D.Create() Local p2b:TV3D=TV3D.Create() Local p3a:TV3D=TV3D.Create() Local p3b:TV3D=TV3D.Create() Local p4a:TV3D=TV3D.Create() Local p4b:TV3D=TV3D.Create() Local m:TV3D=TV3D.Create() 'Maus Local txx:Float=256 Local txy:Float=256 Local pointnr:Int=1 Local pointnrf:Int=0 Local pointnrb:Int=0 Local mu:Float=0 'für Bezier4 Splines Local mwheel:Int,md1:Int,mu1:Int,md2:Int,mu2:Int,md3:Int,mu3:Int 'Maus Abfrage Local ret:Int Local w:Double Local scale:Int=1 Local db:Int=0 Local BlendX:Int=0 Local BlendY:Int=0 Local BlendRange:Float=0 Local t1 'Timer für konstante Frame Rate Local Zone:TZone=Null ZoneMode=cZoneModeNormal While Not KeyHit(KEY_ESCAPE) SetViewport 0,0,GraphicsWidth(),GraphicsHeight() Cls t1=MilliSecs() '------------------------------------------------------------- Maus Abfrage ! m.Set MouseX(),MouseY() mwheel=MouseZ() 'Speed() mu1=0;If md1=1 Then md1=2 If MouseDown(1)=True And md1=0 Then md1=1;mu1=0 If MouseDown(1)=False And md1=2 And mu1=0 Then md1=0;mu1=1 mu2=0;If md2=1 Then md2=2 If MouseDown(2)=True And md2=0 Then md2=1;mu2=0 If MouseDown(2)=False And md2=2 And mu2=0 Then md2=0;mu2=1 mu3=0;If md3=1 Then md3=2 If MouseDown(3)=True And md3=0 Then md3=1;mu3=0 If MouseDown(3)=False And md3=2 And mu3=0 Then md3=0;mu3=1 '-------------- Zone=ZoneShow(m,md1,md2,md3) Select mode '-------------------------------------------------------------------------------- Case mode_LoadImageDialog ZoneMode=cZoneModeNormal DebugLog "Bild auswählen in "+AppDir filename=RequestFile("Please select a image","Image jpg,jpeg,pcx,tga,bmp,gif,png:jpg,jpeg,pcx,tga,bmp,gif,png;All Files *.*:*",False) ',AppDir+"\") scheiße If Len(filename)=0 Then If pix=Null Then DebugLog "Kein Bild ausgewählt , ENDE" End Else mode=mode_SelectPoints 'wieder zurück EndIf Else mode=mode_LoadImage EndIf FlushMouse FlushKeys scale=1 '-------------------------------------------------------------------------------- Case mode_LoadImage ZoneMode=cZoneModeNormal DebugLog "Bild laden" pix3=Null pix2=Null pix=Null pix=LoadPixmap(filename) ConvertPixmap pix,PF_RGB888 If scale>1 Then pix=ResizePixmap(pix,pix.width*scale,pix.height*scale) EndIf If pix.width>GraphicsWidth() Or pix.height>GraphicsHeight()-32 Then pix=FitPixmap(pix,GraphicsWidth(),GraphicsHeight()-32) EndIf pointnr=1 pointnrf=0 pointnrb=0 p1.Set 0,0 p2.Set pix.width-1,0 p3.Set pix.width-1,pix.height-1 p4.Set 0,pix.height-1 mode=mode_SelectPoints DebugLog "ab jetzt Punkte wählen" '-------------------------------------------------------------------------------- Case mode_SelectPoints ZoneMode=cZoneModeSelectPoints 'Bei DrawPixMap , eine Pixmap muß ins Fenster passen sonnst kommt ein Fehler !!! SetAlpha 1.0 SetColor 255,255,255 If pix.width/scale*20 Then Select pointnrf 'fein tuning Case 1 p1.x=p1.x-1 Case 2 p2.x=p2.x-1 Case 3 p3.x=p3.x-1 Case 4 p4.x=p4.x-1 End Select EndIf If KeyHit(KEY_RIGHT)>0 Then Select pointnrf 'fein tuning Case 1 p1.x=p1.x+1 Case 2 p2.x=p2.x+1 Case 3 p3.x=p3.x+1 Case 4 p4.x=p4.x+1 End Select EndIf If KeyHit(KEY_UP)>0 Then Select pointnrf 'fein tuning Case 1 p1.y=p1.y-1 Case 2 p2.y=p2.y-1 Case 3 p3.y=p3.y-1 Case 4 p4.y=p4.y-1 End Select EndIf If KeyHit(KEY_DOWN)>0 Then Select pointnrf 'fein tuning Case 1 p1.y=p1.y+1 Case 2 p2.y=p2.y+1 Case 3 p3.y=p3.y+1 Case 4 p4.y=p4.y+1 End Select EndIf '-------------- Limit Points ! Limit p1.x,0,pix.width-1 Limit p2.x,0,pix.width-1 Limit p3.x,0,pix.width-1 Limit p4.x,0,pix.width-1 Limit p1.y,0,pix.height-1 Limit p2.y,0,pix.height-1 Limit p3.y,0,pix.height-1 Limit p4.y,0,pix.height-1 '-------------- Berechne zwischen Punkte Zwischenpunkt p1a,p1b,p1,p2 Zwischenpunkt p2a,p2b,p2,p3 Zwischenpunkt p3a,p3b,p3,p4 Zwischenpunkt p4a,p4b,p4,p1 pointnrb=0 '-------------- SetOrigin 0,0 m.y=m.y+32 '-------------------------------------------------------------------------------- Case mode_SelectPointsBez ZoneMode=cZoneModeSelectPointsBez 'Bei DrawPixMap , eine Pixmap muß ins Fenster passen sonnst kommt ein Fehler !!! SetAlpha 1.0 SetColor 255,255,255 DrawText "Move Bezier Points",32*6+4*6+10,16-TextHeight("Move")/2 'SetViewport 0,32,GraphicsWidth(),GraphicsHeight()-32 SetOrigin 0,32 m.y=m.y-32 DrawPixmap pix,0,32 'Original Bild SetAlpha 0.5 db=0 For mu=0 To 1 Step 0.025 SetColor 255*db,255*db,255*db db=1-db Bezier4(p,p1,p1a,p1b,p2,mu) Circle p,2 Bezier4(p,p2,p2a,p2b,p3,mu) Circle p,2 Bezier4(p,p3,p3a,p3b,p4,mu) Circle p,2 Bezier4(p,p4,p4a,p4b,p1,mu) Circle p,2 Next If Zone=Null Then SetAlpha 1 'Zwischenpunkte If pointnrb=1 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p1a,3 If pointnrb=2 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p1b,3 If pointnrb=3 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p2a,3 If pointnrb=4 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p2b,3 If pointnrb=5 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p3a,3 If pointnrb=6 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p3b,3 If pointnrb=7 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p4a,3 If pointnrb=8 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p4b,3 'Normale Punkte If pointnrb=9 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p1,3 If pointnrb=10 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p2,3 If pointnrb=11 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p3,3 If pointnrb=12 Then SetColor 0,255,0 Else SetColor 255,0,0 CircleB p4,3 SetColor 255,255,0 Circle m,3 EndIf 'Zone If md2=1 Then 'Zurück mode=mode_SelectPoints EndIf 'Punkt auswählen If md1=1 And Zone=Null Then pointnrb=0 If VEntXY(m,p1a)<5 Then pointnrb=1 If VEntXY(m,p1b)<5 Then pointnrb=2 If VEntXY(m,p2a)<5 Then pointnrb=3 If VEntXY(m,p2b)<5 Then pointnrb=4 If VEntXY(m,p3a)<5 Then pointnrb=5 If VEntXY(m,p3b)<5 Then pointnrb=6 If VEntXY(m,p4a)<5 Then pointnrb=7 If VEntXY(m,p4b)<5 Then pointnrb=8 '.... If VEntXY(m,p1)<5 Then pointnrb=9 If VEntXY(m,p2)<5 Then pointnrb=10 If VEntXY(m,p3)<5 Then pointnrb=11 If VEntXY(m,p4)<5 Then pointnrb=12 EndIf 'bewegen mit gedrückter Maustaste If md1=2 And Zone=Null Then Select pointnrb Case 1 p1a.x=m.x p1a.y=m.y Case 2 p1b.x=m.x p1b.y=m.y Case 3 p2a.x=m.x p2a.y=m.y Case 4 p2b.x=m.x p2b.y=m.y Case 5 p3a.x=m.x p3a.y=m.y Case 6 p3b.x=m.x p3b.y=m.y Case 7 p4a.x=m.x p4a.y=m.y Case 8 p4b.x=m.x p4b.y=m.y Case 9 '. p1.x=m.x p1.y=m.y Case 10 '.. p2.x=m.x p2.y=m.y Case 11 '... p3.x=m.x p3.y=m.y Case 12 '.... p4.x=m.x p4.y=m.y End Select EndIf '-------------- SetOrigin 0,0 m.y=m.y+32 '-------------------------------------------------------------------------------- Case mode_TextureSize ZoneMode=cZoneModeTextureSize SetViewport 0,32,GraphicsWidth(),GraphicsHeight()-32 SetOrigin 0,32 If KeyHit(KEY_X)>0 Or (md1=1 And Zone=cZoneTextureSizeX) Then txx=txx*2 ; txx=txx Mod 4096;If txx=0 Or txx/2=GraphicsWidth() Then txx=8 If KeyHit(KEY_Y)>0 Or (md1=1 And Zone=cZoneTextureSizeY) Then txy=txy*2 ; txy=txy Mod 4096;If txy=0 Or txy/2=GraphicsHeight() Then txy=8 'ToDo ... mit Shift rückwärts ... XY If txx>GraphicsWidth() Then txx=GraphicsWidth() If txy>GraphicsHeight() Then txy=GraphicsHeight() SetAlpha 0.5 SetColor 200,255,200 DrawRect 0,0,txx,txy SetAlpha 1.0 SetColor 255,255,255 DrawText "Output Texture Size , Press X or Y Key",10,fy DrawText "X="+Int(txx)+" x Y="+Int(txy),10,fy*2 SetOrigin 0,0 '-------------------------------------------------------------------------------- Case mode_TransformImage ZoneMode=cZoneModeNormal DebugLog "umrechnen" pix2=TransformImage(pix,txx,txy,p1,p2,p3,p4,p1a,p1b,p2a,p2b,p3a,p3b,p4a,p4b) 'pix2=LoadImage("Images\Karo.bmp") 'Zum testen pix3=CopyImage(pix2) '--- Blenden wieder herstellen falls man mal zurück navigiert !!! BlendX=cZoneBlendX.Checked BlendY=cZoneBlendY.Checked BlendRange=0 If cZoneBlendRange1.Checked=1 Then BlendRange=cZoneBlendRange1.TagFloat If cZoneBlendRange2.Checked=1 Then BlendRange=cZoneBlendRange2.TagFloat If cZoneBlendRange3.Checked=1 Then BlendRange=cZoneBlendRange3.TagFloat If cZoneBlendRange4.Checked=1 Then BlendRange=cZoneBlendRange4.TagFloat If cZoneBlendRange5.Checked=1 Then BlendRange=cZoneBlendRange5.TagFloat If cZoneBlendRange6.Checked=1 Then BlendRange=cZoneBlendRange6.TagFloat pix3=BlendImage(BlendImage(pix2,BlendX,0,BlendRange),0,BlendY,BlendRange) '--- mode=mode_ShowTiledImage '-------------------------------------------------------------------------------- Case mode_ShowTiledImage ZoneMode=cZoneModeNormal SetAlpha 1.0 SetColor 255,255,255 DrawText "Ready",32*6+4*6+10,16-TextHeight("R")/2 SetViewport 0,32,GraphicsWidth(),GraphicsHeight()-32 SetOrigin 0,32 SetAlpha 1.0 SetColor 255,255,255 TileImage pix2,0,0 'Ergebnis SetOrigin 0,0 '-------------------------------------------------------------------------------- Case mode_ShowBlend ZoneMode=cZoneModeBlend SetAlpha 1.0 SetColor 255,255,255 DrawText "Blending",32*13+4*13+10,16-TextHeight("B")/2 SetViewport 0,32,GraphicsWidth(),GraphicsHeight()-32 SetOrigin 0,32 'XY übergänge berechnen (2 Pass sonnst überkreuzt sich das) If md1=1 And Zone=cZoneFlipX Then pix2=ImageFlipX(pix2) EndIf If md1=1 And Zone=cZoneFlipY Then pix2=ImageFlipY(pix2) EndIf If md1=1 And Zone=cZoneImageTurn Then pix2=ImageTurn90(pix2) EndIf If md1=1 Then If Zone=cZoneBlendRange1 Or Zone=cZoneBlendRange2 Or Zone=cZoneBlendRange3 Or Zone=cZoneBlendRange4 Or Zone=cZoneBlendRange5 Or Zone=cZoneBlendRange6 Then BlendX=cZoneBlendX.Checked BlendY=cZoneBlendY.Checked BlendRange=Zone.TagFloat If Zone<>cZoneBlendRange1 Then cZoneBlendRange1.Checked=0 If Zone<>cZoneBlendRange2 Then cZoneBlendRange2.Checked=0 If Zone<>cZoneBlendRange3 Then cZoneBlendRange3.Checked=0 If Zone<>cZoneBlendRange4 Then cZoneBlendRange4.Checked=0 If Zone<>cZoneBlendRange5 Then cZoneBlendRange5.Checked=0 If Zone<>cZoneBlendRange6 Then cZoneBlendRange6.Checked=0 pix3=BlendImage(BlendImage(pix2,BlendX,0,BlendRange),0,BlendY,BlendRange) EndIf If Zone=cZoneBlendX Or Zone=cZoneBlendY Or Zone=cZoneFlipX Or Zone=cZoneFlipY Or Zone=cZoneImageTurn Then BlendX=cZoneBlendX.Checked BlendY=cZoneBlendY.Checked BlendRange=0 If cZoneBlendRange1.Checked=1 Then BlendRange=cZoneBlendRange1.TagFloat If cZoneBlendRange2.Checked=1 Then BlendRange=cZoneBlendRange2.TagFloat If cZoneBlendRange3.Checked=1 Then BlendRange=cZoneBlendRange3.TagFloat If cZoneBlendRange4.Checked=1 Then BlendRange=cZoneBlendRange4.TagFloat If cZoneBlendRange5.Checked=1 Then BlendRange=cZoneBlendRange5.TagFloat If cZoneBlendRange6.Checked=1 Then BlendRange=cZoneBlendRange6.TagFloat pix3=BlendImage(BlendImage(pix2,BlendX,0,BlendRange),0,BlendY,BlendRange) EndIf EndIf 'click SetAlpha 1.0 SetColor 255,255,255 TileImage pix3,0,0 'Ergebnis SetOrigin 0,0 '-------------------------------------------------------------------------------- Case mode_SaveAsDialog ZoneMode=cZoneModeNormal DebugLog "Save As ..." filenamesave=RequestFile("Texture save as ...","Image png:png",True) If Len(filenamesave)=0 Then DebugLog "Kein Dateiname zum speichern ausgewählt" 'abbruch dann Bild wieder zeigen mode=mode_ShowBlend Else DebugLog "Bild speichern "+filenamesave Local map:TPixmap map=LockImage(pix3) ret=SavePixmapPNG(map,filenamesave) UnlockImage pix3 DebugLog ret mode=mode_ShowAfterSave EndIf 'FlushMouse FlushKeys '-------------------------------------------------------------------------------- Case mode_ShowAfterSave ZoneMode=cZoneModeNormal SetViewport 0,32,GraphicsWidth(),GraphicsHeight()-32 SetOrigin 0,32 SetAlpha 1.0 SetColor 255,255,255 TileImage pix3,0,0 'Ergebnis SetAlpha 0.5 SetColor 255,255,255 DrawText "Texture saved as",10,fy DrawText filenamesave,10,fy*2 SetOrigin 0,0 End Select 'Modus '-------------- SetViewport 0,0,GraphicsWidth(),GraphicsHeight() If KeyHit(KEY_SPACE) Or (md1=1 And Zone=cZoneWeiter) Then 'Weiter zum nächsten Schritt Select mode Case mode_SelectPoints ; mode=mode+1 Case mode_SelectPointsBez; mode=mode+1 Case mode_TextureSize ; mode=mode+1 Case mode_ShowTiledImage ; mode=mode+1 Case mode_ShowBlend ; mode=mode+1 Case mode_ShowAfterSave ; mode=mode_LoadImageDialog End Select EndIf '-------------- If KeyHit(KEY_BACKSPACE) Or (md1=1 And Zone=cZoneZurueck) Then 'Zurück zum letzten Schritt Select mode Case mode_SelectPoints ; mode=mode_LoadImageDialog 'Datei Dialog Case mode_SelectPointsBez; mode=mode_SelectPoints 'Punkte verschieben Case mode_TextureSize ; mode=mode_SelectPointsBez 'Bezier Punkte verschieben Case mode_ShowTiledImage ; mode=mode_TextureSize Case mode_ShowBlend ; mode=mode_ShowTiledImage Case mode_ShowAfterSave ; mode=mode_ShowBlend 'nochmal anzeigen End Select EndIf '-------------- Memory :) 'SetAlpha 1.0 'SetColor 255,255,255 'DrawText "MemAlloced="+MemAlloced(),GraphicsWidth()-200,16-TextHeight("Mem")/2 '-------------- w=w+0.5;If w>360 Then w=w-360 '-------------- 'FlushMem While Abs(t1-MilliSecs())<10 Wend Flip Wend End Function '---------------------------------------------------------------------- Function Intp:Float(y1:Float,y2:Float,mu:Float) Return y1+(y2-y1)*mu End Function '---------------------------------------------------------------------- Function Bezier4(p:TV3D Var,p1:TV3D,p2:TV3D,p3:TV3D,p4:TV3D,mu:Float) 'MR 01.07.2005 'Four control point Bezier interpolation 'mu ranges from 0 To 1, start To End of curve Local mum1:Float,mum13:Float,mu3:Float mum1 = 1.0 - mu mum13 = mum1 * mum1 * mum1 mu3 = mu * mu * mu p.x = mum13*p1.x + 3.0*mu*mum1*mum1*p2.x + 3.0*mu*mu*mum1*p3.x + mu3*p4.x p.y = mum13*p1.y + 3.0*mu*mum1*mum1*p2.y + 3.0*mu*mu*mum1*p3.y + mu3*p4.y p.z = mum13*p1.z + 3.0*mu*mum1*mum1*p2.z + 3.0*mu*mu*mum1*p3.z + mu3*p4.z End Function '---------------------------------------------------------------------- Function Circle(p:TV3D,r) DrawOval p.x-r,p.y-r,r*2,r*2 End Function Function CircleB(p:TV3D,r) Local red,green,blue GetColor red,green,blue SetColor 0,0,0 DrawOval p.x-r-2,p.y-r-2,r*2+4,r*2+4 SetColor red,green,blue DrawOval p.x-r,p.y-r,r*2,r*2 End Function '################################################################################################## Function TransformImage:TImage(pix:TPixmap,txx:Float,txy:Float,p1:TV3D,p2:TV3D,p3:TV3D,p4:TV3D,p1a:TV3D,p1b:TV3D,p2a:TV3D,p2b:TV3D,p3a:TV3D,p3b:TV3D,p4a:TV3D,p4b:TV3D) 'pix=original bild 'txx,txy Texture größe 'p1,p2,p3,p4 Punkte im Original Bild (ca. Trapez) 'p a&b sind die Hilfspunkte (Bezier Help Points) Local x:Float Local y:Float Local pix2:TImage Local map:TPixmap '------------------------- TEST !!! 'p1a.y=p1a.y-50 'oben 'p1b.y=p1b.y-50 'p3a.y=p3a.y+50 'unten 'p3b.y=p3b.y+50 'p4a.x=p4a.x-50 'links 'p4b.x=p4b.x-50 'p2a.x=p2a.x+50 'Rechts 'p2b.x=p2b.x+50 '------------------------- TEST 2 !!! 'Local h1:Float=VENT(p1,p2)/2.0 'Local h2:Float=VENT(p4,p3)/2.0 'p1a.x=p1.x 'p1b.x=p2.x 'p1a.z=h1 'Oben 'p1b.z=h1 'p2a.z=200 'Rechts 'p2b.z=200 'p3a.x=p3.x 'p3b.x=p4.x 'p3a.z=h2 'Unten 'p3b.z=h2 'p4a.z=200 'Links 'p4b.z=200 '------------------------- Local mu:Float=0,p:TV3D=TV3D.Create(),db:Int=0 'Für außen Curven 'Local AchseX:TV3D=TV3D.Create() 'AchseX.Set -1,0,0 'Local Normal:TV3D=TV3D.Create() 'Entfernung P1 - P2 'Entfernung P1 - P4 'Beide auf 1 'x*x + y*y + z*z = 1 'VNORMAL p1,p2,p3,Normal 'DebugLog "Normal von p1,p2,p3" 'DebugLog Normal.x 'DebugLog Normal.y 'DebugLog Normal.z 'Local Winkel:Float=-ATan2(p3.y-p1.y,p3.x-p1.x) 'DebugLog "Winkel "+Winkel 'MatrixCreateAxisRotate AchseX,Winkel 'VTrans Normal 'DebugLog "Normal Rotate" 'DebugLog Normal.x 'DebugLog Normal.y 'DebugLog Normal.z x=0 y=0 Local Oben:TV3D=TV3D.Create() Local Unten:TV3D=TV3D.Create() Local Links:TV3D=TV3D.Create() Local Rechts:TV3D=TV3D.Create() Local Mitte:TV3D=TV3D.Create() Bezier4 Mitte,p1,p1,p3,p3,0.5 Local xx:Float,yy:Float 'Pixel im Quellbild Local zz:Float 'höhe Local col:Int 'Farbe Local BlendX:Float Local BlendXInv:Float Local BlendY:Float Local BlendYInv:Float 'Local a:Float,b:Float,c:Float,d:Float '>>> DrawPixmap pix,0,0 '<<< pix2=CreateImage(txx,txy,PF_RGB888) map=LockImage(pix2) txx=txx-1 'weil ja von 0 an in die Texture geschrieben wird , z.B. 0 bis (256-1) txy=txy-1 For x=0 To txx For y=0 To txy BlendX=x/txx '0-1 BlendY=y/txy '0-1 BlendXInv=1.0-BlendX '1-0 BlendYInv=1.0-BlendY '1-0 Bezier4 Oben ,p1,p1a,p1b,p2,BlendX Bezier4 Unten,p4,p3b,p3a,p3,BlendX Bezier4 Links ,p1,p4b,p4a,p4,BlendY Bezier4 Rechts,p2,p2a,p2b,p3,BlendY 'zz=(Oben.z*BlendYInv + Unten.z*BlendY) + (Links.z*BlendXInv + Rechts.z*BlendX ) '??? xx=(Links.x*BlendXInv + Rechts.x*BlendX) yy=( Oben.y*BlendYInv + Unten.y *BlendY) 'zz=(Oben.z*BlendYInv + Unten.z*BlendY) '(Links.z*BlendXInv + Rechts.z*BlendX ) 'a=intp(p1.x,p2.x,0.5)*BlendYInv 'H Oben 'b=intp(p4.x,p3.x,0.5)*BlendY 'H Unten 'c=intp(p1.y,p4.y,0.5)*BlendXInv 'V Links 'd=intp(p2.y,p3.y,0.5)*BlendX 'V Recht '----------TEST 'xx=xx-Mitte.x '(a+b) 'yy=yy-Mitte.y '(c+d) 'xx=xx+Normal.x*zz 'yy=yy+Normal.y*zz 'xx=xx+Mitte.x '(a+b) 'yy=yy+Mitte.y '(c+d) '-------------- Limit xx,0,pix.width-1 Limit yy,0,pix.height-1 col=ReadPixel(pix,xx,yy) WritePixel map,x,y,col '>>> SetColor 255,255,0 VPlot Oben VPlot Unten VPlot Links VPlot Rechts If (x Mod 4)=0 Or (y Mod 4)=0 Then SetColor 255,zz,0 'welcher Bereich ausgelesen wird Plot xx,yy EndIf '<<< Next Next UnlockImage pix2 '------------------------ 'db=0 'For mu=0 To 1 Step 0.025 'SetColor 255*db,255*db,255*db 'db=1-db 'Bezier4(p,p1,p1a,p1b,p2,mu) 'Circle p,2 'Bezier4(p,p2,p2a,p2b,p3,mu) 'Circle p,2 'Bezier4(p,p3,p3a,p3b,p4,mu) 'Circle p,2 'Bezier4(p,p4,p4a,p4b,p1,mu) 'Circle p,2 'Next '------------------------ '>>> SetAlpha 1.0 SetColor 255,255,255 DrawText "Press any Key",5,GraphicsHeight()-TextHeight("P")-5 Flip WaitKey '<<< '------------------------- Oben=Null Unten=Null Links=Null Rechts=Null 'Normal=Null Mitte=Null 'AchseX=Null Return pix2 End Function '################################################################################################## Function ZoneShow:TZone(Maus:TV3D,md1,md2,md3) Local Hit=0 Local x1,y1,x2,y2 Local Zone:TZone Local ZoneClick:TZone=Null For Zone=EachIn Zonen If Zone.Mode=ZoneMode Or Zone.Mode=0 Then If Zone.Visible=1 Then x1=Zone.X1 y1=Zone.Y1 x2=x1+Zone.w-1 y2=y1+Zone.h-1 'Testen ob Maus drüber ist If ((Maus.x>=x1 And Maus.x<=x2) And (Maus.y>=y1 And Maus.y<=y2)) Then ZoneClick=Zone Hit=True Zone.wi=Zone.wi+1;If Zone.wi>180 Then Zone.wi=Zone.wi-180 Else Hit=False Zone.wi=0 EndIf 'Wenn Maus drüber dann Hintergrund füllen If Hit=True Then SetAlpha 0.5+Sin(Zone.wi)/2.0 SetColor 0,128,0;DrawRect Zone.x1,Zone.y1,Zone.w,Zone.h EndIf 'Wenn Checkbox und gesetzt dann markieren If Zone.Checkbox=1 Then If Hit=True And md1=1 Then Zone.Checked=1-Zone.Checked If Zone.Checked=1 Then SetAlpha 0.75 SetColor 128,128,255;DrawRect Zone.x1,Zone.y1,Zone.w,Zone.h EndIf EndIf 'Bild zeigen wenn da SetAlpha 1 SetColor 255,255,255 If Zone.img<>Null Then DrawImage Zone.img,Zone.X1,Zone.Y1 'Wenn Maus drüber dann Rand zeigen in grün SetAlpha 1 If Hit=True Then SetColor 0,255,0 Else SetColor 128,128,128 mRect x1,y1,x2,y2 'wenn kein Bild hat dann Text zeigen If Zone.img=Null Then SetColor 255,255,255 Local t$ t$=Zone.Caption$ DrawText t$,x1 + Zone.w/2-TextWidth(t$)/2,y1 + Zone.h/2-TextHeight(t$)/2 ',True,True,255,255,255 EndIf 'kein Bild dann Caption EndIf 'Visible EndIf 'in Mode Or For All Next Return ZoneClick End Function '################################################################################################## Function ZoneNew:TZone(Mode,c$,image$,x,y,w,h) Local Zone:TZone=TZone.Create() Zone.Mode=Mode Zone.Caption=c$ Zone.Visible=1 Zone.x1=x Zone.y1=y Zone.w=w Zone.h=h Zone.Checkbox=0 Zone.Checked=0 Zone.SliderX=0 Zone.SliderXMin=0 Zone.SliderXMax=0 Zone.SliderXValue=0 Zone.SliderY=0 Zone.SliderYMin=0 Zone.SliderYMax=0 Zone.SliderYValue=0 If Len(image$)>0 Then Zone.img=LoadImage(image$,MASKEDIMAGE) Zonen.addlast Zone Return Zone End Function '################################################################################################## Function ZoneCaption(Zone:TZone,c$) Zone.Caption=c$ End Function '################################################################################################## Function ZoneAsCheckbox(Zone:TZone,Value:Int=0) Zone.Checkbox=1 If value Then Zone.Checked=1 Else Zone.Checked=0 EndIf End Function '################################################################################################## Function ZoneAsSliderX(Zone:TZone,Value:Float,ValueMin:Float=0,ValueMax:Float=100) Zone.SliderX=1 Zone.SliderXValue=Value Zone.SliderXMin=ValueMin Zone.SliderXMax=ValueMax End Function '################################################################################################## '-------------------------------- Function mRect(x1,y1,x2,y2) DrawLine x1,y1,x2,y1 'oben DrawLine x2,y1,x2,y2 'rechts DrawLine x1,y2,x2,y2 'unten DrawLine x1,y1,x1,y2 'links End Function '-------------------------------- Function Limit(a:Float Var,x:Int ,y:Int ) If ay Then a=y End Function '-------------------------------- Function CopyImage2:TImage(img:TImage) Local imgnew:TImage=CreateImage(ImageWidth(img),ImageHeight(img)) Local x:Int,y:Int Local map:TPixmap Local mapnew:TPixmap map=LockImage(img) 'Read mapnew=LockImage(imgnew) 'Write For x=0 To PixmapWidth(map)-1 For y=0 To PixmapHeight(map)-1 WritePixel mapnew,x,y,ReadPixel(map,x,y) Next Next UnlockImage img UnlockImage imgnew Return imgnew End Function '-------------------------------- Function CopyImage:TImage(Image:TImage) Local TempPixmap:TPixmap, NewImage:TImage TempPixmap = LockImage(Image) NewImage = LoadImage(TempPixmap,DYNAMICIMAGE) UnlockImage(Image) Return NewImage End Function '-------------------------------- Function BlendImage:TImage(img:TImage,BlendX,BlendY,BlendRange:Double) Local imgnew:TImage=CreateImage(ImageWidth(img),ImageHeight(img)) Local x:Double,y:Double'Pixel Local x2:Double,y2:Double'Pixel auf anderer Seite (Mirror) Local map:TPixmap 'original Bild Local mapnew:TPixmap 'ausgabe Bild Local ARGB:Int '32 Bit Alpha und Farbe Local Alpha1:Int 'Original Farbe Local Red1:Double Local Green1:Double Local Blue1:Double Local Alpha2:Int 'Farbe auf anderer Seite Local Red2:Double Local Green2:Double Local Blue2:Double Local Alpha3:Int 'Farbe gemischt Local Red3:Double Local Green3:Double Local Blue3:Double Local Blend:Double Blend=2.0 map=LockImage(img) 'Read mapnew=LockImage(imgnew) 'Write 'PixmapFormat Local RangeX:Int=0 'Rand Bereich außen in Pixel Local RangeY:Int=0 Local RangeXBlend:Double=0 Local RangeYBlend:Double=0 Local RangeBlend:Double=0 Local RangeXBlendInv:Double=0 Local RangeYBlendInv:Double=0 Local RangeBlendInv:Double=0 If BlendX Then RangeX=PixmapWidth(map)*BlendRange 'Rand errechnen If BlendY Then RangeY=PixmapHeight(map)*BlendRange For x=0 To PixmapWidth(map)-1 For y=0 To PixmapHeight(map)-1 ARGB=ReadPixel(map,x,y) If (x(PixmapWidth(map)-1)-RangeX) Or (y(PixmapHeight(map)-1)-RangeY) Then RangeXBlend=1.0 If RangeX>0 Then If x(PixmapWidth(map)-1)-RangeX Then RangeXBlend=((PixmapWidth(map)-1)-X)/RangeX EndIf RangeYBlend=1.0 If RangeY>0 Then If y(PixmapHeight(map)-1)-RangeY Then RangeYBlend=((PixmapHeight(map)-1)-Y)/RangeY EndIf RangeBlend=(RangeXBlend+RangeYBlend)/2.0 RangeXBlendInv=1.0-RangeXBlend RangeYBlendInv=1.0-RangeYBlend RangeBlendInv=(RangeXBlendInv+RangeYBlendInv)/2.0 'andere Seite x2=x y2=y 'TEST If BlendX=1 Then x2=(PixmapWidth(map)-1)-x If BlendY=1 Then y2=(PixmapHeight(map)-1)-y';If BlendX=1 Then x2=y Alpha1=ARGB_Alpha(ARGB) Red1 =RangeBlend*Float(ARGB_Red(ARGB)) Green1=RangeBlend*Float(ARGB_Green(ARGB)) Blue1 =RangeBlend*Float(ARGB_Blue(ARGB)) ARGB=ReadPixel(map,x2,y2) Alpha2=ARGB_Alpha(ARGB) Red2 =RangeBlendInv*Float(ARGB_Red(ARGB)) Green2=RangeBlendInv*Float(ARGB_Green(ARGB)) Blue2 =RangeBlendInv*Float(ARGB_Blue(ARGB)) 'DebugStop Alpha3=Alpha1 Red3=(Red1+Red2) '/Blend Green3=(Green1+Green2) '/Blend Blue3=(Blue1+Blue2) '/Blend ARGB=ARGB_Color(Alpha3,Red3,Green3,Blue3) Else 'ARGB=0 'Test um den unberührten Bereich zu sehen EndIf WritePixel mapnew,x,y,ARGB Next Next UnlockImage img UnlockImage imgnew Return imgnew End Function '-------------------------------- Function ARGB_Alpha:Int(ARGB:Int) Return Int((ARGB & $FF000000:Int) / $1000000:Int) End Function Function ARGB_Red:Int(ARGB:Int) Return Int((ARGB & $00FF0000:Int) / $10000:Int) End Function Function ARGB_Green:Int(ARGB:Int) Return Int((ARGB & $0000FF00:Int) / $100:Int) End Function Function ARGB_Blue:Int(ARGB:Int) Return (ARGB & $000000FF:Int) End Function Function ARGB_Color:Int(Alpha:Int,Red:Int,Green:Int,Blue:Int) Return (Alpha*$1000000:Int+Red*$10000:Int+Green*$100:Int+Blue) End Function '-------------------------------- Function VNORMAL(p1:TV3D,p2:TV3D,p3:TV3D,n:TV3D Var) 'MR 09.07.2005 'Oberflächen Normale von einer Ebene mit 3 Punkten (Dreieck) Local a:TV3D=TV3D.Create() Local b:TV3D=TV3D.Create() VSUB p2,p1,a VSUB p3,p1,b VCROSS a,b,n a=Null b=Null VNORMALIZE n End Function '-------------------------------- Function VNORMALIZE(a:TV3D Var) 'MR 05.07.2005 'gibt Normvector zurück , aufpassen auf überlauf ! 'also gesamt Vector auf länge 1 bringen Local fa:Float fa = Sqr(VDOT(a, a)) If fa = 0 Then a.x = 0.0 a.y = 0.0 a.z = 0.0 Else fa = 1.0 / fa a.x = a.x * fa a.y = a.y * fa a.z = a.z * fa End If End Function '-------------------------------- Function VDOT:Float(a:TV3D, b:TV3D) 'MR 05.07.2005 'Dotprodukt - Skalarprodukt 'berechnet ein Skalarprodukt zweier Vectoren Return (a.x * b.x + a.y * b.y + a.z * b.z) End Function '-------------------------------- Function VCROSS(a:TV3D,b:TV3D,c:TV3D Var) 'MR 05.07.2005 'gibt Vectorprodukt zurück c.x = a.y * b.z - b.y * a.z c.y = a.z * b.x - b.z * a.x c.z = a.x * b.y - b.x * a.y End Function '-------------------------------- Function VADD(v1:TV3D, v2:TV3D,vout:TV3D Var) 'MR 05.07.2005 '+ vout.x = v1.x + v2.x vout.y = v1.y + v2.y vout.z = v1.z + v2.z End Function '-------------------------------- Function VSUB(v1:TV3D, v2:TV3D,vout:TV3D Var) 'MR 05.07.2005 '- vout.x = v1.x - v2.x vout.y = v1.y - v2.y vout.z = v1.z - v2.z End Function '-------------------------------- Function VMUL(v1:TV3D, v2:TV3D,vout:TV3D Var) 'MR 05.07.2005 '* vout.x = v1.x * v2.x vout.y = v1.y * v2.y vout.z = v1.z * v2.z End Function '-------------------------------- Function VDIR(a:TV3D, b:TV3D,vd:TV3D Var) 'MR 05.07.2005 Local hyp:Float VSUB b,a,vd hyp = Sqr(vd.x * vd.x + vd.y * vd.y + vd.z * vd.z) If hyp <> 0.0 Then vd.x = vd.x / hyp vd.y = vd.y / hyp vd.z = vd.z / hyp Else vd.x = 0.0 vd.y = 0.0 vd.z = 0.0 End If 'returns vector in vd End Function '-------------------------------- Function VENT:Float(a:TV3D, b:TV3D) 'MR 05.07.2005 'Entfernung Local ve:TV3D=TV3D.Create() Local e:Float VSUB b, a,ve e = Sqr(ve.x * ve.x + ve.y * ve.y + ve.z * ve.z) ve=Null Return e End Function '---------------------------------------------------------------------- Function VENTXY:Float(a:TV3D,b:TV3D) Local dx:Float,dy:Float dx=b.x-a.x dy=b.y-a.y Return Sqr(dx*dx + dy*dy) End Function '-------------------------------- Function VCOPY(v:TV3D, vout:TV3D Var) 'MR 05.07.2005 '= vout.x = v.x vout.y = v.y vout.z = v.z End Function '------------------------------------------------------------------------------------------------- Function VTRANS(a:TV3D Var) 'MR 09.07.2005 'überschribt den Vector ! AUFPASSEN ! Local b:TV3D=TV3D.Create() 'DebugLog "vorher A\xyz" 'DebugLog a.x 'DebugLog a.y 'DebugLog a.z b.x = a.x * mx[0, 0] + a.y * mx[1, 0] + a.z * mx[2, 0] b.y = a.x * mx[0, 1] + a.y * mx[1, 1] + a.z * mx[2, 1] b.z = a.x * mx[0, 2] + a.y * mx[1, 2] + a.z * mx[2, 2] 'ByRef a.x = b.x a.y = b.y a.z = b.z 'DebugLog "nacher A\xyz" 'DebugLog a.x 'DebugLog a.y 'DebugLog a.z 'DebugLog "Matrix" 'DebugLog mx[0,0] 'DebugLog mx[0,1] 'DebugLog mx[0,2] 'DebugLog mx[1,0] 'DebugLog mx[1,1] 'DebugLog mx[1,2] 'DebugLog mx[2,0] 'DebugLog mx[2,1] 'DebugLog mx[2,2] b=Null End Function '-------------------------------- Function VLine(p1:TV3D,p2:TV3D,draw_last_pixel=True) DrawLine p1.x,p1.y,p2.x,p2.y,draw_last_pixel End Function '-------------------------------- Function VPlot(p:TV3D) Plot p.x,p.y End Function '-------------------------------- Function Zwischenpunkt(pa:TV3D Var,pb:TV3D Var,p1:TV3D,p2:TV3D) '... 0.25 0.75 '... 0.33 0.67 pa.x=Intp(p1.x,p2.x,0.33) pa.y=Intp(p1.y,p2.y,0.33) pa.z=Intp(p1.z,p2.z,0.33) pb.x=Intp(p1.x,p2.x,0.67) pb.y=Intp(p1.y,p2.y,0.67) pb.z=Intp(p1.z,p2.z,0.67) End Function '------------------------------------------------------------------------------------------------- Function MatrixZero() 'MR 09.07.2005 Local i, j For i = 0 To 3 For j = 0 To 3 mx[i, j] = 0.0 Next Next End Function '------------------------------------------------------------------------------------------------- Function MatrixCreateIdentity() 'MR 09.07.2005 Local i For i = 0 To 3 mx[i, i] = 1.0 Next End Function '------------------------------------------------------------------------------------------------- Function MatrixCreateTranslate(a:TV3D) 'MR 09.07.2005 MatrixCreateIdentity() mx[3, 0] = a.x mx[3, 1] = a.y mx[3, 2] = a.z End Function '------------------------------------------------------------------------------------------------- Function MatrixCreateAxisRotate(axis:TV3D,Angle:Float) 'MR 09.07.2005 Local sqraxis:TV3D=TV3D.Create() sqraxis.x = sqare(axis.x) sqraxis.y = sqare(axis.y) sqraxis.z = sqare(axis.z) Local cosine:Float cosine = Cos(Angle) Local sine:Float sine = Sin(Angle) Local one_minus_cosine:Float one_minus_cosine = 1.0 - cosine MatrixZero() mx[0, 0] = sqraxis.x + (1.0 - sqraxis.x) * cosine mx[0, 1] = axis.x * axis.y * one_minus_cosine + axis.z * sine mx[0, 2] = axis.x * axis.z * one_minus_cosine - axis.y * sine mx[1, 0] = axis.x * axis.y * one_minus_cosine - axis.z * sine mx[1, 1] = sqraxis.y + (1.0 - sqraxis.y) * cosine mx[1, 2] = axis.y * axis.z * one_minus_cosine + axis.x * sine mx[2, 0] = axis.x * axis.z * one_minus_cosine + axis.y * sine mx[2, 1] = axis.y * axis.z * one_minus_cosine - axis.x * sine mx[2, 2] = sqraxis.z + (1.0 - sqraxis.z) * cosine mx[3, 3] = 1.0 sqraxis=Null End Function '------------------------------------------------------------------------------------------------- Function MatrixCreateScale(a:TV3D) 'MR 09.07.2005 MatrixZero mx[0, 0] = a.x mx[1, 1] = a.y mx[2, 2] = a.z End Function '------------------------------------------------------------------------------------------------- Function MatrixMultiply() 'MR 09.07.2005 'Multipliziert Matrix 1 & 2 Local i,j For i = 0 To 3 For j = 0 To 3 mx[i, j] = mx1[i, 0] * mx2[0, j] + mx1[i, 1] * mx2[1, j] + mx1[i, 2] * mx2[2, j] + mx1[i, 3] * mx2[3, j] Next Next End Function '------------------------------------------------------------------------------------------------- Function MatrixKamera(AchseX:TV3D,AchseY:TV3D,AchseZ:TV3D) 'MR 09.07.2005 Local o:TV3D=TV3D.Create() Local ax:TV3D=TV3D.Create() Local ay:TV3D=TV3D.Create() Local az:TV3D=TV3D.Create() VDIR AchseX, o,ax VDIR AchseY, o,ay VDIR AchseZ, o,az mx[0, 0] = ax.x mx[0, 1] = ay.x mx[0, 2] = az.x mx[0, 3] = 0 mx[1, 0] = ax.y mx[1, 1] = ay.y mx[1, 2] = az.y mx[1, 3] = 0 mx[2, 0] = ax.z mx[2, 1] = ay.z mx[2, 2] = az.z mx[2, 3] = 0 mx[3, 0] = 0 mx[3, 1] = 0 mx[3, 2] = 0 mx[3, 3] = 1 o=Null ax=Null ay=Null az=Null End Function '------------------------------------------------------------------------------------------------- Function Sqare:Float(x:Float) 'MR 09.07.2005 Return (x * x) End Function '------------------------------------------------------------------------------------------------- Function FitPixmap:TPixmap(pix:TPixmap,w:Float,h:Float,Zoom:Int=True) 'MR 10.07.2005 'Fit a Pixmap to width,height with correct ratio If pix=Null Then Return Null Local f1:Float,f2:Float Local pw:Float,ph:Float pw=pix.width ph=pix.height f1 = 1.0 f2 = 1.0 If Zoom Then If pw <> w Then 'with ZOOM <> f1 = w / pw End If If ph <> h Then f2 = h / ph End If Else If pw > w Then 'without ZOOM > f1 = w / pw End If If ph > h Then f2 = h / ph End If EndIf If f2 < f1 Then f1 = f2 pix=ResizePixmap(pix,f1*pw,f1*ph) Return pix End Function '------------------------------------------------------------------------------------------------- Function ImageFlipX:TImage(Image:TImage) Local TempPixmap:TPixmap, NewImage:TImage TempPixmap = LockImage(Image) TempPixmap=XFlipPixmap(TempPixmap) NewImage = LoadImage(TempPixmap,DYNAMICIMAGE) UnlockImage(Image) Return NewImage End Function '------------------------------------------------------------------------------------------------- Function ImageFlipY:TImage(Image:TImage) Local TempPixmap:TPixmap, NewImage:TImage TempPixmap = LockImage(Image) TempPixmap=YFlipPixmap(TempPixmap) NewImage = LoadImage(TempPixmap,DYNAMICIMAGE) UnlockImage(Image) Return NewImage End Function '------------------------------------------------------------------------------------------------- Function ImageTurn90:TImage(Image:TImage) Local TempPixmap:TPixmap Local NewPixmap:TPixmap, NewImage:TImage Local x:Int,y:Int TempPixmap = LockImage(Image,0,True,False) NewImage=CreateImage(TempPixmap.height,TempPixmap.width,1,DYNAMICIMAGE) NewPixmap= LockImage(NewImage,0,False,True) For x=0 To TempPixmap.width-1 For y=0 To TempPixmap.height-1 WritePixel NewPixmap,(TempPixmap.height-1)-y,x,ReadPixel(TempPixmap,x,y) Next Next UnlockImage(NewImage) UnlockImage(Image) Return NewImage End Function '------------------------------------------------------------------------------------------------- ' a=intp(x1,x2,x/txx)*((txy-y)/txy) ;H Oben ' b=intp(x4,x3,x/txx)*(( y)/txy) ;H Unten ' c=intp(y1,y4,y/txy)*((txx-x)/txx) ;V Links ' d=intp(y2,y3,y/txy)*(( x)/txx) ;V Recht