函数

407107 2003-12-26 12:01:29
Function Min(V1,V2:Integer):Integer;
begin
if V1>V2 then Result:=V2 else Result:=V1;
end;
procedure AlphaBlendAreaWithBmp(DBmp, SBmp: TBitmap;L,T:Integer;AValue: Byte);
var S,D:^Cardinal;
RB,G:Cardinal;
I,J,H,W:Integer;
Id:Byte;
begin
DBmp.PixelFormat:=pf32bit;
SBmp.PixelFormat:=pf32bit;
if T<0 then H:=Min(DBmp.Height,SBmp.Height+T) else H:=Min(DBmp.Height-T,SBmp.Height);
if L<0 then W:=Min(DBmp.Width,SBmp.Width+L) else W:=Min(DBmp.Width-L,SBmp.Width);
For I:=0 to H-1 do
begin
if T<0 then
begin
D:=DBmp.ScanLine[I];
S:=SBmp.ScanLine[I-T];
end
else
begin
D:=DBmp.ScanLine[I+T];
S:=SBmp.ScanLine[I];
end;
if L<0 then Inc(S,-L) else Inc(D,L);
For J:=0 to W-1 do
begin
RB:=D^ and $FF00FF * (255-AValue) and $FF00FF00 + S^ and $FF00FF * AValue and $FF00FF00;
G:=D^ and $00FF00 * (255-AValue) and $00FF0000 + S^ and $00FF00 * AValue and $00FF0000;
D^:=(RB+G) Shr 8;
Inc(D);
Inc(S);
end;
end;
end;

procedure AlphaBlendAreaWithColor(DBmp: TBitmap; AColor: TColor;ARect: TRect; AValue: Byte);
var B:TBitmap;
R:TRect;
begin
B:=TBitmap.Create;
B.Width:=Abs(ARect.Right-ARect.Left);
B.Height:=Abs(ARect.Bottom-ARect.Top);
B.Canvas.Brush.Color:=AColor;
R:=Rect(0,0,b.Width,b.Height);
B.Canvas.FillRect(R);
AlphaBlendAreaWithBmp(DBmp,B,Min(ARect.Left,ARect.Right),Min(ARect.Top,ARect.Bottom),AValue);
B.Free;
end;
...全文
63 回复 打赏 收藏 转发到动态 举报
写回复
用AI写文章
回复
切换为时间正序
请发表友善的回复…
发表回复

5,392

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧