shintmanager.pas

Alpha Controls 界面控件包

                           pMouse
                          ]);
        end
        else begin
          k := (Height - (R.Bottom - HeightOf(R) / 2)) / (Height - R.Bottom + 1);
          MaskBmp.Canvas.Polygon([pMouse,
                           Point(xcenter - tr, R.Bottom - HeightOf(R) div 2),
                           Point(xcenter + tr, R.Bottom - HeightOf(R) div 2)
                          ]);
        end;
      end;
    end;
    c.I := 0;
    BlendBmpByMask(TempBmp, MaskBmp, c);

    // Copy back
    BitBlt(Bmp.Canvas.Handle, 0, 0, TempBmp.Width, MaskBmp.Height, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);

    finally
    if Assigned(MaskBmp) then FreeAndNil(MaskBmp);
    if Assigned(Tempbmp) then FreeAndNil(TempBmp);
    end;
  end;
end;

{ TsEllipseHintWindow }

function TsEllipseHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
var
  s, l : real;
begin
  Result := inherited CalcHintRect(MaxWidth, AHint, AData);
  if not Manager.Skinned then begin
    Inc(Result.Bottom, Manager.HintKind.ExOffset);
    if (HintFrame <> nil) then Exit;
    l := Sqrt(Sqr(WidthOf(Result)) + Sqr(HeightOf(Result)));
    s := l - WidthOf(Result);
    dx := Round(s * WidthOf(Result) / HeightOf(Result));
    dy := Round(s * HeightOf(Result) / WidthOf(Result));
    Inc(Result.Right, dx);
    Inc(Result.Bottom, dy);
  end;
end;

function TsEllipseHintWindow.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 TsEllipseHintWindow.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 TsEllipseHintWindow.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;

    i := 0;

      c.R := max(0, min(255, RValue - Round(delta)));
      c.G := c.R;
      c.B := c.R;
      Result.Canvas.Brush.Color := TColor(c);

      Result.Canvas.Ellipse(R.Left + i,
                             R.Top + i,
                             R.Right - i + 1,
                             R.Bottom - i + 1);

      xcenter := R.Left + WidthOf(R) div 2;// + Manager.Blur;
      tr := WidthOf(R) div 8;
      if tr < 0 then tr := 0;
      case FMousePos of
        mpLeftTop, mpRightTop : begin
          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
          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;

function TsEllipseHintWindow.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 TsEllipseHintWindow.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 TsEllipseHintWindow.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.Ellipse(R.Left + i,
                             R.Top + i,
                             R.Right - i + 1,
                             R.Bottom - i + 1);

      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),
                           pMouse
                          ]);
        end
        else begin
          k := (Height - (R.Bottom - HeightOf(R) / 2)) / (Height - R.Bottom + 1);
          MaskBmp.Canvas.Polygon([pMouse,
                           Point(xcenter - tr, R.Bottom - HeightOf(R) div 2),
                           Point(xcenter + tr, R.Bottom - HeightOf(R) div 2)
                          ]);
        end;
      end;
    end;

    c.I := 0;
    BlendBmpByMask(TempBmp, MaskBmp, c);

    // Copy back
  //  BitBlt(Manager.sStyle.FCacheBmp.Canvas.Handle, 0, 0, TempBmp.Width, MaskBmp.Height, MaskBmp.Canvas.Handle, 0, 0, SRCCOPY);
    BitBlt(Bmp.Canvas.Handle, 0, 0, TempBmp.Width, MaskBmp.Height, TempBmp.Canvas.Handle, 0, 0, SRCCOPY);

    finally
      if Assigned(Maskbmp) then FreeAndNil(MaskBmp);
      if Assigned(TempBmp) then FreeAndNil(TempBmp);
    end;
  end;
end;

{ TsBalloonHintWindow }

function TsBalloonHintWindow.CalcHintRect(MaxWidth: Integer;
  const AHint: string; AData: Pointer): TRect;
var
  s, {z,} l : real;
begin
  if not Assigned(Manager) then Exit;
  Result := inherited CalcHintRect(MaxWidth, AHint, AData);
  if not Manager.Skinned then begin
    Inc(Result.Bottom, Manager.HintKind.ExOffset);
    l := Sqrt(Sqr(WidthOf(Result)) + Sqr(HeightOf(Result)));
    s := l - WidthOf(Result);
    dx := Round(s * WidthOf(Result) / HeightOf(Result));
    dy := Round(s * HeightOf(Result) / WidthOf(Result));
    Inc(Result.Right, dx);
    Inc(Result.Bottom, dy);
  end;
end;

constructor TsBalloonHintWindow.Create(AOwner: TComponent);
begin
  inherited;
  BalloonCount := 5;
  Divid := 4;
end;

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

function TsBalloonHintWindow.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 TsBalloonHintWindow.GetMask: TBitmap;
begin
  if Manager.Skinned then Result := inherited GetMask else Result := GetCustMask(False);
end;

function TsBalloonHintWindow.GetCustMask(Shadow: boolean): TBitmap;
var
  R, {mRect,} bRect : TRect;
  RValue, tr, bl, xcenter, w, h : integer;
  pMouse{, bCenter} : TPoint;
  delta: real;
  c : TsColor;
  bSize : TSize;
  j, deltaY, deltaX : integer;
  Blur : integer;
begin
  Result := CreateBmpLike(Manager.FCacheBmp);
  FillDC(Result.Canvas.Handle, ClientRect, clWhite);

  R := MainRect;
  w := WidthOf(R);
  h := HeightOf(R);
  xcenter := R.Left + w div 2;
  if Shadow then begin
    tr := ShadowTransparency;
    blur := Manager.HintKind.ShadowBlur;
  end
  else begin
    if not Layered or acHintsInEditor
      then tr := Manager.HintKind.Transparency * integer(Manager.HintKind.Transparency > 0)
      else tr := 0;
    blur := 0;
  end;
  pMouse := GetArrowPosition;
  RValue := (tr shl 8) div 100;
  delta := (255 - RValue) / (Blur + 1);

  Result.Canvas.Pen.Style := psClear;
  for bl := 0 to Blur do begin
    c.R := max(0, min(255, RValue + Round(delta * (Blur - bl)))); c.G := c.R; c.B := c.R;
    Result.Canvas.Brush.Color := c.C;
    Result.Canvas.Ellipse(R.Left + bl, R.Top + bl, R.Right - bl + 1, R.Bottom - bl + 1);

    // Arrow painting
    bSize.cx := w div Divid;
    bSize.cy := h div Divid;

    case FMousePos of
      mpLeftTop: begin
        DeltaX := (w div 2 - bSize.cx) div (BalloonCount + 1);
        DeltaY := (R.Top + h div 6 - bSize.cy) div (BalloonCount + 1);
        bRect.Left := xcenter - bSize.cx;
        bRect.Top := R.Top + h div 6 - bSize.cy;
      end;
      mpRightTop: begin
        DeltaX := - ((w + Manager.HintKind.ShadowOffset) div 2 - bSize.cx) div (BalloonCount) * 2;
        DeltaY := (R.Top + h div 6 - bSize.cy) div (BalloonCount + 1);
        bRect.Left := xcenter + DeltaX;
        bRect.Top := R.Top + h div 6 - bSize.cy;
      end;
      mpLeftBottom: begin
        DeltaX := (w div 2 - bSize.cx) div (BalloonCount - 1);
        DeltaY := - (Height - R.Bottom {+ h div 6 - bSize.cy}) div (BalloonCount - 1);
        bRect.Left := xcenter - DeltaX div 2;// div 2;//bSize.cx;
        bRect.Top := R.Bottom {+ h div 6} {- bS