function GetBlendColor(BaseColor: TColor; BlendColor: TColor; AlphaVal: Byte): TColor;
type
TMyColor =
record
red: Byte;
green: Byte;
blue: Byte;
end;
var LF1, LF2: TMyColor;
begin
LF1.red := GetRValue(Basecolor);
LF1.green := GetGValue(Basecolor);
LF1.blue := GetBValue(Basecolor);
LF2.red := (LF1.red * (255-AlphaVal) + GetRValue(Blendcolor) * AlphaVal)
div 255;
LF2.green := (LF1.green * (255-AlphaVal) + GetGValue(Blendcolor) * AlphaVal)
div 255;
LF2.blue := (LF1.blue * (255-AlphaVal) + GetBValue(Blendcolor) * AlphaVal)
div 255;
result :=
rgb(LF2.red, LF2.green, LF2.blue);
end;
procedure DrawTexttoBitmap1(ADest: TBitmap; AText:
String; AFont: TFont; AlphaVal: Byte; APos: TPoint);
var LBmp1: TBitmap;
LBGColor, LColor1, LColor2: TColor;
LWdhX, LWdhY: Integer;
begin
if AText <> '
'
then
begin
LBmp1 := TBitmap.Create;
LBmp1.Canvas.Font.Assign(AFont);
LBmp1.Width := LBmp1.Canvas.TextWidth(AText);
LBmp1.Height := LBmp1.Canvas.TextHeight(AText);
if AFont.Color = clWhite
then
LBGColor := clBlack
else
LBGColor := clWhite;
LBmp1.Canvas.Brush.Color := LBGColor;
LBmp1.Canvas.FillRect(Rect(0, 0, LBmp1.Width, LBmp1.Height));
LBmp1.Canvas.TextOut(0,0, AText);
LWdhX := 0;
while (LWdhX < ADest.Width - APos.X)
and (LWdhX < LBmp1.Width)
do
begin
LWdhY := 0;
while (LWdhY < ADest.Height - APos.Y)
and (LWdhY < LBmp1.Height)
do
begin
LColor1 := LBmp1.Canvas.Pixels[LWdhX, LWdhY];
if LColor1 <> LBGColor
then
begin
LColor2 := ADest.Canvas.Pixels[LWdhX + APos.X, LWdhY + APos.Y];
ADest.Canvas.Pixels[LWdhX + APos.X, LWdhY + APos.Y] := GetBlendColor(LColor2, LColor1, AlphaVal);
end;
inc(LWdhY);
end;
inc(LWdhX);
end;
LBmp1.Free;
end;
end;