sgraphutils.pas

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

    RestoreDC(DC, SavedDC);
  end;
end;

procedure PaintItem(SkinIndex : integer; SkinSection : string; ci : TCacheInfo; Filling : boolean; State : integer; R : TRect; pP : TPoint; ItemBmp : TBitmap); overload;
var
  i : integer;
begin
  if not IsValidSkinIndex(SkinIndex) or (R.Bottom > ItemBmp.Height) or (R.Right > ItemBmp.Width) or (R.Left < 0) or (R.Top < 0) then Exit;
  PaintItemBG(SkinIndex, SkinSection, ci, State, R, pP, ItemBmp);
  i := GetMaskIndex(SkinIndex, SkinSection, BordersMask);
  inc(ci.X, pP.X); // Experimental
  inc(ci.Y, pP.Y); // Experimental
  if IsValidImgIndex(i) then DrawMaskRect(ItemBmp, ma[i].Bmp, State, R, ma[i].TransparentColor, Filling, ci);
end;

procedure PaintControl(SkinIndex, BorderIndex : integer; SkinSection : string; ci : TCacheInfo; Filling : boolean; State : integer; pP : TPoint; ItemBmp : TBitmap; Rgn : hrgn);
var
  R : TRect;
begin
  if IsValidSkinIndex(SkinIndex) then begin
    PaintItemBG(SkinIndex, SkinSection, ci, State, Rect(0, 0, ItemBmp.Width, ItemBmp.Height), pP, ItemBmp);
    if IsValidImgIndex(BorderIndex) then begin
      PaintRasterBorder(ItemBmp, ma[BorderIndex].Bmp, State, Rgn, ma[BorderIndex].TransparentColor, Filling);
    end
    else begin
      R := Rect(0, 0, ItemBmp.Width, ItemBmp.Height);
      PaintSimplySkinBorder(SkinIndex, State, R, Itembmp.Canvas.Handle);
    end;
  end;
end;

procedure PaintSimplySkinBorder(SkinIndex : integer; State : integer; Rect : TRect; DC : hdc);
var
  R: TRect;
  i, bw : integer;
  Color1, Color2, ct, cb : TColor;
  cbev : TsBorderStyle;
  procedure DrawRect; begin
    DrawRectangleOnDC(DC, R, ColorToRGB(Color1), ColorToRGB(Color2), i);
  end;
begin
  ct := ColorToRGB(gd[SkinIndex].PaintingColorBorderTop);
  cb := ColorToRGB(gd[SkinIndex].PaintingColorBorderBottom);

  Color1 := ct;
  Color2 := cb;
  R := Rect;
  if (State = 1) then begin
    bw := gd[SkinIndex].HotPaintingBevelWidth;
    if ord(gd[SkinIndex].HotPaintingBevel) > 3 then gd[SkinIndex].HotPaintingBevel := cbRaisedHard; // Check of "out of range" error 21.12.2003 Serge 
    cbev := BevelsArray[ord(gd[SkinIndex].HotPaintingBevel)];

    BeveledBorder(DC, Color1,
                    Color2,
                    gd[SkinIndex].HotPaintingColor, R,
                    bw,
                    cbev, True);
    if (bw > 1) then begin
      i := 1;
      Color1 := clBtnShadow;
      Color2 := clWhite;
      DrawRect;
      i := 1;
      Color1 := cl3DDkShadow;
      Color2 := cl3DLight;
      R := Rect;
      InflateRect(R, - 1, - 1);
      DrawRect;
    end;
  end
  else begin
    bw := gd[SkinIndex].PaintingBevelWidth;
     if ord(gd[SkinIndex].PaintingBevel) > 3 then gd[SkinIndex].PaintingBevel := cbRaisedHard; // Check of "out of range" error 21.12.2003 Serge 
    cbev := BevelsArray[ord(gd[SkinIndex].PaintingBevel)];
    BeveledBorder(dc, ct, cb, gd[SkinIndex].PaintingColor, R, bw, cbev, True);
  end;
end;

procedure FillMaskedBorderH(Bmp, Mask : TBitmap; Mode : integer; Dst, Src : TRect; TransColor : TColor);
var
  x : integer;
  w : integer;
begin
  w := WidthOf(Src);

  x := Dst.Left;
  while x < Dst.Right - w do begin
    CopyByMask(
               Rect(x, Dst.Top, x + w, Dst.Bottom),
               Rect(Src.Left, Src.Top, Src.Right, Src.Bottom),
               Bmp,
               Mask, EmptyCI
              );
    inc(x, w);
  end;
  if x < Dst.Right then begin
    CopyByMask(
               Rect(x, Dst.Top, Dst.Right, Dst.Bottom),
               Rect(Src.Left, Src.Top, Src.Right, Src.Bottom),
               Bmp,
               Mask, EmptyCI
              );
  end;
end;

procedure FillMaskedBorderV(Bmp, Mask : TBitmap; Mode : integer; Dst, Src : TRect; TransColor : TColor);
var
  y : integer;
  h : integer;
begin
  h := Mask.Height div 6;

  // left - middle
  y := Dst.Top;
  while y < Dst.Bottom - h do begin
    CopyByMask(
               Rect(Dst.Left, y, Dst.Right, y + h),
               Rect(Src.Left, Src.Top, Src.Right, Src.Bottom),
               Bmp,
               Mask, EmptyCI
              );
    inc(y, h);
  end;
  if y < Dst.Bottom then begin
    CopyByMask(
               Rect(Dst.Left, y, Dst.Right, Dst.Bottom),
               Rect(Src.Left, Src.Top, Src.Right, Src.Bottom),
               Bmp,
               Mask, EmptyCI
              );
  end;
end;

procedure DrawMaskedRectangle(Bmp, Mask : TBitmap; Mode : integer; Dst : TPoint; Src : TRect; TransColor : TColor);
var
  w, h : integer;
  dw : integer;
begin
  w := Mask.Width div 9;
  h := Mask.Height div 6;

  dw := Mode * 3 * w;
  // left - top
  CopyByMask(Rect(Dst.x, Dst.y, Dst.x + w, Dst.y + h),
               Rect(Src.Left + dw, Src.Top, Src.Right + dw, Src.Bottom), Bmp, Mask, EmptyCI);
end;

procedure DrawMaskRect(Bmp, Mask : TBitmap; Mode : integer; R : TRect; TransColor : TColor; Filling : boolean; ci : TCacheInfo);
var
  x, y : integer;
  w, h : integer;
  dw, dh : integer;
  mw, mh, minhp, minwp, minh, minw : integer;
begin
  if (WidthOf(R) < 2) or (HeightOf(R) < 2) then Exit;
  w := Mask.Width div 9;
  h := Mask.Height div 6;

  dw := Mode * 3 * w;
  dh := Mask.Height div 2;
  mw := 0; mh := 0;

  if WidthOf(R) < w * 2 then mw := WidthOf(R) div 2;
  if HeightOf(R) < h * 2 then mh := HeightOf(R) div 2;
  if mh > 0 then begin
    minh := mh;
    if HeightOf(R) mod 2 <> 0 then minhp := minh + 1 else minhp := minh;
  end else begin
    minh := h;
    minhp := h;
  end;
  if mw > 0 then begin
    minw := mw;
    if WidthOf(R) mod 2 <> 0 then minwp := minw + 1 else minwp := minw;
  end else begin
    minw := w;
    minwp := w;
  end;

  // left - top
  CopyByMask(Rect(R.Left, R.Top, R.Left + minw + 1, R.Top + minh + 1), Rect(dw, 0, dw + minw, minh), Bmp, Mask, ci);
  // left - middle
  y := R.Top + h;
  while y < R.Bottom - 2 * h do begin
    CopyByMask(Rect(R.Left, y, R.Left + minw + 1, y + h + 1), Rect(dw, h, dw + minw, 2 * h), Bmp, Mask, EmptyCI);
    inc(y, h);
  end;
  if y < R.Bottom - h then begin
    CopyByMask(Rect(R.Left, y, R.Left + minw, R.Bottom - h), Rect(dw, h, dw + minw, dh - h), Bmp, Mask, EmptyCI);
  end;
  // top - middle
  x := R.Left + w;
  while x < R.Right - 2 * w do begin
    CopyByMask(Rect(x, R.Top, x + w, R.Top + minh), Rect(dw + w, 0, dw + 2 * w, minh), Bmp, Mask, EmptyCI);
    inc(x, w);
  end;
  if x < R.Right - w then begin
    CopyByMask(Rect(x, R.Top, R.Right - w, R.Top + minh), Rect(dw + w, 0, dw + 2 * w, minh), Bmp, Mask, EmptyCI);
  end;
  // left - bottom
  CopyByMask(Rect(R.Left, R.Bottom - minhp, R.Left + minw, R.Bottom), Rect(dw, dh - minhp, dw + minw, dh), Bmp, Mask, CI);
  // bottom - middle
  x := R.Left + w;
  while x < R.Right - 2 * w do begin
    CopyByMask(Rect(x, R.Bottom - minhp, x + w, R.Bottom), Rect(dw + w, dh - minhp, dw + 2 * w, dh), Bmp, Mask, EmptyCI);
    inc(x, w);
  end;
  if x < R.Right - w then begin
    CopyByMask(Rect(x, R.Bottom - minhp, R.Right - w, R.Bottom), Rect(dw + w, dh - minhp, dw + 2 * w, dh), Bmp, Mask, EmptyCI);
  end;
  // right - bottom
  CopyByMask(Rect(R.Right - minwp, R.Bottom - minhp, R.Right, R.Bottom), Rect(dw + 3 * w - minwp, dh - minhp, dw + 3 * w, dh), Bmp, Mask, CI);
  // right - top
  CopyByMask(Rect(R.Right - minwp, R.Top, R.Right, R.Top + minh), Rect(dw + 3 * w - minwp, 0, dw + 3 * w, minh), Bmp, Mask, CI);
  // right - middle
  y := R.Top + h;
  while y < R.Bottom - 2 * h do begin
    CopyByMask(Rect(R.Right - minwp, y, R.Right, y + h), Rect(dw + 3 * w - minwp, h, dw + 3 * w, 2 * h), Bmp, Mask, EmptyCI);
    inc(y, h);
  end;
  if y < R.Bottom - h then begin
    CopyByMask(Rect(R.Right - minwp, y, R.Right, R.Bottom - h), Rect(dw + 3 * w - minwp, h, dw + 3 * w, 2 * h), Bmp, Mask, EmptyCI);
  end;
  // Fill
  if Filling then begin
    y := R.Top + h;
    while y < R.Bottom - 2 * h do begin
      x := R.Left + w;
      while x < R.Right - 2 * w do begin
        CopyByMask(Rect(x, y, x + w, y + h), Rect(dw + w, h, dw + 2 * w, 2 * h), Bmp, Mask, EmptyCI);
        inc(x, w);
      end;
      if x < R.Right - w then begin
        CopyByMask(Rect(x, y, R.Right - w, y + h), Rect(dw + w, h, dw + 2 * w, 2 * h), Bmp, Mask, EmptyCI);
      end;
      inc(y, h);
    end;
    x := R.Left + w;
    if y < R.Bottom - h then begin
      while x < R.Right - 2 * w do begin
        CopyByMask(Rect(x, y, x + w, R.Bottom - h), Rect(dw + w, h, dw + 2 * w, 2 * h), Bmp, Mask, EmptyCI);
        inc(x, w);
      end;
      if x < R.Right - w then begin
        CopyByMask(Rect(x, y, R.Right - w, R.Bottom - h), Rect(dw + w, h, dw + 2 * w, 2 * h), Bmp, Mask, EmptyCI);
      end
    end;
  end;
end;

procedure PaintSimplyBorder(Canvas : TCanvas; R : TRect; BGColor, ColorTop, ColorBottom : TColor; Lowered : boolean; Width : integer);
begin
  if not Lowered then begin
    BeveledBorder(Canvas.Handle, ColorToRGB(ColorTop),
                      ColorToRGB(ColorBottom),
                      ColorToRGB(BGColor), R,
                      Width,
                      sConst.bsRaised, False);
  end
  else begin
    BeveledBorder(Canvas.Handle, ColorToRGB(ColorTop),
                      ColorToRGB(ColorBottom),
                      ColorToRGB(BGColor), R,
                      1,//Width,
                      sConst.bsLowered, False);
  end;
end;

procedure DrawGlyphEx(Glyph, DstBmp : TBitmap; R : TRect; NumGlyphs : integer; Enabled, Grayed : boolean; DisabledGlyphKind : TsDisabledGlyphKind; State, Blend : integer);
var
  Bmp : TBitmap;
  {c,} MaskColor: TsColor;
  w : integer;
begin
//  IRect := ImgRect;
  Glyph.PixelFormat := pf24bit;
  case NumGlyphs of
    1 : begin
      Bmp := TBitmap.Create;
      Bmp.Assign(Glyph);
      Bmp.PixelFormat := pf24bit;
      Bmp.TransparentColor := Bmp.Canvas.Pixels[0, Bmp.Height - 1];

      try
      if not Enabled then begin
        if dgGrayed in DisabledGlyphKind then begin
          GrayScale(Bmp);
        end;
        if dgBlended in DisabledGlyphKind then begin
          MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
          BlendTransRectangle(DstBmp, R.Left, R.Top, Bmp, Rect(0, 0, WidthOf(R), HeightOf(R)), 0.5, MaskColor);
        end
        else begin
          MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);
          CopyTransBitmaps(DstBmp, Bmp, R.Left, R.Top, MaskColor);
        end;
      end
      else begin
        if (State = 0) and Grayed then begin
          GrayScale(Bmp);
        end;
        MaskColor := TsColor(Bmp.Canvas.Pixels[0, Bmp.Height - 1]);

        if (State = 0) and (Blend > 0) then begin
//          c.C := ColorToRGB(sStyle.Painting.Color);
          BlendTransRectangle(DstBmp, R.Left, R.Top, Bmp, Rect(0, 0, WidthOf(R), HeightOf(R)), Blend / 100, MaskColor);
        end
        else begin
          CopyTransBitmaps(DstBmp, Bmp, R.Left, R.Top, MaskColor);
        end;
      end;
      finally
        FreeAndNil(Bmp);
      end;
    end;
    2 : begin
      w := Glyph.Width div NumGlyphs;
      if not Enabled then begin
        CopyTransRect(DstBmp, Glyph, R.Left, R.Top, Rect(w, 0, 2 * w - 1, Glyph.Height - 1), Glyph.Canvas.Pixels[0, Glyph.Height - 1]);
      end
      else begin
        CopyTransRect(DstBmp, Glyph, R.Left, R.Top, Rect(0, 0, w - 1, Glyph.Height - 1), Glyph.Canvas.Pixels[0, Glyph.Height - 1]);
      end;
    end;
  end;
end;

function CreateDisBitmap(FOriginal: TBitmap; TransColor : TsRGB) : TBitmap;
var
  S1, S3 : PRGBArray;
  X, Y, w, h: Integer;
  GrayColor, WhiteColor, BlackColor : TsRGB;
  function Equal(c1, c2 : TsRGB) : boolean; begin Result := (c1.R = c2.R) and (c1.G = c2.G) and (c1.B = c2.B); end;
  function CurX : TsRGB; begin Result := S1[X]; end;
  function PrevX : TsRGB; begin Result := S1[X - 1]; end;
  function PxY : TsRGB; begin Result := S3[X]; end;
  function PrevY : TsRGB; begin Result := S3[X - 1]; end;
begin
  Result := TBitmap.Create;
  Result.Assign(FOriginal);
  Result.PixelFormat := pf24bit;

  GrayColor.R := 127; GrayColor.G := 126; GrayColor.B := 127;
  WhiteColor.R := 255; WhiteColor.G := 254; WhiteColor.B := 255;
  BlackColor.R := 0; BlackColor.G := 1; BlackColor.B := 0;
  w := Result.Width - 1;
  h := Result.Height - 1;

  for Y := 0 to h do begin
    S1 := Result.ScanLine[Y];
    if Y > 0 then S3 := FOriginal.ScanLine[Y - 1] else S3 := nil;

    for X := 0 to w do begin
      if Equal(CurX, TransColor) then begin
        if ((X > 0) and not Equal(PrevX, TransColor) and not Equal(PrevX, WhiteColor)) or
           ((X > 0) and (S3 <> nil) and not Equal(PrevY, TransColor) and not Equal(PrevY, TransColor))
             then begin
          S1[X] := WhiteColor;
        end;
      end
      else begin
        if (X > 0) and not Equal(PrevX, TransColor) and not Equal(PrevX, WhiteColor) and
            ((S3 <> nil) and not Equal(PxY, TransColor)) then begin
          S1[X] := BlackColor;
        end

        else if (X = w) or (Y = h) then begin
          S1[X] := WhiteColor;
        end
        else if (X = 0) then begin
          S1[X] := GrayColor;
        end
        else if not Assigned(S3) then begin
          S1[X] := GrayColor;
        end
        else if (S3 <> nil) and Equal(PxY, TransColor) then begin
          S1[X] := GrayColor;
        end
        else if (X > 0) and Equal(PrevX, TransColor) then begin
          S1[X] := GrayColor;