home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kolekce / d6 / RX275D6.ZIP / Units / RXHINTS.PAS < prev    next >
Pascal/Delphi Source File  |  1999-10-12  |  16KB  |  528 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 1997 Master-Bank                }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit RxHints;
  10.  
  11. {$I RX.INC}
  12.  
  13. interface
  14.  
  15. uses {$IFDEF WIN32} Windows, {$ELSE} WinTypes, WinProcs, {$ENDIF} Messages,
  16.   Graphics, Classes, Controls, Forms, Dialogs;
  17.  
  18. type
  19.   THintStyle = (hsRectangle, hsRoundRect, hsEllipse);
  20.   THintPos = (hpTopRight, hpTopLeft, hpBottomRight, hpBottomLeft);
  21.   THintShadowSize = 0..15;
  22.  
  23.   TRxHintWindow = class(THintWindow)
  24.   private
  25.     FSrcImage: TBitmap;
  26.     FImage: TBitmap;
  27.     FPos: THintPos;
  28.     FRect: TRect;
  29.     FTextRect: TRect;
  30.     FTileSize: TPoint;
  31.     FRoundFactor: Integer;
  32.     procedure WMEraseBkgnd(var Message: TMessage); message WM_ERASEBKGND;
  33. {$IFDEF RX_D3}
  34.     procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  35. {$ENDIF}
  36.     function CreateRegion(Shade: Boolean): HRgn;
  37.     procedure FillRegion(Rgn: HRgn; Shade: Boolean);
  38.   protected
  39.     procedure CreateParams(var Params: TCreateParams); override;
  40.     procedure Paint; override;
  41.   public
  42.     constructor Create(AOwner: TComponent); override;
  43.     destructor Destroy; override;
  44.     procedure ActivateHint(Rect: TRect; const AHint: string); override;
  45. {$IFDEF RX_D3}
  46.     procedure ActivateHintData(Rect: TRect; const AHint: string;
  47.       AData: Pointer); override;
  48. {$ENDIF}
  49.     function CalcHintRect(MaxWidth: Integer; const AHint: string;
  50.       AData: Pointer): TRect; {$IFDEF RX_D3} override; {$ENDIF}
  51.   end;
  52.  
  53. procedure SetHintStyle(Style: THintStyle; ShadowSize: THintShadowSize;
  54.   Tail: Boolean; Alignment: TAlignment);
  55. procedure SetStandardHints;
  56. procedure RegisterHintWindow(AClass: THintWindowClass);
  57. function GetHintControl: TControl;
  58.  
  59. implementation
  60.  
  61. uses SysUtils, VclUtils, AppUtils, MaxMin;
  62.  
  63. const
  64.   HintStyle: THintStyle = hsRectangle;
  65.   HintShadowSize: THintShadowSize = 0;
  66.   HintTail: Boolean = False;
  67.   HintAlignment: TAlignment = taLeftJustify;
  68.  
  69. { Utility routines }
  70.  
  71. procedure RegisterHintWindow(AClass: THintWindowClass);
  72. begin
  73.   HintWindowClass := AClass;
  74.   with Application do
  75.     if ShowHint then begin
  76.       ShowHint := False;
  77.       ShowHint := True;
  78.     end;
  79. end;
  80.  
  81. procedure SetStandardHints;
  82. begin
  83.   RegisterHintWindow(THintWindow);
  84. end;
  85.  
  86. procedure SetHintStyle(Style: THintStyle; ShadowSize: THintShadowSize;
  87.   Tail: Boolean; Alignment: TAlignment);
  88. begin
  89.   HintStyle := Style;
  90.   HintShadowSize := ShadowSize;
  91.   HintTail := Tail;
  92.   HintAlignment := Alignment;
  93.   RegisterHintWindow(TRxHintWindow);
  94. end;
  95.  
  96. function GetHintControl: TControl;
  97. var
  98.   CursorPos: TPoint;
  99. begin
  100.   GetCursorPos(CursorPos);
  101.   Result := FindDragTarget(CursorPos, True);
  102.   while (Result <> nil) and not Result.ShowHint do
  103.     Result := Result.Parent;
  104.   if (Result <> nil) and (csDesigning in Result.ComponentState) then
  105.     Result := nil;
  106. end;
  107.  
  108. procedure StandardHintFont(AFont: TFont);
  109. {$IFDEF WIN32}
  110. var
  111.   NonClientMetrics: TNonClientMetrics;
  112. {$ENDIF}
  113. begin
  114. {$IFDEF WIN32}
  115.   NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
  116.   if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
  117.     AFont.Handle := CreateFontIndirect(NonClientMetrics.lfStatusFont)
  118.   else begin
  119.     AFont.Name := 'MS Sans Serif';
  120.     AFont.Size := 8;
  121.   end;
  122.   AFont.Color := clInfoText;
  123. {$ELSE}
  124.   AFont.Name := 'MS Sans Serif';
  125.   AFont.Size := 8;
  126.   AFont.Color := clWindowText;
  127. {$ENDIF}
  128. end;
  129.  
  130. {$IFDEF WIN32}
  131. {$IFNDEF RX_D3}
  132. function GetCursorHeightMargin: Integer;
  133. { Return number of scanlines between the scanline containing cursor hotspot
  134.   and the last scanline included in the cursor mask. }
  135. var
  136.   IconInfo: TIconInfo;
  137.   BitmapInfoSize: Integer;
  138.   BitmapBitsSize: Integer;
  139.   Bitmap: PBitmapInfoHeader;
  140.   Bits: Pointer;
  141.   BytesPerScanline, ImageSize: Integer;
  142.  
  143.     function FindScanline(Source: Pointer; MaxLen: Cardinal;
  144.       Value: Cardinal): Cardinal; assembler;
  145.     asm
  146.             PUSH    ECX
  147.             MOV     ECX,EDX
  148.             MOV     EDX,EDI
  149.             MOV     EDI,EAX
  150.             POP     EAX
  151.             REPE    SCASB
  152.             MOV     EAX,ECX
  153.             MOV     EDI,EDX
  154.     end;
  155.  
  156. begin
  157.   { Default value is entire icon height }
  158.   Result := GetSystemMetrics(SM_CYCURSOR);
  159.   if GetIconInfo(GetCursor, IconInfo) then
  160.   try
  161.     GetDIBSizes(IconInfo.hbmMask, BitmapInfoSize, BitmapBitsSize);
  162.     Bitmap := AllocMem(BitmapInfoSize + BitmapBitsSize);
  163.     try
  164.       Bits := Pointer(Longint(Bitmap) + BitmapInfoSize);
  165.       if GetDIB(IconInfo.hbmMask, 0, Bitmap^, Bits^) and
  166.         (Bitmap^.biBitCount = 1) then
  167.       begin
  168.         { Point Bits to the end of this bottom-up bitmap }
  169.         with Bitmap^ do
  170.         begin
  171.           BytesPerScanline := ((biWidth * biBitCount + 31) and not 31) div 8;
  172.           ImageSize := biWidth * BytesPerScanline;
  173.           Bits := Pointer(Integer(Bits) + BitmapBitsSize - ImageSize);
  174.           { Use the width to determine the height since another mask bitmap
  175.             may immediately follow }
  176.           Result := FindScanline(Bits, ImageSize, $FF);
  177.           { In case the and mask is blank, look for an empty scanline in the
  178.             xor mask. }
  179.           if (Result = 0) and (biHeight >= 2 * biWidth) then
  180.             Result := FindScanline(Pointer(Integer(Bits) - ImageSize),
  181.               ImageSize, $00);
  182.           Result := Result div BytesPerScanline;
  183.         end;
  184.         Dec(Result, IconInfo.yHotSpot);
  185.       end;
  186.     finally
  187.       FreeMem(Bitmap, BitmapInfoSize + BitmapBitsSize);
  188.     end;
  189.   finally
  190.     if IconInfo.hbmColor <> 0 then DeleteObject(IconInfo.hbmColor);
  191.     if IconInfo.hbmMask <> 0 then DeleteObject(IconInfo.hbmMask);
  192.   end;
  193. end;
  194. {$ENDIF}
  195. {$ENDIF}
  196.  
  197. { TRxHintWindow }
  198.  
  199. constructor TRxHintWindow.Create(AOwner: TComponent);
  200. begin
  201.   inherited Create(AOwner);
  202.   StandardHintFont(Canvas.Font);
  203.   FImage := TBitmap.Create;
  204.   FSrcImage := TBitmap.Create;
  205. end;
  206.  
  207. destructor TRxHintWindow.Destroy;
  208. begin
  209.   FSrcImage.Free;
  210.   FImage.Free;
  211.   inherited Destroy;
  212. end;
  213.  
  214. procedure TRxHintWindow.CreateParams(var Params: TCreateParams);
  215. begin
  216.   inherited CreateParams(Params);
  217.   Params.Style := Params.Style and not WS_BORDER;
  218. end;
  219.  
  220. {$IFDEF RX_D3}
  221. procedure TRxHintWindow.WMNCPaint(var Message: TMessage);
  222. begin
  223. end;
  224. {$ENDIF}
  225.  
  226. procedure TRxHintWindow.WMEraseBkgnd(var Message: TMessage);
  227. begin
  228.   Message.Result := 1;
  229. end;
  230.  
  231. function TRxHintWindow.CreateRegion(Shade: Boolean): HRgn;
  232. var
  233.   R: TRect;
  234.   W, TileOffs: Integer;
  235.   Tail, Dest: HRgn;
  236.   P: TPoint;
  237.  
  238.   function CreatePolyRgn(const Points: array of TPoint): HRgn;
  239.   type
  240.     PPoints = ^TPoints;
  241.     TPoints = array[0..0] of TPoint;
  242.   begin
  243.     Result := CreatePolygonRgn(PPoints(@Points)^, High(Points) + 1, WINDING);
  244.   end;
  245.  
  246. begin
  247.   R := FRect;
  248.   Result := 0;
  249.   if Shade then OffsetRect(R, HintShadowSize, HintShadowSize);
  250.   case HintStyle of
  251.     hsRoundRect: Result := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom,
  252.       FRoundFactor, FRoundFactor);
  253.     hsEllipse: Result := CreateEllipticRgnIndirect(R);
  254.     hsRectangle: Result := CreateRectRgnIndirect(R);
  255.   end;
  256.   if HintTail then begin
  257.     R := FTextRect;
  258.     GetCursorPos(P);
  259.     TileOffs := 0;
  260.     if FPos in [hpTopLeft, hpBottomLeft] then TileOffs := Width;
  261.     if Shade then begin
  262.       OffsetRect(R, HintShadowSize, HintShadowSize);
  263.       Inc(TileOffs, HintShadowSize);
  264.     end;
  265.     W := Min(Max(8, Min(WidthOf(R), HeightOf(R)) div 4), WidthOf(R) div 2);
  266.     case FPos of
  267.       hpTopRight:
  268.         Tail := CreatePolyRgn([Point(TileOffs, Height - HintShadowSize),
  269.           Point(R.Left + W div 4, R.Bottom), Point(R.Left + 2 * W, R.Bottom)]);
  270.       hpTopLeft:
  271.         Tail := CreatePolyRgn([Point(TileOffs, Height - HintShadowSize),
  272.           Point(R.Right - W div 4, R.Bottom), Point(R.Right - 2 * W, R.Bottom)]);
  273.       hpBottomRight:
  274.         Tail := CreatePolyRgn([Point(TileOffs, 0),
  275.           Point(R.Left + W div 4, R.Top), Point(R.Left + 2 * W, R.Top)]);
  276.       else {hpBottomLeft}
  277.         Tail := CreatePolyRgn([Point(TileOffs, 0),
  278.           Point(R.Right - W div 4, R.Top), Point(R.Right - 2 * W, R.Top)]);
  279.     end;
  280.     try
  281.       Dest := Result;
  282.       Result := CreateRectRgnIndirect(R);
  283.       try
  284.         CombineRgn(Result, Dest, Tail, RGN_OR);
  285.       finally
  286.         if Dest <> 0 then DeleteObject(Dest);
  287.       end;
  288.     finally
  289.       DeleteObject(Tail);
  290.     end;
  291.   end;
  292. end;
  293.  
  294. procedure TRxHintWindow.FillRegion(Rgn: HRgn; Shade: Boolean);
  295. begin
  296.   if Shade then begin
  297.     FImage.Canvas.Brush.Bitmap :=
  298. {$IFDEF RX_D4}
  299.       AllocPatternBitmap(clBtnFace, clWindowText);
  300. {$ELSE}
  301.       CreateTwoColorsBrushPattern(clBtnFace, clWindowText);
  302. {$ENDIF}
  303.     FImage.Canvas.Pen.Style := psClear;
  304.   end
  305.   else begin
  306.     FImage.Canvas.Pen.Style := psSolid;
  307.     FImage.Canvas.Brush.Color := Color;
  308.   end;
  309.   try
  310.     PaintRgn(FImage.Canvas.Handle, Rgn);
  311.     if not Shade then begin
  312.       FImage.Canvas.Brush.Color := Font.Color;
  313. {$IFDEF WIN32}
  314.       if (HintStyle = hsRectangle) and not HintTail then begin
  315.         DrawEdge(FImage.Canvas.Handle, FRect, BDR_RAISEDOUTER, BF_RECT);
  316.       end
  317.       else
  318. {$ENDIF}
  319.         FrameRgn(FImage.Canvas.Handle, Rgn, FImage.Canvas.Brush.Handle, 1, 1);
  320.     end;
  321.   finally
  322.     if Shade then begin
  323. {$IFDEF RX_D4}
  324.       FImage.Canvas.Brush.Bitmap := nil;
  325. {$ELSE}
  326.       FImage.Canvas.Brush.Bitmap.Free;
  327. {$ENDIF}
  328.       FImage.Canvas.Pen.Style := psSolid;
  329.     end;
  330.     FImage.Canvas.Brush.Color := Color;
  331.   end;
  332. end;
  333.  
  334. procedure TRxHintWindow.Paint;
  335. var
  336.   R: TRect;
  337.   FShadeRgn, FRgn: HRgn;
  338.  
  339.   procedure PaintText(R: TRect);
  340.   const
  341.     Flag: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
  342. {$IFNDEF WIN32}
  343.   var
  344.     ACaption: array[0..255] of Char;
  345. {$ENDIF}
  346.   begin
  347. {$IFDEF WIN32}
  348.     DrawText(FImage.Canvas.Handle, PChar(Caption),
  349. {$ELSE}
  350.     DrawText(FImage.Canvas.Handle, StrPCopy(ACaption, Caption),
  351. {$ENDIF}
  352.       -1, R, DT_NOPREFIX or DT_WORDBREAK or Flag[HintAlignment]
  353.       {$IFDEF RX_D4} or DrawTextBiDiModeFlagsReadingOnly {$ENDIF});
  354.   end;
  355.  
  356. begin
  357.   R := ClientRect;
  358.   FImage.Handle := CreateCompatibleBitmap(Canvas.Handle,
  359.     WidthOf(ClientRect), HeightOf(ClientRect));
  360.   FImage.Canvas.Font := Self.Canvas.Font;
  361.   if (HintStyle <> hsRectangle) or (HintShadowSize > 0) or HintTail then
  362.     FImage.Canvas.Draw(0, 0, FSrcImage);
  363.   FRgn := CreateRegion(False);
  364.   FShadeRgn := CreateRegion(True);
  365.   try
  366.     FillRegion(FShadeRgn, True);
  367.     FillRegion(FRgn, False);
  368.   finally
  369.     DeleteObject(FShadeRgn);
  370.     DeleteObject(FRgn);
  371.   end;
  372.   R := FTextRect;
  373.   if HintAlignment = taLeftJustify then Inc(R.Left, 2);
  374.   PaintText(R);
  375.   Canvas.Draw(0, 0, FImage);
  376. end;
  377.  
  378. procedure TRxHintWindow.ActivateHint(Rect: TRect; const AHint: string);
  379. var
  380.   R: TRect;
  381.   ScreenDC: HDC;
  382.   P: TPoint;
  383. begin
  384.   Caption := AHint;
  385.   GetCursorPos(P);
  386.   FPos := hpBottomRight;
  387.   R := CalcHintRect(Screen.Width, AHint, nil);
  388. {$IFDEF RX_D3}
  389.   OffsetRect(R, Rect.Left - R.Left, Rect.Top - R.Top);
  390. {$ELSE}
  391.  {$IFDEF WIN32}
  392.   OffsetRect(R, P.X, P.Y + GetCursorHeightMargin);
  393.  {$ELSE}
  394.   OffsetRect(R, P.X, Rect.Top - R.Top);
  395.  {$ENDIF WIN32}
  396. {$ENDIF}
  397.   Rect := R;
  398.   BoundsRect := Rect;
  399.  
  400.   if HintTail then begin
  401.     Rect.Top := P.Y - Height - 3;
  402.     if Rect.Top < 0 then Rect.Top := BoundsRect.Top
  403.     else Rect.Bottom := Rect.Top + HeightOf(BoundsRect);
  404.  
  405.     Rect.Left := P.X + 1;
  406.     if Rect.Left < 0 then Rect.Left := BoundsRect.Left
  407.     else Rect.Right := Rect.Left + WidthOf(BoundsRect);
  408.   end;
  409.  
  410.   if Rect.Top + Height > Screen.Height then begin
  411.     Rect.Top := Screen.Height - Height;
  412.     if Rect.Top <= P.Y then Rect.Top := P.Y - Height - 3;
  413.   end;
  414.   if Rect.Left + Width > Screen.Width then begin
  415.     Rect.Left := Screen.Width - Width;
  416.     if Rect.Left <= P.X then Rect.Left := P.X - Width -3;
  417.   end;
  418.   if Rect.Left < 0 then begin
  419.     Rect.Left := 0;
  420.     if Rect.Left + Width >= P.X then Rect.Left := P.X - Width - 1;
  421.   end;
  422.   if Rect.Top < 0 then begin
  423.     Rect.Top := 0;
  424.     if Rect.Top + Height >= P.Y then Rect.Top := P.Y - Height - 1;
  425.   end;
  426.  
  427.   if (HintStyle <> hsRectangle) or (HintShadowSize > 0) or HintTail then
  428.   begin
  429.     FPos := hpBottomRight;
  430.     if (Rect.Top + Height < P.Y) then FPos := hpTopRight;
  431.     if (Rect.Left + Width < P.X) then begin
  432.       if FPos = hpBottomRight then FPos := hpBottomLeft
  433.       else FPos := hpTopLeft;
  434.     end;
  435.     if HintTail then begin
  436.       if (FPos in [hpBottomRight, hpBottomLeft]) then begin
  437.         OffsetRect(FRect, 0, FTileSize.Y);
  438.         OffsetRect(FTextRect, 0, FTileSize.Y);
  439.       end;
  440.       if (FPos in [hpBottomRight, hpTopRight]) then begin
  441.         OffsetRect(FRect, FTileSize.X, 0);
  442.         OffsetRect(FTextRect, FTileSize.X, 0);
  443.       end;
  444.     end;
  445.     if HandleAllocated then begin
  446.       SetWindowPos(Handle, HWND_BOTTOM, 0, 0, 0, 0, SWP_HIDEWINDOW or
  447.         SWP_NOACTIVATE or SWP_NOSIZE or SWP_NOMOVE);
  448.       if Screen.ActiveForm <> nil then UpdateWindow(Screen.ActiveForm.Handle);
  449.     end;
  450.     ScreenDC := GetDC(0);
  451.     try
  452.       with FSrcImage do begin
  453.         Width := WidthOf(BoundsRect);
  454.         Height := HeightOf(BoundsRect);
  455.         BitBlt(Canvas.Handle, 0, 0, Width, Height, ScreenDC, Rect.Left,
  456.           Rect.Top, SRCCOPY);
  457.       end;
  458.     finally
  459.       ReleaseDC(0, ScreenDC);
  460.     end;
  461.   end;
  462.   SetWindowPos(Handle, HWND_TOPMOST, Rect.Left, Rect.Top, 0,
  463.     0, SWP_SHOWWINDOW or SWP_NOACTIVATE or SWP_NOSIZE);
  464. end;
  465.  
  466. function TRxHintWindow.CalcHintRect(MaxWidth: Integer; const AHint: string;
  467.   AData: Pointer): TRect;
  468. const
  469.   Flag: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
  470. var
  471.   A: Integer;
  472.   X, Y, Factor: Double;
  473. {$IFNDEF WIN32}
  474.   ACaption: array[0..255] of Char;
  475. {$ENDIF}
  476. begin
  477.   Result := Rect(0, 0, MaxWidth, 0);
  478.   DrawText(Canvas.Handle,
  479. {$IFDEF WIN32}
  480.     PChar(AHint),
  481. {$ELSE}
  482.     StrPCopy(ACaption, AHint),
  483. {$ENDIF}
  484.     -1, Result, DT_CALCRECT or DT_WORDBREAK or DT_NOPREFIX or Flag[HintAlignment]
  485.     {$IFDEF RX_D4} or DrawTextBiDiModeFlagsReadingOnly {$ENDIF});
  486.   Inc(Result.Right, 8);
  487.   Inc(Result.Bottom, 4);
  488.   FRect := Result;
  489.   FTextRect := Result;
  490.   InflateRect(FTextRect, -1, -1);
  491.   case HintAlignment of
  492.     taCenter: OffsetRect(FTextRect, -1, 0);
  493.     taRightJustify: OffsetRect(FTextRect, -4, 0);
  494.   end;
  495.   FRoundFactor := Max(6, Min(WidthOf(Result), HeightOf(Result)) div 4);
  496.   if HintStyle = hsRoundRect then
  497.     InflateRect(FRect, FRoundFactor div 4, FRoundFactor div 4)
  498.   else if HintStyle = hsEllipse then begin
  499.     X := WidthOf(FRect) / 2;
  500.     Y := HeightOf(FRect) / 2;
  501.     if (X <> 0) and (Y <> 0) then begin
  502.       Factor := Round(Y / 3);
  503.       A := Round(Sqrt((Sqr(X) * Sqr(Y + Factor)) / (Sqr(Y + Factor) - Sqr(Y))));
  504.       InflateRect(FRect, A - Round(X), Round(Factor));
  505.     end;
  506.   end;
  507.   Result := FRect;
  508.   OffsetRect(FRect, -Result.Left, -Result.Top);
  509.   OffsetRect(FTextRect, -Result.Left, -Result.Top);
  510.   Inc(Result.Right, HintShadowSize);
  511.   Inc(Result.Bottom, HintShadowSize);
  512.   if HintTail then begin
  513.     FTileSize.Y := Max(14, Min(WidthOf(FTextRect), HeightOf(FTextRect)) div 2);
  514.     FTileSize.X := FTileSize.Y - 8;
  515.     Inc(Result.Right, FTileSize.X);
  516.     Inc(Result.Bottom, FTileSize.Y);
  517.   end;
  518. end;
  519.  
  520. {$IFDEF RX_D3}
  521. procedure TRxHintWindow.ActivateHintData(Rect: TRect; const AHint: string;
  522.   AData: Pointer);
  523. begin
  524.   ActivateHint(Rect, AHint);
  525. end;
  526. {$ENDIF}
  527.  
  528. end.