shintmanager.pas

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

procedure TsHintManager.SetStyle(const Value: TsHintStyle);
begin
  FStyle := Value;
  SetNewStyle(Value);
  SetCustomDefinition;
end;

procedure TsHintManager.ShowHint(p: TPoint; Hint: string);
//var
//  h : TsSimplyHintWindow;
begin
{  h := TsSimplyHintWindow.Create(Application);
  h.Caption := Hint;
  h.ActivateHint(Rect(p.x, p.y, p.x + 100, p.y + 100), Hint);
//  h.S
  FreeAndNil(h);}
end;

{ TsCustomHintWindow }

procedure TsCustomHintWindow.ActivateHint(Rect: TRect; const AHint: string);
var
  DC: HDC;
  w, h : integer;
  t, l : boolean;
  p : TPoint;
begin
  Application.ProcessMessages;
  if (Manager.Style = hsNone) or not Assigned(Manager) then exit;

  Application.HintHidePause := Manager.FPauseHide;
  Application.ProcessMessages;

  Caption := AHint;
  p := GetMousePosition;

  w := WidthOf(Rect);
  h := HeightOf(Rect);
  FMousePos := mpLeftTop;


  Rect := Classes.Rect(p.x, p.y, p.x + w, p.y + h);

  UpdateBoundsRect(Rect);

  t := True;
  l := True;

  if Rect.Bottom > Screen.DesktopHeight then begin
    Rect.Top := p.y - h;
    t := False;
  end;
  if Rect.Top < Screen.DesktopTop then begin
    Rect.Top := p.y;
    t := True;
  end;
  if Rect.Right > Screen.DesktopWidth then begin
    Rect.Left := p.x - w;
    l := False;
  end;
  if Rect.Left < Screen.DesktopLeft then begin
    Rect.Left := p.x;
    l := True;
  end;
  if t and l         then FMousePos := mpLeftTop;
  if t and not l     then FMousePos := mpRightTop;
  if not t and l     then FMousePos := mpLeftBottom;
  if not t and not l then FMousePos := mpRightBottom;

  Rect.Right := Rect.Left + w;
  Rect.Bottom := Rect.Top + h;

  Manager.sStyle.FCacheBmp.PixelFormat := pf24bit;
  Manager.sStyle.FCacheBmp.Width := w;
  Manager.sStyle.FCacheBmp.Height := h;

  DC := GetDC(0);
  if DC = 0 then begin
    ShowError('GDI error (out of resources)');
    Exit;
  end;

  // Grabbing of screen !!! Sometimes work incorrect. When? / Serge
  BitBlt(Manager.sStyle.FCacheBmp.Canvas.Handle,
               0, 0, w, h,
               DC,
               Rect.Left, Rect.Top,
               SrcCopy);

  ReleaseDC(0, DC);

  // Show window with hint
  SetWindowPos(Handle,
               HWND_TOPMOST,
               Rect.Left,
               Rect.Top,
               w,
               h,
               SWP_SHOWWINDOW or SWP_NOACTIVATE);
//  Invalidate;
end;

constructor TsCustomHintWindow.Create(AOwner: TComponent);
begin
  inherited;
  dx := 0;
  dy := 0;
end;

procedure TsCustomHintWindow.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  Ctl3D := False;
  BorderWidth := 0;
  Params.Style := Params.Style - WS_BORDER + WS_EX_TRANSPARENT;
{$IFDEF DELPHI7UP}
  if CheckWin32Version(5, 1) then Params.WindowClass.Style := Params.WindowClass.style and not CS_DROPSHADOW;
{$ENDIF}
//  Params.ExStyle := WS_EX_TOOLWINDOW or WS_EX_TRANSPARENT;
  Params.WindowClass.hbrBackground := 0
end;

function TsCustomHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
var
  sHTML : TsHtml;
begin
  Result := Rect(0, 0, Manager.FMaxWidth, 0);
  if Assigned(Manager) and Assigned(Manager.Font) then Manager.sStyle.FCacheBmp.Canvas.Font.Assign(Manager.Font);
  if Manager.FHTMLMode then begin

    sHTML := TsHtml.Create;
    sHTML.Init(Manager.sStyle.FCacheBmp, aHint, Result);
    Result := sHTML.HtmlText;
    FreeAndNil(sHTML);
  end
  else begin
    DrawText(Manager.sStyle.FCacheBmp.Canvas.Handle, PChar(AHint), -1, Result,
           DT_CALCRECT or DT_CENTER or DT_VCENTER or DT_WORDBREAK or DT_NOPREFIX or DrawTextBiDiModeFlagsReadingOnly);
  end;
  Inc(Result.Right,  (Manager.MarginH + Manager.FBevelWidth) * 2 + iffi(Manager.sStyle.Shadow.Enabled, Manager.sStyle.Shadow.Offset, 0));
  Inc(Result.Bottom, (Manager.MarginV + Manager.FBevelWidth) * 2 + iffi(Manager.sStyle.Shadow.Enabled, Manager.sStyle.Shadow.Offset, 0));
end;

procedure TsCustomHintWindow.WMEraseBkGND(var Message: TWMPaint);
begin
  Message.Result := 1;
end;

procedure TsCustomHintWindow.WMNCPaint(var Message: TWMPaint);
begin
  Message.Result := 1;
end;

procedure TsCustomHintWindow.Paint;
var
  MaskBmp, BodyBmp: TBitmap;
begin
  if Manager.sStyle.Shadow.Enabled then begin
    PaintShadow;
  end;
  MaskBmp := GetMask;
  BodyBmp := GetBody;
  try
  if Assigned(BodyBmp) and Assigned(MaskBmp) then begin
    SumByMask(Manager.sStyle.FCacheBmp, BodyBmp, MaskBmp, ClientRect);
  end;

  BitBlt(Canvas.Handle,
         0,
         0,
         Manager.sStyle.FCacheBmp.Width,
         Manager.sStyle.FCacheBmp.Height,
         Manager.sStyle.FCacheBmp.Canvas.Handle,
         0,
         0,
         SRCCOPY);

  finally
  if Assigned(MaskBmp) then FreeAndNil(MaskBmp);
  if Assigned(BodyBmp) then FreeAndNil(BodyBmp);
  end;
end;

procedure TsCustomHintWindow.PaintBG(Bmp: TBitmap; aRect: TRect);
var
  ci : TCacheInfo;
begin
  ci.Bmp := Manager.sStyle.FCacheBmp;
  ci.X := 0;
  ci.Y := 0;
  ci.Ready := True;
  Manager.PaintBG(Bmp, aRect, ci);
end;

procedure TsCustomHintWindow.TextOut(Bmp: TBitmap);
var
  R : TRect;
  sHTML : TsHtml;
begin
  Bmp.Canvas.Brush.Style := bsClear;
  Bmp.Canvas.Pen.Style := psSolid;
  Bmp.Canvas.Font.Assign(Manager.Font);


  R := MainRect;
  InflateRect(R, - Manager.MarginH - Manager.BevelWidth - dx div 2, - Manager.MarginV - Manager.BevelWidth - dy div 2);

  if Manager.FHTMLMode then begin
    sHTML := TsHtml.Create;
    sHTML.Init(Bmp, Caption, R);
    sHTML.HtmlText;
    FreeAndNil(sHTML);
  end
  else begin
    DrawText(Bmp.Canvas.Handle, PChar(Caption), -1, R, DT_CENTER or DT_NOPREFIX or DT_WORDBREAK or DrawTextBiDiModeFlagsReadingOnly);
  end;
end;

function TsCustomHintWindow.MainRect: TRect;
var
  ShadowOffset : integer;
begin
  ShadowOffset := iffi(Manager.sStyle.Shadow.Enabled, Manager.sStyle.Shadow.Offset, 0);
  Result.Left  := 0;
  Result.Right := Width - ShadowOffset;
  Result.Top  := 0;
  Result.Bottom := Height - ShadowOffset;
end;

procedure TsCustomHintWindow.PaintBorder(Bmp: TBitmap);
var
  R: TRect;
begin
  if Manager.FBevelWidth > 0 then begin
    Bmp.Canvas.Pen.Style := psSolid;
    R := MainRect;
    inc(R.Left);
    inc(R.Top);

    Frame3d(Bmp.Canvas, R,
            ColorToRGB(Manager.sStyle.Painting.ColorBorderTop), ColorToRGB(Manager.sStyle.Painting.ColorBorderBottom), Manager.FBevelWidth);
  end;
end;

function TsCustomHintWindow.ShadowTransparency: integer;
begin
  Result := Manager.sStyle.Painting.Transparency * integer(Manager.sStyle.Painting.Transparency > 0);
  Result := SumTrans(Result, Manager.sStyle.Shadow.Transparency);
end;

{ TsSimplyHintWindow }

function TsSimplyHintWindow.GetBody: TBitmap;
var
  R : TRect;
  ShadowOffset : integer;
begin
  Result := CreateBmpLike(Manager.sStyle.FCacheBmp);

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

  PaintBG(Result, Classes.Rect(R.Left, R.Top, R.Right - ShadowOffset, R.Bottom - ShadowOffset));

  TextOut(Result);

  PaintBorder(Result);
end;

function TsSimplyHintWindow.GetMask: TBitmap;
var
  c : TsColor;
//  r : TRect;
begin
  Result := CreateBmpLike(Manager.sStyle.FCacheBmp);
  Result.Canvas.Pen.Style := psClear;
  Result.Canvas.Brush.Color := clWhite;
  Result.Canvas.FillRect(ClientRect);

  c.C := clBlack;

  // Painting
  FadeBmp(Result, MainRect, 0, c, Manager.Blur, 0);
end;

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

procedure TsSimplyHintWindow.PaintBorder(Bmp: TBitmap);
var
  R: TRect;
begin
  if Manager.FBevelWidth > 0 then begin
    Bmp.Canvas.Pen.Style := psSolid;
    R := MainRect;
    dec(R.Right);
    dec(R.Bottom);
    Frame3d(Bmp.Canvas, R,
            ColorToRGB(Manager.sStyle.Painting.ColorBorderTop),
            ColorToRGB(Manager.sStyle.Painting.ColorBorderBottom), Manager.FBevelWidth);
  end;
end;

procedure TsSimplyHintWindow.PaintShadow;
var
  tr: integer;
  R: TRect;
  ShadowOffset : integer;
begin
  R := ClientRect;
  ShadowOffset := iffi(Manager.sStyle.Shadow.Enabled, Manager.sStyle.Shadow.Offset, 0);
  tr := ShadowTransparency;

  // Painting
  FadeBmp(Manager.sStyle.FCacheBmp,
          Classes.Rect(R.Left + ShadowOffset,
          R.Top + ShadowOffset, R.Right, R.Bottom),
          tr, TsColor(Manager.sStyle.Shadow.Color), Manager.sStyle.Shadow.Blur, 0);//Manager.Radius);
end;

{ TsComicsHintWindow }

function TsComicsHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string; AData: Pointer): TRect;
begin
  Result := inherited CalcHintRect(MaxWidth, AHint, AData);
  Inc(Result.Bottom, Manager.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
//  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 TsComicsHintWindow.GetMask: TBitmap;
var
  R: TRect;
//  ShadowOffset,
  RValue, tr, i, xcenter : integer;
  pMouse : TPoint;
  delta, k : real;