sxbitmap32utils.pas

skin components for design of your applicastions

begin
 SetLength(Colors,Bitmap.Width);
 for X:=0 to Bitmap.Width-1 do
  begin
   CLA:=255*(X+1) div Bitmap.Width;
   Colors[X]:=CombineReg(Color2,Color1,CLA);
  end;
 D:=@Bitmap.Bits[0];
 for Y:=0 to Bitmap.Height-1 do
  for X:=0 to Bitmap.Width-1 do
   begin
    D^:=ColorAdd(D^,Colors[X]);
    Inc(D);
   end;
 EMMS;
end;

procedure LightenVertG(Bitmap:TBitmap32;Color1,Color2:TColor32);
var X,Y:Integer;
      D:PColor32;
  Color:TColor32;
    CLA:Integer;
begin
 D:=@Bitmap.Bits[0];
 for Y:=0 to Bitmap.Height-1 do
  begin
   CLA:=255*(Y+1) div Bitmap.Height;
   Color:=CombineReg(Color2,Color1,CLA);
   for X:=0 to Bitmap.Width-1 do
    begin
     D^:=ColorAdd(D^,Color);
     Inc(D);
    end;
  end;
 EMMS;
end;

procedure Darken(Bitmap:TBitmap32;Color:TColor32);
 var I:Integer;
     D:PColor32;
begin
 D:=@Bitmap.Bits[0];
 for I:=0 to Bitmap.Width*Bitmap.Height-1 do
  begin
   D^:=ColorSub(D^,Color);
   Inc(D);
  end;
 EMMS;
end;

procedure DarkenHorizG(Bitmap:TBitmap32;Color1,Color2:TColor32);
var X,Y:Integer;
      D:PColor32;
 Colors:array of TColor32;
    CLA:Integer;
begin
 SetLength(Colors,Bitmap.Width);
 for X:=0 to Bitmap.Width-1 do
  begin
   CLA:=255*(X+1) div Bitmap.Width;
   Colors[X]:=CombineReg(Color2,Color1,CLA);
  end;
 D:=@Bitmap.Bits[0];
 for Y:=0 to Bitmap.Height-1 do
  for X:=0 to Bitmap.Width-1 do
   begin
    D^:=ColorSub(D^,Colors[X]);
    Inc(D);
   end;
 EMMS;
end;

procedure DarkenVertG(Bitmap:TBitmap32;Color1,Color2:TColor32);
var X,Y:Integer;
      D:PColor32;
  Color:TColor32;
    CLA:Integer;
begin
 D:=@Bitmap.Bits[0];
 for Y:=0 to Bitmap.Height-1 do
  begin
   CLA:=255*(Y+1) div Bitmap.Height;
   Color:=CombineReg(Color2,Color1,CLA);
   for X:=0 to Bitmap.Width-1 do
    begin
     D^:=ColorSub(D^,Color);
     Inc(D);
    end;
  end;
 EMMS;
end;

procedure AdvDrawToAsAlpha(Bitmap:TBitmap32;Dst:TBitmap32;DstX,DstY:Integer;
           MAlpha:Integer=255);
var A:Cardinal;
begin
 A:=Bitmap.MasterAlpha;
 Bitmap.MasterAlpha:=MAlpha;
 AdvDrawTo(Bitmap,Dst,DstX,DstY);
 Bitmap.MasterAlpha:=A;
end;

procedure DrawToAsAlpha(Bitmap:TBitmap32;Dst:TBitmap32;DstX,DstY:Integer;
           MAlpha:Integer=255);
var A:Cardinal;
begin
 A:=Bitmap.MasterAlpha;
 Bitmap.MasterAlpha:=MAlpha;
 Bitmap.DrawTo(Dst,DstX,DstY);
 Bitmap.MasterAlpha:=A;
end;

procedure DrawToAsAlpha(Bitmap:TBitmap32;Dst:TBitmap32;DstRect:TRect;
           MAlpha:Integer=255);
var A:Cardinal;
begin
 A:=Bitmap.MasterAlpha;
 Bitmap.MasterAlpha:=MAlpha;
 Bitmap.DrawTo(Dst,DstRect);
 Bitmap.MasterAlpha:=A;
end;

procedure DrawMixedBitmap(Bitmap:TBitmap32;B1,B2:TBitmap32;Step:Byte);
var A:Integer;
  D,D1,D2:PColor32;
begin
 if (B1.Width<>B2.Width) or (B1.Height<>B2.Height) or (Bitmap.Width<>B1.Width) or
    (Bitmap.Height<>B1.Height) then exit;
 D:=@Bitmap.Bits[0];
 D1:=@B1.Bits[0];
 D2:=@B2.Bits[0];
 for A:=0 to B1.Width*B1.Height-1 do
  begin
   if D2^ shr 24=0 then
    begin
     D^:=SetAlpha(D1^,DivTable[D1^ shr 24,255-Step]);
    end else
   if D1^ shr 24=0 then
    begin
     D^:=SetAlpha(D2^,((D2^ shr 24)*Step) div 255);
    end else
     begin
      D^:=MergeRegEx(D2^,SetAlpha(D1^,DivTable[D1^ shr 24,255-Step]),Step);
      D^:=SetAlpha(D^,Integer(D1^ shr 24)+((Integer(D2^ shr 24)-Integer(D1^ shr 24))*Step) div 255);
     end;
   Inc(D); Inc(D1); Inc(D2);
  end;
 EMMS;
end;

procedure DrawHColorFade(Bitmap:TBitmap32;StartColor,StopColor:TColor;
           iLeft,iTop,iRight,iBottom:Integer);
var iCounter:Integer;
   aStepsNum:Integer;
  CL,CL1,CL2:TColor32;
         CLA:Integer;
begin
 if iBottom>Bitmap.Height then iBottom:=Bitmap.Height;
 if iTop<0 then iTop:=0;
 if iRight>Bitmap.Width then iRight:=Bitmap.Width;
 if iLeft<0 then iLeft:=0;
 Dec(iRight);
 CL1:=Color32(StartColor);
 CL2:=Color32(StopColor);
 aStepsNum:=iRight-iLeft+1;
 for iCounter:=iRight downto iLeft do
  begin
   CLA:=Trunc(255/aStepsNum*(iCounter-iLeft));
   CL:=CL1;
   BlendMem(SetAlpha(CL2,CLA),CL);
   EMMS;
   Bitmap.VertLineS(iCounter,iTop,iBottom,CL);
  end;
end;

procedure DrawVColorFade(Bitmap:TBitmap32;StartColor,StopColor:TColor;
           iLeft,iTop,iRight,iBottom:Integer);
var iCounter:Integer;
   aStepsNum:Integer;
  CL,CL1,CL2:TColor32;
         CLA:Integer;
begin
 if iBottom>Bitmap.Height then iBottom:=Bitmap.Height;
 if iTop<0 then iTop:=0;
 if iRight>Bitmap.Width then iRight:=Bitmap.Width;
 if iLeft<0 then iLeft:=0;
 Dec(iBottom);
 CL1:=Color32(StartColor);
 CL2:=Color32(StopColor);
 aStepsNum:=iBottom-iTop+1;
 for iCounter:=iBottom downto iTop do
  begin
   CLA:=Trunc(255/aStepsNum*(iCounter-iTop));
   CL:=CL1;
   BlendMem(SetAlpha(CL2,CLA),CL);
   EMMS;
   Bitmap.HorzLineS(iLeft,iCounter,iRight,CL);
  end;
end;

procedure TopRoundRectVFade(Bitmap:TBitmap32;StartColor,StopColor:TColor;
           X,Y,W,H,R:Integer;TotalHeight:Integer=0);
var     A,B:Integer;
 CL,CL1,CL2:TColor32;
        CLA:Integer;
         L:Integer;
begin
 B:=H;
 CL1:=Color32(StartColor);
 CL2:=Color32(StopColor);
 for A:=0 to B-1 do
  begin
   CLA:=255*(A+1) div B;
   CL:=CL1;
   BlendMem(SetAlpha(CL2,CLA),CL);
   EMMS;
   if A<R then L:=Ceil(R-Sqrt(2*R*A-Sqr(A))) else L:=0;
   Bitmap.HorzLineS(L+X,Y+A,L+X+W-2*L,CL);
  end;
end;

procedure BottomRoundRectVFade(Bitmap:TBitmap32;StartColor,StopColor:TColor;
           X,Y,W,H,R:Integer;TotalHeight:Integer=0);
var     A,B:Integer;
 CL,CL1,CL2:TColor32;
        CLA:Integer;
          L:Integer;
begin
 B:=Trunc(H);
 CL1:=Color32(StartColor);
 CL2:=Color32(StopColor);
 for A:=0 to B-1 do
  begin
   CLA:=255*(A+1) div B;
   CL:=CL1;
   BlendMem(SetAlpha(CL2,CLA),CL);
   EMMS;
   if A>H-R then L:=Ceil(R-Sqrt(2*R*(H-A-1)-Sqr(H-A-1))) else L:=0;
   if (L=0) and (TotalHeight<>0) then
    begin
     if (TotalHeight-H<R) and (A<R-TotalHeight+H) then
      L:=Ceil(R-Sqrt(2*R*(TotalHeight-H+A)-Sqr(TotalHeight-H+A)));
    end;
   Bitmap.HorzLineS(L+X,Y+A,L+X+W-2*L,CL);
  end;
end;

procedure RoundRectFill(Bitmap:TBitmap32;Color:TColor;X,Y,W,H,R:Integer);
var A,B,D:Integer;
        L:Integer;
        C:TColor32;
begin
 C:=Color32(Color);
 B:=H;
 for A:=0 to B-1 do
  begin
   if A<R then L:=Ceil(R-Sqrt(A*(2*R-A))) else
    if A>H-R then
     begin
      D:=H-A-1;
      L:=Ceil(R-Sqrt(D*(2*R-D)));
     end else L:=0;
   Bitmap.HorzLineS(L+X,Y+A,X+W-L,C);
  end;
end;

procedure RoundRectFill(Bitmap:TBitmap32;Color:TColor32;X,Y,W,H,R:Integer;
           Corners:TSXCorners=[crLeftTop,crRightTop,crRightBottom,crLeftBottom]);
var         A:Integer;
         SA,D:Single;
      L,LL,RR:Integer;
        SH,FH:Integer;
 HorzLineFunc:procedure(X1,Y,X2:Integer;Value:TColor32)of object;
begin
 if (X>=Bitmap.ClipRect.Right) or (Y>=Bitmap.ClipRect.Bottom) or
    (X+W<=Bitmap.ClipRect.Left) or (Y+H<=Bitmap.ClipRect.Top) then exit;
 if Color and $FF000000=$FF000000 then
  HorzLineFunc:=Bitmap.HorzLine else
   HorzLineFunc:=Bitmap.HorzLineT;
 SH:=0;
 if Bitmap.ClipRect.Top>Y then
  SH:=Bitmap.ClipRect.Top-Y;
 FH:=H-1;
 if Bitmap.ClipRect.Bottom<Y+H then
  FH:=Bitmap.ClipRect.Bottom-Y-1;
 for A:=SH to FH do
  begin
   SA:=A+0.5;
   if SA<R then
    begin
     L:=Ceil(R-Sqrt(SA*(2*R-SA)));
     if crLeftTop in Corners then
      LL:=L+X else LL:=X;
     if crRightTop in Corners then
      RR:=X+W-L else RR:=X+W;
    end else
   if SA>H-R then
    begin
     D:=H-SA;
     L:=Ceil(R-Sqrt(D*(2*R-D)));
     if crLeftBottom in Corners then
      LL:=L+X else LL:=X;
     if crRightBottom in Corners then
      RR:=X+W-L else RR:=X+W;
    end else
     begin
      LL:=X;
      RR:=X+W;
     end;
   if (LL<Bitmap.ClipRect.Right) and (RR>Bitmap.ClipRect.Left) and (LL<RR) then
    begin
     if LL<Bitmap.ClipRect.Left then
      LL:=Bitmap.ClipRect.Left;
     if RR>Bitmap.ClipRect.Right then
      RR:=Bitmap.ClipRect.Right;
     HorzLineFunc(LL,Y+A,RR-1,Color);
    end;
  end;
end;

procedure EllipseFill(Bitmap:TBitmap32;Color:TColor32;X,Y,W,H:Integer);
var   A,LL,RR:Integer;
      L,SH,FH:Integer;
   R1,R2,SA,D:Double;
 HorzLineFunc:procedure(X1,Y,X2:Integer;Value:TColor32)of object;
begin
 if (X>=Bitmap.ClipRect.Right) or (Y>=Bitmap.ClipRect.Bottom) or
    (X+W<=Bitmap.ClipRect.Left) or (Y+H<=Bitmap.ClipRect.Top) then exit;
 if Color and $FF000000=$FF000000 then
  HorzLineFunc:=Bitmap.HorzLine else
   HorzLineFunc:=Bitmap.HorzLineT;
 SH:=0;
 if Bitmap.ClipRect.Top>Y then
  SH:=Bitmap.ClipRect.Top-Y;
 FH:=H-1;
 if Bitmap.ClipRect.Bottom<Y+H then
  FH:=Bitmap.ClipRect.Bottom-Y-1;
 R1:=W/2; R2:=H/2;
 for A:=SH to FH do
  begin
   SA:=A+0.5;
   if SA<R2 then L:=round((R2-Sqrt(SA*(2*R2-SA)))*R1/R2) else
    if SA>H-R2 then
     begin
      D:=H-SA;
      L:=round((R2-Sqrt(D*(2*R2-D)))*R1/R2);
     end else L:=0;
   LL:=L+X; RR:=X+W-L;
   if (LL<Bitmap.ClipRect.Right) and (RR>Bitmap.ClipRect.Left) and (LL<RR) then
    begin
     if LL<Bitmap.ClipRect.Left then
      LL:=Bitmap.ClipRect.Left;
     if RR>Bitmap.ClipRect.Right then
      RR:=Bitmap.ClipRect.Right;
     HorzLineFunc(LL,Y+A,RR-1,Color);
    end;
  end;
end;

procedure RoundRectVFade(Bitmap:TBitmap32;StartColor,StopColor:TColor;
           X,Y,W,H,R:Integer);
var     A,B:Integer;
 CL,CL1,CL2:TColor32;
        CLA:Integer;
         L:Integer;
begin
 B:=H;
 CL1:=Color32(StartColor);
 CL2:=Color32(StopColor);
 for A:=0 to B-1 do
  begin
   CLA:=255*(A+1) div B;
   CL:=CL1;
   BlendMem(SetAlpha(CL2,CLA),CL);
   EMMS;
   if A<R then L:=Ceil(R-Sqrt(2*R*A-Sqr(A))) else
    if A>H-R then L:=Ceil(R-Sqrt(2*R*(H-A)-Sqr(H-A))) else L:=0;
   Bitmap.HorzLineS(L+X,Y+A,L+X+W-2*L,CL);
  end;
end;

procedure RoundRectVFadeT(Bitmap:TBitmap32;CL1,CL2:TColor32;X,Y,W,H,R:Integer;
           Corners:TSXCorners=[crLeftTop,crRightTop,crRightBottom,crLeftBottom]);
var   A,SH,FH:Integer;
         SA,D:Single;
           CL:TColor32;
          CLA:Integer;
      L,LL,RR:Integer;
 HorzLineFunc:procedure(X1,Y,X2:Integer;Value:TColor32)of object;
begin
 if (X>=Bitmap.ClipRect.Right) or (Y>=Bitmap.ClipRect.Bottom) or
    (X+W<=Bitmap.ClipRect.Left) or (Y+H<=Bitmap.ClipRect.Top) then exit;
 if (CL1 and $FF000000=$FF000000) and (CL2 and $FF000000=$FF000000) then
  HorzLineFunc:=Bitmap.HorzLine else
   HorzLineFunc:=Bitmap.HorzLineT;
 SH:=0;
 if Bitmap.ClipRect.Top>Y then
  SH:=Bitmap.ClipRect.Top-Y;
 FH:=H-1;
 if Bitmap.ClipRect.Bottom<Y+H then
  FH:=Bitmap.ClipRect.Bottom-Y-1;
 for A:=SH to FH do
  begin
   CLA:=255*(A+1) div H;
   CL:=CombineReg(CL2,CL1,CLA);
   EMMS;
   SA:=A+0.5;
   if SA<R then
    begin
     L:=Ceil(R-Sqrt(SA*(2*R-SA)));
     if crLeftTop in Corners then
      LL:=L+X else LL:=X;
     if crRightTop in Corners then
      RR:=X+W-L else RR:=X+W;
    end else
   if SA>H-R then
    begin
     D:=H-SA;
     L:=Ceil(R-Sqrt(D*(2*R-D)));
     if crLeftBottom in Corners then
      LL:=L+X else LL:=X;
     if crRightBottom in Corners then
      RR:=X+W-L else RR:=X+W;
    end else
     begin
      LL:=X;
      RR:=X+W;
     end;
   if (LL<Bitmap.ClipRect.Right) and (RR>Bitmap.ClipRect.Left) and (LL<RR) then
    begin
     if LL<Bitmap.ClipRect.Left then
      LL:=Bitmap.ClipRect.Left;
     if RR>Bitmap.ClipRect.Right then
      RR:=Bitmap.ClipRect.Right;
     HorzLineFunc(LL,Y+A,RR-1,CL);
    end;
  end;
end;

procedure RoundRectHFadeT(Bitmap:TBitmap32;CL1,CL2:TColor32;
           X,Y,W,H,R:Integer;Corners:TSXCorners=[crLeftTop,crRightTop,crRightBottom,crLeftBottom]);