elpspanl.pas

动态提示控件

{$I DFS.INC}  { Standard defines for all Delphi Free Stuff components }

{------------------------------------------------------------------------------}
{ TdfsEllipsisPanel v1.19                                                      }
{------------------------------------------------------------------------------}
{ A panel that can shorten the caption text, replacing it with '...' when      }
{ it does not fit the available space.  Also provided is a generic function    }
{ that will "ellipsify" a string.  This function can be used to produce        }
{ other components like TdfsEllipsisPanel, such as TdfsEllipsisLabel.          }
{                                                                              }
{ Copyright 2000-2001, Brad Stowers.  All Rights Reserved.                     }
{                                                                              }
{ Copyright:                                                                   }
{ All Delphi Free Stuff (hereafter "DFS") source code is copyrighted by        }
{ Bradley D. Stowers (hereafter "author"), and shall remain the exclusive      }
{ property of the author.                                                      }
{                                                                              }
{ Distribution Rights:                                                         }
{ You are granted a non-exlusive, royalty-free right to produce and distribute }
{ compiled binary files (executables, DLLs, etc.) that are built with any of   }
{ the DFS source code unless specifically stated otherwise.                    }
{ You are further granted permission to redistribute any of the DFS source     }
{ code in source code form, provided that the original archive as found on the }
{ DFS web site (http://www.delphifreestuff.com) is distributed unmodified. For }
{ example, if you create a descendant of TDFSColorButton, you must include in  }
{ the distribution package the colorbtn.zip file in the exact form that you    }
{ downloaded it from http://www.delphifreestuff.com/mine/files/colorbtn.zip.   }
{                                                                              }
{ Restrictions:                                                                }
{ Without the express written consent of the author, you may not:              }
{   * Distribute modified versions of any DFS source code by itself. You must  }
{     include the original archive as you found it at the DFS site.            }
{   * Sell or lease any portion of DFS source code. You are, of course, free   }
{     to sell any of your own original code that works with, enhances, etc.    }
{     DFS source code.                                                         }
{   * Distribute DFS source code for profit.                                   }
{                                                                              }
{ Warranty:                                                                    }
{ There is absolutely no warranty of any kind whatsoever with any of the DFS   }
{ source code (hereafter "software"). The software is provided to you "AS-IS", }
{ and all risks and losses associated with it's use are assumed by you. In no  }
{ event shall the author of the softare, Bradley D. Stowers, be held           }
{ accountable for any damages or losses that may occur from use or misuse of   }
{ the software.                                                                }
{                                                                              }
{ Support:                                                                     }
{ Support is provided via the DFS Support Forum, which is a web-based message  }
{ system.  You can find it at http://www.delphifreestuff.com/discus/           }
{ All DFS source code is provided free of charge. As such, I can not guarantee }
{ any support whatsoever. While I do try to answer all questions that I        }
{ receive, and address all problems that are reported to me, you must          }
{ understand that I simply can not guarantee that this will always be so.      }
{                                                                              }
{ Clarifications:                                                              }
{ If you need any further information, please feel free to contact me directly.}
{ This agreement can be found online at my site in the "Miscellaneous" section.}
{------------------------------------------------------------------------------}
{ The lateset version of my components are always available on the web at:     }
{   http://www.delphifreestuff.com/                                            }
{ See ElpsPanl.txt for notes, known issues, and revision history.              }
{------------------------------------------------------------------------------}
{ Date last modified:  June 27, 2001                                           }
{------------------------------------------------------------------------------}

unit ElpsPanl;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls, Menus;

const
  { This shuts up C++Builder 3 about the redefiniton being different. There
    seems to be no equivalent in C1.  Sorry. }
  {$IFDEF DFS_CPPB_3_UP}
  {$EXTERNALSYM DFS_COMPONENT_VERSION}
  {$ENDIF}
  DFS_COMPONENT_VERSION = 'TdfsEllipsisPanel v1.19';

type
  TAutoHintOption = (ahEnabled, ahWindowOnly, ahOnEllipsis);
  { ahEnabled    - Enable auto hint (set hint when caption too big.           }
  { ahWindowOnly - Don't generate applicatoin events, only the popup hint.    }
  {                Basically, it sticks an '|' on the end of the hint string. }
  { ahOnEllipsis - When Caption too big, Hint is set to Caption. When Caption }
  {                fits, Hint is set to last value assigned to it, either in  }
  {                IDE or code. For example, you set Hint = "My hint" and the }
  {                panel has to use "..." when it displayes the caption       }
  {                "Some Text String".  The hint would pop up as "Some Text   }
  {                String".  You then resize and the entire caption can be    }
  {                displayed in the panel.  The hint would then be "My hint". }

  TAutoHintOptions = set of TAutoHintOption;

const
  DEF_AUTOHINTOPTIONS = [ahEnabled, ahWindowOnly, ahOnEllipsis];

type
  TdfsEllipsisPanel = class(TCustomPanel)
  private
    FAutoHintOptions: TAutoHintOptions;
    FIsPath: boolean;
    FCaption: string;
    FSaveHint: string;

    procedure SetAutoHintOptions(Val: TAutoHintOptions);
    procedure SetIsPath(Val: boolean);
    procedure SetCaption(const Val: string);
    function GetCaption: string;

    procedure WMSize(var Msg: TWMSize); message WM_SIZE;
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
  protected
    procedure UpdatePanelText;
    procedure UpdateHintText;
    procedure Loaded; override;
    function GetVersion: string;
    procedure SetVersion(const Val: string);
  public
    constructor Create(AOwner: TComponent); override;
    {$IFDEF DFS_COMPILER_4_UP}
    property DockManager;
    {$ENDIF}
  published
    property Version: string
       read GetVersion
       write SetVersion
       stored FALSE;
    property AutoHintOptoins: TAutoHintOptions
       read FAutoHintOptions
       write SetAutoHintOptions
       default DEF_AUTOHINTOPTIONS;
    property IsPath: boolean
       read FIsPath
       write SetIsPath
       default FALSE;
    property Caption: string
       read GetCaption
       write SetCaption;

    { Publish inherited stuff }
    property Align;
    property Alignment;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderWidth;
    property BorderStyle;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Color;
    property Ctl3D;
    property Font;
    property Locked;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint default TRUE;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    {$IFDEF DFS_COMPILER_2_UP}
    property OnStartDrag;
    {$ENDIF}
    {$IFDEF DFS_COMPILER_3_UP}
    property FullRepaint;
    {$ENDIF}
    {$IFDEF DFS_COMPILER_4_UP}
    property Anchors;
    property AutoSize;
    property BiDiMode;
    property Constraints;
    property UseDockManager default True;
    property DockSite;
    property DragKind;
    property ParentBiDiMode;
    property OnCanResize;
    property OnConstrainedResize;
    property OnDockDrop;
    property OnDockOver;
    property OnEndDock;
    property OnGetSiteInfo;
    property OnStartDock;
    property OnUnDock;
    {$ENDIF}
    {$IFDEF DFS_COMPILER_5_UP}
    property OnContextPopup;
    {$ENDIF}
    {$IFDEF DFS_COMPILER_7_UP}
    Make sure to add any new properties introduced in TPanel.
    {$ENDIF}
  end;

function EllipsifyText(AsPath: boolean; const Text: string;
                       const Canvas: TCanvas; MaxWidth: integer): string;


implementation


{$IFNDEF DFS_WIN32}
procedure SetLength(var s: string; NewLen: byte);
begin
  S[0] := chr(NewLen);
end;
{$ENDIF}

function EllipsifyText(AsPath: boolean; const Text: string;
                       const Canvas: TCanvas; MaxWidth: integer): string;
{$IFDEF DFS_WIN32}
var
   TempPChar: PChar;
   TempRect: TRect;
   Params: UINT;
begin
  // Alocate mem for PChar
  GetMem(TempPChar, Length(Text)+1);
  try
    // Copy Text into PChar
    TempPChar := StrPCopy(TempPChar, Text);
    // Create Rectangle to Store PChar
    TempRect := Rect(0,0, MaxWidth, High(Integer));
    // Set Params depending wether it's a path or not
    if AsPath then