home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibdemo3.zip / SOURCE.DAT / SOURCE / ADDON / HINTS.PAS < prev    next >
Pascal/Delphi Source File  |  1998-05-02  |  15KB  |  506 lines
  1. Unit Hints;
  2.  
  3.  
  4. Interface
  5.  
  6. Uses
  7.   Classes,Forms;
  8.  
  9. Type
  10.   {$M+}
  11.   TShadowStyle=(shsSolid,shsShadowed);
  12.   {$M-}
  13.  
  14.   TCustomHint=Class(TComponent)
  15.     Private
  16.       FOutlined:BOOLEAN;
  17.       FOutlineColor:TColor;
  18.       FShadowSize:LONGINT;
  19.       FShadowStyle:TShadowStyle;
  20.       FShadowColor:TColor;
  21.       FHintPenColor:TColor;
  22.       FHintColor:TColor;
  23.       FMaxWidth:LONGINT;
  24.       FHintOrigin:THintOrigin;
  25.       Procedure SetShadowSize(NewValue:LONGINT);
  26.       Procedure SetHintOrigin(NewValue:THintOrigin);
  27.     Protected
  28.       Procedure SetupComponent;Override;
  29.     Public
  30.       Destructor Destroy;Override;
  31.     Published
  32.       Property Outlined:BOOLEAN read FOutlined write FOutLined;
  33.       Property OutlineColor:TColor read FOutlineColor write FOutlineColor;
  34.       Property ShadowSize:LONGINT read FShadowSize write SetShadowSize;
  35.       Property ShadowStyle:TShadowStyle read FShadowStyle write FShadowStyle;
  36.       Property ShadowColor:TColor read FShadowColor write FShadowColor;
  37.       Property HintPenColor:TColor read FHintPenColor write FHintPenColor;
  38.       Property HintColor:TColor read FHintColor write FHintColor;
  39.       Property MaxWidth:LONGINT read FMaxWidth write FMaxWidth;
  40.       Property Origin:THintOrigin read FHintOrigin write SetHintOrigin;
  41.   End;
  42.  
  43.  
  44.   {$M+}
  45.   TBalloonShape=(basRectangle,basRounded);
  46.   {$M-}
  47.  
  48.   TBalloonHint=Class(TCustomHint)
  49.     Private
  50.       FBalloonShape:TBalloonShape;
  51.       Property Origin;
  52.     Protected
  53.       Procedure SetupComponent;Override;
  54.     Public
  55.       Destructor Destroy;Override;
  56.     Published
  57.       Property BalloonShape:TBalloonShape read FBalloonShape write FBalloonShape;
  58.   End;
  59.  
  60.  
  61. Implementation
  62.  
  63. Const
  64.   CustomHint:TCustomHint=Nil;
  65.   BalloonHint:TBalloonHint=Nil;
  66.  
  67. {
  68. ╔═══════════════════════════════════════════════════════════════════════════╗
  69. ║                                                                           ║
  70. ║ Speed-Pascal/2 Version 2.0                                                ║
  71. ║                                                                           ║
  72. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  73. ║                                                                           ║
  74. ║ This section: TCustomHintWindow Class implementation                      ║
  75. ║                                                                           ║
  76. ║ Last modified: September 1995                                             ║
  77. ║                                                                           ║
  78. ║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
  79. ║                                                                           ║
  80. ╚═══════════════════════════════════════════════════════════════════════════╝
  81. }
  82.  
  83. Type
  84.   TCustomHintWindow=Class(THintWindow)
  85.     Private
  86.       FCustomHint:TCustomHint;
  87.     Protected
  88.       Procedure SplitText(Bubble:String;Ret:TStrings;Var CX,CY:LONGINT);Virtual;
  89.       Procedure DrawBubbleShape(Const rec:TRect);Virtual;
  90.       Procedure DrawBubbleText(Const Bubble:String;Const rec:TRect);Virtual;
  91.     Public
  92.       Procedure Redraw(Const rec:TRect);Override;
  93.       Procedure ActivateHint(Rect:TRect; Const AHint:String);Override;
  94.   End;
  95.  
  96.  
  97. Procedure TCustomHintWindow.SplitText(Bubble:String;Ret:TStrings;Var CX,CY:LONGINT);
  98. Const
  99.   Separators:Set Of CHAR = [' ','.',',',':',';',')',']','!','?'];
  100. Var
  101.   CX1,CY1:LONGINT;
  102.   t:LONGINT;
  103.   s:String;
  104.   LastFound:LONGINT;
  105. Begin
  106.    CY := 0;
  107.    CX := 0;
  108.    While Bubble <> '' Do
  109.    Begin
  110.      LastFound := 0;
  111.      For t := 1 To length(Bubble) Do
  112.        If Bubble[t] In Separators Then
  113.        Begin
  114.          s := Copy(Bubble,1,t);
  115.          Canvas.GetTextExtent(s,CX1,CY1);
  116.          If CX1 < CustomHint.FMaxWidth - CustomHint.FShadowSize Then
  117.          Begin
  118.            LastFound := t;
  119.            If CX1 > CX Then CX := CX1;
  120.          End
  121.          Else break;
  122.        End;
  123.  
  124.      If LastFound=0 Then //no separator, split at will
  125.      Begin
  126.        For t := 1 To length(Bubble) Do
  127.        Begin
  128.          s := Copy(Bubble,1,t);
  129.          Canvas.GetTextExtent(s,CX1,CY1);
  130.          If CX1 < CustomHint.FMaxWidth - CustomHint.FShadowSize Then
  131.          Begin
  132.            LastFound := t;
  133.            If CX1 > CX Then CX := CX1;
  134.          End
  135.          Else break;
  136.        End;
  137.      End;
  138.  
  139.      If LastFound = 0 Then LastFound := 1;
  140.  
  141.      s := Copy(Bubble,1,LastFound);
  142.      Delete(Bubble,1,LastFound);
  143.      Ret.Add(s);
  144.      inc(CY,Canvas.Font.Height);
  145.    End;
  146. End;
  147.  
  148.  
  149. Procedure TCustomHintWindow.DrawBubbleShape(Const rec:TRect);
  150. Begin
  151.   Canvas.Rectangle(rec);
  152. End;
  153.  
  154.  
  155. Procedure TCustomHintWindow.DrawBubbleText(Const Bubble:String;Const rec:TRect);
  156. Var
  157.   CX,CY:LONGINT;
  158.   X,Y:LONGINT;
  159.   Strings:TStringList;
  160.   t:LONGINT;
  161. Begin
  162.   {Draw Text}
  163.   Canvas.ClipRect := rec;
  164.   Canvas.GetTextExtent(Bubble,CX,CY);
  165.   Canvas.Brush.Mode := bmTransparent;
  166.  
  167.   If CX < CustomHint.FMaxWidth - CustomHint.FShadowSize Then
  168.   Begin
  169.     //Center text within the rectangle
  170.     X := rec.Left+((rec.Right-rec.Left-CX) Div 2);
  171.     If X < rec.Left Then X := rec.Left;
  172.  
  173.     Y := rec.Bottom+((rec.Top-rec.Bottom-CY) Div 2);
  174.     If Y < rec.Bottom Then Y := rec.Bottom;
  175.     Canvas.TextOut(X,Y,Bubble);
  176.   End
  177.   Else //split
  178.   Begin
  179.     Strings.Create;
  180.     SplitText(Bubble,Strings,CX,CY);
  181.  
  182.     X := rec.Left+((rec.Right-rec.Left-CX) Div 2);
  183.     If X < rec.Left Then X := rec.Left;
  184.     Y := rec.Top-Canvas.Font.Height-((rec.Top-rec.Bottom-CY) Div 2);
  185.     For t := 0 To Strings.Count-1 Do
  186.     Begin
  187.       Canvas.TextOut(X,Y,Strings[t]);
  188.       dec(Y,Canvas.Font.Height);
  189.     End;
  190.  
  191.     Strings.Destroy;
  192.   End;
  193.  
  194.   Canvas.Brush.Mode := bmOpaque;
  195.   Canvas.DeleteClipRegion;
  196. End;
  197.  
  198.  
  199. Procedure TCustomHintWindow.ActivateHint(Rect:TRect; Const AHint:String);
  200. Var
  201.   Strings:TStringList;
  202.   CX:LONGINT;
  203.   w,h:LONGINT;
  204. Begin
  205.   Canvas.Font := Font;
  206.  
  207.   Canvas.GetTextExtent(AHint,w,h);
  208.  
  209.   If w >= CustomHint.FMaxWidth - CustomHint.FShadowSize Then
  210.   Begin
  211.     //Split
  212.     w := CustomHint.FMaxWidth - CustomHint.FShadowSize;
  213.     Strings.Create;
  214.     SplitText(AHint,Strings,CX,h);
  215.     w := CX;
  216.     Strings.Destroy;
  217.   End;
  218.  
  219.   inc(w,CustomHint.FShadowSize+16);
  220.   inc(h,CustomHint.FShadowSize+10);
  221.  
  222.   If Application.HintOrigin = hiTop Then Rect.Bottom := Screen.MousePos.Y
  223.   Else Rect.Bottom := Screen.MousePos.Y - 15 - h;
  224.  
  225.   Rect.Right := Rect.Left + w;
  226.   Rect.Top := Rect.Bottom + h;
  227.  
  228.   Inherited ActivateHint(Rect,AHint);
  229. End;
  230.  
  231.  
  232. Procedure TCustomHintWindow.Redraw(Const rec:TRect);
  233. Var
  234.   Target:TRect;
  235. Begin
  236.   Canvas.Pen.Color := CustomHint.FHintColor;
  237.   Canvas.Pen.Width := 1;
  238.   Canvas.Brush.Style := bsSolid;
  239.  
  240.   Canvas.ClipRect := rec;
  241.  
  242.   Target := ClientRect;
  243.   dec(Target.Right,4+CustomHint.FShadowSize);
  244.   dec(Target.Top,4);
  245.   inc(Target.Bottom,CustomHint.FShadowSize);
  246.  
  247.   Canvas.BeginPath;
  248.   DrawBubbleShape(Target);
  249.   Canvas.EndPath;
  250.   Canvas.FillPath;
  251.  
  252.   If CustomHint.FOutlined Then
  253.   Begin
  254.     Canvas.Pen.Color := CustomHint.FOutlineColor;
  255.     DrawBubbleShape(Target);
  256.   End;
  257.  
  258.   {Draw shadow}
  259.   If CustomHint.FShadowSize > 0 Then
  260.   Begin
  261.        Canvas.Pen.Color:=CustomHint.FShadowColor;
  262.  
  263.        {Create complex clip region}
  264.        Canvas.BeginPath;
  265.        DrawBubbleShape(Target);
  266.        Canvas.EndPath;
  267.        Canvas.PathToClipRegion(paSubtract);
  268.  
  269.        If CustomHint.FShadowStyle = shsShadowed Then
  270.        Begin
  271.             Canvas.Pen.Mode := pmMerge;
  272.             Canvas.Brush.Style := bsDiagCross;
  273.             Canvas.Pen.Color := clBlack;
  274.             Canvas.Brush.Color := clBlack;
  275.        End;
  276.  
  277.        Target := rec;
  278.        dec(Target.Right,4);
  279.        dec(Target.Top,4+CustomHint.FShadowSize);
  280.        inc(Target.Left,CustomHint.FShadowSize);
  281.  
  282.        Canvas.BeginPath;
  283.        DrawBubbleShape(Target);
  284.        Canvas.EndPath;
  285.        Canvas.FillPath;
  286.   End;
  287.  
  288.   Canvas.Pen.Mode := pmCopy;
  289.   Canvas.DeleteClipRegion;
  290.  
  291.   Target := rec;
  292.   inc(Target.Bottom,CustomHint.FShadowSize);
  293.   dec(Target.Right,CustomHint.FShadowSize+3);
  294.   Canvas.Pen.Color := CustomHint.FHintPenColor;
  295.   DrawBubbleText(Caption,Target);
  296. End;
  297.  
  298.  
  299. {
  300. ╔═══════════════════════════════════════════════════════════════════════════╗
  301. ║                                                                           ║
  302. ║ Speed-Pascal/2 Version 2.0                                                ║
  303. ║                                                                           ║
  304. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  305. ║                                                                           ║
  306. ║ This section: TCustomHint Class implementation                            ║
  307. ║                                                                           ║
  308. ║ Last modified: September 1995                                             ║
  309. ║                                                                           ║
  310. ║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
  311. ║                                                                           ║
  312. ╚═══════════════════════════════════════════════════════════════════════════╝
  313. }
  314.  
  315. Procedure TCustomHint.SetupComponent;
  316. Begin
  317.   Inherited SetupComponent;
  318.  
  319.   If Not InDesigner Then
  320.   Begin
  321.     HintWindowClass := TCustomHintWindow;
  322.     CustomHint := Self;
  323.   End;
  324.  
  325.   Name := 'CustomHint';
  326.   FOutlined := TRUE;
  327.   FShadowSize := 10;
  328.   FShadowStyle := shsShadowed;
  329.   FShadowColor := clBlack;
  330.   FHintPenColor := Application.HintPenColor;
  331.   FHintColor := Application.HintColor;
  332.   FHintOrigin := Application.HintOrigin;
  333.   FMaxWidth := 200;
  334. End;
  335.  
  336.  
  337. Destructor TCustomHint.Destroy;
  338. Begin
  339.   If CustomHint = Self Then CustomHint := Nil;
  340.   Inherited Destroy;
  341. End;
  342.  
  343.  
  344. Procedure TCustomHint.SetHintOrigin(NewValue:THintOrigin);
  345. Begin
  346.   If Not InDesigner Then Application.HintOrigin := NewValue;
  347.   FHintOrigin := NewValue;
  348. End;
  349.  
  350.  
  351. Procedure TCustomHint.SetShadowSize(NewValue:LONGINT);
  352. Begin
  353.   If (NewValue < 0) Or (NewValue > 50) Then exit;
  354.   FShadowSize := NewValue;
  355. End;
  356.  
  357.  
  358. {
  359. ╔═══════════════════════════════════════════════════════════════════════════╗
  360. ║                                                                           ║
  361. ║ Speed-Pascal/2 Version 2.0                                                ║
  362. ║                                                                           ║
  363. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  364. ║                                                                           ║
  365. ║ This section: TBallonHintWindow Class implementation                      ║
  366. ║                                                                           ║
  367. ║ Last modified: September 1995                                             ║
  368. ║                                                                           ║
  369. ║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
  370. ║                                                                           ║
  371. ╚═══════════════════════════════════════════════════════════════════════════╝
  372. }
  373.  
  374. Type
  375.   TBalloonHintWindow=Class(TCustomHintWindow)
  376.     Protected
  377.       Procedure DrawBubbleShape(Const rec:TRect);Override;
  378.       Procedure DrawBubbleText(Const Bubble:String;Const rec:TRect);Override;
  379.     Public
  380.       Procedure ActivateHint(Rect:TRect; Const AHint:String);Override;
  381.   End;
  382.  
  383.  
  384. Procedure TBalloonHintWindow.DrawBubbleShape(Const rec:TRect);
  385. Begin
  386.   Canvas.PenPos := Point(rec.Left,rec.Bottom);
  387.  
  388.   Canvas.LineTo(rec.Left+20,rec.Bottom+15);
  389.  
  390.   If BalloonHint.FBalloonShape = basRectangle Then
  391.   Begin
  392.     Canvas.LineTo(rec.Right,rec.Bottom+15);
  393.     Canvas.LineTo(rec.Right,rec.Top);
  394.     Canvas.LineTo(rec.Left+5,rec.Top);
  395.     Canvas.LineTo(rec.Left+5,rec.Bottom+15);
  396.     Canvas.LineTo(rec.Left+10,rec.Bottom+15);
  397.     Canvas.LineTo(rec.Left,rec.Bottom);
  398.   End
  399.   Else
  400.   Begin
  401.     Canvas.LineTo(rec.Right-8,rec.Bottom+15);
  402.     Canvas.Arc(rec.Right-8,rec.Bottom+23,8,8,270,90);
  403.     Canvas.LineTo(rec.Right,rec.Top-8);
  404.     Canvas.Arc(rec.Right-8,rec.Top-8,8,8,0,90);
  405.     Canvas.LineTo(rec.Left+13,rec.Top);
  406.     Canvas.Arc(rec.Left+13,rec.Top-8,8,8,90,90);
  407.     Canvas.LineTo(rec.Left+5,rec.Bottom+23);
  408.     Canvas.Arc(rec.Left+13,rec.Bottom+23,8,8,180,70);
  409.     Canvas.LineTo(rec.Left+10,rec.Bottom+15);
  410.     Canvas.LineTo(rec.Left,rec.Bottom);
  411.   End;
  412. End;
  413.  
  414.  
  415. Procedure TBalloonHintWindow.DrawBubbleText(Const Bubble:String;Const rec:TRect);
  416. Var
  417.   rc1:TRect;
  418. Begin
  419.   rc1 := rec;
  420.   inc(rc1.Left,4);
  421.   inc(rc1.Bottom,15);
  422.  
  423.   Inherited DrawBubbleText(Bubble,rc1);
  424. End;
  425.  
  426.  
  427. Procedure TBalloonHintWindow.ActivateHint(Rect:TRect; Const AHint:String);
  428. Var
  429.   Strings:TStringList;
  430.   CX:LONGINT;
  431.   w,h:LONGINT;
  432. Begin
  433.   Canvas.Font := Font;
  434.  
  435.   Canvas.GetTextExtent(AHint,w,h);
  436.  
  437.   If w >= CustomHint.FMaxWidth - CustomHint.FShadowSize Then
  438.   Begin
  439.     //Split
  440.     w := CustomHint.FMaxWidth - CustomHint.FShadowSize;
  441.     Strings.Create;
  442.     SplitText(AHint,Strings,CX,h);
  443.     w := CX;
  444.     Strings.Destroy;
  445.   End;
  446.  
  447.   inc(w,CustomHint.FShadowSize+16);
  448.   inc(h,CustomHint.FShadowSize+10);
  449.  
  450.   If Application.HintOrigin = hiTop Then Rect.Bottom := Screen.MousePos.Y
  451.   Else Rect.Bottom := Screen.MousePos.Y - 15 - h;
  452.  
  453.   inc(w,8);
  454.   inc(h,15);
  455.  
  456.   Rect.Right := Rect.Left + w;
  457.   Rect.Top := Rect.Bottom + h;
  458.  
  459.   THintWindow.ActivateHint(Rect,AHint);
  460. End;
  461.  
  462.  
  463. {
  464. ╔═══════════════════════════════════════════════════════════════════════════╗
  465. ║                                                                           ║
  466. ║ Speed-Pascal/2 Version 2.0                                                ║
  467. ║                                                                           ║
  468. ║ Speed-Pascal Component Classes (SPCC)                                     ║
  469. ║                                                                           ║
  470. ║ This section: TBalloonHint Class implementation                           ║
  471. ║                                                                           ║
  472. ║ Last modified: September 1995                                             ║
  473. ║                                                                           ║
  474. ║ (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited !          ║
  475. ║                                                                           ║
  476. ╚═══════════════════════════════════════════════════════════════════════════╝
  477. }
  478.  
  479. Procedure TBalloonHint.SetupComponent;
  480. Begin
  481.   Inherited SetupComponent;
  482.  
  483.   If Not InDesigner Then
  484.   Begin
  485.     HintWindowClass := TBalloonHintWindow;
  486.     BalloonHint := Self;
  487.     Application.HintOrigin := hiTop;
  488.   End;
  489.  
  490.   Name := 'BalloonHint';
  491.   FBalloonShape := basRounded;
  492. End;
  493.  
  494.  
  495. Destructor TBalloonHint.Destroy;
  496. Begin
  497.   If BalloonHint = Self Then BalloonHint := Nil;
  498.   Inherited Destroy;
  499. End;
  500.  
  501.  
  502.  
  503. Begin
  504.   RegisterClasses([TCustomHint,TBalloonHint]);
  505. End.
  506.