⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 sxbitmap32utils.pas

📁 skin components for design of your applicastions
💻 PAS
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
var   A,SW,FW:Integer;
         SA,D:Single;
           CL:TColor32;
          CLA:Integer;
      T,TT,BB:Integer;
 VertLineFunc:procedure(X,Y1,Y2: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
  VertLineFunc:=Bitmap.VertLine else
   VertLineFunc:=Bitmap.VertLineT;
 SW:=0;
 if Bitmap.ClipRect.Left>X then
  SW:=Bitmap.ClipRect.Left-X;
 FW:=W-1;
 if Bitmap.ClipRect.Right<X+W then
  FW:=Bitmap.ClipRect.Right-X-1;
 for A:=SW to FW do
  begin
   CLA:=255*(A+1) div W;
   CL:=CombineReg(CL2,CL1,CLA);
   EMMS;
   SA:=A+0.5;
   if SA<R then
    begin
     T:=Ceil(R-Sqrt(SA*(2*R-SA)));
     if crLeftTop in Corners then
      TT:=T+Y else TT:=Y;
     if crLeftBottom in Corners then
      BB:=Y+H-T else BB:=Y+H;
    end else
   if SA>W-R then
    begin
     D:=W-SA;
     T:=Ceil(R-Sqrt(D*(2*R-D)));
     if crRightTop in Corners then
      TT:=T+Y else TT:=Y;
     if crRightBottom in Corners then
      BB:=Y+H-T else BB:=Y+H;
    end else
     begin
      TT:=Y;
      BB:=Y+H;
     end;
   if (TT<Bitmap.ClipRect.Bottom) and (BB>Bitmap.ClipRect.Top) and (TT<BB) then
    begin
     if TT<Bitmap.ClipRect.Top then
      TT:=Bitmap.ClipRect.Top;
     if BB>Bitmap.ClipRect.Bottom then
      BB:=Bitmap.ClipRect.Bottom;
     VertLineFunc(X+A,TT,BB-1,CL);
    end; 
  end;
end;

procedure RectVFadeT(Bitmap:TBitmap32;CL1,CL2:TColor32;X,Y,W,H:Integer);
var         A:Integer;
           CL:TColor32;
          CLA: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 (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;
 if X<Bitmap.ClipRect.Left then
  begin
   W:=W-Bitmap.ClipRect.Left+X;
   X:=Bitmap.ClipRect.Left;
  end;
 if X+W>Bitmap.ClipRect.Right then W:=Bitmap.ClipRect.Right-X;
 for A:=SH to FH do
  begin
   CLA:=255*(A+1) div H;
   CL:=CombineReg(CL2,CL1,CLA);
   EMMS;
   HorzLineFunc(X,Y+A,X+W-1,CL);
  end;
end;

procedure RectHFadeT(Bitmap:TBitmap32;CL1,CL2:TColor32;X,Y,W,H:Integer);
var         A:Integer;
           CL:TColor32;
          CLA:Integer;
        SW,FW:Integer;  
 VertLineFunc:procedure(X,Y1,Y2: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
  VertLineFunc:=Bitmap.VertLine else
   VertLineFunc:=Bitmap.VertLineT;
 SW:=0;
 if Bitmap.ClipRect.Left>X then
  SW:=Bitmap.ClipRect.Left-X;
 FW:=W-1;
 if Bitmap.ClipRect.Right<X+W then
  FW:=Bitmap.ClipRect.Right-X-1;
 if Y<Bitmap.ClipRect.Top then
  begin
   H:=H-Bitmap.ClipRect.Top+Y;
   Y:=Bitmap.ClipRect.Top;
  end; 
 if Y+H>Bitmap.ClipRect.Bottom then H:=Bitmap.ClipRect.Bottom-Y;
 for A:=SW to FW do
  begin
   CLA:=255*(A+1) div W;
   CL:=CombineReg(CL2,CL1,CLA);
   EMMS;
   VertLineFunc(X+A,Y,Y+H-1,CL);
  end;
end;

procedure EllipseHFade(Bitmap:TBitmap32;CL1,CL2:TColor32;X,Y,W,H:Integer);
var         A:Integer;
         SA,D:Single;
           CL:TColor32;
    CLA,SW,FW:Integer;
      L,TT,BB:Integer;
        R1,R2:Single;
 VertLineFunc:procedure(X,Y1,Y2: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
  VertLineFunc:=Bitmap.VertLine else
   VertLineFunc:=Bitmap.VertLineT;
 SW:=0;
 if Bitmap.ClipRect.Left>X then
  SW:=Bitmap.ClipRect.Left-X;
 FW:=W-1;
 if Bitmap.ClipRect.Right<X+W then
  FW:=Bitmap.ClipRect.Right-X-1;
 R1:=W/2; R2:=H/2;
 for A:=SW to FW do
  begin
   CLA:=255*(A+1) div W;
   CL:=CombineReg(CL2,CL1,CLA);
   EMMS;
   SA:=A+0.5;
   if SA<R1 then L:=Ceil((R1-Sqrt(SA*(2*R1-SA)))*R2/R1) else
    if SA>W-R1 then
     begin
      D:=W-SA;
      L:=Ceil((R1-Sqrt(D*(2*R1-D)))*R2/R1);
     end else L:=0;
   TT:=L+Y; BB:=-L+Y+H;
   if (TT<Bitmap.ClipRect.Bottom) and (BB>Bitmap.ClipRect.Top) and (TT<BB) then
    begin
     if TT<Bitmap.ClipRect.Top then
      TT:=Bitmap.ClipRect.Top;
     if BB>Bitmap.ClipRect.Bottom then
      BB:=Bitmap.ClipRect.Bottom;
     VertLineFunc(X+A,TT,BB-1,CL);
    end; 
  end;
end;

procedure EllipseVFade(Bitmap:TBitmap32;CL1,CL2:TColor32;X,Y,W,H:Integer);
var         A:Integer;
         SA,D:Single;
           CL:TColor32;
    CLA,LL,RR:Integer;
      L,SH,FH:Integer;
        R1,R2:Single;
 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;
 R1:=W/2; R2:=H/2;
 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<R2 then L:=Ceil((R2-Sqrt(SA*(2*R2-SA)))*R1/R2) else
    if SA>H-R2 then
     begin
      D:=H-SA;
      L:=Ceil((R2-Sqrt(D*(2*R2-D)))*R1/R2);
     end else L:=0;
   LL:=L+X; RR:=-L+X+W;
   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 TopRoundRectangle(Bitmap:TBitmap32;X,Y,W,H,R:Single);
const S_PI=3.141592;
var T:Double;
    F:Boolean;
 Step:Single;
begin
 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;
 T:=-S_PI/2;
 F:=True;
 while T>-S_PI do
  begin
   if F then
    begin
     F:=False;
     Bitmap.MoveToF(X+Cos(T)*R+R,Y+Sin(T)*R+R);
    end else
     Bitmap.LineToFS(X+Cos(T)*R+R,Y+Sin(T)*R+R);
   T:=T-Step;
  end;
 Bitmap.LineToFS(X,Y+H);
 Bitmap.LineToFS(X+W,Y+H);
 Bitmap.LineToFS(X+W,Y+R);

 T:=0;
 F:=True;
 while T>-S_PI/2 do
  begin
   if F then
    begin
     F:=False;
     Bitmap.MoveToF(X+Cos(T)*R-R+W,Y+Sin(T)*R+R);
    end else
     Bitmap.LineToFS(X+Cos(T)*R-R+W,Y+Sin(T)*R+R);
   T:=T-Step;
  end;
 Bitmap.LineToFS(X+R,Y-0.001);
end;

procedure BottomRoundRectangle(Bitmap:TBitmap32;X,Y,W,H,R:Single);
const S_PI=3.141592;
var T:Double;
    F:Boolean;
 Step:Single;
begin
 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;
 T:=-S_PI/2;
 F:=True;
 while T>-S_PI do
  begin
   if F then
    begin
     F:=False;
     Bitmap.MoveToF(X+Cos(T)*R+R,Y+Sin(T)*R+R);
    end else
     Bitmap.LineToFS(X+Cos(T)*R+R,Y+Sin(T)*R+R);
   T:=T-Step;
  end;
 Bitmap.LineToFS(X,Y+H);
 Bitmap.LineToFS(X+W,Y+H);
 Bitmap.LineToFS(X+W,Y+R);

 T:=0;
 F:=True;
 while T>-S_PI/2 do
  begin
   if F then
    begin
     F:=False;
     Bitmap.MoveToF(X+Cos(T)*R-R+W,Y+Sin(T)*R+R);
    end else
     Bitmap.LineToFS(X+Cos(T)*R-R+W,Y+Sin(T)*R+R);
   T:=T-Step;
  end;
 Bitmap.LineToFS(X+R,Y-0.001);
end;

procedure RoundRectangle(Bitmap:TBitmap32;X,Y,W,H,R:Integer;
           Corners:TSXCorners=[crLeftTop,crRightTop,crRightBottom,crLeftBottom]);
const S_PI=3.141592;
var T:Double;
    F:Boolean;
 Step:Single;
begin
 Dec(W); Dec(H);
 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;
   F:=True;
   while T>-S_PI do
    begin
     if F then
      begin
       F:=False;
       Bitmap.MoveToF(X+Cos(T)*R+R,Y+Sin(T)*R+R);
      end else
       Bitmap.LineToFS(X+Cos(T)*R+R,Y+Sin(T)*R+R);
     T:=T-Step;
    end;
  end else Bitmap.MoveToF(X,Y);
 if crLeftBottom in Corners then
  begin
   Bitmap.LineToFS(X,Y+H-R);
   T:=S_PI;
   F:=True;
   while T>S_PI/2 do
    begin
     if F then
      begin
       F:=False;
       Bitmap.MoveToF(X+Cos(T)*R+R,Y+Sin(T)*R+H-R);
      end else
       Bitmap.LineToFS(X+Cos(T)*R+R,Y+Sin(T)*R+H-R);
     T:=T-Step;
    end;
  end else Bitmap.LineToFS(X,Y+H);
 if crRightBottom in Corners then
  begin
   Bitmap.LineToFS(X+W-R,Y+H);
   T:=S_PI/2;
   F:=True;
   while T>0 do
    begin
     if F then
      begin
       F:=False;
       Bitmap.MoveToF(X+Cos(T)*R-R+W,Y+Sin(T)*R+H-R);
      end else
       Bitmap.LineToFS(X+Cos(T)*R-R+W,Y+Sin(T)*R+H-R);
     T:=T-Step;
    end;
  end else Bitmap.LineToFS(X+W,Y+H);
 if crRightTop in Corners then
  begin
   Bitmap.LineToFS(X+W,Y+R);
   T:=0;
   F:=True;
   while T>-S_PI/2 do
    begin
     if F then
      begin
       F:=False;
       Bitmap.MoveToF(X+Cos(T)*R-R+W,Y+Sin(T)*R+R);
      end else
       Bitmap.LineToFS(X+Cos(T)*R-R+W,Y+Sin(T)*R+R);
     T:=T-Step;
    end;
  end else Bitmap.LineToFS(X+W,Y);
 if crLeftTop in Corners then
  Bitmap.LineToFS(X+R,Y-0.001) else
   Bitmap.LineToFS(X,Y);
end;

procedure RoundRectangle(Bitmap:TBitmap32;X,Y,W,H,R:Single);
const S_PI=3.141592;
var T:Double;
    F:Boolean;
 Step:Single;
begin
 W:=W-1; H:=H-1;
 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;
 T:=-S_PI/2;
 F:=True;
 while T>-S_PI do
  begin
   if F then
    begin
     F:=False;
     Bitmap.MoveToF(X+Cos(T)*R+R,Y+Sin(T)*R+R);
    end else
     Bitmap.LineToFS(X+Cos(T)*R+R,Y+Sin(T)*R+R);
   T:=T-Step;
  end;
 Bitmap.LineToFS(X,Y+H-R);

 T:=S_PI;
 F:=True;
 while T>S_PI/2 do
  begin
   if F then
    begin
     F:=False;
     Bitmap.MoveToF(X+Cos(T)*R+R,Y+Sin(T)*R+H-R);
    end else
     Bitmap.LineToFS(X+Cos(T)*R+R,Y+Sin(T)*R+H-R);
   T:=T-Step;
  end;
 Bitmap.LineToFS(X+W-R,Y+H);

 T:=S_PI/2;
 F:=True;
 while T>0 do
  begin
   if F then
    begin
     F:=False;
     Bitmap.MoveToF(X+Cos(T)*R-R+W,Y+Sin(T)*R+H-R);
    end else
     Bitmap.LineToFS(X+Cos(T)*R-R+W,Y+Sin(T)*R+H-R);
   T:=T-Step;
  end;
 Bitmap.LineToFS(X+W,Y+R);

 T:=0;
 F:=True;
 while T>-S_PI/2 do
  begin
   if F then
    begin
     F:=False;
     Bitmap.MoveToF(X+Cos(T)*R-R+W,Y+Sin(T)*R+R);
    end else
     Bitmap.LineToFS(X+Cos(T)*R-R+W,Y+Sin(T)*R+R);
   T:=T-Step;
  end;
 Bitmap.LineToFS(X+R,Y-0.001);
end;
1234

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -