sgraphutils.pas

Alpha Controls 5.40,delphi上的alpha开发源码控件包。没有密码。5.40版的最新版。

  var
    bmp : TBitmap;
    R : TRect;
  begin
    iDrawed := False;
    R := aRect;
    // BGImage painting
    if (ImagePercent > 0) then with TsSkinManager(SkinManager) do begin
      if IsJpg then begin
        if (PatternIndex > -1) and (PatternIndex < Length(pa)) then begin
          TileBitmap(aBmp.Canvas, R, pa[PatternIndex].Img, md);
          iDrawed := True;
        end;
      end
      else if (PatternIndex > -1) and (PatternIndex < Length(ma)) then begin
        if boolean(ma[PatternIndex].MaskType)
          then TileMasked(aBmp, R, CI, ma[PatternIndex], acFillModes[ma[PatternIndex].DrawMode])
          else TileBitmap(aBmp.Canvas, R, ma[PatternIndex].Bmp, ma[PatternIndex], acFillModes[ma[PatternIndex].DrawMode]);
        iDrawed := True;
      end;
      if R.Right <> -1 then FillDC(aBmp.Canvas.Handle, R, Color);
    end;
    // BGGradient painting
    if (GradientPercent > 0) then begin
      if iDrawed then begin
        bmp := CreateBmp24(WidthOf(aRect), HeightOf(aRect));
        try
          if Length(GradientData) > 0
            then PaintGrad(Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), GradientArray)
            else FillDC(Bmp.Canvas.Handle, aRect, Color);

          TransColor.A := 0;
          TransColor.R := IntToByte((ImagePercent * 255) div 100); TransColor.G := TransColor.R; TransColor.B := TransColor.R;
          SumBmpRect(aBmp, Bmp, TransColor, Rect(0, 0, Bmp.Width - 1, Bmp.Height{ - 1}), Point(aRect.Left, aRect.Top));
        finally
          FreeAndNil(Bmp);
        end;
      end
      else if Length(GradientData) > 0 then PaintGrad(aBmp, aRect, GradientArray) else FillDC(aBmp.Canvas.Handle, aRect, Color);
    end;
    case GradientPercent + ImagePercent of
      1..99 : BlendColorRect(aBmp, aRect, GradientPercent + ImagePercent, Color);
      0 : if (ParentCenterColor <> clFuchsia) and (Transparency <> 0)
        then FillDC(aBmp.Canvas.Handle, aRect, ParentCenterColor)
        else FillDC(aBmp.Canvas.Handle, aRect, Color);
    end;
  end;
begin
  if SkinManager = nil then SkinManager := DefaultManager;
  if not Assigned(DefaultManager) or not TsSkinManager(SkinManager).IsValidSkinIndex(SkinIndex) then Exit;
  with TsSkinManager(SkinManager) do begin {SeeLater}
    aRect := R;
    IsJpg := False;

    case State of
      0 : begin
        if CustomColor = clFuchsia then Color := gd[SkinIndex].Color else Color := CustomColor;
        ImagePercent := gd[SkinIndex].ImagePercent;
        GradientPercent := gd[SkinIndex].GradientPercent;
        if (ImagePercent > 0) then begin
          if TextureIndex <> -1 then begin
            if ma[TextureIndex].MaskType = 0 then PatternIndex := TextureIndex
          end else PatternIndex := GetMaskIndex(SkinIndex, SkinSection, s_PatternFile);
          if not TsSkinManager(SkinManager).IsValidImgIndex(PatternIndex) then begin PatternIndex := GetPatternIndex(SkinIndex, SkinSection, s_PatternFile); IsJpg := PatternIndex > -1 end;
        end;
        if GradientPercent <> 0 then begin GradientData := gd[SkinIndex].GradientData; GradientArray := gd[SkinIndex].GradientArray end;
        Transparency := gd[SkinIndex].Transparency;
      end
      else begin
        if CustomColor = clFuchsia then Color := gd[SkinIndex].HotColor else Color := CustomColor;
        ImagePercent := TsSkinManager(SkinManager).gd[SkinIndex].HotImagePercent;
        GradientPercent := gd[SkinIndex].HotGradientPercent;
        if (ImagePercent > 0) then begin
          if HotTextureIndex <> -1 then begin
            if TsSkinManager(SkinManager).ma[HotTextureIndex].MaskType = 0 then PatternIndex := HotTextureIndex
          end else PatternIndex := GetMaskIndex(SkinIndex, SkinSection, s_HotPatternFile);
          if not TsSkinManager(SkinManager).IsValidImgIndex(PatternIndex) then begin PatternIndex := GetPatternIndex(SkinIndex, SkinSection, s_HotPatternFile); IsJpg := PatternIndex > -1 end;
        end;
        if GradientPercent <> 0 then begin GradientData := gd[SkinIndex].HotGradientData; GradientArray := gd[SkinIndex].HotGradientArray end;
        Transparency := gd[SkinIndex].HotTransparency;
      end;
    end;
    if ci.Ready then case Transparency of
      100 : begin
        if ci.Ready then begin
          if ItemBmp <> ci.Bmp then begin
            if (ParentCenterColor = clFuchsia) {and (ci.Bmp.Width > ItemBmp.Width - 1)} // If BG not filled by one color
              then BitBlt(ItemBmp.Canvas.Handle, aRect.Left, aRect.Top, WidthOf(aRect), HeightOf(aRect), ci.Bmp.Canvas.Handle, ci.X + pP.X, ci.Y + pP.Y, SRCCOPY)
              else FillDC(ItemBmp.Canvas.Handle, aRect, ParentCenterColor);
          end;
        end
        else if ParentCenterColor <> clFuchsia then FillDC(ItemBmp.Canvas.Handle, aRect, ParentCenterColor);
      end;
      0 : PaintAddons(ItemBmp);
      else begin
        TempBmp := CreateBmp24(WidthOf(aRect), HeightOf(aRect));
        try
          OffsetRect(aRect, - aRect.Left, - aRect.Top);
          PaintAddons(TempBmp);
          aRect := R;
          TransColor.A := 0; TransColor.R := IntToByte(Transparency * 255 div 100); TransColor.G := TransColor.R; TransColor.B := TransColor.R;

          if ci.Bmp <> ItemBmp then begin
            if ParentCenterColor = clFuchsia
              then BitBlt(ItemBmp.Canvas.Handle, R.Left, R.Top, WidthOf(R), HeightOf(R), ci.Bmp.Canvas.Handle, ci.X + pP.X, ci.Y + pP.y, SRCCOPY)
              else FillDC(ItemBmp.Canvas.Handle, R, ParentCenterColor);
          end;

          SumBmpRect(ItemBmp, TempBmp, TransColor, Rect(0, 0, WidthOf(aRect), HeightOf(aRect)), Point(aRect.Left, aRect.Top));
        finally
          FreeAndNil(TempBmp);
        end;
      end;
    end else PaintAddons(ItemBmp);
    case State of
      0 : if (TextureIndex <> -1) and (ma[TextureIndex].MaskType > 0) then begin
        if (ma[TextureIndex].DrawMode in [ord(fmDisTiled)]) then begin
          TileMasked(ItemBmp, R, ci, ma[TextureIndex], acFillModes[ma[TextureIndex].DrawMode])
        end;
      end
      else if (HotTextureIndex <> -1) and (ma[HotTextureIndex].MaskType > 0) then begin
        if (ma[HotTextureIndex].DrawMode in [ord(fmDisTiled)]) then begin
          TileMasked(ItemBmp, R, ci, ma[HotTextureIndex], acFillModes[ma[HotTextureIndex].DrawMode])
        end;
      end;
    end;
  end;
end;

procedure PaintItemBG(SkinData : TsCommonData; ci : TCacheInfo; State : integer; R : TRect; pP : TPoint; ItemBmp : TBitmap; OffsetX : integer = 0; OffsetY : integer = 0); overload;
var
  CustomColor : TColor;
begin
  if SkinData.CustomColor then begin // If custom color used
    if SkinData.FOwnerObject is TsSkinProvider
      then CustomColor := ColorToRGB(TsHackedControl(TsSkinProvider(SkinData.FOwnerObject).Form).Color)
      else if (SkinData.FOwnerControl <> nil)
        then CustomColor := ColorToRGB(TsHackedControl(SkinData.FOwnerControl).Color)
        else CustomColor := clFuchsia;
  end else CustomColor := clFuchsia;
  PaintItemBG(SkinData.SkinIndex, SkinData.SkinSection, ci, State, R, pP, ItemBmp, SkinData.SkinManager, SkinData.Texture, SkinData.HotTexture, CustomColor);
end;

procedure PaintItemBGFast(SkinIndex, BGIndex, BGHotIndex : integer; const SkinSection : string; ci : TCacheInfo; State : integer; R : TRect; pP : TPoint; ItemBmp : TBitmap; SkinManager : TObject = nil);
var
  aRect: TRect;
  TransColor : TsColor;
  iDrawed : boolean;
  TempBmp : TBitmap;

  ImagePercent, GradientPercent : integer;
  PatternIndex, Transparency : integer;
  GradientData : string;
  GradientArray : TsGradArray;
  Color : TColor;
  Isjpg : boolean;
  md : TsMaskData;

  procedure PaintAddons(var aBmp : TBitmap);
  var
    bmp : TBitmap;
    R : TRect;
  begin
    iDrawed := False;
    R := aRect;
    // BGImage painting
    if (ImagePercent > 0) then with TsSkinManager(SkinManager) do begin
      if IsJpg then begin
        if (PatternIndex > -1) and (PatternIndex < Length(pa)) then begin
          TileBitmap(aBmp.Canvas, R, pa[PatternIndex].Img, md);
          iDrawed := True;
        end;
      end
      else if (PatternIndex > -1) and (PatternIndex < Length(ma)) then begin
        if boolean(ma[PatternIndex].MaskType)
          then TileMasked(aBmp, R, CI, ma[PatternIndex], acFillModes[ma[PatternIndex].DrawMode])
          else TileBitmap(aBmp.Canvas, R, ma[PatternIndex].Bmp, ma[PatternIndex], acFillModes[ma[PatternIndex].DrawMode]);
        iDrawed := True;
      end;
      if R.Right <> -1 then FillDC(aBmp.Canvas.Handle, R, Color);
    end;
    // BGGradient painting
    if (GradientPercent > 0) then begin
      if iDrawed then begin
        bmp := CreateBmp24(WidthOf(aRect), HeightOf(aRect));
        try                                                
          if Length(GradientData) > 0
            then PaintGrad(Bmp, Rect(0, 0, Bmp.Width, Bmp.Height), GradientArray)
            else FillDC(Bmp.Canvas.Handle, aRect, Color);

          TransColor.A := 0;
          TransColor.R := ImagePercent * 256 div 100; TransColor.G := TransColor.R; TransColor.B := TransColor.R;
          SumBmpRect(aBmp, Bmp, TransColor, Rect(0, 0, Bmp.Width - 1, Bmp.Height{ - 1}), Point(aRect.Left, aRect.Top));
        finally
          FreeAndNil(Bmp);
        end;
      end
      else begin
        if Length(GradientData) > 0 then begin
          PaintGrad(aBmp, aRect, GradientArray);
        end
        else FillDC(aBmp.Canvas.Handle, aRect, Color);
      end;
    end;
    case GradientPercent + ImagePercent of
      1..99 : BlendColorRect(aBmp, aRect, GradientPercent + ImagePercent, Color);
      100 :
      else begin
        if (ParentCenterColor <> clFuchsia) and (Transparency <> 0)
          then FillDC(aBmp.Canvas.Handle, aRect, ParentCenterColor)
          else FillDC(aBmp.Canvas.Handle, aRect, Color);
      end;
    end;
  end;
begin
  if SkinManager = nil then SkinManager := DefaultManager;
  if not Assigned(DefaultManager) or not TsSkinManager(SkinManager).IsValidSkinIndex(SkinIndex) then Exit;
  with TsSkinManager(SkinManager) do begin

  aRect := R;
  IsJpg := False;
  // Properties definition from skin file
  case State of
    0 : begin
      Color := gd[SkinIndex].Color;
      ImagePercent := gd[SkinIndex].ImagePercent;
      GradientPercent := gd[SkinIndex].GradientPercent;
      PatternIndex := BGIndex;
      if GradientPercent <> 0 then begin
        GradientData := gd[SkinIndex].GradientData;
        GradientArray := gd[SkinIndex].GradientArray;
      end;
      Transparency := gd[SkinIndex].Transparency;
    end
    else begin
      Color := gd[SkinIndex].HotColor;
      ImagePercent := gd[SkinIndex].HotImagePercent;
      GradientPercent := gd[SkinIndex].HotGradientPercent;
      PatternIndex := BGHotIndex;
      if GradientPercent <> 0 then begin
        GradientData := gd[SkinIndex].HotGradientData;
        GradientArray := gd[SkinIndex].HotGradientArray;
      end;
      Transparency := gd[SkinIndex].HotTransparency;
    end;
  end;

  if ci.Ready and (Transparency = 100) then begin
    if ItemBmp <> ci.Bmp then begin
      BitBlt(ItemBmp.Canvas.Handle, aRect.Left, aRect.Top, WidthOf(aRect), HeightOf(aRect),
        ci.Bmp.Canvas.Handle, ci.X + pP.X, ci.Y + pP.Y, SRCCOPY);
    end;
  end
  else if not ci.Ready or (Transparency = 0) then begin
    PaintAddons(ItemBmp);
  end
  else if ci.Ready and (Transparency > 0) then begin
    TempBmp := CreateBmp24(WidthOf(aRect), HeightOf(aRect));
    try
      OffsetRect(aRect, - aRect.Left, - aRect.Top);
      PaintAddons(TempBmp);
      aRect := R;
      TransColor.A := 0;
      TransColor.R := IntToByte(Transparency * 255 div 100); TransColor.G := TransColor.R; TransColor.B := TransColor.R;
      if ci.Ready and (ci.Bmp <> nil) and (ci.Bmp <> ItemBmp) then begin
        BitBlt(ItemBmp.Canvas.Handle, aRect.Left, aRect.Top, WidthOf(aRect), HeightOf(aRect),
             ci.Bmp.Canvas.Handle, ci.X + pP.X, ci.Y + pP.y, SRCCOPY);
      end;
      SumBmpRect(ItemBmp, TempBmp, TransColor, Rect(0, 0, WidthOf(aRect), HeightOf(aRect)), Point(aRect.Left, aRect.Top));
    finally
      FreeAndNil(TempBmp);
    end;
  end;
  end;
end;

procedure PaintItem(SkinIndex : integer; const SkinSection : string; ci : TCacheInfo; Filling : boolean; State : integer; R : TRect; pP : TPoint; DC : HDC; SkinManager : TObject = nil); overload;
var
  TempBmp : TBitmap;
  SavedDC : HDC;
begin
  if (SkinManager = nil) then SkinManager := DefaultManager;
  if not Assigned(SkinManager) or not TsSkinManager(SkinManager).IsValidSkinIndex(SkinIndex) or (R.Left < 0) or (R.Top < 0) or (WidthOf(r) < 1) or (HeightOf(r) < 1) then Exit;
  SavedDC := SaveDC(DC);
  TempBmp := CreateBmp24(WidthOf(r), HeightOf(r));
  try
    PaintItem(SkinIndex, SkinSection, ci, Filling, State, Rect(0, 0, TempBmp.Width, TempBmp.Height), pP, TempBmp, SkinManager);
    BitBlt(DC, r.Left, r.top, WidthOf(r), HeightOf(r), TempBmp.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    FreeAndNil(TempBmp);
    RestoreDC(DC, SavedDC);
  end;
end;

procedure PaintItem(SkinIndex : integer; const SkinSection : string; ci : TCacheInfo; Filling : boolean; State : integer; R : TRect; pP : TPoint; ItemBmp : TBitmap; SkinManager : TObject = nil; BGIndex : integer = -1; BGHotIndex : integer = -1); overload;
var
  i : integer;
begin
  if (ItemBmp = nil) or (R.Left >= R.Right) or (R.Top >= R.Bottom) then Exit;
  if (SkinManager = nil) then SkinManager := DefaultManager;
  if not Assigned(SkinManager) or not TsSkinManager(SkinManager).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, SkinManager, BGIndex, BGHotIndex);
  i := TsSkinManager(SkinManager).GetMaskIndex(SkinIndex, SkinSection, s_BordersMask);
  inc(ci.X, pP.X);
  inc(ci.Y, pP.Y);
  if TsSkinManager(SkinManager).IsValidImgIndex(i) then DrawSkinRect(ItemBmp, R, Filling, ci, TsSkinManager(SkinManager).ma[i], State, True);
end;

procedure PaintItemFast(SkinIndex, MaskIndex, BGIndex, BGHotIndex : integer; const SkinSection : string; var ci : TCacheInfo; Filling : boolean; State : integer; R : TRect; pP : TPoint; ItemBmp : TBitmap; SkinManager : TObject = nil); overload;
begin
  if SkinManager = nil then SkinManager := DefaultManager;
  if not Assigned(SkinManager) or not TsSkinManager(SkinManager).IsValidSkinIndex(SkinIndex) then Exit;
  if (R.Bottom > ItemBmp.Height) or (R.Right > ItemBmp.Width) or (R.Left < 0) or (R.Top < 0) then Exit;