sborders.pas

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

unit sBorders;

interface

uses Windows, Graphics, Classes, sConst, SysUtils;

type
  TsBevelWidth = (bwThin, bwMedium, bwThick);

procedure PaintRasterBorder(Bmp, Mask : TBitmap; Mode : integer; Region : hrgn; TransColor : TColor; Filling : boolean);
procedure PaintBlendGlyph(Bmp, Mask : TBitmap; p : TPoint; Mode : integer; TransColor : TColor; AddedTransparency : integer);
procedure PaintRasterGlyph(Bmp, Mask : TBitmap; p : TPoint; Mode : integer; TransColor : TColor);
function GetBorder(sStyle : TPersistent) : TBitmap;

var
  BORD1, BORD2, BORD3, BORD4, BORD5, BORD6 : TBitmap;

implementation

uses sUtils, Math, sStyleUtil, sGraphUtils;

{$R SBORD.RES}

function GetBorder(sStyle : TPersistent) : TBitmap;
begin
  case TsActiveBGStyle(sStyle).BtnEffects.MaskedBorders.Predefined of
    pdBorder1 : begin
      Result := BORD1;
    end;
    pdBorder2 : begin
      Result := BORD2;
    end;
    pdBorder3 : begin
      Result := BORD3;
    end;
    pdBorder4 : begin
      Result := BORD4;
    end;
    pdBorder5 : begin
      Result := BORD5;
    end;
    pdBorder6 : begin
      Result := BORD6;
    end
    else begin
      if (TsActiveBGStyle(sStyle).BtnEffects.MaskedBorders.Mask.Width > 0) then begin
        Result := TsActiveBGStyle(sStyle).BtnEffects.MaskedBorders.Mask;
      end
      else begin
        Result := BORD1;
      end;
    end;
  end;
end;

procedure FadeByMask(R1, R2 : TRect; Bmp1, Bmp2 : TBitmap; Region : hrgn; TransColor : TColor);
var
  S1, S2, M : PRGBArray;
  X, Y, h, w: Integer;
  c, ct : TsColor;
  RegRect : TRect;
  fr : hrgn;
  function Div256(X: word): byte; asm
    MOV AX, X
    MOV AL, AH
    MOV AH, 0
  end;
begin
  h := Min(HeightOf(R1), HeightOf(R2));
  w := Min(WidthOf(R1), WidthOf(R2));
  RegRect := Rect(-1, 0, 0, 0);
  ct.C := ColorToRGB(TransColor);
  try
    for Y := 0 to h do begin
      S1 := Bmp1.ScanLine[R1.Top + Y];
      S2 := Bmp2.ScanLine[R2.Top + Y];
      M  := Bmp2.ScanLine[R2.Top + Bmp2.Height div 2 + Y];
      for X := 0 to w do begin
        c.A := 0;
        c.R := S2[R2.Left + X].R;
        c.G := S2[R2.Left + X].G;
        c.B := S2[R2.Left + X].B;
        // If transparent pixel..
        if c.C = ct.C then begin
          if RegRect.Left <> -1 then begin
            RegRect.Right := RegRect.Right + 1;
          end
          else begin
            RegRect.Left := R1.Left + X;
            RegRect.Right := RegRect.Left + 1;
            RegRect.Top := R1.Top + Y;
            RegRect.Bottom := RegRect.Top + 1;
          end;
        end 
        else begin
          if RegRect.Left <> -1 then begin
            fr := CreateRectRgn(RegRect.Left,
                                      RegRect.Top,
                                      RegRect.Right,
                                      RegRect.Bottom);
            CombineRgn(Region, Region, fr, RGN_XOR);
            DeleteObject(fr);
            RegRect.Left := -1;
          end;
          // Optimized by Serge 24.11.2003
          S1[R1.Left + X].R := Div256((S1[R1.Left + X].R - S2[R2.Left + X].R) * M[R2.Left + X].R + S2[R2.Left + X].R * 256);
          S1[R1.Left + X].G := Div256((S1[R1.Left + X].G - S2[R2.Left + X].G) * M[R2.Left + X].G + S2[R2.Left + X].G * 256);
          S1[R1.Left + X].B := Div256((S1[R1.Left + X].B - S2[R2.Left + X].B) * M[R2.Left + X].B + S2[R2.Left + X].B * 256);
{
          S1[R1.Left + X].R := Div256(M[R2.Left + X].R * S1[R1.Left + X].R) + S2[R2.Left + X].R - Div256(M[R2.Left + X].R * S2[R2.Left + X].R);
          S1[R1.Left + X].G := Div256(M[R2.Left + X].G * S1[R1.Left + X].G) + S2[R2.Left + X].G - Div256(M[R2.Left + X].G * S2[R2.Left + X].G);
          S1[R1.Left + X].B := Div256(M[R2.Left + X].B * S1[R1.Left + X].B) + S2[R2.Left + X].B - Div256(M[R2.Left + X].B * S2[R2.Left + X].B);
}
        end;
      end;
      if RegRect.Left <> -1 then begin
        fr := CreateRectRgn(RegRect.Left,
                                  RegRect.Top,
                                  RegRect.Right,
                                  RegRect.Bottom);
        CombineRgn(Region, Region, fr, RGN_DIFF);
        DeleteObject(fr);
        RegRect.Left := -1;
      end;
    end;
  except
  end;
end;

procedure PaintRasterBorder(Bmp, Mask : TBitmap; Mode : integer; Region : hrgn; TransColor : TColor; Filling : boolean);
var
  x, y : integer;
  w, h : integer;
  dw, dh{, i} : integer;
  mw, mh, minhp, minwp, minh, minw : integer;
begin
  if (Mask = nil) or (Bmp.Width < 3) or (Bmp.Height < 3) then Exit;
  mw := 0; mh := 0;
  w := Mask.Width div 9;
  h := Mask.Height div 6;

  // Offset for number of pict
  dw := Mode * 3 * w;
  // Offset for mask
  dh := Mask.Height div 2;

  if Bmp.Width < w * 2 then mw := Bmp.Width div 2;
  if Bmp.Height < h * 2 then mh := Bmp.Height div 2;
  if mh > 0 then begin
    minh := mh;
    if Bmp.Height mod 2 <> 0 then begin
      minhp := minh + 1;
    end
    else begin
      minhp := minh;
    end;
  end else begin
    minh := h;
    minhp := h;
  end;
  if mw > 0 then begin
    minw := mw;
    if Bmp.Width mod 2 <> 0 then begin
      minwp := minw + 1;
    end
    else begin
      minwp := minw;
    end;
  end else begin
    minw := w;
    minwp := w;
  end;

  // left - top
  FadeByMask(Rect(0, 0, minw, minh),
             Rect(dw, 0, dw + minw - 1, minh - 1),
             Bmp,
             Mask, Region, TransColor);

  // left - middle
  y := h;
  while y < Bmp.Height - 2 * minhp do begin
    FadeByMask(Rect(0, y, minw, y + h),
               Rect(dw, h, dw + minw - 1, 2 * h - 1),
               Bmp,
               Mask, Region, TransColor);
    inc(y, h);
  end;
  if y < Bmp.Height - minhp then begin
    FadeByMask(Rect(0, y, minw - 1, Bmp.Height - h - 1),
               Rect(dw, h, dw + minw, dh - h - 1),
               Bmp,
               Mask, Region, TransColor);
  end;

  // top - middle
  x := w;
  while x < Bmp.Width - 2 * minw do begin
    FadeByMask(Rect(x, 0, x + w - 1, minh - 1),
               Rect(dw + w, 0, dw + 2 * w - 1, minh - 1),
               Bmp, Mask, Region, TransColor);
    inc(x, w);
  end;
  if x < Bmp.Width - minw then begin
    FadeByMask(Rect(x, 0, Bmp.Width - minw - 1, minh - 1),
               Rect(dw + w, 0, dw + 2 * w - 1, minh - 1),
               Bmp, Mask, Region, TransColor);
  end;

  // left - bottom
  FadeByMask(Rect(0, Bmp.Height - minhp, minw - 1, Bmp.Height - 1),
             Rect(dw, dh - minhp, dw + minw - 1, dh - 1),
             Bmp, Mask, Region, TransColor);

  // bottom - middle
  x := w;
  while x < Bmp.Width - 2 * minw do begin
    FadeByMask(Rect(x, Bmp.Height - minhp, x + w - 1, Bmp.Height - 1),
               Rect(dw + w, dh - minhp, dw + 2 * w - 1, dh - 1),
               Bmp, Mask, Region, TransColor);
    inc(x, w);
  end;
  if x < Bmp.Width - minw then begin
    FadeByMask(Rect(x, Bmp.Height - minhp, Bmp.Width - w - 1, Bmp.Height - 1),
               Rect(dw + w, dh - minhp, dw + 2 * w - 1, dh - 1),
               Bmp, Mask, Region, TransColor);
  end;

  // right - bottom
  FadeByMask(Rect(Bmp.Width - minwp, Bmp.Height - minhp, Bmp.Width - 1, Bmp.Height - 1),
             Rect(dw + 3 * w - minwp, dh - minhp, dw + 3 * w - 1, dh - 1),
             Bmp, Mask, Region, TransColor);

  // right - top
  FadeByMask(Rect(Bmp.Width - minwp, 0, Bmp.Width - 1, minh - 1),
             Rect(dw + 3 * w - minwp, 0, dw + 3 * w - 1, minh - 1),
             Bmp, Mask, Region, TransColor);

  // right - middle
  y := h;
  while y < Bmp.Height - 2 * minh do begin
    FadeByMask(Rect(Bmp.Width - w, y, Bmp.Width - 1, y + h - 1),
               Rect(dw + 2 * w, h, dw + 3 * w - 1, 2 * h - 1),
               Bmp, Mask, Region, TransColor);
    inc(y, h);
  end;