shintmanager.pas

Alpha Controls 界面控件包

begin
{$IFNDEF ACHINTS}
  CtrlParentColor := ColorToRGB(clFuchsia) - 1;
  White.C := clWhite;
  Black.I := 0;
  Result := CreateBmpLike(Manager.FCacheBmp);
  PaintItemFast(SkinIndex, BorderIndex, BGIndex, BGIndex, '', EmptyCI, True, 0, Rect(0, 0, Width, Height), Point(0, 0), Result, DefaultManager);

  if Fast24Src.Attach(Result) then begin
    h := Result.Height - 1;
    w := Result.Width - 1;
    for y := 0 to h do
      for x := 0 to w do
        if Fast24Src.Pixels[x, y].I = CtrlParentColor
          then Fast24Src.Pixels[x, y] := White
          else Fast24Src.Pixels[x, y] := Black;
  end;
  CtrlParentColor := clFuchsia;
{$ENDIF}
end;

function TsCustomHintWindow.GetBody: TBitmap;
{$IFNDEF ACHINTS}
var
  CI : TCacheInfo;
  R : TRect;
{$ENDIF}
begin
{$IFNDEF ACHINTS}
  CI.Ready := False;
  Result := CreateBmpLike(Manager.FCacheBmp);
  if HintFrame <> nil then BodyBmp := Result;
  R := ClientRect;
  if Assigned(ScreenBmp) then begin
    CI := MakeCacheInfo(ScreenBmp);
    PaintItemFast(SkinIndex, BorderIndex, BGIndex, BGIndex, '', CI, True, 0, Rect(0, 0, Width, Height), Point(0, 0), Result, DefaultManager)
  end
  else PaintItemFast(SkinIndex, BorderIndex, BGIndex, BGIndex, '', CI, True, 0, Rect(0, 0, Width, Height), Point(0, 0), Result, DefaultManager);
  TextOut(Result);
{$ENDIF}
end;

procedure TsCustomHintWindow.PaintShadow(Bmp : TBitmap = nil);
{$IFNDEF ACHINTS}
var
  tr: integer;
  R: TRect;
  ShadowOffset : integer;
  c : TsColor;
{$ENDIF}
begin
{$IFNDEF ACHINTS}
  if Manager.Skinned and acHintsInEditor then begin
    if Bmp = nil then Bmp := Manager.FCacheBmp;
    R := ClientRect;
    FillDC(Bmp.Canvas.Handle, R, clWhite);
    ShadowOffset := iffi(Manager.HintKind.ShadowEnabled, Manager.HintKind.ShadowOffset, 0);
    tr := ShadowTransparency;
    c.I := 0;
    // Painting
    FadeBmp(Bmp,
            Classes.Rect(R.Left + ShadowOffset,
            R.Top + ShadowOffset, R.Right, R.Bottom),
            tr, c, Manager.HintKind.ShadowBlur, 0);
  end;
{$ENDIF}
end;

function TsCustomHintWindow.SkinMargin(Border: byte): integer;
begin
{$IFNDEF ACHINTS}
  if BorderIndex > -1 then begin
    if DefaultManager.ma[BorderIndex].BorderWidth > 0 then begin
      Result := DefaultManager.ma[BorderIndex].BorderWidth;
    end
    else case Border of
      0 : begin
        if DefaultManager.ma[BorderIndex].WL > 0
          then Result := DefaultManager.ma[BorderIndex].WL
          else Result := WidthOf(DefaultManager.ma[BorderIndex].R) div (DefaultManager.ma[BorderIndex].ImageCount * 3)
      end;
      1 : begin
        if DefaultManager.ma[BorderIndex].WT > 0
          then Result := DefaultManager.ma[BorderIndex].WT
          else Result := HeightOf(DefaultManager.ma[BorderIndex].R) div ((DefaultManager.ma[BorderIndex].MaskType + 1) * 3)
      end;
      2 : begin
        if DefaultManager.ma[BorderIndex].WR > 0
          then Result := DefaultManager.ma[BorderIndex].WR
          else Result := WidthOf(DefaultManager.ma[BorderIndex].R) div (DefaultManager.ma[BorderIndex].ImageCount * 3)
      end
      else {3} begin
        if DefaultManager.ma[BorderIndex].WB > 0
          then Result := DefaultManager.ma[BorderIndex].WB
          else Result := HeightOf(DefaultManager.ma[BorderIndex].R) div ((DefaultManager.ma[BorderIndex].MaskType + 1) * 3)
      end;
    end
  end else
{$ENDIF}
  Result := 0;
end;

{ TsSimplyHintWindow }
function TsSimplyHintWindow.GetBody: TBitmap;
var
  R : TRect;
  ShadowOffset : integer;
begin
  if Manager.Skinned then Result := inherited GetBody else begin
    Result := CreateBmpLike(Manager.FCacheBmp);
    if HintFrame <> nil then BodyBmp := Result;
    R := ClientRect;
    ShadowOffset := iffi(Manager.HintKind.ShadowEnabled, Manager.HintKind.ShadowOffset, 0);
    PaintBG(Result, Classes.Rect(R.Left, R.Top, R.Right - ShadowOffset, R.Bottom - ShadowOffset));
    TextOut(Result);
    PaintBorder(Result);
  end;
end;

function TsSimplyHintWindow.GetMask: TBitmap;
var
  c : TsColor;
begin
  if Manager.Skinned then Result := inherited GetMask else begin
    Result := CreateBmpLike(Manager.FCacheBmp);
    Result.Canvas.Pen.Style := psClear;
    Result.Canvas.Brush.Color := clWhite;
    Result.Canvas.FillRect(Rect(0, 0, Width, Height));
    c.I := 0;
    // Painting
    Result.Canvas.Brush.Color := clBlack;
    Result.Canvas.FillRect(MainRect);
  end;
end;

function TsSimplyHintWindow.GetMousePosition: TPoint;
begin
  Result := inherited GetMousePosition;
  if not Manager.Skinned then inc(Result.y, 16);
end;

procedure TsSimplyHintWindow.PaintBorder(Bmp: TBitmap);
var
  R: TRect;
begin
  if Manager.Skinned then inherited else begin
    if Manager.HintKind.FBevelWidth > 0 then begin
      Bmp.Canvas.Pen.Style := psSolid;
      R := MainRect;
      Frame3d(Bmp.Canvas, R,
              ColorToRGB(Manager.HintKind.ColorBorderTop),
              ColorToRGB(Manager.HintKind.ColorBorderBottom), Manager.HintKind.FBevelWidth);
    end;
  end;
end;

procedure TsSimplyHintWindow.PaintShadow;
var
  tr: integer;
  R: TRect;
  ShadowOffset : integer;
  c : TsColor;
begin
  if Manager.Skinned then inherited else begin
    if Bmp = nil then Bmp := Manager.FCacheBmp;
    R := ClientRect;
    ShadowOffset := iffi(Manager.HintKind.ShadowEnabled, Manager.HintKind.ShadowOffset, 0);
    tr := ShadowTransparency;
    c.I := 0;
    // Painting
    FadeBmp(Bmp,
            Classes.Rect(R.Left + ShadowOffset,
            R.Top + ShadowOffset, R.Right, R.Bottom),
            tr, c, Manager.HintKind.ShadowBlur, 0);
  end;
end;

{ TsComicsHintWindow }
function TsComicsHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
begin
  Result := inherited CalcHintRect(MaxWidth, AHint, AData);
  if not Manager.Skinned then Inc(Result.Bottom, Manager.HintKind.ExOffset);
end;

function TsComicsHintWindow.GetArrowPosition: TPoint;
const
  Offs = 3;
begin
  case FMousePos of
    mpLeftTop: begin
      Result := Point(Offs, Offs);
    end;
    mpRightTop: begin
      Result := Point(Width - Offs, Offs);
    end;
    mpLeftBottom: begin
      Result := Point(Offs, Height - Offs);
    end;
    mpRightBottom: begin
      Result := Point(Width - Offs, Height - Offs);
    end;
  end;
end;

function TsComicsHintWindow.GetBody: TBitmap;
var
  R: TRect;
begin
  if Manager.Skinned then Result := inherited GetBody else begin
    Result := CreateBmpLike(Manager.FCacheBmp);
    if HintFrame <> nil then BodyBmp := Result;
    R := ClientRect;
    PaintBg(Result, ClientRect);
    TextOut(Result);
    PaintBorder(Result);
  end;
end;

function TsComicsHintWindow.GetMask: TBitmap;
var
  R: TRect;
  RValue, tr, i, xcenter : integer;
  pMouse : TPoint;
  delta : real;
  c : TsColor;
begin
  if Manager.Skinned then Result := inherited GetMask else begin
    Result := CreateBmpLike(Manager.FCacheBmp);

    Result.Canvas.Pen.Style := psClear;
    Result.Canvas.Brush.Color := clWhite;
    Result.Canvas.FillRect(ClientRect);

    R := MainRect;

    if not Layered or acHintsInEditor
      then tr := Manager.HintKind.Transparency * integer(Manager.HintKind.Transparency > 0)
      else tr := 0;

    RValue := 255 * tr div 100;

    delta := 255 - RValue;

    // Prepare mask
    TColor(c) := clWhite;
    Result.Canvas.Pen.Style := psClear;
    Result.Canvas.Brush.Style := bsSolid;
    Result.Canvas.Brush.Color := clWhite;

    pMouse := GetArrowPosition;

//    k := 0;
    i := 0;

//    for i := 0 to 1 do begin
      c.R := max(0, min(255, RValue + Round(delta * ( - 1))));
      c.G := c.R;
      c.B := c.R;
      Result.Canvas.Brush.Color := TColor(c);

      Result.Canvas.RoundRect(R.Left + i,
                               R.Top + i,
                               R.Right - i + 1,
                               R.Bottom - i + 1,
                               Manager.HintKind.Radius,
                               Manager.HintKind.Radius);

      xcenter := R.Left + WidthOf(R) div 2;// + Manager.Blur;
      tr := WidthOf(R) div 8;// - Round(i * k * 2);
      if tr < 0 then tr := 0;
      case FMousePos of
        mpLeftTop, mpRightTop : begin
//          k := (R.Top + HeightOf(R) / 2) / (R.Top + 1);
          Result.Canvas.Polygon([pMouse,
                           Point(xcenter - tr, R.Top + HeightOf(R) div 2),
                           Point(xcenter + tr, R.Top + HeightOf(R) div 2),
                           pMouse
                          ]);
        end
        else begin
//          k := (Height - (R.Bottom - HeightOf(R) / 2)) / (Height - R.Bottom + 1);
          Result.Canvas.Polygon([pMouse,
                           Point(xcenter - tr, R.Bottom - HeightOf(R) div 2),
                           Point(xcenter + tr, R.Bottom - HeightOf(R) div 2)
                          ]);
        end;
      end;
//    end;
  end;
end;

function TsComicsHintWindow.MainRect: TRect;
var
  ShadowOffset : integer;
begin
  if Manager.Skinned then Result := inherited MainRect else begin
    ShadowOffset := iffi(Manager.HintKind.ShadowEnabled, Manager.HintKind.ShadowOffset, 0);
    Result.Left  := 0;
    Result.Right := Width - ShadowOffset;
    case FMousePos of
      mpLeftTop, mpRightTop: begin
        Result.Top := Manager.HintKind.ExOffset;
        Result.Bottom := Height - ShadowOffset;
      end;
      mpLeftBottom, mpRightBottom: begin
        Result.Top := 0;
        Result.Bottom := Height - ShadowOffset - Manager.HintKind.ExOffset;
      end;
    end;
  end;
end;

procedure TsComicsHintWindow.PaintBorder(Bmp: TBitmap);
var
  MskBmp : TBitmap;
begin
  if Manager.Skinned then inherited else begin
    if Manager.HintKind.FBevelWidth > 0 then begin
      MskBmp := GetMask;
      try
        Bmp.Canvas.Pen.Style := psSolid;
        BorderByMask(Bmp, MskBmp, TsColor(ColorToRGB(Manager.HintKind.ColorBorderTop)), TsColor(ColorToRGB(Manager.HintKind.ColorBorderBottom)));
      finally
        if Assigned(MskBmp) then FreeAndNil(MskBmp);
      end;
    end;
  end;
end;

procedure TsComicsHintWindow.PaintShadow;
var
  R: TRect;
  {ShadowOffset,} RValue, tr, i, xcenter : integer;
  pMouse : TPoint;
  MaskBmp, TempBmp : TBitmap;
  delta, k: real;
  c : TsColor;
begin
  if Manager.Skinned then inherited else begin
    if Bmp = nil then Bmp := Manager.FCacheBmp;
    MaskBmp := CreateBmpLike(Bmp);
    TempBmp := CreateBmpLike(Bmp);

    try
    MaskBmp.Canvas.Pen.Style := psClear;
    MaskBmp.Canvas.Brush.Color := clWhite;
    MaskBmp.Canvas.FillRect(ClientRect);

    R := MainRect;
    OffsetRect(R, Manager.HintKind.ShadowOffset, Manager.HintKind.ShadowOffset);

    tr := ShadowTransparency;

    RValue := 255 * tr div 100;

    bitBlt(TempBmp.Canvas.Handle, 0, 0, TempBmp.Width, TempBmp.Height, Bmp.Canvas.Handle, 0, 0, SrcCopy);

    delta := (255 - RValue) / (Manager.HintKind.ShadowBlur + 1);

    // Prepare mask
    TColor(c) := clWhite;
    MaskBmp.Canvas.Pen.Style := psClear;
    MaskBmp.Canvas.Brush.Style := bsSolid;
    MaskBmp.Canvas.Brush.Color := clWhite;

    pMouse := GetArrowPosition;

    k := 0;

    for i := 0 to Manager.HintKind.ShadowBlur do begin
      c.R := max(0, min(255, RValue + Round(delta * (Manager.HintKind.ShadowBlur - i))));
      c.G := c.R;
      c.B := c.R;
      MaskBmp.Canvas.Brush.Color := TColor(c);

      MaskBmp.Canvas.RoundRect(R.Left + i,
                               R.Top + i,
                               R.Right - i + 1,
                               R.Bottom - i + 1,
                               Manager.HintKind.Radius,
                               Manager.HintKind.Radius);

      xcenter := R.Left + WidthOf(R) div 2 + Manager.HintKind.ShadowBlur;
      tr := WidthOf(R) div 8 - Round(i * k * 2);
      if tr < 0 then tr := 0;
      case FMousePos of
        mpLeftTop, mpRightTop : begin
          k := (R.Top + HeightOf(R) / 2) / (R.Top + 1);
          MaskBmp.Canvas.Polygon([pMouse,
                           Point(xcenter - tr, R.Top + HeightOf(R) div 2),
                           Point(xcenter + tr, R.Top + HeightOf(R) div 2),