shintmanager.pas

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

  c : TsColor;
begin
  Result := CreateBmpLike(Manager.sStyle.FCacheBmp);

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

  R := MainRect;

  tr := Manager.sStyle.Painting.Transparency * integer(Manager.sStyle.Painting.Transparency > 0);

  RValue := 255 * tr div 100;

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

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

  pMouse := GetArrowPosition;

  k := 0;

  for i := 0 to Manager.Blur do begin
    c.R := RValue + Round(delta * (Manager.Blur - i));
    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.Radius,
                             Manager.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;

function TsComicsHintWindow.GetMousePosition: TPoint;
var
  m : TMouse;
begin
  m := TMouse.Create;
  Result := m.CursorPos;
  inc(Result.x, 0);
  inc(Result.y, 0);
  FreeAndNil(m);
end;

function TsComicsHintWindow.MainRect: TRect;
var
  ShadowOffset : integer;
begin
  ShadowOffset := iffi(Manager.sStyle.Shadow.Enabled, Manager.sStyle.Shadow.Offset, 0);
  Result.Left  := 0;
  Result.Right := Width - ShadowOffset;
  case FMousePos of
    mpLeftTop, mpRightTop: begin
      Result.Top := Manager.ExOffset;
      Result.Bottom := Height - ShadowOffset;
    end;
    mpLeftBottom, mpRightBottom: begin
      Result.Top := 0;
      Result.Bottom := Height - ShadowOffset - Manager.ExOffset;
    end;
  end;
end;

procedure TsComicsHintWindow.PaintBorder(Bmp: TBitmap);
var
//  R: TRect;
  MskBmp : TBitmap;
begin
  if Manager.FBevelWidth > 0 then begin
    MskBmp := GetMask;
    try
    MonoBmp(MskBmp); //!!! Slow
    Bmp.Canvas.Pen.Style := psSolid;
    BorderByMask(Bmp, MskBmp, TsColor(ColorToRGB(Manager.sStyle.Painting.ColorBorderTop)), TsColor(ColorToRGB(Manager.sStyle.Painting.ColorBorderBottom)));
    finally
      if Assigned(MskBmp) then FreeAndNil(MskBmp);
    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
  MaskBmp := CreateBmpLike(Manager.sStyle.FCacheBmp);
  TempBmp := CreateBmpLike(Manager.sStyle.FCacheBmp);

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

  R := MainRect;
  OffsetRect(R, Manager.sStyle.Shadow.Offset, Manager.sStyle.Shadow.Offset);

  tr := ShadowTransparency;

  RValue := 255 * tr div 100;

  bitBlt(TempBmp.Canvas.Handle, 0, 0, TempBmp.Width, TempBmp.Height, Manager.sStyle.FCacheBmp.Canvas.Handle, 0, 0, SrcCopy);

  delta := (255 - RValue) / (Manager.sStyle.Shadow.Blur + 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.sStyle.Shadow.Blur do begin
    c.R := RValue + Round(delta * (Manager.sStyle.Shadow.Blur - 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.Radius,
                             Manager.Radius);

    xcenter := R.Left + WidthOf(R) div 2;// + Manager.sStyle.Shadow.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);
        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;

//  SumBitmaps(TempBmp, MaskBmp, TsColor(Manager.sStyle.Shadow.Color));
  BlendBmpByMask(TempBmp, MaskBmp, TsColor(Manager.sStyle.Shadow.Color));

  // Copy back
//  BitBlt(Manager.sStyle.FCacheBmp.Canvas.Handle, 0, 0, TempBmp.Width, MaskBmp.Height, MaskBmp.Canvas.Handle, 0, 0, SRCCOPY);
  BitBlt(Manager.sStyle.FCacheBmp.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;

{ TsEllipseHintWindow }

function TsEllipseHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
var
  s, {z,} l : real;
begin
  Result := inherited CalcHintRect(MaxWidth, AHint, AData);
  Inc(Result.Bottom, Manager.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;

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
  //P : TPoint;
  R{, rText}: TRect;
//  SmallOffset, ShadowOffset : integer;
//  MaskBmp, BodyBmp: TBitmap;
begin
  Result := CreateBmpLike(Manager.sStyle.FCacheBmp);

  R := ClientRect;
//  ShadowOffset := iffi(Manager.sStyle.Shadow.Enabled, Manager.sStyle.Shadow.Offset, 0);

  PaintBg(Result, ClientRect);

  TextOut(Result);

  PaintBorder(Result);
end;

function TsEllipseHintWindow.GetMask: TBitmap;
var
  R: TRect;
  RValue, tr, i, xcenter : integer;
  pMouse : TPoint;
  delta, k: real;
  c : TsColor;
begin

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

  R := MainRect;

  tr := Manager.sStyle.Painting.Transparency * integer(Manager.sStyle.Painting.Transparency > 0);

  RValue := 255 * tr div 100;

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

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

  pMouse := GetArrowPosition;

  k := 0;

  for i := 0 to Manager.Blur do begin
    c.R := RValue + Round(delta * (Manager.Blur - i));
    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 - 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;

function TsEllipseHintWindow.GetMousePosition: TPoint;
var
  m : TMouse;
begin
  m := TMouse.Create;
  Result := m.CursorPos;
  inc(Result.x, 0);
  inc(Result.y, 0);
  FreeAndNil(m);
end;

function TsEllipseHintWindow.MainRect: TRect;
var
  ShadowOffset : integer;
begin
  ShadowOffset := iffi(Manager.sStyle.Shadow.Enabled, Manager.sStyle.Shadow.Offset, 0);
  Result.Left  := 0;
  Result.Right := Width - ShadowOffset;
  case FMousePos of
    mpLeftTop, mpRightTop: begin
      Result.Top := Manager.ExOffset;
      Result.Bottom := Height - ShadowOffset;
    end;
    mpLeftBottom, mpRightBottom: begin
      Result.Top := 0;
      Result.Bottom := Height - ShadowOffset - Manager.ExOffset;
    end;
  end;
end;

procedure TsEllipseHintWindow.PaintBorder(Bmp: TBitmap);
var
//  R: TRect;
  MskBmp : TBitmap;
begin
  if Manager.FBevelWidth > 0 then begin
    MskBmp := GetMask;
    try
    MonoBmp(MskBmp); //!!! Slow
    Bmp.Canvas.Pen.Style := psSolid;
    BorderByMask(Bmp, MskBmp, TsColor(ColorToRGB(Manager.sStyle.Painting.ColorBorderTop)), TsColor(ColorToRGB(Manager.sStyle.Painting.ColorBorderBottom)));
    finally
      if Assigned(MskBmp) then FreeAndNil(MskBmp);
    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
  MaskBmp := CreateBmpLike(Manager.sStyle.FCacheBmp);
  TempBmp := CreateBmpLike(Manager.sStyle.FCacheBmp);

  try

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

  R := MainRect;
  OffsetRect(R, Manager.sStyle.Shadow.Offset, Manager.sStyle.Shadow.Offset);