sgradient.pas

AlphaControls是一个Delphi标准控件的集合

unit sGradient;
interface

uses
  windows, Graphics, Classes, Controls,
  sUtils, SysUtils, StdCtrls, sConst, math,
  Dialogs, Forms, Messages, extctrls, IniFiles;

type

  TsGradFillMode = (fmSolid, fmTransparent);

  TsGradPie = record
    Color1 : TColor;
    Color2 : TColor;
    Percent : TPercent;
    Mode1 : integer;
    Mode2 : integer;
  end;

  TsGradArray = array of TsGradPie;

// Fills bitmap by custom properties of Gradient
procedure PaintGrad(Bmp: TBitMap; aRect : TRect; Data : TsGradArray);
procedure PaintGradV(Bmp: TBitMap; aRect : TRect; Data : TsGradArray);
procedure PrepareGradArray(GradientStr : string; var GradArray : TsGradArray);

implementation

uses sStyleActive;

procedure PaintGrad(Bmp: TBitMap; aRect : TRect; Data : TsGradArray);
var
  SSrc : PRGBArray;
  i, w, dX, dY: Integer;
  R, G, B : real;
  RStep, GStep, BStep : real;
  SavedDC : longint;
  CurrentColor, Color1, Color2 : TsRGB;
  Count, Percent, CurrentX, MaxX, CurrentY, MaxY : integer;
  Y, X : integer;

  function sRGB(Color : TColor) : TsRGB; begin
    Result.R := GetRValue(Color);
    Result.G := GetGValue(Color);
    Result.B := GetBValue(Color);
  end;
begin
  if aRect.Right > Bmp.Width then
    aRect.Right := Bmp.Width;
  if aRect.Bottom > Bmp.Height then
    aRect.Bottom := Bmp.Height;
  if aRect.Left < 0 then aRect.Left := 0;
  if aRect.Top < 0 then aRect.Top := 0;

  Count := Length(Data); if Count = 0 then Exit;

  case Data[0].Mode1 of
    0 : begin
      SavedDC := SaveDC(Bmp.Canvas.Handle);
      try

        MaxY := aRect.Top;

        for i := 0 to Count - 1 do begin
          Color1 := sRGB(Data[i].Color1);
          Color2 := sRGB(Data[i].Color2);
          Percent := Data[i].Percent;
          CurrentY := MaxY;
          MaxY := CurrentY + (HeightOf(aRect) * Percent) div 100;
          if i = (Count - 1) then
              MaxY := Bmp.Height - 1;
          if MaxY - CurrentY > 0 then begin
            R := Color1.R;
            G := Color1.G;
            B := Color1.B;

            if (i = (Count - 1)) or (MaxY > bmp.Height - 1) then begin
              MaxY := min(aRect.Bottom - 1, bmp.Height - 1);
            end;

            dY := MaxY - CurrentY;
            if dY = 0 then Exit;
            w := min(WidthOf(aRect) + aRect.Left, bmp.Width);

            RStep := (Color2.R - Color1.R) / dY;
            GStep := (Color2.G - Color1.G) / dY;
            BStep := (Color2.B - Color1.B) / dY;

            for Y := CurrentY to MaxY do begin
              SSrc := Bmp.ScanLine[Y];
              CurrentColor.R := Round(R);
              CurrentColor.G := Round(G);
              CurrentColor.B := Round(B);

              for X := aRect.Left to w - 1 do begin
                SSrc[X] := CurrentColor;
              end;

              R := R + RStep;
              G := G + GStep;
              B := B + BStep;
            end;
          end;
        end;

      finally
        RestoreDC(Bmp.Canvas.Handle, SavedDC);
      end;
    end;
    1 : begin
      SavedDC := SaveDC(Bmp.Canvas.Handle);
      try
        for CurrentY := aRect.Top to aRect.Bottom - 1 do begin

          SSrc := Bmp.ScanLine[CurrentY];
          MaxX := aRect.Left;

          for i := 0 to Count - 1 do begin
            Color1 := sRGB(Data[i].Color1);
            Color2 := sRGB(Data[i].Color2);
            Percent := Data[i].Percent;
            CurrentX := MaxX;
            MaxX := CurrentX + (WidthOf(aRect) * Percent) div 100;
            if i = (Count - 1) then
                MaxX := Bmp.Width - 1;
            if MaxX - CurrentX > 0 then begin
              dX := MaxX - CurrentX;
              if dX = 0 then Exit;

              R := Color1.R;
              G := Color1.G;
              B := Color1.B;

//              w := min(WidthOf(aRect) + aRect.Left, bmp.Width);

              RStep := (Color2.R - Color1.R) / dX;
              GStep := (Color2.G - Color1.G) / dX;
              BStep := (Color2.B - Color1.B) / dX;

              for X := CurrentX to MaxX do begin
                CurrentColor.R := Round(R);
                CurrentColor.G := Round(G);
                CurrentColor.B := Round(B);

                SSrc[X] := CurrentColor;

                R := R + RStep;
                G := G + GStep;
                B := B + BStep;
              end;
            end;
          end;
        end;
      finally
        RestoreDC(Bmp.Canvas.Handle, SavedDC);
      end;
    end;
  end;

end;

procedure PaintGradV(Bmp: TBitMap; aRect : TRect; Data : TsGradArray);
var
  SSrc : PRGBArray;
  i, w, dY: Integer;
  R, G, B : real;
  RStep, GStep, BStep : real;
  SavedDC : longint;
  CurrentColor, Color1, Color2 : TsRGB;
  Count, Percent, CurrentY, MaxY : integer;
//  Last : boolean;

  function GetRGB(Color : TColor) : TsRGB; begin
    Result.R := GetRValue(Color);
    Result.G := GetGValue(Color);
    Result.B := GetBValue(Color);
  end;

  procedure Paint(Color1, Color2 : TsRGB; cY, mY : integer; Last : boolean);
  var
    Y, X : integer;
  begin
    R := Color1.R;
    G := Color1.G;
    B := Color1.B;

    if Last or (my > bmp.Height - 1) then begin
      mY := min(aRect.Bottom - 1, bmp.Height - 1);
    end;

    dY := mY - cY;
    if dY = 0 then Exit;
    w := min(WidthOf(aRect) + aRect.Left, bmp.Width);

    RStep := (Color2.R - Color1.R) / dY;
    GStep := (Color2.G - Color1.G) / dY;
    BStep := (Color2.B - Color1.B) / dY;

    for Y := cY to mY do begin
      SSrc := Bmp.ScanLine[Y];
      CurrentColor.R := Round(R);
      CurrentColor.G := Round(G);
      CurrentColor.B := Round(B);

      for X := aRect.Left to w - 1 do begin
        SSrc[X] := CurrentColor;
      end;

      R := R + RStep;
      G := G + GStep;
      B := B + BStep;
    end;
  end;
begin
  if aRect.Right > Bmp.Width then
    aRect.Right := Bmp.Width;
  if aRect.Bottom > Bmp.Height then
    aRect.Bottom := Bmp.Height;
  if aRect.Left < 0 then aRect.Left := 0;
  if aRect.Top < 0 then aRect.Top := 0;

  Count := Length(Data); if Count = 0 then Exit;

  SavedDC := SaveDC(Bmp.Canvas.Handle);
  try

    MaxY := aRect.Top;

    for i := 0 to Count - 1 do begin
      Color1 := GetRGB(Data[i].Color1);
      Color2 := GetRGB(Data[i].Color2);
      Percent := Data[i].Percent;
      CurrentY := MaxY;
      MaxY := CurrentY + (HeightOf(aRect) * Percent) div 100;
      if i = (Count - 1) then
          MaxY := Bmp.Height - 1;
      if MaxY - CurrentY > 0 then begin
        Paint(Color1, Color2, CurrentY, MaxY, i = (Count - 1));
      end;
    end;

  finally
    RestoreDC(Bmp.Canvas.Handle, SavedDC);
  end;
end;

procedure PrepareGradArray(GradientStr : string; var GradArray : TsGradArray);
var
  Count, i : integer;
begin
  SetLength(GradArray, 0);
  if GradientStr = '' then Exit;

  Count := WordCount(GradientStr, [';']) div 5;
  SetLength(GradArray, Count);
  for i := 0 to Count - 1 do begin
    GradArray[i].Color1 := StrToInt(ExtractWord(i * 5 + 1, GradientStr, [';']));
    GradArray[i].Color2 := StrToInt(ExtractWord(i * 5 + 2, GradientStr, [';']));
    GradArray[i].Percent := StrToInt(ExtractWord(i * 5 + 3, GradientStr, [';']));
    GradArray[i].Mode1 := StrToInt(ExtractWord(i * 5 + 4, GradientStr, [';']));
  end;
end;

end.