hedgewars/uLandGraphics.pas
changeset 4791 458d9854c679
parent 4700 e8fd20b2d66b
child 4886 e3e5362a308e
--- a/hedgewars/uLandGraphics.pas	Thu Dec 30 22:20:17 2010 +0100
+++ b/hedgewars/uLandGraphics.pas	Fri Dec 31 00:37:39 2010 +0100
@@ -27,6 +27,7 @@
                                    Left, Right: LongInt;
                                    end;
 
+function  addBgColor(OldColor, NewColor: LongWord): LongWord;
 function  SweepDirty: boolean;
 function  Despeckle(X, Y: LongInt): boolean;
 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
@@ -42,6 +43,31 @@
 implementation
 uses SDLh, uLandTexture, uVariables, uUtils, uDebug;
 
+function addBgColor(OldColor, NewColor: LongWord): LongWord;
+// Factor ranges from 0 to 100% NewColor
+var
+    oRed, oBlue, oGreen, oAlpha, nRed, nBlue, nGreen, nAlpha: Byte;
+begin
+    // Get colors
+    oAlpha := (OldColor shr 24) and $FF;
+    oRed   := (OldColor shr 16) and $FF;
+    oGreen := (OldColor shr 8) and $FF;
+    oBlue  := (OldColor) and $FF;
+
+    nAlpha := (NewColor shr 24) and $FF;
+    nRed   := (NewColor shr 16) and $FF;
+    nGreen := (NewColor shr 8) and $FF;
+    nBlue  := (NewColor) and $FF;
+
+    // Mix colors
+    nAlpha := min(255, oAlpha + nAlpha);
+    nRed   := ((oRed * oAlpha) + (nRed * (255-oAlpha))) div 255;
+    nGreen := ((oGreen * oAlpha) + (nGreen * (255-oAlpha))) div 255;
+    nBlue  := ((oBlue * oAlpha) + (nBlue * (255-oAlpha))) div 255;
+
+    addBgColor := (nAlpha shl 24) or (nRed shl 16) or (nGreen shl 8) or (nBlue);
+end;
+
 procedure FillCircleLines(x, y, dx, dy: LongInt; Value: Longword);
 var i: LongInt;
 begin