sgraphutils.pas

Alpha Controls.v5.46b Source

    r := 60 / d;
    rt := max - c.R * r;
    gt := max - c.G * r;
    bt := max - c.B * r;
    if c.R = max then H := bt - gt else if c.G = max then H := 120 + rt - bt else H := 240 + gt - rt;
    if H < 0 then H := H + 360;
  end;

  H := round(H + Delta) mod 360;

  if S = 0 then begin C.R := Round(V) end else begin
    H := H / 60;
    I := Round(Int(H));
    F := (H - I);

    M := V * (1 - S);
    N := V * (1 - S * F);
    K := V * (1 - S * (1 - F));

    M := Math.max(Math.min(M, 255), 0);
    N := Math.max(Math.min(N, 255), 0);
    K := Math.max(Math.min(K, 255), 0);

    case I of
      0: begin C.R := Round(V); C.G := Round(K); C.B := Round(M) end;
      1: begin C.R := Round(N); C.G := Round(V); C.B := Round(M) end;
      2: begin C.R := Round(M); C.G := Round(V); C.B := Round(K) end;
      3: begin C.R := Round(M); C.G := Round(N); C.B := Round(V) end;
      4: begin C.R := Round(K); C.G := Round(M); C.B := Round(V) end
    else begin C.R := Round(V); C.G := Round(M); C.B := Round(N) end
    end;
  end;
  C.A := 0;
  Result := C.C
end;

procedure  HSVtoRGB (const H,S,V: Real; var R,G,B: real);
var
  f    :  Real;
  i    :  Integer;
  hTemp:  Real;              // since H is const parameter
  p, q, t:  Real;
begin
  if   (ABS(S-0.0001) <= 0.0001)  OR
       IsNan(H)                 // color is on black-and-white center line
  then begin
    if   IsNaN(H)
    then begin
      R := V;                   // achromatic:  shades of gray
      G := V;
      B := V
    end
  end

  else begin                    // chromatic color
    if   H = 360.0              // 360 degrees same as 0 degrees
    then hTemp := 0.0
    else hTemp := H;

    hTemp := hTemp / 60;        // h is now IN [0,6)
    i := TRUNC(hTemp);          // largest integer <= h
    f := hTemp - i;             // fractional part of h

    p := V * (1.0 - S);
    q := V * (1.0 - (S * f));
    t := V * (1.0 - (S * (1.0 - f)));

    CASE i OF
      0:  begin R := V;  G := t;  B := p  end;
      1:  begin R := q;  G := V;  B := p  end;
      2:  begin R := p;  G := V;  B := t  end;
      3:  begin R := p;  G := q;  B := V  end;
      4:  begin R := t;  G := p;  B := V  end;
      5:  begin R := V;  G := p;  B := q  end
    end
  end
end {HSVtoRGB};

procedure RGBToHSV (const R, G, B: Real; var H, S, V: Real);
var
  Delta:  Real;
  Min  :  Real;
begin
  Min := MinValue( [R, G, B] );
  V   := MaxValue( [R, G, B] );

  Delta := V - Min;

  // Calculate saturation:  saturation is 0 if r, g and b are all 0
  if   V =  0.0
  then S := 0
  else S := Delta / V;

  if   S  = 0.0
  then {H := NAN} // Achromatic:  When s = 0, h is undefined
  else begin    // Chromatic
    if   R = V
    then  // between yellow and magenta [degrees]
          H := 60.0 * (G - B) / Delta
    else
      if   G = V
      then // between cyan and yellow
           H := 120.0 + 60.0 * (B - R) / Delta
      else
        if  B = V
        then // between magenta and cyan
             H := 240.0 + 60.0 * (R - G) / Delta;

    if   H < 0.0
    then H := H + 360.0
  end
end {RGBtoHSV};

procedure GetRgnFromBmp(var rgn : hrgn; MaskBmp : TBitmap; TransColor : TColor);
var
  ArOR : TAOR;
  subrgn : hrgn;
  i, l : integer;
begin
  SetLength(ArOR, 0);
  AddRgnBmp(ArOR, MaskBmp, ColorToSColor(TransColor));//ColorToSColor(clWhite));

  l := Length(ArOR);
  rgn := CreateRectRgn(0, 0, MaskBmp.Width, MaskBmp.Height);
  if l > 0 then begin
    for i := 0 to l - 1 do begin
      subrgn := CreateRectRgn(ArOR[i].Left, ArOR[i].Top, ArOR[i].Right, ArOR[i].Bottom);
      CombineRgn(rgn, rgn, subrgn, RGN_DIFF);
      DeleteObject(subrgn);
    end
  end
end;

procedure AddRgnBmp(var AOR : TAOR; MaskBmp : TBitmap; TransColor : TsColor);
var
  X, Y, h, w, l: Integer;
  c : TsColor;
  RegRect : TRect;
begin
  h := MaskBmp.Height - 1;
  w := MaskBmp.Width - 1;
  RegRect := Rect(-1, 0, 0, 0);
  TransColor.A := 0;
  c.A := 0;
  l := Length(AOR);
  try
    if Fast24Src.Attach(MaskBmp) then for Y := 0 to h do begin
      for X := 0 to w do begin
        c := Fast24Src.Pixels[x, y];
        if c.C = TransColor.C then begin
          if RegRect.Left <> -1 then inc(RegRect.Right) else begin
            RegRect.Left := X;
            RegRect.Right := RegRect.Left + 1;
            RegRect.Top := Y;
            RegRect.Bottom := RegRect.Top + 1;
          end;
        end
        else if RegRect.Left <> -1 then begin
          SetLength(aOR, l + 1);
          AOR[l] := RegRect;
          inc(l);
          RegRect.Left := -1;
        end;
      end;
      if RegRect.Left <> -1 then begin
        SetLength(AOR, l + 1);
        AOR[l] := RegRect;
        inc(l);
        RegRect.Left := -1;
      end;
    end;
  except
  end;
end;

procedure AddRgn(var AOR : TAOR; Width : integer; MaskData : TsMaskData; VertOffset : integer; Bottom : boolean);
var
  S : PRGBArray;
  X, Y, h, w, l, w2, cx: Integer;
  c, ct : TsColor;
  cur : TsRGB;
  RegRect : TRect;
  Bmp : TBitmap;
  XOffs, YOffs, MaskOffs : integer;
begin
  if MaskData.Manager = nil then Exit;
  if MaskData.Bmp = nil then Bmp := TsSkinManager(MaskData.Manager).MasterBitmap else Bmp := MaskData.Bmp;

  if Bottom then h := MaskData.WB else h := MaskData.WT;
  w := MaskData.WL;
  MaskOffs := integer(Bottom) * (HeightOf(MaskData.R) div (1 + MaskData.MaskType) - MaskData.WB);
  XOffs := MaskData.R.Left; YOffs := MaskData.R.Top;

  if Bmp = nil then Exit;
  inc(YOffs, MaskOffs);
  RegRect := Rect(-1, 0, 0, 0);
  ct.C := clFuchsia;
  l := Length(AOR);
  dec(h); dec(w);
  if h + YOffs > Bmp.Height then Exit;
  c.A := 0;
  try
    for Y := 0 to h do begin
      S := Bmp.ScanLine[Y + YOffs];
      for X := 0 to w do begin
        cur := S[X + XOffs];
        if (cur.R = ct.R) and (cur.G = ct.G) and (cur.B = ct.B) then begin
          if RegRect.Left <> -1 then inc(RegRect.Right) else begin
            RegRect.Left := X;
            RegRect.Right := RegRect.Left + 1;
            RegRect.Top := Y + VertOffset;
            RegRect.Bottom := RegRect.Top + 1;
          end;
        end
        else if RegRect.Left <> -1 then begin
          SetLength(aOR, l + 1);
          AOR[l] := RegRect;
          inc(l);
          RegRect.Left := -1;
        end;
      end;
      if RegRect.Left <> -1 then begin
        SetLength(AOR, l + 1);
        AOR[l] := RegRect;
        inc(l);
        RegRect.Left := -1;
      end;
    end;

    w2 := WidthOf(MaskData.R) div MaskData.ImageCount - 1;      //x2
    w := WidthOf(MaskData.R) div MaskData.ImageCount - MaskData.WR;
//    w := 2 * WidthOf(MaskData.R) div (3 * MaskData.ImageCount); //x1
    cx := Width - WidthOf(MaskData.R) div MaskData.ImageCount;  //First pixel on control
    for Y := 0 to h do begin
      S := Bmp.ScanLine[Y + YOffs];
      for X := w to w2 do begin
        cur := S[X + XOffs];
        if (cur.R = ct.R) and (cur.G = ct.G) and (cur.B = ct.B) then begin
          if RegRect.Left <> -1 then inc(RegRect.Right) else begin
            RegRect.Left := cx + X;
            RegRect.Right := RegRect.Left + 1;
            RegRect.Top := Y + VertOffset;
            RegRect.Bottom := RegRect.Top + 1;
          end;
        end
        else if RegRect.Left <> -1 then begin
          SetLength(aOR, l + 1);
          AOR[l] := RegRect;
          inc(l);
          RegRect.Left := -1;
        end;
      end;
      if RegRect.Left <> -1 then begin
        SetLength(AOR, l + 1);
        AOR[l] := RegRect;
        inc(l);
        RegRect.Left := -1;
      end;
    end;
  except
  end;
end;

function GetRgnForMask(MaskIndex, Width, Height : integer; SkinManager : TObject) : hrgn;
var
  ArOR : TAOR;
  SubRgn : hrgn;
  i, l : integer;
begin
  Result := 0;
  SetLength(ArOR, 0);
  if TsSkinManager(SkinManager).IsValidImgIndex(MaskIndex) then begin
    AddRgn(ArOR, Width, TsSkinManager(SkinManager).ma[MaskIndex], 0, False);
    if TsSkinManager(SkinManager).ma[MaskIndex].Bmp = nil
      then AddRgn(ArOR, Width, TsSkinManager(SkinManager).ma[MaskIndex], Height - (HeightOf(TsSkinManager(SkinManager).ma[MaskIndex].R) div (3 * (1 + TsSkinManager(SkinManager).ma[MaskIndex].MaskType))), True)
      else AddRgn(ArOR, Width, TsSkinManager(SkinManager).ma[MaskIndex], Height - TsSkinManager(SkinManager).ma[MaskIndex].Bmp.Height div 6, True);

    l := Length(ArOR);
    if (l > 0) then begin
      Result := CreateRectRgn(0, 0, Width, Height);
      for i := 0 to l - 1 do begin
        SubRgn := CreateRectRgn(ArOR[i].Left, ArOR[i].Top, ArOR[i].Right, ArOR[i].Bottom);
        CombineRgn(Result, Result, SubRgn, RGN_DIFF);
        DeleteObject(SubRgn);
      end;
    end
  end;
end;

procedure CopyImage(Glyph : TBitmap; ImageList: TCustomImageList; Index: Integer);
begin
  with Glyph do
  begin
    Width := ImageList.Width;
    Height := ImageList.Height;
    if ImageList.BkColor = clNone then Canvas.Brush.Color := clFuchsia else Canvas.Brush.Color := ImageList.BkColor;//! for lack of a better color
    Canvas.FillRect(Rect(0,0, Width, Height));
    ImageList.Draw(Canvas, 0, 0, Index);
  end;
end;

procedure PaintItemBG(SkinIndex : integer; const SkinSection : string; ci : TCacheInfo; State : integer; R : TRect; pP : TPoint; ItemBmp : TBitmap; SkinManager : TObject = nil; TextureIndex : integer = -1; HotTextureIndex : integer = -1; CustomColor : TColor = clFuchsia);
var
  aRect: TRect;
  TransColor : TsColor;
  iDrawed : boolean;
  TempBmp : TBitmap;

  ImagePercent, GradientPercent : integer;