Strict

'BlitzMax 1.28

'M.Rauch 07.12.2007

'+Kantenglättung

'Programm womit man sich Hintergrundbilder für einen dititalen Fotorahmen machen kann .

'Bei 640x480 und 80% JPEG passen so ca. 15000 Fotos auf einer 1 Gigabyte SD Karte :)

'Einfach EXE machen und die Bilder mit der Maus drauf ziehen und los lassen .
'Da wo die EXE ist wird ein Bild neues Bild erstellt . Bild größe siehe Funktion MainLoop

Global NeedX:Int
Global NeedY:Int

Local a$,b$
Local width:Int=640,height:Int=480,depth:Int=0,herz:Int=60,gl=0
Global Bild:String=""

'Programm Command Line width 1280 height 1024 gl 1
For a$=EachIn AppArgs
 If b$="width" Then
  width=Int(a$)
 ElseIf b$="height" Then
  height=Int(a$)
 ElseIf b$="depth" Then
  depth=Int(a$)
 ElseIf b$="herz" Then
  herz=Int(a$)
 ElseIf b$="gl" Then
  gl=True
 EndIf
 a$=Lower(a$)
 If Instr(a$,".jpg")=>1 Or Instr(a$,".bmp")=>1 Or Instr(a$,".gif")=>1 Or Instr(a$,".png")=>1 Then
  bild$=a$
 Else
  b$=a$
 EndIf
Next

If gl Then SetGraphicsDriver GLMax2DDriver() 

If GraphicsModeExists(width,height,depth,herz)=True Then
 Graphics width,height,depth,herz
Else
 Graphics 640,480
EndIf

Type TFarbe

 Field Alpha:Float
 Field Rot:Float
 Field Gruen:Float
 Field Blau:Float
 
 Function Create:TFarbe()
  Local F:TFarbe=New TFarbe
  Return F
 End Function

End Type

MainLoop()
End

Function MainLoop()

 Local UseX:Int
 Local UseY:Int

 '-----------------------------------
 SetColor 255,255,255

 Local pix:TPixmap
 Local img:TImage=LoadImage(Bild)
 If img Then
  pix=LockImage(img,0,True,True)
  ConvertPixmap pix,PF_RGB888

  NeedX=640 '<---
  NeedY=480 '<---

  If Float(NeedY)/Float(NeedX) <> Float(pix.height)/Float(pix.width) Then   
   pix=FitPixmap(pix,NeedX*2,NeedY*2,True) 'Tricky
   NeedX=pix.Width/2 'Böse :)
   NeedY=pix.Height/2
   UseX=pix.Width
   UseY=pix.Height
   '=1:1
  Else
   UseX=pix.Width
   UseY=pix.Height
  EndIf

  UnlockImage img
  Cls;DrawText "Wait ...",0,0;Flip 0
  Save bild,pix,0,0,UseX-1,UseY-1 '<- NeedX wird in der Funk. auch genutzt also 1:1
  Cls;DrawText "Ready",0,0;Flip 0
 Else
  If Len(Bild)=0 Then
   Notify "Bild bitte einfach auf die Exe fallen lassen ."
  Else
   Notify "Kann Bild '"+Bild+"' nicht laden !?"
  EndIf
 EndIf
 '-----------------------------------

End Function

Function Save(Name:String,pix:TPixmap,x1:Int,y1:Int,x2:Int,y2:Int)

 'x1,y1 Start
 'x2,y2 Ende

 Local NameNeu:String
 NameNeu="dg"+StripDir(StripExt(Lower(Name)))+".jpg"

 Local x:Int,y:Int
 Local xr:Float
 Local xrFloor:Float
 Local xrCeil:Float
 Local xrWeight:Float
 Local yr:Float
 Local yrFloor:Float
 Local yrCeil:Float
 Local yrWeight:Float

 Local Farbe00:TFarbe=TFarbe.Create()
 Local Farbe10:TFarbe=TFarbe.Create()
 Local Farbe01:TFarbe=TFarbe.Create()
 Local Farbe11:TFarbe=TFarbe.Create()

 Local FarbeOben:TFarbe=TFarbe.Create()
 Local FarbeUnten:TFarbe=TFarbe.Create()
 Local Farbe:TFarbe=TFarbe.Create()

 Local pixbg:TPixmap=CreatePixmap(needx,needy,PF_RGB888)
 Local c:Int

 For x=0 To needx-1
 xr=Intp(Float(x1),Float(x2),Float(x)/Float(needx-1))
 xrFloor = Floor(xr)
 xrCeil  = Ceil(xr)
 xrWeight= xrCeil - xr

  For y=0 To needy-1
   yr=Intp(Float(y1),Float(y2),Float(y)/Float(needy-1))
   yrFloor = Floor(yr)
   yrCeil  = Ceil(yr)
   yrWeight= yrCeil - yr

   LeseFarbe Farbe00 , pix , xrFloor, yrFloor
   LeseFarbe Farbe10 , pix , xrCeil , yrFloor
   LeseFarbe Farbe01 , pix , xrFloor, yrCeil
   LeseFarbe Farbe11 , pix , xrCeil , yrCeil

   InterPolFarbe FarbeOben  , Farbe00 , Farbe01 , xrWeight
   InterPolFarbe FarbeUnten , Farbe10 , Farbe11 , xrWeight
   InterPolFarbe Farbe , FarbeOben , FarbeUnten , yrWeight

   c=ARGB_Color(Farbe.Alpha,Farbe.Rot,Farbe.Gruen,Farbe.Blau)

   WritePixel pixbg,x,y,c
  Next
 Next

 SavePixmapJPeg pixbg,NameNeu,80

End Function

Function InterPolFarbe(FarbeInterPol:TFarbe,FarbeA:TFarbe,FarbeB:TFarbe,Wert:Float)

 'Wert von 0-1
 'wechselt nach Wert von Farbe A nach B

  FarbeInterPol.Alpha = FarbeA.Alpha * (1.0 - Wert) + FarbeB.Alpha * Wert

  FarbeInterPol.Rot   = FarbeA.Rot   * (1.0 - Wert) + FarbeB.Rot   * Wert
  FarbeInterPol.Gruen = FarbeA.Gruen * (1.0 - Wert) + FarbeB.Gruen * Wert
  FarbeInterPol.Blau  = FarbeA.Blau  * (1.0 - Wert) + FarbeB.Blau  * Wert

End Function

Function LeseFarbe(Farbe:TFarbe,pix:TPixmap,x:Int,y:Int)

 'Ließt einen Pixel aus und merkt sich die Farbwerte

 Limit x,0,PixmapWidth(pix)-1
 Limit y,0,PixmapHeight(pix)-1

 Local c:Int
 c=ReadPixel(pix,x,y)

 Farbe.Alpha=ARGB_Alpha(c)
 Farbe.Rot  =ARGB_Red(c)
 Farbe.Gruen=ARGB_Green(c)
 Farbe.Blau =ARGB_Blue(c)

End Function

Function Intp:Float(y1:Float,y2:Float,mu:Float)
 Return y1+(y2-y1)*mu
End Function

Function Limit(a:Int Var,x:Int ,y:Int )

 If a<x Then a=x
 If a>y Then a=y

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 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

'--------------------------------