sborders.pas

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

  if y < Bmp.Height - minh then begin
    FadeByMask(Rect(Bmp.Width - w, y, Bmp.Width - 1, Bmp.Height - h - 1),
               Rect(dw + 2 * w, h, dw + 3 * w - 1, 2 * h - 1),
               Bmp, Mask, Region, TransColor);
  end;


  if Filling then begin
    // Fill
    y := h;
    while y < Bmp.Height - 2 * h do begin
      x := w;
      while x < Bmp.Width - 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 < Bmp.Width - w then begin
        CopyByMask(
                 Rect(x, y, Bmp.Width - w, y + h),
                 Rect(dw + w, h, dw + 2 * w, 2 * h),
                 Bmp, Mask, EmptyCI
                );
      end;
      inc(y, h);
    end;

    x := w;
    if y < Bmp.Height - h then begin
      while x < Bmp.Width - 2 * w do begin
        CopyByMask(
                 Rect(x, y, x + w, Bmp.Height - h),
                 Rect(dw + w, h, dw + 2 * w, 2 * h),
                 Bmp, Mask, EmptyCI
                );
        inc(x, w);
      end;
      if x < Bmp.Width - w then begin
        CopyByMask(
                 Rect(x, y, Bmp.Width - w, Bmp.Height - h),
                 Rect(dw + w, h, dw + 2 * w, 2 * h),
                 Bmp, Mask, EmptyCI
                );
      end
    end;
  end;
end;

procedure BlendGlyphByMask(R1, R2 : TRect; Bmp1, Bmp2 : TBitmap; TransColor : TColor; AddedTransparency : integer);
var
  S1, S2, M : PRGBArray;
  X, Y, h, w, hdiv2: Integer;
  c, ct : TsColor;
  RegRect : TRect;
  function Div256(X: word): byte; asm
    MOV AX, X
    MOV AL, AH
    MOV AH, 0
  end;
begin
  hdiv2 := Bmp2.Height div 2;
  h := Min(HeightOf(R1), HeightOf(R2));
  h := min(h, Bmp1.Height - R1.Top - 1);
  h := min(h, hdiv2 - R2.Top - 1);
  w := Min(WidthOf(R1), WidthOf(R2));
  w := min(w, Bmp1.Width - R1.Left - 1);
  w := min(w, Bmp2.Width - R2.Left - 1);
  RegRect := Rect(-1, 0, 0, 0);
  ct.C := ColorToRGB(TransColor);
  ct.A := 0;
  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 + hdiv2 + 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 not transparent..
        if c.C <> ct.C then begin
          if AddedTransparency <> 1 then begin
            // Optimized by Serge 24.11.2003
            S1[R1.Left + X].R := Div256((S1[R1.Left + X].R - S2[R2.Left + X].R) * min(M[R2.Left + X].R + 100, 255) + S2[R2.Left + X].R * 256);
            S1[R1.Left + X].G := Div256((S1[R1.Left + X].G - S2[R2.Left + X].G) * min(M[R2.Left + X].G + 100, 255) + S2[R2.Left + X].G * 256);
            S1[R1.Left + X].B := Div256((S1[R1.Left + X].B - S2[R2.Left + X].B) * min(M[R2.Left + X].B + 100, 255) + S2[R2.Left + X].B * 256);
{
            S1[R1.Left + X].R := Div256(min((M[R2.Left + X].R + 100), 255) * S1[R1.Left + X].R) + S2[R2.Left + X].R - Div256(min((M[R2.Left + X].R + 100), 255) * S2[R2.Left + X].R);
            S1[R1.Left + X].G := Div256(min((M[R2.Left + X].G + 100), 255) * S1[R1.Left + X].G) + S2[R2.Left + X].G - Div256(min((M[R2.Left + X].G + 100), 255) * S2[R2.Left + X].G);
            S1[R1.Left + X].B := Div256(min((M[R2.Left + X].B + 100), 255) * S1[R1.Left + X].B) + S2[R2.Left + X].B - Div256(min((M[R2.Left + X].B + 100), 255) * S2[R2.Left + X].B);
}
          end
          else begin
            // 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;
      end;
    end;
  except
//    Alert('Error in BlendGlyphByMask');
  end;
end;

procedure FadeGlyphByMask(R1, R2 : TRect; Bmp1, Bmp2 : TBitmap; TransColor : TColor);
var
  S1, S2, M : PRGBArray;
  X, Y, h, w: Integer;
  c, ct : TsColor;
  RegRect : TRect;
  function Div256(X: word): byte; asm
    MOV AX, X
    MOV AL, AH
    MOV AH, 0
  end;
begin
  h := Min(HeightOf(R1), HeightOf(R2));
  h := min(h, Bmp1.Height - R1.Top - 1);
  w := Min(WidthOf(R1), WidthOf(R2));
  w := min(w, Bmp1.Width - R1.Left - 1);
  RegRect := Rect(-1, 0, 0, 0);
  ct.C := ColorToRGB(TransColor);
  ct.A := 0;
  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 c.C <> ct.C then begin
          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;
    end;
  except
  end;
end;

procedure PaintBlendGlyph(Bmp, Mask : TBitmap; p : TPoint; Mode : integer; TransColor : TColor; AddedTransparency : integer);
var
  w, h, cy, cx : integer;
  dw{, dh} : integer;
begin
  if not Assigned(Mask) then alert('PaintBlendGlyph error');

  w := Mask.Width div 3;
  h := Mask.Height div 2;

  if w >= Bmp.Width then Exit;
  if h >= Bmp.Height then Exit; //??

  dw := Mode * w;

  Bmp.PixelFormat := pf24bit;
  Mask.PixelFormat := pf24bit;

  if p.y < 0 then begin
    cy := 0 - p.y;
  end
  else cy := 0;
  if p.x < 0 then begin
    cx := 0 - p.x;
  end
  else cx := 0;
  BlendGlyphByMask(Rect(p.x + cx, p.y + cy, p.x + w - 1 + cx, p.y + h + cy - 1),
             Rect(dw + cx, cy, dw + w - 1 + cx, h - 1 + cy),
             Bmp,
             Mask, TransColor, AddedTransparency);
end;

procedure PaintRasterGlyph(Bmp, Mask : TBitmap; p : TPoint; Mode : integer; TransColor : TColor);
var
  w, h, cy, cx : integer;
  dw{, dh} : integer;
begin
  w := Mask.Width div 3;
  h := Mask.Height div 2;

  if w > Bmp.Width then Exit;
  if h > Bmp.Height then Exit;

  dw := Mode * w;

  Bmp.PixelFormat := pf24bit;
  Mask.PixelFormat := pf24bit;

  if p.y < 0 then begin
    cy := 0 - p.y;
  end
  else cy := 0;
  if p.x < 0 then begin
    cx := 0 - p.x;
  end
  else cx := 0;
  FadeGlyphByMask(Rect(p.x + cx, p.y + cy, p.x + w - 1 + cx, p.y + h + cy - 1),
             Rect(dw + cx, cy, dw + w - 1 + cx, h - 1 + cy),
             Bmp,
             Mask, TransColor);
end;

initialization
  BORD1 := TBitmap.Create;
  BORD1.LoadFromResourceName(hInstance, 'BORD1');

  BORD2 := TBitmap.Create;
  BORD2.LoadFromResourceName(hInstance, 'BORD2');

  BORD3 := TBitmap.Create;
  BORD3.LoadFromResourceName(hInstance, 'BORD3');

  BORD4 := TBitmap.Create;
  BORD4.LoadFromResourceName(hInstance, 'BORD4');

  BORD5 := TBitmap.Create;
  BORD5.LoadFromResourceName(hInstance, 'BORD5');

  BORD6 := TBitmap.Create;
  BORD6.LoadFromResourceName(hInstance, 'BORD6');

finalization
  if Assigned(Bord1) then FreeAndNil(BORD1);
  if Assigned(Bord2) then FreeAndNil(BORD2);
  if Assigned(Bord3) then FreeAndNil(BORD3);
  if Assigned(Bord4) then FreeAndNil(BORD4);
  if Assigned(Bord5) then FreeAndNil(BORD5);
  if Assigned(Bord6) then FreeAndNil(BORD6);

end.