Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/kompon/d123456/CHEMPLOT.ZIP/Misc/Mlabel.pas

Pascal/Delphi Source File | 2001-07-26 | 26.6 KB | 885 lines

unit Mlabel;

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at

http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License.

The Original Code is: MLabel.pas, released 12 September 2000.

The Initial Developer of the Original Code is Mat Ballard.
Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard.
Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
All Rights Reserved.

Contributor(s): Mat Ballard                 e-mail: [e-mail].

Last Modified: 05/25/2000
Current Version: 2.00

You may retrieve the latest version of this file from:

        http://Chemware.hypermart.net/

This work was created with the Project JEDI VCL guidelines:

        http://www.delphi-jedi.org/Jedi:VCLVCL

in mind.


Purpose:
This component is similar to TLabel, but adds the ability to make every line
a different color.


Known Issues:
-----------------------------------------------------------------------------}

{$I Misc.inc}

interface

uses
  Classes, SysUtils,
{$IFDEF WINDOWS}
  WinTypes, WinProcs,
  Controls, Forms, Graphics, Menus, StdCtrls,
{$ENDIF}
{$IFDEF WIN32}
  Windows,
  Controls, Forms, Graphics, Menus, StdCtrls,
{$ENDIF}
{$IFDEF LINUX}
  Types, Untranslated,
  QControls, QForms, QGraphics, QMenus, QStdCtrls,
{$ENDIF}
  Misc;

type
  {Colors = (clAqua,
clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray,
clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow,
clActiveBorder, clActiveCaption, clAppWorkSpace, clBackground, clBtnFace,
clBtnHighlight, clBtnShadow, clBtnText, clCaptionText, clGrayText, clHighlight,
clHighlightText, clInactiveBorder, clInactiveCaption, clInactiveCaptionText,
clMenu, clMenuText, clScrollBar, clWindow, clWindowFrame, clWindowText);}

  {TPenStyle = (psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear, psInsideFrame)}

  TDirection = (dRight, dLeft, dUp, dDown);
  {dRight means normal left-to-right}
  {dLeft means upside-down}
  {dUp means the text reads upwards}
  {dDown means the text reads downwards}

  et_Popup = (puBorders,
              puBorderWidth,
              puColor,
              puDirection,
              puEdit,
              puFont,
              puLineLength,
              puSameColor,
              puTransparent);

{$IFNDEF DELPHI4_UP}
  TBorderWidth = 0..MaxInt;
{$ENDIF}
{$IFDEF KYLIX1}
  TBorderWidth = 0..MaxInt;
{$ENDIF}

  TMultiLabel = class(TCustomLabel)
  private
    { Private declarations }
    FBorderStyle: TBorderStyle;
    FBorderWidth: TBorderWidth;
    FCaption: TStringList;
    FDirection: TDirection;
    FLineLength: Word;
{the nice stuff:}
    TextEdit: TMemo;
    MyPopup: TPopupMenu;

{general variables:}

    Procedure SetCaption(Value: TStringList);
    Procedure SetBorderStyle(Value: TBorderStyle);
    Procedure SetBorderWidth(Value: TBorderWidth);
    Procedure SetDirection(Value: TDirection);
    Procedure SetLineLength(Value: Word);
    {Procedure SetAutoSize(Value: Boolean);}
  protected
    {procedure AdjustBounds;}
    {This overrides TCustomLabel's method}
    procedure DoDrawText(Text: String; var Rect: TRect; Flags: LongInt);{$IFDEF DELPHI4_UP} reintroduce;{$ENDIF}
    {This overrides TCustomLabel's method}
    Function ExtractColor(Index: Integer): TColor; virtual;
    {This extracts the color from the full caption.}
    Function ExtractPenStyle(Index: Integer): TPenStyle; virtual;
    {This extracts the color from the full caption.}
    Function ExtractText(Index: Integer): String; virtual;
    {This extracts the text from the full caption, thereby removing the color
     information from display..}
    Procedure Outline; virtual;
    {This draws the border around the text.}
    Procedure SetSize; virtual;

{mouse response procedures:}
    Procedure DblClick; Override;
    procedure EditFinished(Sender: TObject);
    procedure EditKeyDown(Sender: TObject;
                          var Key: Word;
                          Shift: TShiftState);

  public
    { Public declarations }
    Constructor Create(AOwner: TComponent); override;
    {This is the normal constructor. It initializes the caption and some properties.}
    Destructor Destroy; override;
    {This is the normal destructor. It frees the caption.}
    Procedure Paint; override;
    {This is the new Paint procedure that draws the coloured text on the canvas.}

  published
    Property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle;
    {This is the normal BorderStyle, which is found in TButton but not in TLabel.}
    Property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth;
    {This sets the width of the gap between the text and the border}
    Property Caption: TStringList read FCaption write SetCaption;
    {This is a list of the strings that you want to display, along with the
     colour information. The required format is:}
    {}
    {Text that you want to display//DelphiColor}
    {}
    {where DelphiColor is the name of the Delphi color that you want
     (eg: clAqua, clBlack, clBlue, clDkGray, etc.}

    Property Direction: TDirection read FDirection write SetDirection;

    Property LineLength: Word read FLineLength write SetLineLength;

{the inherited properties in TLabel we want:}
    property Align;
    property Alignment;
    property AutoSize;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property FocusControl;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowAccelChar;
    property ShowHint;
    property Transparent;
    property Visible;
{    property WordWrap;}
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;

{$IFDEF DELPHI2_UP}
    property OnStartDrag;
{$ENDIF}
{$IFDEF DELPHI3_UP}
    property Layout;
{$ENDIF}
{$IFDEF DELPHI4_UP}
{$ENDIF}
{$IFDEF DELPHI5_UP}
{$ENDIF}

  end;

const
  TMULTILABEL_VERSION = 100;

  NULL = 0;

  function GetWord (var This_Line: String; Delimiter: String): String;

implementation

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.Create
  Description: standard constructor
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the Caption and other Properties
 Known Issues:
 ------------------------------------------------------------------------------}
Constructor TMultiLabel.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  FCaption := TStringList.Create;
  FCaption.Add('TMultiLabel//clBlue psSolid');
  FCaption.Add('... has many//clGreen psDash');
  FCaption.Add('Colored Lines !//clRed psDot');
  Color := clBtnFace;
  FBorderStyle := bsSingle;
  FBorderWidth := 5;
  FDirection := dRight;
  FLineLength := 50;
  Font.Name := 'Arial';
  TextEdit := nil;
  MyPopup := nil;
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.Destroy
  Description: standard destructor
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: frees the Caption
 Known Issues:
 ------------------------------------------------------------------------------}
Destructor TMultiLabel.Destroy;
begin
  FCaption.Free;
  inherited Destroy;
end;

{Procedure TMultiLabel.SetAutoSize(Value: Boolean);
begin
  FAutoSize := Value;
  Refresh;
end;}

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.SetBorderStyle
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the BorderStyle Property
 Known Issues:
 ------------------------------------------------------------------------------}
Procedure TMultiLabel.SetBorderStyle(Value: TBorderStyle);
begin
  FBorderStyle := Value;
  if (Value = bsNone)
    then Canvas.Pen.Color := Parent.Brush.Color
    else Canvas.Pen.Color := clBlack;
  Refresh;
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.SetBorderWidth
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the BorderWidth Property
 Known Issues:
 ------------------------------------------------------------------------------}
Procedure TMultiLabel.SetBorderWidth(Value: TBorderWidth);
begin
  FBorderWidth := Value;
  Refresh;
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.SetCaption
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the Caption Property
 Known Issues:
 ------------------------------------------------------------------------------}
Procedure TMultiLabel.SetCaption(Value: TStringList);
begin
  Caption.Assign(Value);
  Refresh;
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.SetDirection
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the Direction Property
 Known Issues:
 ------------------------------------------------------------------------------}
Procedure TMultiLabel.SetDirection(Value: TDirection);
begin
  FDirection := Value;
  Refresh;
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.SetLineLength
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the LineLength Property
 Known Issues:
 ------------------------------------------------------------------------------}
Procedure TMultiLabel.SetLineLength(Value: Word);
begin
  FLineLength := Value;
  Refresh;
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.Paint
  Description: standard Paint method
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: Paints the multilabel, in various colors and orientations
 Known Issues:
 ------------------------------------------------------------------------------}
Procedure TMultiLabel.Paint;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
  i: Integer;
  CharStart: Integer;
  TheLine: TRect;
  Rect: TRect;
{$IFDEF DELPHI3_UP}
  CalcRect: TRect;
{$ENDIF}
  DrawStyle: Longint;
  TheTextHeight: Integer;
begin
  if (TextEdit <> nil) then
  begin
    TextEdit.Free;
    TextEdit := nil;
  end;
  if (MyPopup <> nil) then
  begin
    MyPopup.Free;
    MyPopup := nil;
  end;

  Canvas.Font := Font;
  SetSize;

  TheTextHeight := Canvas.TextHeight('Wp');

  CharStart := FBorderWidth;
  for i := 0 to Caption.Count-1 do
  begin
   if (Pos('ps', Caption.Strings[i]) > 0) then
   begin
     Inc(CharStart, FLineLength + FBorderWidth);
     break;
   end;
  end;

  case FDirection of
    dRight:
      begin
{the text:}
        Rect.Left := CharStart;
        Rect.Right := Width - FBorderWidth;
        Rect.Top := FBorderWidth;
        Rect.Bottom := Rect.Top + TheTextHeight;
{the line}
        TheLine.Left := FBorderWidth;
        TheLine.Right := TheLine.Left + FLineLength;
        TheLine.Top := FBorderWidth + TheTextHeight div 2;
        TheLine.Bottom := TheLine.Top;
      end;
    dLeft:
      begin
        Rect.Right := FBorderWidth;
        Rect.Left := Width - CharStart;
        Rect.Top := Height - FBorderWidth;
        Rect.Bottom := Rect.Top - TheTextHeight;
        TheLine.Right := Width - FBorderWidth;
        TheLine.Left := TheLine.Right - FLineLength;
        TheLine.Top := Height - FBorderWidth - TheTextHeight div 2;
        TheLine.Bottom := TheLine.Top;
      end;
    dUp:
      begin
        Rect.Left := FBorderWidth;
        Rect.Right := Rect.Left + TheTextHeight;
        Rect.Bottom := FBorderWidth;
        Rect.Top := Height - CharStart;
        TheLine.Left := FBorderWidth + TheTextHeight div 2;
        TheLine.Right := TheLine.Left;
        TheLine.Bottom := Height - FBorderWidth;
        TheLine.Top := TheLine.Bottom - FLineLength;
      end;
    dDown:
      begin
        Rect.Left := Width - FBorderWidth;
        Rect.Right := Rect.Left - TheTextHeight;
        Rect.Top := CharStart;
        Rect.Bottom := Height - FBorderWidth;
        TheLine.Left := Width - FBorderWidth - TheTextHeight div 2;
        TheLine.Right := TheLine.Left;
        TheLine.Top := FBorderWidth;
        TheLine.Bottom := TheLine.Top + FLineLength;
      end;
  end;

  if not Transparent then
  begin
    Canvas.Brush.Color := Self.Color;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(ClientRect);
  end;

  for i := 0 to Caption.Count-1 do
  begin
    Canvas.Font.Color := ExtractColor(i);
    {Canvas.TextOut(XStart, Y, ExtractText(i));}


    Canvas.Brush.Style := bsClear;
    { DoDrawText takes care of BiDi alignments }
    DrawStyle := DT_EXPANDTABS or WordWraps[WordWrap] or Alignments[Alignment];
{$IFDEF DELPHI3_UP}
    { Calculate vertical layout }
    if Layout <> tlTop then
    begin
      CalcRect := Rect;
      DoDrawText(ExtractText(i), CalcRect, DrawStyle or DT_CALCRECT);
      if Layout = tlBottom then OffsetRect(Rect, 0, Height - CalcRect.Bottom)
      else OffsetRect(Rect, 0, (Height - CalcRect.Bottom) div 2);
    end;
{$ENDIF}
    DoDrawText(ExtractText(i), Rect, DrawStyle);
{draw the lines:}
    Canvas.Pen.Style := ExtractPenStyle(i);
    Canvas.Pen.Color := Font.Color;
    Canvas.MoveTo(TheLine.Left, TheLine.Top);
    Canvas.LineTo(TheLine.Right, TheLine.Bottom);
{increment the rectangles:}
    case FDirection of
      dRight:
        begin
{the text:}
          Inc(Rect.Top, TheTextHeight);
          Inc(Rect.Bottom, TheTextHeight);
{the line}
          Inc(TheLine.Top, TheTextHeight);
          Inc(TheLine.Bottom, TheTextHeight);
        end;
      dLeft:
        begin
          Dec(Rect.Top, TheTextHeight);
          Dec(Rect.Bottom, TheTextHeight);
          Dec(TheLine.Top, TheTextHeight);
          Dec(TheLine.Bottom, TheTextHeight);
        end;
      dUp:
        begin
          Inc(Rect.Left, TheTextHeight);
          Inc(Rect.Right, TheTextHeight);
          Inc(TheLine.Left, TheTextHeight);
          Inc(TheLine.Right, TheTextHeight);
        end;
      dDown:
        begin
          Dec(Rect.Left, TheTextHeight);
          Dec(Rect.Right, TheTextHeight);
          Dec(TheLine.Left, TheTextHeight);
          Dec(TheLine.Right, TheTextHeight);
        end;
    end;
  end; {for}
{draw the border:}
  if (BorderStyle = bsSingle) then
  begin
    Canvas.Pen.Color := clBlack;
    Canvas.Pen.Style := psSolid;
    Outline;
  end;
end;

{------------------------------------------------------------------------------
     Function: TMultiLabel.ExtractPenStyle
  Description: Extracts the PenStyle from the String
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: see Description
 Return Value: psXXX - the PenStyle
 Known Issues:
 ------------------------------------------------------------------------------}
Function TMultiLabel.ExtractPenStyle(Index: Integer): TPenStyle;
var
  PenStyle: String;
begin
  PenStyle := FCaption.Strings[Index];
  if (Pos('ps',PenStyle) > 0) then
  begin
    GetWord(PenStyle, 'ps');
    PenStyle := 'ps' + GetWord(PenStyle, ' ');
    if (PenStyle = 'psSolid') then
    begin
      ExtractPenStyle := psSolid;
    end
    else if (PenStyle = 'psDash') then
    begin
      ExtractPenStyle := psDash;
    end
    else if (PenStyle = 'psDot') then
    begin
      ExtractPenStyle := psDot;
    end
    else if (PenStyle = 'psDashDot') then
    begin
      ExtractPenStyle := psDashDot;
    end
    else if (PenStyle = 'psDashDotDot') then
    begin
      ExtractPenStyle := psDashDotDot;
    end
    else if (PenStyle = 'psInsideFrame') then
    begin
      ExtractPenStyle := psInsideFrame;
    end
    else {(PenStyle = 'psClear'}
    begin
      ExtractPenStyle := psClear;
    end;
  end
  else
  begin
    ExtractPenStyle := psClear;
  end;
end;

{------------------------------------------------------------------------------
     Function: TMultiLabel.ExtractColor
  Description: Extracts the PenColor from the String
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: see Description
 Return Value: the color
 Known Issues:
 ------------------------------------------------------------------------------}
Function TMultiLabel.ExtractColor(Index: Integer): TColor;
var
  StringColor: String;
begin
  StringColor := FCaption.Strings[Index];
  if (Pos('cl',StringColor) > 0) then
  begin
    GetWord(StringColor, 'cl');
    StringColor := 'cl' + GetWord(StringColor, ' ');
    try
      ExtractColor := StringToColor(StringColor);
    except
      ExtractColor := clBlack;
    end;
  end
  else
  begin
    ExtractColor := Font.Color;
  end;
end;

{------------------------------------------------------------------------------
     Function: TMultiLabel.ExtractText
  Description: Extracts the Text from the String
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: see Description
 Return Value: The text to dsiplay
 Known Issues:
 ------------------------------------------------------------------------------}
Function TMultiLabel.ExtractText(Index: Integer): String;
begin
  if (Pos('//',FCaption.Strings[Index]) > 0) then
  begin
    ExtractText := Copy(Caption.Strings[Index],
                        1,
                        Pos('//',Caption.Strings[Index])-1);
  end
  else
  begin
    ExtractText := Caption.Strings[Index];
  end;
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.Outline
  Description: Draws an outline around the text
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: see Description
 Known Issues:
 ------------------------------------------------------------------------------}
Procedure TMultiLabel.Outline;
begin
  Canvas.MoveTo(0, 0);
  Canvas.LineTo(Width-1, 0);
  Canvas.LineTo(Width-1, Height-1);
  Canvas.LineTo(0, Height-1);
  Canvas.LineTo(0, 0);
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.DoDrawText
  Description: draws a line of text in the given rectangle
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: see Description
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TMultiLabel.DoDrawText(Text: String; var Rect: TRect; Flags: Longint);
var
  LogRec: TLogFont;
  OldFontHandle, NewFontHandle: hFont;
  {H, W, X, Y: Integer;
  BRect: TRect;}
begin
  if (Flags and DT_CALCRECT <> 0) and ((Text = '') or ShowAccelChar and
    (Text[1] = '&') and (Text[2] = #0)) then Text := Text + ' ';
  {if not ShowAccelChar then Flags := Flags or DT_NOPREFIX;}
{$IFDEF DELPHI3_UP}
  {Flags := DrawTextBiDiModeFlags(Flags);}
{$ENDIF}
  {Canvas.Font := Font;}

  OldFontHandle := 0;
  if (FDirection <> dRight) then
  begin
{create a rotated font based on the font object Font}
    GetObject(Font.Handle, SizeOf(LogRec), Addr(LogRec));
    case FDirection of
      dLeft:  LogRec.lfEscapement := 1800;
      dRight: LogRec.lfEscapement := 0;
      dUp:    LogRec.lfEscapement := 900;
      dDown:  LogRec.lfEscapement := 2700;
    end;
    LogRec.lfOutPrecision := OUT_DEFAULT_PRECIS;
    NewFontHandle := CreateFontIndirect(LogRec);
{select the new font:}
    OldFontHandle := SelectObject(Canvas.Handle, NewFontHandle);
  end;

  if not Enabled then
  begin
    OffsetRect(Rect, 1, 1);
    Canvas.Font.Color := clBtnHighlight;
    Canvas.TextOut(Rect.Left, Rect.Top, Text);
    {DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);}
    OffsetRect(Rect, -1, -1);
    Canvas.Font.Color := clBtnShadow;
    Canvas.TextOut(Rect.Left, Rect.Top, Text);
    {DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);}
  end
  else
  begin
    Canvas.TextOut(Rect.Left, Rect.Top, Text);
    {DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, Flags);}
  end;

  if (FDirection <> dRight) then
  begin
{go back to original font:}
    NewFontHandle := SelectObject(Canvas.Handle, OldFontHandle);
{and delete the old one:}
    DeleteObject(NewFontHandle);
  end;
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.SetSize
  Description: sets the width of the MultiLabel
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: see Description
 Known Issues:
 ------------------------------------------------------------------------------}
Procedure TMultiLabel.SetSize;
var
  i, MaxWidth: Integer;
  TheTextHeight, TheTextWidth: Integer;
begin
  if (AutoSize) then
  begin
    TheTextHeight := Caption.Count * Canvas.TextHeight('Ap') +
              2 * FBorderWidth;
    MaxWidth := 0;
    for i := 0 to Caption.Count-1 do
    begin
      if (Canvas.TextWidth(ExtractText(i)) > MaxWidth) then
      begin
        MaxWidth := Canvas.TextWidth(ExtractText(i));
      end;
    end;
    TheTextWidth := MaxWidth + 3 * FBorderWidth;
    for i := 0 to Caption.Count-1 do
    begin
     if (Pos('ps', Caption.Strings[i]) > 0) then
     begin
       Inc(TheTextWidth, FLineLength);
       break;
     end;
    end;
{take account of direction:}
    if ((FDirection = dUp) or (FDirection = dDown)) then
    begin
      Width := TheTextHeight;
      Height := TheTextWidth;
    end
    else
    begin
      Width := TheTextWidth;
      Height := TheTextHeight;
    end;
  end;
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.DblClick
  Description: standard DblClick event handler
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: makes the component editable
 Known Issues:
 ------------------------------------------------------------------------------}
Procedure TMultiLabel.DblClick;
begin
  Visible := FALSE;
  TextEdit := TMemo.Create(Self); {.Owner}

  TextEdit.Parent := Self.Parent;
  TextEdit.Top := Top;
  TextEdit.Left := Left;
  if ((FDirection = dRight) or (FDirection = dLeft)) then
  begin
    TextEdit.Height := 3*Height div 2;
    TextEdit.Width := 3*Width div 2;
  end
  else
  begin
    TextEdit.Height := 3*Width div 2;
    TextEdit.Width := 3*Height div 2;
  end;
  TextEdit.Lines.Assign(Caption);
  TextEdit.ParentColor := TRUE;

  TextEdit.OnExit := EditFinished;
  TextEdit.OnKeyDown := EditKeyDown;

  inherited DblClick;
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.EditFinished
  Description: saves the edited text into the Caption property
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: in-place editing
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TMultiLabel.EditFinished(Sender: TObject);
begin
  TextEdit.Visible := FALSE;
  Caption.Assign(TextEdit.Lines);
  Visible := TRUE;
end;

{------------------------------------------------------------------------------
    Procedure: TMultiLabel.EditKeyDown
  Description: KeyDown event handler for in-place editing
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: terminates editing when Esc pressed
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TMultiLabel.EditKeyDown(Sender: TObject;
                                  var Key: Word;
                                  Shift: TShiftState);
begin
  if (Key = VK_ESCAPE) then
    EditFinished(Sender);
end;

{procedure TMultiLabel.AdjustBounds;
const
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
  DC: HDC;
  X: Integer;
  Rect: TRect;
  AAlignment: TAlignment;
  i, MaxWidth: Integer;
begin
  if not (csReading in ComponentState) and FAutoSize then
  begin
    MaxWidth := 0;
    for i := 0 to Caption.Count-1 do
    begin
      if (Length(ExtractText(i)) > MaxWidth) then
      begin
        MaxWidth := i;
      end;
    end;

    Rect.Left := 0;
    Rect.Top := 0;
    Rect.Width :=
    Rect.Height :=
    DC := GetDC(0);
    Canvas.Handle := DC;
    DoDrawText(ExtractText(MaxWidth),
               Rect,
               (DT_EXPANDTABS or DT_CALCRECT) or WordWraps[FWordWrap]);
    Canvas.Handle := 0;
    ReleaseDC(0, DC);
    X := Left;
    AAlignment := FAlignment;
    if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
    if AAlignment = taRightJustify then Inc(X, Width - Rect.Right);
    SetBounds(X, Top, Rect.Right, Rect.Bottom);
  end;
end;}


Function GetWord (var This_Line: String; Delimiter: String): String;
var
  Delimiter_Position: Integer;
begin
  Delimiter_Position := Pos(Delimiter, This_Line);
  If (Delimiter_Position > 0) Then
  begin
    GetWord := Copy(This_Line, 1, Delimiter_Position-1);
    This_Line := Copy(This_Line, Delimiter_Position + Length(Delimiter), Length(This_Line));
  end
  Else
  begin
    GetWord := This_Line;
    This_Line := '';
  end;
end;

end.