hedgewars/uLandGraphics.pas
changeset 5041 3dc6ad20cbfe
parent 4976 088d40d8aba2
child 5179 8d64dcb566ea
equal deleted inserted replaced
5040:c6cd873ac13a 5041:3dc6ad20cbfe
    47 // Factor ranges from 0 to 100% NewColor
    47 // Factor ranges from 0 to 100% NewColor
    48 var
    48 var
    49     oRed, oBlue, oGreen, oAlpha, nRed, nBlue, nGreen, nAlpha: Byte;
    49     oRed, oBlue, oGreen, oAlpha, nRed, nBlue, nGreen, nAlpha: Byte;
    50 begin
    50 begin
    51     // Get colors
    51     // Get colors
    52     oAlpha := (OldColor shr 24) and $FF;
    52     oAlpha := (OldColor shr AShift) and $FF;
    53     oRed   := (OldColor shr 16) and $FF;
    53     oRed   := (OldColor shr RShift) and $FF;
    54     oGreen := (OldColor shr 8) and $FF;
    54     oGreen := (OldColor shr GShift) and $FF;
    55     oBlue  := (OldColor) and $FF;
    55     oBlue  := (OldColor shr BShift) and $FF;
    56 
    56 
    57     nAlpha := (NewColor shr 24) and $FF;
    57     nAlpha := (NewColor shr AShift) and $FF;
    58     nRed   := (NewColor shr 16) and $FF;
    58     nRed   := (NewColor shr RShift) and $FF;
    59     nGreen := (NewColor shr 8) and $FF;
    59     nGreen := (NewColor shr GShift) and $FF;
    60     nBlue  := (NewColor) and $FF;
    60     nBlue  := (NewColor shr BShift) and $FF;
    61 
    61 
    62     // Mix colors
    62     // Mix colors
    63     nAlpha := min(255, oAlpha + nAlpha);
    63     nAlpha := min(255, oAlpha + nAlpha);
    64     nRed   := ((oRed * oAlpha) + (nRed * (255-oAlpha))) div 255;
    64     nRed   := ((oRed * oAlpha) + (nRed * (255-oAlpha))) div 255;
    65     nGreen := ((oGreen * oAlpha) + (nGreen * (255-oAlpha))) div 255;
    65     nGreen := ((oGreen * oAlpha) + (nGreen * (255-oAlpha))) div 255;
    66     nBlue  := ((oBlue * oAlpha) + (nBlue * (255-oAlpha))) div 255;
    66     nBlue  := ((oBlue * oAlpha) + (nBlue * (255-oAlpha))) div 255;
    67 
    67 
    68     addBgColor := (nAlpha shl 24) or (nRed shl 16) or (nGreen shl 8) or (nBlue);
    68     addBgColor := (nAlpha shl AShift) or (nRed shl RShift) or (nGreen shl GShift) or (nBlue shl BShift);
    69 end;
    69 end;
    70 
    70 
    71 procedure FillCircleLines(x, y, dx, dy: LongInt; Value: Longword);
    71 procedure FillCircleLines(x, y, dx, dy: LongInt; Value: Longword);
    72 var i: LongInt;
    72 var i: LongInt;
    73 begin
    73 begin