sxbitmap32utils.pas

skin components for design of your applicastions

unit SXBitmap32Utils;

////////////////////////////////////////////////////////////////////////////////
// SXSkinComponents: Skinnable Visual Controls for Delphi and C++Builder      //
//----------------------------------------------------------------------------//
// Version: 1.2.1                                                             //
// Author: Alexey Sadovnikov                                                  //
// Web Site: http://www.saarixx.info/sxskincomponents/                        //
// E-Mail: [e-mail]                                      //
//----------------------------------------------------------------------------//
// LICENSE:                                                                   //
// 1. You may freely distribute this file.                                    //
// 2. You may not make any changes to this file.                              //
// 3. The only person who may change this file is Alexey Sadovnikov.          //
// 4. You may use this file in your freeware projects.                        //
// 5. If you want to use this file in your shareware or commercial project,   //
//    you should purchase a project license or a personal license of          //
//    SXSkinComponents: http://saarixx.info/sxskincomponents/en/purchase.htm  //
// 6. You may freely use, distribute and modify skins for SXSkinComponents.   //
// 7. You may create skins for SXSkinComponents.                              //
//----------------------------------------------------------------------------//
// Copyright (C) 2006-2007, Alexey Sadovnikov. All Rights Reserved.           //
////////////////////////////////////////////////////////////////////////////////

interface

{$I Compilers.inc}

uses Types, Windows, Graphics, Classes, GR32, GR32_Polygons;

type

 TSXCorner=(crLeftTop,crRightTop,crRightBottom,crLeftBottom);
 TSXCorners=set of TSXCorner;

procedure DrawWindowShadow(B:TBitmap32;Left,Top,Right,Bottom:Integer);
procedure SetEllipse(P:TPolygon32;X,Y,RX,RY:Single);
procedure SetRoundRectangle(P:TPolygon32;X,Y,W,H,R:Single;Corners:TSXCorners=[crLeftTop,crRightTop,crRightBottom,crLeftBottom]);
procedure SetRectangle(P:TPolygon32;X,Y,W,H:Single);
procedure DrawTextInBitmapCenter(B:TBitmap32;const Text:String;
           Width,Height,TextWidth,OX,OY:Integer;Color:TColor;
           ShadowColor1:TColor=clNone;ShadowColor2:TColor=clNone);

procedure MultiplyAlpha(Bitmap:TBitmap32;MulAlpha:Integer);
procedure Monochrome(Bitmap:TBitmap32;Color1,Color2:TColor32);
procedure ColorOverlay(Bitmap:TBitmap32;Color:TColor32);
procedure ColorOverlayHorizG(Bitmap:TBitmap32;Color1,Color2:TColor32);
procedure ColorOverlayVertG(Bitmap:TBitmap32;Color1,Color2:TColor32);
procedure Lighten(Bitmap:TBitmap32;Color:TColor32);
procedure LightenHorizG(Bitmap:TBitmap32;Color1,Color2:TColor32);
procedure LightenVertG(Bitmap:TBitmap32;Color1,Color2:TColor32);
procedure Darken(Bitmap:TBitmap32;Color:TColor32);
procedure DarkenHorizG(Bitmap:TBitmap32;Color1,Color2:TColor32);
procedure DarkenVertG(Bitmap:TBitmap32;Color1,Color2:TColor32);
procedure AdvDrawTo(Bitmap:TBitmap32;Dst:TBitmap32); overload;
procedure AdvDrawTo(Bitmap:TBitmap32;Dst:TBitmap32;DstX,DstY:Integer); overload;
procedure DrawMixedBitmap(Bitmap:TBitmap32;B1,B2:TBitmap32;Step:Byte);
procedure DrawHColorFade(Bitmap:TBitmap32;StartColor,StopColor:TColor;iLeft,iTop,iRight,iBottom:Integer);
procedure DrawVColorFade(Bitmap:TBitmap32;StartColor,StopColor:TColor;iLeft,iTop,iRight,iBottom:Integer);
procedure RectVFadeT(Bitmap:TBitmap32;CL1,CL2:TColor32;X,Y,W,H:Integer);
procedure RectHFadeT(Bitmap:TBitmap32;CL1,CL2:TColor32;X,Y,W,H:Integer);
procedure DrawToAsGray(Bitmap:TBitmap32;Dst:TBitmap32;DstRect:TRect;MAlpha:Integer=255); overload;
procedure DrawToAsGray(Bitmap:TBitmap32;Dst:TBitmap32;DstX,DstY:Integer;MAlpha:Integer=255); overload;
procedure DrawToAsChannel(Bitmap:TBitmap32;Dst:TBitmap32;DstX,DstY:Integer;Ch:Byte;MAlpha:Integer=255);
procedure AdvDrawToAsAlpha(Bitmap:TBitmap32;Dst:TBitmap32;DstX,DstY:Integer;MAlpha:Integer=255);
procedure DrawToAsAlpha(Bitmap:TBitmap32;Dst:TBitmap32;DstX,DstY:Integer;MAlpha:Integer=255); overload;
procedure DrawToAsAlpha(Bitmap:TBitmap32;Dst:TBitmap32;DstRect:TRect;MAlpha:Integer=255); overload;
procedure RoundRectangle(Bitmap:TBitmap32;X,Y,W,H,R:Integer;
           Corners:TSXCorners=[crLeftTop,crRightTop,crRightBottom,crLeftBottom]); overload;
procedure RoundRectangle(Bitmap:TBitmap32;X,Y,W,H,R:Single); overload;
procedure RoundRectVFade(Bitmap:TBitmap32;StartColor,StopColor:TColor;X,Y,W,H,R:Integer);
procedure RoundRectVFadeT(Bitmap:TBitmap32;CL1,CL2:TColor32;X,Y,W,H,R:Integer;
           Corners:TSXCorners=[crLeftTop,crRightTop,crRightBottom,crLeftBottom]);
procedure RoundRectHFadeT(Bitmap:TBitmap32;CL1,CL2:TColor32;X,Y,W,H,R:Integer;
           Corners:TSXCorners=[crLeftTop,crRightTop,crRightBottom,crLeftBottom]);
procedure RoundRectFill(Bitmap:TBitmap32;Color:TColor;X,Y,W,H,R:Integer); overload;
procedure RoundRectFill(Bitmap:TBitmap32;Color:TColor32;X,Y,W,H,R:Integer;
           Corners:TSXCorners=[crLeftTop,crRightTop,crRightBottom,crLeftBottom]); overload;
procedure Ellipse(Bitmap:TBitmap32;X,Y,W,H:Single);
procedure EllipseFill(Bitmap:TBitmap32;Color:TColor32;X,Y,W,H:Integer);
procedure EllipseHFade(Bitmap:TBitmap32;CL1,CL2:TColor32;X,Y,W,H:Integer);
procedure EllipseVFade(Bitmap:TBitmap32;CL1,CL2:TColor32;X,Y,W,H:Integer);
procedure BottomRoundRectangle(Bitmap:TBitmap32;X,Y,W,H,R:Single);
procedure BottomRoundRectVFade(Bitmap:TBitmap32;StartColor,StopColor:TColor;
           X,Y,W,H,R:Integer;TotalHeight:Integer=0);
procedure TopRoundRectangle(Bitmap:TBitmap32;X,Y,W,H,R:Single);
procedure TopRoundRectVFade(Bitmap:TBitmap32;StartColor,StopColor:TColor;
           X,Y,W,H,R:Integer;TotalHeight:Integer=0);
procedure BlendBitmap(B:TBitmap32;A:Integer;C:TColor);

procedure GetRenderedTextSize(Bitmap:TBitmap32;const Text:String;AALevel:Integer;
           var Width,Height:Integer); overload;
procedure GetRenderedTextSize(Canvas:TCanvas;const Text:String;AALevel:Integer;
           var Width,Height:Integer); overload;
procedure DrawSmoothText(Bitmap:TBitmap32;const Text:String;var TextRect:TRect;
           Flags:UINT;AALevel:Integer;Color:TColor32); overload;
procedure DrawSmoothText(Canvas:TCanvas;const Text:String;var TextRect:TRect;
           Flags:UINT;AALevel:Integer); overload;
procedure DrawAlphaText(Bitmap:TBitmap32;const Text:String;var TextRect:TRect;
           Flags:UINT;Color:TColor32);           

procedure SX_BlendLineEx(Src,Dst:PColor32;Count:Integer;M:TColor32);
procedure SX_CombineMem(F:TColor32;var B:TColor32;W:TColor32);
procedure SX_BlendMem(F:TColor32;var B:TColor32);

procedure ColorToRedComponent(Dst,Src:TBitmap32);
procedure ColorToGreenComponent(Dst,Src:TBitmap32);
procedure ColorToBlueComponent(Dst,Src:TBitmap32);

procedure AdvBlockTransfer(Dst:TBitmap32;DstX:Integer;DstY:Integer;DstClip:TRect;
           Src:TBitmap32;SrcRect:TRect;CombineOp:TDrawMode;CombineCallBack:TPixelCombineEvent=nil);

implementation

uses GR32_LowLevel, GR32_Filters, Math, GR32_Blend;

const WShadow:array[0..4,0..5]of Byte=((   3,  14,  42,  82, 110, 113),
                                       (   2,  13,  38,  65,  82,  84),
                                       (   2,  10,  18,  38,  42,  43),
                                       (   1,   5,  10,  13,  14,  14),
                                       (   1,   1,   2,   2,   3,   3));

procedure DrawWindowShadow(B:TBitmap32;Left,Top,Right,Bottom:Integer);
var X,Y:Integer;
  RS,BS:Integer;
      P:PColor32Array;
begin
 RS:=Right+1;
 BS:=Bottom+1;
 //Top Right Corner
 for Y:=0 to 4 do
  begin
   P:=B.ScanLine[Y+5+Top];
   for X:=0 to 4 do
    P[X+RS]:=CombineReg(clBlack32,P[X+RS],WShadow[4-Y,4-X]);
  end;
 //Bottom Right Corner
 for Y:=0 to 4 do
  begin
   P:=B.ScanLine[Y+BS];
   for X:=0 to 4 do
    P[X+RS]:=CombineReg(clBlack32,P[X+RS],WShadow[Y,4-X]);
  end;
 //Bottom Left Corner
 for Y:=0 to 4 do
  begin
   P:=B.ScanLine[Y+BS];
   for X:=0 to 4 do
    P[X+5+Left]:=CombineReg(clBlack32,P[X+5+Left],WShadow[Y,X]);
  end;
 //Right Center Line
 for Y:=10+Top to Bottom do
  begin
   P:=B.ScanLine[Y];
   for X:=0 to 4 do
    P[X+RS]:=CombineReg(clBlack32,P[X+RS],WShadow[X,5]);
  end;
 //Bottom Center Line
 for Y:=0 to 4 do
  begin
   P:=B.ScanLine[Y+BS];
   for X:=10+Left to Right do
    P[X]:=CombineReg(clBlack32,P[X],WShadow[Y,5]);
  end;
 EMMS;
end;

procedure SetEllipse(P:TPolygon32;X,Y,RX,RY:Single);
const S_PI=3.14159;
var Step:Single;
   Angle:Single;
       R:Single;
begin
 P.Clear;
 if RX>RY then R:=RX else R:=RY;
 if R<3 then Step:=0.2 else
  if R<10 then Step:=0.1 else
   Step:=0.05;
 Angle:=0;
 repeat
  P.Add(FixedPoint(X+RX*cos(Angle),Y+RY*sin(Angle)));
  Angle:=Angle+Step;
 until Angle>S_PI*2;
 P.Closed:=True;
end;

procedure SetRoundRectangle(P:TPolygon32;X,Y,W,H,R:Single;Corners:TSXCorners=[crLeftTop,crRightTop,crRightBottom,crLeftBottom]);
const S_PI=3.141592;
var T:Double;
 Step:Single;
begin
 W:=W-1; H:=H-1;
 P.Clear;
 if R<3 then Step:=0.7 else
  if R<6 then Step:=0.5 else
   if R<20 then Step:=0.1 else
    Step:=0.05;
 if crLeftTop in Corners then
  begin
   T:=-S_PI/2;
   while T>-S_PI do
    begin
     P.Add(FixedPoint(X+Cos(T)*R+R,Y+Sin(T)*R+R));
     T:=T-Step;
    end;
   P.Add(FixedPoint(X,Y+R));
  end else P.Add(FixedPoint(X,Y));
 if crLeftBottom in Corners then
  begin
   P.Add(FixedPoint(X,Y+H-R));
   T:=S_PI;
   while T>S_PI/2 do
    begin
     P.Add(FixedPoint(X+Cos(T)*R+R,Y+Sin(T)*R+H-R));
     T:=T-Step;
    end;
   P.Add(FixedPoint(X+R,Y+H));
  end else P.Add(FixedPoint(X,Y+H));
 if crRightBottom in Corners then
  begin
   P.Add(FixedPoint(X+W-R,Y+H));
   T:=S_PI/2;
   while T>0 do
    begin
     P.Add(FixedPoint(X+Cos(T)*R-R+W,Y+Sin(T)*R+H-R));
     T:=T-Step;
    end;
   P.Add(FixedPoint(X+W,Y+H-R));
  end else P.Add(FixedPoint(X+W,Y+H));
 if crRightTop in Corners then
  begin
   P.Add(FixedPoint(X+W,Y+R));
   T:=0;                              
   while T>-S_PI/2 do
    begin
     P.Add(FixedPoint(X+Cos(T)*R-R+W,Y+Sin(T)*R+R));
     T:=T-Step;
    end;
   P.Add(FixedPoint(X-R+W,Y)); 
  end else P.Add(FixedPoint(X+W,Y));
 P.Closed:=True;
end;

procedure SetRectangle(P:TPolygon32;X,Y,W,H:Single);
begin
 P.Clear;
 P.Add(FixedPoint(X,Y));
 P.Add(FixedPoint(X+W-1,Y));
 P.Add(FixedPoint(X+W-1,Y+H-1));
 P.Add(FixedPoint(X,Y+H-1));
 P.Closed:=True;
end;

procedure DrawTextInBitmapCenter(B:TBitmap32;const Text:String;Width,Height,TextWidth,OX,OY:Integer;
           Color:TColor;ShadowColor1:TColor=clNone;ShadowColor2:TColor=clNone);
var R:TRect;
  A,H:Integer;
begin
 R:=Rect((Width-TextWidth) div 2+OX,OY,(Width+TextWidth) div 2+OX,Height+OY);
 B.Canvas.Brush.Style:=bsClear;
 A:=DT_VCENTER or DT_WORDBREAK or DT_CENTER or DT_NOCLIP or DT_CALCRECT;
 DrawText(B.Canvas.Handle,PChar(Text),length(Text),R,A);
 H:=R.Bottom-R.Top;
 R:=Rect((Width-TextWidth) div 2+OX,(Height-H) div 2+OY,(Width+TextWidth) div 2+OX,Height+OY);
 A:=DT_VCENTER or DT_WORDBREAK or DT_CENTER or DT_NOCLIP;
 Inc(R.Left,2); Inc(R.Top,2); Inc(R.Right,2);
 if ShadowColor2<>clNone then
  begin
   B.Canvas.Font.Color:=ShadowColor2;
   DrawText(B.Canvas.Handle,PChar(Text),length(Text),R,A);
  end;
 Dec(R.Left); Dec(R.Top); Dec(R.Right);
 if ShadowColor1<>clNone then
  begin
   B.Canvas.Font.Color:=ShadowColor1;
   DrawText(B.Canvas.Handle,PChar(Text),length(Text),R,A);
  end;
 Dec(R.Left); Dec(R.Top); Dec(R.Right);
 B.Canvas.Font.Color:=Color;
 DrawText(B.Canvas.Handle,PChar(Text),length(Text),R,A);
end;

procedure DrawToAsGray(Bitmap:TBitmap32;Dst:TBitmap32;DstX,DstY:Integer;
           MAlpha:Integer=255);
var B2:TBitmap32;
begin
 if Bitmap.Empty or Dst.Empty then exit;
 B2:=TBitmap32.Create;
 try
  ColorToGrayScale(B2,Bitmap,True);
  B2.DrawMode:=dmBlend;
  B2.MasterAlpha:=MAlpha;
  B2.DrawTo(Dst,DstX,DstY);
 finally
  B2.Free;
 end;
end;

procedure DrawToAsGray(Bitmap:TBitmap32;Dst:TBitmap32;DstRect:TRect;
           MAlpha:Integer=255);
var B2:TBitmap32;
begin
 if Bitmap.Empty or Dst.Empty then exit;
 B2:=TBitmap32.Create;
 try
  ColorToGrayScale(B2,Bitmap,True);
  B2.DrawMode:=dmBlend;
  B2.MasterAlpha:=MAlpha;
  B2.DrawTo(Dst,DstRect);
 finally
  B2.Free;
 end;
end;

procedure DrawToAsChannel(Bitmap:TBitmap32;Dst:TBitmap32;DstX,DstY:Integer;
           Ch:Byte;MAlpha:Integer=255);
var B2:TBitmap32;
begin
 if Bitmap.Empty or Dst.Empty then exit;
 B2:=TBitmap32.Create;
 try
  case Ch of
   0: ColorToRedComponent(B2,Bitmap);
   1: ColorToGreenComponent(B2,Bitmap);
   2: ColorToBlueComponent(B2,Bitmap);
  end;
  B2.DrawMode:=dmBlend;
  B2.MasterAlpha:=MAlpha;
  B2.DrawTo(Dst,DstX,DstY);
 finally
  B2.Free;
 end;
end;

procedure MultiplyAlpha(Bitmap:TBitmap32;MulAlpha:Integer);
var I:Integer;
    P:PByte;
begin
 P:=@Bitmap.Bits[0];
 Inc(P,3);
 for I:=0 to Bitmap.Width*Bitmap.Height-1 do
  begin
   P^:=Integer(P^)*MulAlpha div 255;
   Inc(P,4);
  end;
end;

procedure Monochrome(Bitmap:TBitmap32;Color1,Color2:TColor32);
var   P:PColor32;
    A,C:Integer;
  Color:TColor32;
 Colors:array[Byte]of TColor32;
begin
 P:=@Bitmap.Bits[0];
 Colors[0]:=Color1;
 for A:=1 to 254 do
  Colors[A]:=CombineReg(Color2,Color1,A);
 Colors[255]:=Color2;
 for C:=0 to Bitmap.Width*Bitmap.Height-1 do
  begin
   A:=Intensity(P^);
   Color:=Colors[A];
   P^:=(DivTable[P^ shr 24,Color shr 24] shl 24) or (Color and $00FFFFFF);
   Inc(P);
  end;
 EMMS;
end;

procedure ColorOverlay(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^:=(BlendReg(Color,D^) and $00FFFFFF) or (D^ and $FF000000);
   Inc(D);
  end;
 EMMS;
end;

procedure ColorOverlayHorizG(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^:=(BlendReg(Colors[X],D^) and $00FFFFFF) or (D^ and $FF000000);
    Inc(D);
   end;
 EMMS;
end;

procedure ColorOverlayVertG(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^:=(BlendReg(Color,D^) and $00FFFFFF) or (D^ and $FF000000);
     Inc(D);
    end;
  end;
 EMMS;
end;

procedure Lighten(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^:=ColorAdd(D^,Color);
   Inc(D);
  end;
 EMMS;
end;

procedure LightenHorizG(Bitmap:TBitmap32;Color1,Color2:TColor32);
var X,Y:Integer;
      D:PColor32;
 Colors:array of TColor32;
    CLA:Integer;