salphagraph.pas

来自「Alpha Controls 5.40,delphi上的alpha开发源码控件包」· PAS 代码 · 共 1,529 行 · 第 1/5 页

var
  S1, S2, M : PRGBArray;
  X, Y, h, w: Integer;
  c : TsRGB;
  col : TsColor;
begin
  if MaskData.Manager = nil then Exit;
  with TsSkinManager(MaskData.Manager) do begin
    h := Min(HeightOf(R1), HeightOf(R2));
    h := Min(h, Bmp.Height - R1.Top);
    h := Min(h, TsSkinManager(MaskData.Manager).MasterBitmap.Height - R2.Top) - 1; //!!!
    if h < 0 then Exit;
    w := Min(WidthOf(R1), WidthOf(R2));
    w := Min(w, Bmp.Width - R1.Left);
    w := Min(w, MasterBitmap.Width - R2.Left) - 1; //!!!
    if w < 0 then Exit;
    if R1.Left < R2.Left then begin
      if (R1.Left < 0) then begin
        inc(R2.Left, - R1.Left);
        dec(h, - R1.Left);
        R1.Left := 0;
      end;
    end
    else
      if (R2.Left < 0) then begin
        inc(R1.Left, - R2.Left);
        dec(h, - R2.Left);
        R2.Left := 0;
      end;
    if R1.Top < R2.Top then begin
      if (R1.Top < 0) then begin
        inc(R2.Top, - R1.Top);
        dec(h, - R1.Top);
        R1.Top := 0;
      end;
    end
    else
      if (R2.Top < 0) then begin
        inc(R1.Top, - R2.Top);
        dec(h, - R2.Top);
        R2.Top := 0;
      end;
    c.R := 255; c.G := 0; c.B := 255; // clFuchsia
    col.C := CtrlParentColor;
    if not CI.Ready then begin
      for Y := 0 to h do begin
        S1 := Bmp.ScanLine[R1.Top + Y];
        S2 := MasterBitmap.ScanLine[R2.Top + Y];
        M  := MasterBitmap.ScanLine[R2.Top + HeightOf(MaskData.R) div 2 + Y];
        for X := 0 to w do begin
          if (S2[R2.Left + X].R <> c.R) or (S2[R2.Left + X].G <> c.G) or (S2[R2.Left + X].B <> c.B) then begin // v4
//          if (S2[R2.Left + X].R <> c.R) or (S2[R2.Left + X].G <> c.G) or (S2[R2.Left + X].B <> c.B) then begin // v4
            S1[R1.Left + X].R := IntToByte(((S1[R1.Left + X].R - S2[R2.Left + X].R) * M[R2.Left + X].R + S2[R2.Left + X].R shl 8) shr 8);
            S1[R1.Left + X].G := IntToByte(((S1[R1.Left + X].G - S2[R2.Left + X].G) * M[R2.Left + X].G + S2[R2.Left + X].G shl 8) shr 8);
            S1[R1.Left + X].B := IntToByte(((S1[R1.Left + X].B - S2[R2.Left + X].B) * M[R2.Left + X].B + S2[R2.Left + X].B shl 8) shr 8);
          end
          else if CtrlParentColor <> clFuchsia then begin
            S1[R1.Left + X].R := col.R;
            S1[R1.Left + X].G := col.G;
            S1[R1.Left + X].B := col.B;
          end;
        end;
      end;
    end
    else begin
      if ci.Bmp.PixelFormat = pf24bit then begin
        if Fast24Src.Attach(ci.Bmp) then for Y := 0 to h do begin
          S1 := Bmp.ScanLine[R1.Top + Y];
          S2 := MasterBitmap.ScanLine[R2.Top + Y];
          M  := MasterBitmap.ScanLine[R2.Top + HeightOf(MaskData.R) div 2 + Y];
          for X := 0 to w do begin
            if (S2[R2.Left + X].R <> c.R) or (S2[R2.Left + X].G <> c.G) or (S2[R2.Left + X].B <> c.B) then begin
              S1[R1.Left + X].R := IntToByte(((S1[R1.Left + X].R - S2[R2.Left + X].R) * M[R2.Left + X].R + S2[R2.Left + X].R shl 8) shr 8);
              S1[R1.Left + X].G := IntToByte(((S1[R1.Left + X].G - S2[R2.Left + X].G) * M[R2.Left + X].G + S2[R2.Left + X].G shl 8) shr 8);
              S1[R1.Left + X].B := IntToByte(((S1[R1.Left + X].B - S2[R2.Left + X].B) * M[R2.Left + X].B + S2[R2.Left + X].B shl 8) shr 8);
            end
            else if CtrlParentColor <> clFuchsia then begin
              S1[R1.Left + X].R := col.R;
              S1[R1.Left + X].G := col.G;
              S1[R1.Left + X].B := col.B;
            end
            else begin
              if (CI.Bmp.Height <= R1.Top + ci.Y + Y) then Continue;
              if (CI.Bmp.Width <= R1.Left + ci.X + X) then Break;
              if R1.Top + ci.Y + Y < 0 then Continue;//Break;
              if R1.Left + ci.X + X < 0 then Continue;
              col := Fast24Src.Pixels[R1.Left + ci.X + X, R1.Top + ci.Y + Y];// GetPixel(ci.Bmp.Canvas.Handle, R1.Left + ci.X + X, R1.Top + ci.Y + Y);
              S1[R1.Left + X].R := col.R;
              S1[R1.Left + X].G := col.G;
              S1[R1.Left + X].B := col.B;
            end;
          end;
        end;
      end
      else if ci.Bmp.PixelFormat = pf32bit then begin
        if Fast32Src.Attach(ci.Bmp) then for Y := 0 to h do begin
          S1 := Bmp.ScanLine[R1.Top + Y];
          S2 := MasterBitmap.ScanLine[R2.Top + Y];
          M  := MasterBitmap.ScanLine[R2.Top + HeightOf(MaskData.R) div 2 + Y];
          for X := 0 to w do begin
            if (S2[R2.Left + X].R <> c.R) or (S2[R2.Left + X].G <> c.G) or (S2[R2.Left + X].B <> c.B) then begin
              S1[R1.Left + X].R := IntToByte(((S1[R1.Left + X].R - S2[R2.Left + X].R) * M[R2.Left + X].R + S2[R2.Left + X].R shl 8) shr 8);
              S1[R1.Left + X].G := IntToByte(((S1[R1.Left + X].G - S2[R2.Left + X].G) * M[R2.Left + X].G + S2[R2.Left + X].G shl 8) shr 8);
              S1[R1.Left + X].B := IntToByte(((S1[R1.Left + X].B - S2[R2.Left + X].B) * M[R2.Left + X].B + S2[R2.Left + X].B shl 8) shr 8);
            end
            else if CtrlParentColor <> clFuchsia then begin
              S1[R1.Left + X].R := col.R;
              S1[R1.Left + X].G := col.G;
              S1[R1.Left + X].B := col.B;
            end
            else begin
              if (CI.Bmp.Height <= R1.Top + ci.Y + Y) then Continue;
              if (CI.Bmp.Width <= R1.Left + ci.X + X) then Break;
              if R1.Top + ci.Y + Y < 0 then Continue;//Break;
              if R1.Left + ci.X + X < 0 then Continue;
              col := Fast32Src.Pixels[R1.Left + ci.X + X, R1.Top + ci.Y + Y];// GetPixel(ci.Bmp.Canvas.Handle, R1.Left + ci.X + X, R1.Top + ci.Y + Y);
              S1[R1.Left + X].R := col.R;
              S1[R1.Left + X].G := col.G;
              S1[R1.Left + X].B := col.B;
            end;
          end;
        end;
      end
    end;
  end;
end;

procedure CopyMasterRectA(R1, R2 : TRect; Bmp : TBitmap; CI : TCacheInfo; MaskData : TsMaskData);
var
  S1, S2, M : PRGBArray;
  X, Y, h, w: Integer;
  c : TsRGB;
  col : TsColor;
begin
  if MaskData.Manager = nil then Exit;
  with TsSkinManager(MaskData.Manager) do begin
    h := Min(HeightOf(R1), HeightOf(R2));
    h := Min(h, Bmp.Height - R1.Top);
    h := Min(h, MasterBitmap.Height - R2.Top) - 1; //!!!
    if h < 0 then Exit;
    w := Min(WidthOf(R1), WidthOf(R2));
    w := Min(w, Bmp.Width - R1.Left);
    w := Min(w, MasterBitmap.Width - R2.Left) - 1; //!!!
    if w < 0 then Exit;
    if R1.Left < R2.Left then begin
      if (R1.Left < 0) then begin
        inc(R2.Left, - R1.Left);
        dec(h, - R1.Left);
        R1.Left := 0;
      end;
    end
    else
      if (R2.Left < 0) then begin
        inc(R1.Left, - R2.Left);
        dec(h, - R2.Left);
        R2.Left := 0;
      end;
    if R1.Top < R2.Top then begin
      if (R1.Top < 0) then begin
        inc(R2.Top, - R1.Top);
        dec(h, - R1.Top);
        R1.Top := 0;
      end;
    end
    else
      if (R2.Top < 0) then begin
        inc(R1.Top, - R2.Top);
        dec(h, - R2.Top);
        R2.Top := 0;
      end;
    c.R := 255; c.G := 0; c.B := 255; // clFuchsia
    col.C := CtrlParentColor;
    if not CI.Ready then for Y := 0 to h do begin
      S1 := Bmp.ScanLine[R1.Top + Y];
      S2 := MasterBitmap.ScanLine[R2.Top + Y];
      M  := MasterBitmap.ScanLine[R2.Top + HeightOf(MaskData.R) div 2 + Y];
      for X := 0 to w do if (S2[R2.Left + X].R <> c.R) or (S2[R2.Left + X].G <> c.G) or (S2[R2.Left + X].B <> c.B) then begin // v4
        S1[R1.Left + X].R := IntToByte(((S1[R1.Left + X].R - S2[R2.Left + X].R) * M[R2.Left + X].R + S2[R2.Left + X].R shl 8) shr 8);
        S1[R1.Left + X].G := IntToByte(((S1[R1.Left + X].G - S2[R2.Left + X].G) * M[R2.Left + X].G + S2[R2.Left + X].G shl 8) shr 8);
        S1[R1.Left + X].B := IntToByte(((S1[R1.Left + X].B - S2[R2.Left + X].B) * M[R2.Left + X].B + S2[R2.Left + X].B shl 8) shr 8);
      end;
    end
    else for Y := 0 to h do begin
      S1 := Bmp.ScanLine[R1.Top + Y];
      S2 := MasterBitmap.ScanLine[R2.Top + Y];
      M  := MasterBitmap.ScanLine[R2.Top + HeightOf(MaskData.R) div 2 + Y];
      for X := 0 to w do if (S2[R2.Left + X].R <> c.R) or (S2[R2.Left + X].G <> c.G) or (S2[R2.Left + X].B <> c.B) then begin
        S1[R1.Left + X].R := IntToByte(((S1[R1.Left + X].R - S2[R2.Left + X].R) * M[R2.Left + X].R + S2[R2.Left + X].R shl 8) shr 8);
        S1[R1.Left + X].G := IntToByte(((S1[R1.Left + X].G - S2[R2.Left + X].G) * M[R2.Left + X].G + S2[R2.Left + X].G shl 8) shr 8);
        S1[R1.Left + X].B := IntToByte(((S1[R1.Left + X].B - S2[R2.Left + X].B) * M[R2.Left + X].B + S2[R2.Left + X].B shl 8) shr 8);
      end;
    end;
  end;
end;

procedure DrawSkinGlyph(Bmp : TBitmap; P : TPoint; State, AddedTransparency : integer; MaskData : TsMaskData);
var
  w, h, cy, cx : integer;
  dw : integer;
  c : TsColor;
begin
  w := WidthOf(MaskData.R) div MaskData.ImageCount;
  h := HeightOf(MaskData.R) div (1 + MaskData.MaskType);

  if State > MaskData.ImageCount - 1 then State := MaskData.ImageCount - 1;
  dw := State * w;                  
  if p.y < 0 then cy := - p.y else cy := 0;
  if p.x < 0 then cx := - p.x else cx := 0;

  if MaskData.Bmp = nil then with TsSkinManager(MaskData.Manager) do begin
    if MaskData.Manager = nil then Exit;
    if MaskData.ImageCount = 0 then Exit;

    if (MaskData.MaskType > 0) then begin
      BlendGlyphByMask(Rect(p.x + cx, p.y + cy, p.x + w - 1 + cx, p.y + h + cy - 1),
               Rect(dw + cx + MaskData.R.Left, cy + MaskData.R.Top, dw + w - 1 + cx + MaskData.R.Left, h - 1 + cy + MaskData.R.Top),
               Bmp, MasterBitmap, clFuchsia, AddedTransparency, MaskData);
    end
    else begin
      c.C := clFuchsia;
      if AddedTransparency <> 1 then begin
        BlendTransRectangle(Bmp, p.x + cx, p.y + cy, MasterBitmap,
          Rect(dw + cx + MaskData.R.Left, cy + MaskData.R.Top, dw + cx + MaskData.R.Left + w - 1, cy + MaskData.R.Top + h - 1),
          0.5, c);
      end
      else
        CopyTransRect(Bmp, MasterBitmap, p.x + cx, p.y + cy,
          Rect(dw + cx + MaskData.R.Left, cy + MaskData.R.Top, dw + cx + MaskData.R.Left + w - 1, cy + MaskData.R.Top + h - 1),
          clFuchsia, EmptyCI, True);
    end;
  end
  else begin
    BlendGlyphByMask(Rect(p.x + cx, p.y + cy, p.x + w - 1 + cx, p.y + h + cy - 1),
               Rect(dw + cx + MaskData.R.Left, cy + MaskData.R.Top, dw + w - 1 + cx + MaskData.R.Left, h - 1 + cy + MaskData.R.Top),
               Bmp, MaskData.Bmp, clFuchsia, AddedTransparency, MaskData);
  end;
end;

procedure BlendGlyphByMask(R1, R2 : TRect; Bmp1, Bmp2 : TBitmap; TransColor : TColor; AddedTransparency : integer; MaskData : TsMaskData);
var
  S1, S2, M : PRGBArray;
  X, Y, h, w, hdiv2: Integer;
  c, ct : TsColor;
  RegRect : TRect;
begin
//  hdiv2 := HeightOf(MaskData.R);
//  if MaskData.MaskType > 0 then hdiv2 := hdiv2 div 2 else hdiv2 := 0;
//  if MaskData.MaskType > 0 then
  hdiv2 := HeightOf(MaskData.R) div (MaskData.MaskType + 1);//2 else hdiv2 := Bmp2.Height div 2;
//  if MaskData.MaskType > 0 then hdiv2 := HeightOf(MaskData.R) div 2 else hdiv2 := Bmp2.Height div 2;
  h := Min(HeightOf(R1), HeightOf(R2));
  h := min(h, Bmp1.Height - R1.Top - 1);

  if MaskData.ImageCount < 1 then h := min(h, hdiv2 - R2.Top - 1);
  w := Min(WidthOf(R1), WidthOf(R2));
  w := min(w, Bmp1.Width - R1.Left - 1);

  if MaskData.ImageCount < 1 then w := min(w, Bmp2.Width - R2.Left - 1);
  RegRect := Rect(-1, 0, 0, 0);
  ct.C := ColorToRGB(clFuchsia);

  if MaskData.MaskType = 0 then begin
    CopyTransRectA(Bmp1, Bmp2, R1.Left, R1.Top, R2, clFuchsia, EmptyCI);
  end
  else try
    c.A := 0;
    if R2.Top + h > Bmp2.Height then Exit;
    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.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
            S1[R1.Left + X].R := IntToByte(((S1[R1.Left + X].R - S2[R2.Left + X].R) * min(M[R2.Left + X].R + 100, 255) + S2[R2.Left + X].R shl 8) shr 8);
            S1[R1.Left + X].G := IntToByte(((S1[R1.Left + X].G - S2[R2.Left + X].G) * min(M[R2.Left + X].G + 100, 255) + S2[R2.Left + X].G shl 8) shr 8);
            S1[R1.Left + X].B := IntToByte(((S1[R1.Left + X].B - S2[R2.Left + X].B) * min(M[R2.Left + X].B + 100, 255) + S2[R2.Left + X].B shl 8) shr 8);
          end
          else begin
            S1[R1.Left + X].R := IntToByte(((S1[R1.Left + X].R - S2[R2.Left + X].R) * M[R2.Left + X].R + S2[R2.Left + X].R shl 8) shr 8);
            S1[R1.Left + X].G := IntToByte(((S1[R1.Left + X].G - S2[R2.Left + X].G) * M[R2.Left + X].G + S2[R2.Left + X].G shl 8) shr 8);
            S1[R1.Left + X].B := IntToByte(((S1[R1.Left + X].B - S2[R2.Left + X].B) * M[R2.Left + X].B + S2[R2.Left + X].B shl 8) shr 8);
          end;
        end;
      end;
    end;
  except end;
end;

procedure UpdateCorners(SkinData : TsCommonData; State : integer);
begin
  UpdateCorners(SkinData, State, [scLeftTop, scLeftBottom, scRightTop, scRightBottom]);
end;

procedure UpdateCorners(SkinData : TsCommonData; State : integer; Corners : TsCorners);
var
  w, Width, Height : integer;
  dw, dh : integer;
  MaskData : TsMaskData;
  CI : TCacheInfo;
  ParentRGB : TsRGB;
  ParentColor : TsColor;