
{                                                                              }
{ IBC_Label                                                                    }
{                                                                              }

{***************************************************************}
{                                                               }
{          IB Objects Components and Resources Library          }
{                                                               }
{          Copyright (C) 1996-2007 Jason Wharton                }
{          and Computer Programming Solutions, Mesa, AZ         }
{                                                               }
{  This source code unit is released under the terms of the     }
{  CPS Trustware License.                                       }
{  It may be distributed or deployed as source code or in       }
{  compiled form only in compliance with the terms and          }
{  conditions of the CPS Trustware License which may be         )
{  examined at http://www.ibobjects.com/ibo_trustware.html      )
{                                                               }
{***************************************************************}

{******************************************************************************}
{  CONTRIBUTED MODIFICATIONS                                                   }
{  Additions or modifications listed below using format:                       }
{                                                                              }
{  Joe Citizen <joe@joecitizen.com>                                            }
{  mm/dd/yyyy                                                                  }
{     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                 }
{     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                 }
{     xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx                 }
{            Copyright (C) 2001 Joe Citizen                                    }
{                                                                              }
{------------------------------------------------------------------------------}
{  Place your credits and information in the top of the section                }
{  below with any other descriptions or explanations desired.                  }
{------------------------------------------------------------------------------}
{                                                                              }
{  Mark Pickersgill <mpickers@iprimus.com.au>                                  }
{  8-Nov-2004                                                                  }
{     Added Spacing property to autolabel to provide more control over the     }
{     pixel spacing between the control and the label.                         }
{     Added new albLeftCenter and albTopCenter Kind options to provide         }
{     vertically and horizontally centered labels.                             }
{     Added TrimX and TrimY to the Options property.                           }
{     Added Font, Transparent and Color properties.                            }
{     Sped-up the drawing of labels                                            }
{                                                                              }
{  Geoff Worboys <geoff@telesiscomputing.com.au>                               }
{  10-Jan-2002                                                                 }
{     Improved autolabel model management when using IIB_GridWinControl        }
{     interface (automatic model label creation when necessary).               }
{     Introduced a new global variable IB_AutoLabel_PreventFlicker             }
{     See notes for online help generation.                                    }
{                                                                              }
{  Geoff Worboys <geoff@telesiscomputing.com.au>                               }
{  20-Dec-2001                                                                 }
{     Added ability to use new GetAutoLabel IIB_GridWinControl interface       }
{     method - so any control implementing the interface can be used as a      }
{     as a model for the AutoLabel.                                            }
{                                                                              }
{  Geoff Worboys <geoff@telesiscomputing.com.au>                               }
{  10-Aug-2001                                                                 }
{     Changed the GetIBControlColumn function so that it will return the       }
{     foreign key column of the main dataset if it can be determined.          }
{     This allows the processing to determine whether the label may need       }
{     to be made bold if the foreign key is required.                          }
{                                                                              }
{------------------------------------------------------------------------------}

// ***** TIB_Label ******
{ IBO-aware Label component by Tobias Giesen with amendments by Geoff Worboys

Based on an earlier TLabelEnh component this source has been donated to the
IBObjects library as a base for the AutoLabel capability.  Functionality has
now been separated so that the base enhancement functions can be found in
IBC_CustomLabel.pas (without IBO-awareness).  This unit defines a derivation
that is IBO-aware, in that it will display the field display name of a
control attached to the focuscontrol.
}

// ***** TIB_AutoLabel ******
{                                                                              }
{ Written January 2001 by Tobias Giesen (tobias@tgtools.de)                    }
{ With contributions from Geoff Worboys                                        }

(*

This component is used by TIB_Edit, TIB_LookupCombo etc. to implement an
automatic label.

ADDING the AutoLabel to an existing component (the hard way)
---------------------------------------------
1. Add to the classes private section:
  FAutoLabel:TIB_AutoLabel;

2. If not existing yet, add these:
  procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
  procedure StateChanged( Sender: TIB_DataLink;
                                DataSource: TIB_DataSource );
3. If it's a base class, add the following to the public section
  else to the published section
  property AutoLabel: TIB_AutoLabel read FAutoLabel write FAutoLabel;

4. Add this to the published section of the final component
  property AutoLabel;

To provide a maximum of design-time and run-time efficiency, a few lines
have to be added to an existing component as follows:

5. Into the constructor:
  FAutoLabel := TIB_AutoLabel.Create(self);
  // call inherited after AutoLabel create
  DataLink.OnStateChanged:=StateChanged;

6. Into the destructor:
  FAutoLabel.Free;

8. the WMWindowPosChanged routine:
procedure TIB_XXX.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
  inherited;
  if Assigned(AutoLabel) and
     not (csDestroying in ComponentState) and
     (Assigned(AutoLabel.theLabel) or (csDesigning in ComponentState)) then
     AutoLabel.Make;
  end;

9 the StateChanged routine:
procedure TIB_CustomEdit.StateChanged( Sender: TIB_DataLink;
                                             DataSource: TIB_DataSource );
begin
  if Assigned(AutoLabel) and
     not (csDestroying in ComponentState) and
     (Assigned(AutoLabel.theLabel) or (csDesigning in ComponentState)) then
     AutoLabel.Make;
  end;


ADDING the AutoLabel to an existing component (the easy way)
---------------------------------------------

Create the component using IBO provided includes and then perform
steps 5 & 6 above to construct and destroy the autolabel.
See IBC_Edit.* files in the IBO source for an example of how this is done.


*)
{                                                                              }
{******************************************************************************}

{$INCLUDE IB_Directives.inc}

unit
  IBC_Label;

interface

uses
  SysUtils, Messages, Windows, Classes, Graphics, Menus, Controls, Forms,
  StdCtrls,

  IBC_CustomLabel,
  IB_Components,
  IB_FieldDataLink;

//---------------------------------------------------------------------------
//---------------------------------------------------------------------------
type

  TIB_AutoLabel = class;

//---------------------------------------------------------------------------
{: A TIB_CustomLabel that is IBO data control aware.}
  TIB_Label = class(TIB_CustomLabel)
  private
    FAutoLabel: TIB_AutoLabel;
    FModelRefs: TList;
    FUseIBOLabel: boolean;
    FUseIBOBold: boolean;
    FCaptionInitialised: boolean;
    FCaptionChanged : Boolean;
    FLastCaption : string;
    procedure CheckCaptionChanged(const CurCaption : string);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation);
      override;
    procedure Loaded; override;
    procedure SetUseIBOLabel(AVal: boolean);
    procedure SetUseIBOBold(AVal: boolean);
    function CheckCaptionInitialised: boolean;
    procedure DoGetLabel(var AText: string; const AFont: TFont); override;
    procedure DoModelPropertyChange; override;

    procedure AddModelRef(const AutoLabel: TIB_AutoLabel);
    procedure RemoveModelRef(const AutoLabel: TIB_AutoLabel);
    function ModelRefCount: integer;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property CaptionChanged : Boolean read FCaptionChanged;
  published
    property UseIBOLabel: boolean read FUseIBOLabel
                                  write SetUseIBOLabel
                                  default true;
    property UseIBOBold: boolean read FUseIBOBold
                                 write SetUseIBOBold
                                 default true;
    {$INCLUDE IBC_CustomLabel.pbl}
  end; // TIB_Label

{: The various kinds of Automatic layouts for an AutoLabel.
<br>
albNone - No AutoLabel is shown (default)
<br>
albLeft - The AutoLabel appears to the left of the owner control and vertically,
Top aligned with the owner control.
<br>
albLeftCenter - The AutoLabel appears to the left of the owner control and
vertically, Center aligned with the owner control.
<br>
albTop - The AutoLabel appears above the owner control and is horizontally, Left
aligned with the owner control.
<br>
albTopCenter - The AutoLabel appears above the owner control and is
horizontally, Center aligned with the owner control.
}
  TIB_AutoLabelKind = (albNone, albLeft, albLeftCenter, albTop, albTopCenter);

{: Various options available for an AutoLabel.
<br>
albAlignToModel - If a model is assigned, then the AutoLabel should use the
Model's Left or Top property to assign to its own.
<br>
If the AutoLabel is an albTop or albTopCenter, then the Model MUST have a
FocusControl and that Focused Control's Top property must match the Top property
of the AutoLabel's Owner's Top property. If this holds true then the AutoLabel's
Top property is set to the Model Label's Top property.
<br>
If the AutoLabel is an albLeft or albLeftCeter, then the AutoLabel's Left
property is set to the Model Label's Left Property.
<br>
albLowerCase - Forces the case of the AutoLabel's Caption to be only lowercase.
<br>
albOnlyFirstCharUpper - Forces the First character of the AutoLabel's Caption to
be uppercase and the rest of the Caption to be lowercase. NOTE: This property
overrides the albLowerCase property.
<br>
albBoldIfRequired - If the Column associated with the owner component is
required, then display the AutoLabel's caption in bold.
<br>
albDotLeader - Fills the empty space between the end of the AutoLabel's Caption
text and the owner control.
<br>
albSuffixBeforeDots - Determines whether the Suffix Text is placed before or
after the dots. This option only comes into effect if the albDotLeader option
is set.
<br>
albTrimX - Trims empty space to the left and right of AutoLabel's Caption Text.
<br>
albTrimY - Trims empty space above and below the AutoLabel's Caption Text. 
}
  TIB_AutoLabelOptions = (albAlignToModel, albLowerCase, albOnlyFirstCharUpper,
    albBoldIfRequired, albDotLeader, albSuffixBeforeDots, albTrimX, albTrimY);
  TIB_AutoLabelOptionsSet = set of TIB_AutoLabelOptions;

{: The TIB_FontShell provides a light-weight storage of Font properties without using up
any GDI resources.
}
  TIB_FontShell = class(TPersistent)
  private
    FCharset : TFontCharset;
    FColor : TColor;
    FHeight : Integer;
    FName : TFontName;
    FPitch : TFontPitch;
    FStyle : TFontStyles;
    FPixelsPerInch : Integer;
    FOnChange : TNotifyEvent;
    function GetCharset: TFontCharset;
    function GetColor: TColor;
    function GetHeight: Integer;
    function GetName: TFontName;
    function GetPitch: TFontPitch;
    function GetSize: Integer;
    function GetStyle: TFontStyles;
    procedure SetCharset(Value: TFontCharset);
    procedure SetColor(Value: TColor);
    procedure SetHeight(Value: Integer);
    procedure SetName(const Value: TFontName);
    procedure SetPitch(Value: TFontPitch);
    procedure SetSize(Value: Integer);
    procedure SetStyle(Value: TFontStyles);
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch;
    property OnChange : TNotifyEvent read FOnChange write FOnChange;
  published
    property Charset: TFontCharset read GetCharset write SetCharset;
    property Color: TColor read GetColor write SetColor;
    property Height: Integer read GetHeight write SetHeight;
    property Name: TFontName read GetName write SetName;
    property Pitch: TFontPitch read GetPitch write SetPitch default fpDefault;
    property Size: Integer read GetSize write SetSize stored False;
    property Style: TFontStyles read GetStyle write SetStyle;
  end;

{: The TIB_AutoLabel provides controls with the ability to automatically display
their own labels.
<br>
These labels are attached and aligned to the control itself.
}
  TIB_AutoLabel = class(TPersistent)
  private
    FKind: TIB_AutoLabelKind;
    FCaption: string;
    FSuffix: string;
    FRelativePosition: Integer;
    FMargin: Integer;
    FSpacing: Integer;
    FModel: TControl;
    FOptions: TIB_AutoLabelOptionsSet;
    FtheLabel: TIB_Label;
    FOwner: TWinControl;
    FTransparent : Boolean;
    FColor : TColor;
    FFont : TIB_FontShell;
    FFontChanged : Boolean;
    FDimsChanged : Boolean;
    FLastDims : TRect;
    function GetLabelRect : TRect;
    procedure OnFontChange(Sender : TObject);
    procedure OnLabelFontChange(Sender : TObject);
    function IsKindStored: boolean;
    function IsSuffixStored: boolean;
    function IsPositionStored: boolean;
    function IsMarginStored: boolean;
    function IsSpacingStored: boolean;
    function IsOptionsStored: boolean;
    function IsTransparentStored : Boolean;
    function IsColorStored : Boolean;
    function IsFontStored: Boolean;
  protected
    procedure CreateLabel;
    procedure DestroyLabel;
{: Does the actual processing of the AutoLabel's positioning and attributes.
}
    procedure MakeLabel( CheckPreventFlag: boolean );
  public
    constructor Create(AOwner: TWinControl);
    destructor Destroy; override;
{: Retrieves a reference to a label from the Model.
<br>
The function attempts to determine if the Model is either a label itself, or is
a component that has an AutoLabel and returns a reference to that label.
}
    function GetModelLabel(MakeIt: boolean): TCustomLabel;
{: This method is used to redraw the AutoLabel when a property of a TIB_Label
based model is changed.
<br>
When a Model is assigned to the AutoLabel and the label extracted from the Model
turns out to be a TIB_Label, then a reference is added to that TIB_Label to the
AutoLabel to allow the AutoLabel to receive notification that the TIB_Label
(of the model) has changed.
}
    procedure ModelChanged;
{: Used to rebuild the AutoLabel when the owner's position changes or the State
of the referenced DataSource changes.
<br><br>
This method should be called in the WMWindowPosChanged and StateChanged
methods when adding AutoLabel capability to an IBO enabled component.
<br><br>
(see Source code for more details about adding an AutoLabel to an IBO enabled
component).
}
    procedure Make;
{: This property is the actual label that is created and drawn on the screen.
<br>
Use this property to set any other properties of the label that aren't available
using the standard AutoLabel properties.
<br><br>
Note: This property should be checked to ensure it is assigned before use.
}
    property theLabel: TIB_Label read FtheLabel;
{: A refernce to the actual control that the AutoLabel is linked to.
}
    property Owner: TWinControl read FOwner;
  published
    procedure SetKind(const K: TIB_AutoLabelKind);
    procedure SetSuffix(const S: string);
    procedure SetCaption(const S: string);
    procedure SetRelativePosition(const P: Integer);
    procedure SetMargin(const P: Integer);
    procedure SetSpacing(const P: Integer);
    procedure SetModel(const M: TControl);
    procedure SetOptions(const O: TIB_AutoLabelOptionsSet);
    procedure SetTransparent(const Value : Boolean);
    procedure SetColor(const Value : TColor);
    procedure SetFont(const Value : TIB_FontShell);
{: Specifies the Override Caption to use for this AutoLabel.
<br>
If left blank then the Caption is automatically set using the associated
Column's DisplayLabel property or if that's not set, then it will use the raw
Column name.}
    property Caption: string read FCaption write SetCaption;
{: Specifies the background colour of the AutoLabel.
}
    property Color : TColor read FColor write SetColor stored IsColorStored;
{: Specifies the Font of the AutoLabel.
<br>
This property is NOT a TFont object but behaves almost identically.
If you wish to assign a TFont to this property, then use <AutoLabel>.Font.Assign().
}
    property Font : TIB_FontShell read FFont write SetFont stored IsFontStored;
{: Specifies the kind of Automatic positioning to use for the AutoLabel.
}
    property Kind: TIB_AutoLabelKind read FKind write SetKind stored IsKindStored;
{: The Margin is how many pixels away from the label's starting point that the
label should actually start to draw.
<br>
For a left aligned label, the margin is the number of pixels down from the
owner's Top property that the AutoLabel's Top property is set to.
<br><br>
For a Top aligned label, the margin is the number of pixels to the right of the
owner's Left property that the AutoLabel's Left property is set to.
}
    property Margin: Integer read FMargin write SetMargin stored IsMarginStored;
{: The Model property allows you to set a control from which to inherit various
properties for assigning to the AutoLabel.
<br>
When this property is assigned, some of the AutoLabel's own properties are
ignored in favour of retrieving them for a compatible Model.
<br><br>
The Model must itself be a TCustomLabel of some sort, or be a control that
supports and has an AutoLabel property.
<br><br>
When it comes time to draw the AutoLabel, properties from the the Model
(or the Model's label), such as Color, Font, Alignment etc are used for the
AutoLabel.
<br>
This allows you to setup and maintain only one Label and have all the other
Labels use its properties automatically.
}
    property Model: TControl read FModel write SetModel;
{: Various options to set for the AutoLabel.
}
    property Options: TIB_AutoLabelOptionsSet read FOptions write SetOptions stored IsOptionsStored;
{: This property overrides the automatic positioning and positions the AutoLabel
Relative to the owner's Top or Left property.
<br>
Setting this property to something other than 0 causes the AutoLabel's Top or
Left property to be set to the specified pixel offset, relative to the owner's
Top or Left property.
<br><br>
How this property is used depends on the Kind option. If the Kind option is
albLeft or albLeftCenter, then this property is added to the Left property. If
the Kind option is albTop or albTopCenter, then this property is added to the
Top property.
<br><br>
Use negative values to position the label to the left or above the owner
control.
}
    property RelativePosition: Integer read FRelativePosition write SetRelativePosition stored IsPositionStored;
{: The Spacing specifies the gap between the control that the AutoLabel belongs
to and the AutoLabel itself.
<br>
This property allows you to control how much of a gap there should be between
the borders of the AutoLabel and the border of the control.
<br><br>
For a Left aligned label, the Spacing is the number of pixel's to the left of
the owner's Left property that the AutoLabel should stop drawing at.
<br>
ie AutoLabel.Left + AutoLabel.Width < Owner.Left - Spacing
<br><br>
For a Top aligned label, the Spacing is the number of pixel's up from the
owner's Top property that the AutoLabel should stop drawing at.
<br>
ie AutoLabel.Top + AutoLabel.Height < Owner.Top - Spacing
<br><br>
Note 1: The spacing is always used, even when the Relative property is <> 0.
Note 2: The spacing may appear to be larger than specified if the Relative
property is used AND the TrimX option is set.
}
    property Spacing: Integer read FSpacing write SetSpacing stored IsSpacingStored;
{: Text to place at the end of the retrieved label.
}
    property Suffix: string read FSuffix write SetSuffix stored IsSuffixStored;
{: Specifies whether controls that sit below the label on a form can be seen through the label.
<br>
Set this option to False to use the AutoLabel's Color property.
}
    property Transparent : Boolean read FTransparent write SetTransparent stored IsTransparentStored;
  end;

var
  IB_AutoLabel_DefaultKind: TIB_AutoLabelKind;
  IB_AutoLabel_DefaultSuffix: string;
  IB_AutoLabel_DefaultMargin: integer;
  IB_AutoLabel_DefaultSpacing: integer;
  IB_AutoLabel_DefaultPosition: Integer;
  IB_AutoLabel_DefaultOptions: TIB_AutoLabelOptionsSet;
  IB_AutoLabel_IgnoreZeroDefault: boolean;
  IB_AutoLabel_DefaultTransparent : Boolean;
  IB_AutoLabel_DefaultColor : TColor;
{: Set true to prevent redraw flicker on autolabels.
<br>
Defaults to false, allowing all label updates to take place.<br>
<br>
In some configurations AutoLabels attached to controls can show some redraw
flicker (particularly when attached to detail datasets of master/detail
arrangements).  This cannot be easily avoided without stopping the labels
from updating when actually needed.  So instead this global variable has been
provided to allow you to take control of the problem within your own
project.<br>
<br>
For most projects you will be able to prevent unnecessary redrawing of the
autolabels simply by including the following line in the OnCreate event of
the main form (you will need IBC_Label in the uses clause):<br>
  IB_AutoLabel_PreventFlicker := true;<br>
<br>
However with the above change, if you make changes to dataset or connection
properties at runtime, then you may discover that the autolabels are not
updating as they should.  In such cases you may have to alter the section of
your code where you alter those properties so that:<br>
<br>
IB_AutoLabel_PreventFlicker := false;<br>
try<br>
 ...your code...<br>
finally<br>
IB_AutoLabel_PreventFlicker := true;<br>
end;<br>
<br>
This will allow all label update requests to take place while your code is
executed, but turn off unnecessary updates when you have finished.<br>
<br>
The above code is not required with direct changes to the AutoLabel itself,
as these will detect such changes and force the label to be updated.}
  IB_AutoLabel_PreventFlicker: boolean;

implementation

uses
  IB_ControlInterface,
  IB_Grid,
  IB_Parse,
  IB_Controls;

var
  DefPixelsPerInch : Integer;

//---------------------------------------------------------------------------
// copied from IBA_Statement.IMP

function GetColAttrTxt(const ACol: TIB_Column;
  const AColStrings,
  AConStrings: TIB_StringList): string;
begin
  with ACol do
  begin
    Result := AColStrings.LinkValues[FullFieldName];
    if (Length(Result) = 0) and (AConStrings.Count > 0) then
    begin
      Result := AConStrings.LinkValues[FullFieldName];
      if (Length(Result) = 0) and
        (fetDomainName in Statement.IB_Connection.FieldEntryTypes) then
      begin
        Result := AConStrings.LinkValues[DomainName];
      end;
      if (Length(Result) = 0) and
        (fetSQLType in Statement.IB_Connection.FieldEntryTypes) then
      begin
        Result := AConStrings.LinkValues[SQLTypeSource[true]];
      end;
    end;
  end;
end;
//---------------------------------------------------------------------------
// A couple of utility functions.  May want to move these to a more accessible
// location later.

// Locate the appropriate TIB_Column reference for a control
// (or return nil).  Always return most direct column that it can.

function GetIBControlColumn(AControl: TControl; var FldName: string):
  TIB_Column;
var
  DL: TIB_DataLink;
begin
  Result := nil;

  // Most controls should define CM_GETDATALINK...
  DL := TIB_DataLink(AControl.Perform(CM_GETDATALINK, 0, 0));
  if (DL <> nil) and (DL is TIB_FieldDataLink) then
  begin
    Result := TIB_FieldDataLink(DL).Field;
    FldName := TIB_FieldDataLink(DL).FieldName;
  end
  else
  begin
    // I wanted to use TIB_CustomCombo to be generic but I cannot
    // seem to get a hold of its DataSource.
    if AControl is TIB_LookupCombo then
      with AControl as TIB_LookupCombo do
      begin
        FldName := DisplayField;
        if Assigned(DataSource) and Assigned(DataSource.Dataset) then
          with DataSource.Dataset do
          begin
            if (KeyLinks.Count > 0) and Assigned(KeyDataset) then
            begin
              FldName := KeyLinks.IndexValues[KeyLinks.Count - 1];
              Result := KeyDataset.FindField( FldName );
              // Display name best to come from DisplayField if available
              FldName := DisplayField;
              if FldName = '' then
                FldName := OrderingLink;
            end
            else
            begin
              if not Fields.GetByName(DisplayField, Result) then
                Fields.GetByName(OrderingLink, Result);
              if FldName = '' then
                FldName := OrderingLink;
            end;
          end;
      end;
  end;
end;

// Find out if a column should be considered mandatory.
// Will only ever return true for TIB_Dataset columns, and only
// when the dataset is in dssEdit or dssInsert mode.
// Checks Nullable, Readonly and Required column properties and
// then looks to see if a DefaultValue has been assigned.
// Set IgnoreZero to true to ignore a "0" default value, which is
// often set for enumerations for aesthetic reasons.  (Boolean
// columns are exempted from the IgnoreZero processing.)

function IsIBColumnMandatory(ACol: TIB_Column; IgnoreZero: boolean): boolean;
var
  tmpStr: string;
begin
  Result := false;
  if (ACol.Statement is TIB_Dataset) and
    (TIB_Dataset(ACol.Statement).State in [dssEdit, dssInsert]) and
    (ACol.Required and not ACol.Readonly) then
  begin
    tmpStr := GetColAttrTxt(ACol, TIB_Dataset(ACol.Statement).DefaultValues,
      ACol.Statement.IB_Connection.DefaultValues);
    if Length(tmpStr) <= 0 then
      Result := true
    else
      if IgnoreZero and (not ACol.IsBoolean) and (tmpStr = '0') then
        Result := true;
  end;
end;

// Convert a raw "FieldName" property into text appropriate for display
// without any associated relation.

function IBFieldNameToDisplay(AFieldName: string): string;
var
  i: integer;
begin
  i := getLitSafePos('.', AFieldName, 1);
  if i > 0 then
    Result := Copy(AFieldName, i + 1, Length(AFieldName) - i)
  else
    Result := AFieldName;
  if Length(Result) > 0 then
    Result := stLitCriteria(Result);    // Remove dialect 3 quotes
end;

//---------------------------------------------------------------------------

constructor TIB_Label.Create(AOwner: TComponent);
begin
  FAutoLabel := nil;
  FModelRefs := nil;
  inherited Create(AOwner);
  FUseIBOLabel := true;
  FUseIBOBold := true;
  FCaptionInitialised := false;
  FCaptionChanged := False;
  FLastCaption := '';
end;

destructor TIB_Label.Destroy;
var
  TmpRef: TIB_AutoLabel;
begin
  while (FModelRefs <> nil) and (FModelRefs.Count > 0) do
  begin
    TmpRef := FModelRefs.Items[FModelRefs.Count - 1];
    FModelRefs.Delete(FModelRefs.Count - 1); // to be sure they go
    if TmpRef.GetModelLabel(false) = Self then
      TmpRef.Model := nil;
  end;
  if FModelRefs <> nil then
  begin
    FModelRefs.Free;
    FModelRefs := nil;
  end;
  inherited;
end;

// Implemented specifically to support AutoLabels with a model based on TLabel.
// In those instances the AutoLabel will pass its internal Label as a
// reference to the FreeNotification of the model TLabel.  Hence, we must
// pickup in here that we are part of an AutoLabel and reset the model
// property if the TLabel is removed.

procedure TIB_Label.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (FAutoLabel <> nil) and (Operation = opRemove) and
    (AComponent = FAutoLabel.Model) then
    FAutoLabel.Model := nil;
end;

procedure TIB_Label.Loaded;
begin
  inherited;
  DoModelPropertyChange;
end;
//---------------------------------------------------------------------------

procedure TIB_Label.SetUseIBOLabel(AVal: boolean);
begin
  if AVal <> FUseIBOLabel then
  begin
    FUseIBOLabel := AVal;
    if AutoSize then
      AdjustBounds;
    Invalidate;
    DoModelPropertyChange;
  end;
end;

//---------------------------------------------------------------------------

procedure TIB_Label.SetUseIBOBold(AVal: boolean);
begin
  if AVal <> FUseIBOBold then
  begin
    FUseIBOBold := AVal;
    if AutoSize then
      AdjustBounds;
    Invalidate;
    DoModelPropertyChange;
  end;
end;

// this is called by the autolabel so that the label gets a chance to
// validate when the status of FCaptionInitialised should be changed.
function TIB_Label.CheckCaptionInitialised: boolean;
var
  tmpCol: TIB_Column;
  tmpStr: string;
begin
  if FCaptionInitialised and Assigned(FocusControl) then
  begin
    tmpCol := GetIBControlColumn(FocusControl, tmpStr);
    FCaptionInitialised := Assigned(tmpCol);
  end;
  Result := FCaptionInitialised;
end;

//---------------------------------------------------------------------------

procedure TIB_Label.CheckCaptionChanged(const CurCaption : string);
begin
  // Added here mainly for TIB_AutoLabel support so we can detect if we need
  // to redraw the label if the Caption has changed
  if CurCaption <> FLastCaption then
    FCaptionChanged := True
  else
    FCaptionChanged := False;
  FLastCaption := CurCaption;
end;

//---------------------------------------------------------------------------

procedure TIB_Label.DoGetLabel(var AText: string; const AFont: TFont);
var
  tmpCol: TIB_Column;
  tmpStr: string;
  tmpIntf: IIB_GridWinControl;
begin
  if (not UseIBOLabel) or (FocusControl = nil) then
  begin
    if Assigned(FocusControl) then
    begin
      tmpCol := GetIBControlColumn(FocusControl, tmpStr);
      if Assigned(tmpCol) then
      begin
        // Get mandatory setting before we check for display column
        if UseIBOBold and
          IsIBColumnMandatory(tmpCol, IB_AutoLabel_IgnoreZeroDefault) then
          AFont.Style := AFont.Style + [fsBold];
      end;
    end;
    inherited;
    // If not UseIBOLabel then the caption is initialised (to whatever
    // is defined in the Caption property).
    FCaptionInitialised := true;
    CheckCaptionChanged(AText);
    Exit;
  end;

  tmpCol := GetIBControlColumn(FocusControl, tmpStr);

  if Assigned(tmpCol) then
  begin
    // Get mandatory setting before we check for display column
    if UseIBOBold and
      IsIBColumnMandatory(tmpCol, IB_AutoLabel_IgnoreZeroDefault) then
      AFont.Style := AFont.Style + [fsBold];
    // Controls with IIB_GridWinControl support a display column return
    if (FocusControl.GetInterface(IIB_GridWinControl, tmpIntf)) then
    begin
      if tmpIntf.DisplayColumn is TIB_Column then
        tmpCol := TIB_Column(tmpIntf.DisplayColumn);
    end;
    AText := tmpCol.DisplayLabel;
    // If we were given a valid display name...
    if Length(AText) > 0 then
    begin
      // if this name is too large try the grid name
      if (not AutoSize) and (Canvas.TextWidth(AText) > Width) then
      begin
        tmpStr := tmpCol.GridDisplayName;
        if Length(tmpStr) > 0 then
          AText := tmpStr;
      end;
    end
    // If no valid display name so far, extract fieldname from col
    else
      AText := IBFieldNameToDisplay(tmpCol.FieldName);
    FCaptionInitialised := true;
  end
  // If no column return, we simply process the raw field name returned
  // from the datalink (in the call to GetIBControlColumn above).
  else
  begin
    FCaptionInitialised := false;
    AText := IBFieldNameToDisplay(tmpStr);
  end;

  // This seems like a convenient way of covering the problem of no
  // datasource/datafield connection during design mode.
  if (AText = '') and (csDesigning in ComponentState) then
    AText := '(' + FocusControl.Name + ')';

  inherited;
  CheckCaptionChanged(AText);
end;

procedure TIB_Label.DoModelPropertyChange;
var
  i: integer;
begin
  if (ComponentState * [csLoading, csDestroying]) = [] then
  begin
    if FModelRefs <> nil then
      with FModelRefs do
      begin
        for i := 0 to Count - 1 do
        begin
          TIB_AutoLabel(Items[i]).ModelChanged;
        end;
      end;
  end;
end;

procedure TIB_Label.AddModelRef(const AutoLabel: TIB_AutoLabel);
begin
  if FModelRefs = nil then
    FModelRefs := TList.Create;
  FModelRefs.Add(AutoLabel);
end;

procedure TIB_Label.RemoveModelRef(const AutoLabel: TIB_AutoLabel);
begin
  if FModelRefs <> nil then
  begin
    FModelRefs.Remove(AutoLabel);
    if FModelRefs.Count <= 0 then
    begin
      FModelRefs.Free;
      FModelRefs := nil;
    end;
  end;
end;

function TIB_Label.ModelRefCount: integer;
begin
  if FModelRefs = nil then
    Result := 0
  else
    Result := FModelRefs.Count;
end;

//---------------------------------------------------------------------------

constructor TIB_AutoLabel.Create(AOwner: TWinControl);
begin
  FModel := nil;
  FOwner := AOwner;
  inherited Create;
  FFont := TIB_FontShell.Create;
  FFont.OnChange := OnFontChange;
  FtheLabel := nil;
  FFontChanged := False;
  FDimsChanged := False;
  FKind := IB_AutoLabel_DefaultKind;
  FSuffix := IB_AutoLabel_DefaultSuffix;
  FMargin := IB_AutoLabel_DefaultMargin;
  FSpacing := IB_AutoLabel_DefaultSpacing;
  FRelativePosition := IB_AutoLabel_DefaultPosition;
  FOptions := IB_AutoLabel_DefaultOptions;
  FTransparent := IB_AutoLabel_DefaultTransparent;
  FColor := IB_AutoLabel_DefaultColor;
  if FKind <> albNone then
    CreateLabel;
end;

destructor TIB_AutoLabel.Destroy;
begin
  SetModel(nil);
  // Destroy the label directly, dont call DestroyLabel
  if Assigned(theLabel) then
  begin
    theLabel.Parent := nil;
    theLabel.Free;
    FtheLabel := nil;
  end;
  FFont.Free;
  inherited Destroy;
end;

function TIB_AutoLabel.IsKindStored: boolean;
begin
  Result := (Kind <> IB_AutoLabel_DefaultKind);
end;

function TIB_AutoLabel.IsSuffixStored: boolean;
begin
  Result := (Suffix <> IB_AutoLabel_DefaultSuffix);
end;

function TIB_AutoLabel.IsPositionStored: boolean;
begin
  Result := (RelativePosition <> IB_AutoLabel_DefaultPosition);
end;

function TIB_AutoLabel.IsMarginStored: boolean;
begin
  Result := (Margin <> IB_AutoLabel_DefaultMargin);
end;

function TIB_AutoLabel.IsSpacingStored: boolean;
begin
  Result := (Spacing <> IB_AutoLabel_DefaultSpacing);
end;

function TIB_AutoLabel.IsOptionsStored: boolean;
begin
  Result := (Options <> IB_AutoLabel_DefaultOptions);
end;

function TIB_AutoLabel.IsTransparentStored : Boolean;
begin
  Result := (Transparent <> IB_AutoLabel_DefaultTransparent);
end;

function TIB_AutoLabel.IsColorStored : Boolean;
begin
  Result := (Color <> IB_AutoLabel_DefaultColor);
end;

function TIB_AutoLabel.IsFontStored: Boolean;
begin
  Result :=
    (FFont.Charset <> DefFontData.Charset) or
    (FFont.Color <> clWindowText) or
    (FFont.Height <> DefFontData.Height) or
    (FFont.Name <> DefFontData.Name) or
    (FFont.Pitch <> DefFontData.Pitch) or
    (FFont.Style <> DefFontData.Style);
end;

// Isolated the create/destroy label processes for easy management.
// Note that TIB_AutoLabel.Destroy must destroy the label directly,
// whereas this create/destroy process manages the label according
// to whether the reference is required for other reasons

procedure TIB_AutoLabel.CreateLabel;
begin
  if not Assigned(theLabel) then
  begin
    FtheLabel := TIB_Label.Create(Owner);
    FtheLabel.FAutoLabel := Self;
    // Take over the Font change event of the label so we can feed the changes
    // back to the FontShell object
    FFontChanged := False;
    FDimsChanged := False;
    FtheLabel.Font.OnChange := OnLabelFontChange;
    FtheLabel.AutoSize := false;
    if Kind = albNone then
      theLabel.Visible := false;
  end;
end;

procedure TIB_AutoLabel.DestroyLabel;
var
  NeedToKeep: boolean;
  ModelLabel: TCustomLabel;
begin
  if Assigned(theLabel) then
  begin
    // For clarity in the code I am using this NeedToKeep flag
    NeedToKeep := false;
    ModelLabel := GetModelLabel(false);
    // If kind is not albNone we still need the label
    if Kind <> albNone then
      NeedToKeep := true
    // If the model label is not TIB_Label then we need to keep the internal
    // label to support FreeNotification.  Only TIB_Label has its own specific
    // notification processing to tell AutoLabels when the model is deleted.
    else
      if (ModelLabel <> nil) and not (ModelLabel is TIB_Label) then
        NeedToKeep := true
      // If the label is being used as a model then it must remain.
      else
        if theLabel.ModelRefCount > 0 then
          NeedToKeep := true;
    // If need to keep it just hide it
    if NeedToKeep then
    begin
      theLabel.Visible := false;
    end
    // otherwise destroy it properly
    else
    begin
      theLabel.Free;
      FtheLabel := nil;
    end;
  end;
end;

// Isolated this function to make it easy to re-use
// If we add support for additional controls as models we only have to
// add them to this function.  Normally called with MakeIt set to false
// but SetModel procedures calls with MakeIt=true if the model should
// have a label created ready for use as a reference.

function TIB_AutoLabel.GetModelLabel(MakeIt: boolean): TCustomLabel;
var
  tmpIntf: IIB_GridWinControl;
begin
  Result := nil;
  if Assigned(Model) then
  begin
    if Model is TLabel then
      Result := TCustomLabel(Model)
    else
      if Model is TIB_CustomLabel then
        Result := TCustomLabel(Model)
      else
        if Model is TIB_Edit then
        begin
          Result := TIB_Edit(Model).AutoLabel.theLabel;
          if (Result = nil) and MakeIt then
          begin
            TIB_Edit(Model).AutoLabel.CreateLabel;
            Result := TIB_Edit(Model).AutoLabel.theLabel;
          end;
        end
        else
          // Controls with IIB_GridWinControl support an AutoLabel definition
          if (Model.GetInterface(IIB_GridWinControl, tmpIntf)) then
          begin
            if tmpIntf.GetAutoLabel is TIB_AutoLabel then
              with TIB_AutoLabel(tmpIntf.GetAutoLabel) do
              begin
                Result := theLabel;
                if (Result = nil) and MakeIt then
                begin
                  CreateLabel;
                  Result := theLabel;
                end;
              end;
          end;
  end;
end;

procedure TIB_AutoLabel.MakeLabel( CheckPreventFlag: boolean );
var
  ModelLabel: TCustomLabel;
  ModelUsed : Boolean;
  Rect : TRect;
  CurWidth, CurHeight : Integer;

begin
  if Kind = albNone then
  begin
    DestroyLabel;
    Exit;
  end;

  if not Assigned(theLabel) then
    CreateLabel;
  if (csLoading in Owner.ComponentState) and
    not (csDesigning in Owner.ComponentState) then
    Exit;

  if CheckPreventFlag and
    IB_AutoLabel_PreventFlicker and
    theLabel.CheckCaptionInitialised then
    Exit;

  // Assign some of the basic properties to the actual label being drawn.
  theLabel.Parent := Owner.Parent;
  theLabel.Layout := tlTop;
  theLabel.Transparent := FTransparent;
  theLabel.Color := FColor;
  theLabel.Suffix := FSuffix;
  // Set the Font properties
  theLabel.Font.OnChange := nil;
  theLabel.Font.Height := FFont.Height;
  theLabel.Font.PixelsPerInch := FFont.PixelsPerInch;
  theLabel.Font.Charset := FFont.Charset;
  theLabel.Font.Color := FFont.Color;
  theLabel.Font.Name := FFont.Name;
  theLabel.Font.Pitch := FFont.Pitch;
  theLabel.Font.Style := FFont.Style;
  theLabel.UseIBOBold := albBoldIfRequired in Options;
  theLabel.FocusControl := Owner;
  theLabel.Enabled := Owner.Enabled;
  theLabel.Visible := Owner.Visible;

  // Handle the Caption property
  if Caption = '' then
    theLabel.UseIBOLabel := true
  else
  begin
    theLabel.UseIBOLabel := false;
    theLabel.Caption := Caption;
  end;

  // Handle character case options
  if albOnlyFirstCharUpper in Options then
    theLabel.CharCase := ccProperCase
  else
    if albLowerCase in Options then
      theLabel.CharCase := ccLowerCase
    else
      theLabel.CharCase := IBC_CustomLabel.ccNormal;

  if albDotLeader in Options then
  begin
    theLabel.DotLeader := true;
    theLabel.SuffixBeforeDots := albSuffixBeforeDots in Options;
  end
  else
  begin
    theLabel.DotLeader := false;
    theLabel.SuffixBeforeDots := false;
  end;

  // We set ModelLabel to the TCustomLabel derivation related
  // to the supplied model - if available.
  ModelLabel := GetModelLabel(false);
  ModelUsed := False;
  if (ModelLabel <> nil) and (ModelLabel is TIB_CustomLabel) then
  begin
    with ModelLabel as TIB_CustomLabel do
    begin
      ModelUsed := True;
      theLabel.Suffix := Suffix;
      if (Kind in [albTop, albTopCenter]) then
      begin
        theLabel.Height := Height;
      end;
      theLabel.Layout := Layout;
      if ModelLabel is TIB_Label then
        with ModelLabel as TIB_Label do
        begin
          theLabel.UseIBOBold := UseIBOBold;
          theLabel.UseIBOLabel := UseIBOLabel;
        end;
      if theLabel.Font <> Font then
        FFontChanged := True; // Ensure we catch a change in the Model font
      theLabel.Font := Font;
      theLabel.ShowAccelChar := ShowAccelChar;
      theLabel.WordWrap := WordWrap;
      theLabel.DotLeader := DotLeader;
      theLabel.SuffixBeforeDots := SuffixBeforeDots;
      theLabel.CharCase := CharCase;
    end;
  end
  // otherwise only support TLabel
  else
    if (ModelLabel <> nil) and (ModelLabel is TLabel) then
    begin
      ModelUsed := True;
      with ModelLabel as TLabel do
      begin
        if (Kind in [albTop, albTopCenter]) then
        begin
          theLabel.Height := Height;
        end;
        theLabel.Layout := Layout;
        theLabel.Font := Font;
        theLabel.ShowAccelChar := ShowAccelChar;
        theLabel.WordWrap := WordWrap;
      end
    end;

  // This call is to get around switching the AutoSize property on and off
  // which causes large rendering times with the labels
  Rect := GetLabelRect;
  CurWidth := (Rect.Right - Rect.Left);
  CurHeight := (Rect.Bottom - Rect.Top);

  // We're finished tinkering with the Font property so we can re-instate the
  // OnChange event
  theLabel.Font.OnChange := OnLabelFontChange;

  if (Kind in [albLeft, albLeftCenter]) then
  begin
    if (RelativePosition <> 0) then
    begin
      theLabel.Left := Owner.Left + RelativePosition;
      if (RelativePosition < 0) and (not (albTrimX in Options)) then
        theLabel.Width := -RelativePosition - Spacing
      else
        theLabel.Width := CurWidth;
      theLabel.Alignment := taLeftJustify;
    end
    else
    begin
      theLabel.Width := CurWidth;
      theLabel.Alignment := taRightJustify;
      theLabel.Left := Owner.Left - theLabel.Width - Spacing;
    end;

    if ModelUsed or (not (albTrimY in Options)) then begin
      // Label spans the height of the owner control
      theLabel.Height := Owner.Height - Margin;
    end
    else begin
      // Label height remains the height of the Caption
      theLabel.Height := CurHeight;
    end;

    if (Kind = albLeftCenter) and (albTrimY in Options) then begin
      // Vertically Center the label ourselves
      theLabel.Top := Owner.Top + ((Owner.Height - theLabel.Height + Margin) div 2);
    end
    else begin
      theLabel.Top := Owner.Top + Margin;
    end;

    if Kind = albLeftCenter then
      theLabel.Layout := tlCenter;
  end
  else if (Kind = albTopCenter) then
  begin
    // Don't set the height if a Model has already been used.
    if (RelativePosition <> 0) then begin
      theLabel.Top := Owner.Top + RelativePosition;
      if (not ModelUsed) and (not (albTrimY in Options)) then
        theLabel.Height := Owner.Top - theLabel.Top - Spacing
      else begin
        if not ModelUsed then
          theLabel.Height := CurHeight;
      end;
    end
    else begin
      if not ModelUsed then
        theLabel.Height := CurHeight;
      theLabel.Top := Owner.Top - theLabel.Height - Spacing;
    end;

    if (CurWidth < (Owner.Width - Margin)) and (not ModelUsed) and (albTrimX in Options) then begin
      // Center the label and keep the label width the same as the Caption width
      theLabel.Width := CurWidth;
      theLabel.Left := Owner.Left + ((Owner.Width - theLabel.Width + Margin) div 2);
      theLabel.Alignment := taCenter;
    end
    else begin
      // Change the label width to the width of the Owner
      theLabel.Left := Owner.Left + Margin;
      if CurWidth > (Owner.Width - Margin) then
        theLabel.Width := CurWidth
      else
        theLabel.Width := Owner.Width - Margin;
      // Center the label
      if not ModelUsed then
        theLabel.Alignment := taCenter;
    end;
  end
  else
  begin
    // Kind = albTop
    // Don't set the height if a Model has already been used.
    if (RelativePosition <> 0) then begin
      theLabel.Top := Owner.Top + RelativePosition;
      if (not ModelUsed) and (not (albTrimY in Options)) then begin
        if RelativePosition < 0 then
          theLabel.Height := Owner.Top - theLabel.Top - Spacing
        else begin
          theLabel.Layout := tlBottom;
          theLabel.Height := CurHeight + (theLabel.Top - (Owner.Top + Owner.Height) - Spacing); //theLabel.Height
          theLabel.Top := Owner.Top + Owner.Height + Spacing;
        end;
      end
      else begin
        if not ModelUsed then
          theLabel.Height := CurHeight;
      end;
    end
    else begin
      if not ModelUsed then
        theLabel.Height := CurHeight;
      theLabel.Top := Owner.Top - theLabel.Height - Spacing;
    end;

    theLabel.Left := Owner.Left + Margin;
    if not ModelUsed then
      theLabel.Alignment := taLeftJustify;
    if (CurWidth < (Owner.Width - Margin)) and
       (ModelUsed or (not (albTrimX in Options))) then begin
      // Set the width of the label to the width of the owner
      theLabel.Width := Owner.Width - Margin;
    end
    else begin
      // Label width remains the width of the Caption
      theLabel.Width := CurWidth;
    end;
  end;

  // If we have a TIB_CustomLabel based model...
  if (ModelLabel <> nil) and (ModelLabel is TIB_CustomLabel) then
  begin
    with ModelLabel as TIB_CustomLabel do
    begin
      theLabel.Alignment := Alignment;
      {$IFDEF IBO_VCL40_OR_GREATER}
      theLabel.BiDiMode := BiDiMode;
      {$ENDIF}
      theLabel.Color := Color;
      if (albAlignToModel in Options) and
        (theLabel.Parent = Parent) then
        if (abs(theLabel.Top - Top) > Height) and
          (Left < self.Owner.Left) and
          (Kind in [albLeft,albLeftCenter]) then
        begin
          theLabel.Left := Left;
          theLabel.Width := Self.Owner.Left - Left - Spacing;
        end
        else
          if (abs(theLabel.Left - Left) > Width) and
            (Top < self.Owner.Top) and
            (Kind in [albTop,albTopCenter]) and
            Assigned(FocusControl) and
            (theLabel.FocusControl.Top = FocusControl.Top) then
            theLabel.Top := Top;
      theLabel.PopupMenu := PopupMenu;
      theLabel.ShowHint := ShowHint;
      theLabel.Transparent := Transparent;
    end;
  end
  // otherwise only support TLabel
  else
    if (ModelLabel <> nil) and (ModelLabel is TLabel) then
    begin
      with ModelLabel as TLabel do
      begin
        theLabel.Alignment := Alignment;
        {$IFDEF IBO_VCL40_OR_GREATER}
        theLabel.BiDiMode := BiDiMode;
        {$ENDIF}
        theLabel.Color := Color;
        if (albAlignToModel in Options) and
          (theLabel.Parent = Parent) then
          if (abs(theLabel.Top - Top) > Height) and
            (Left < self.Owner.Left) and
            (Kind in [albLeft,albLeftCenter]) then
          begin
            theLabel.Left := Left;
            theLabel.Width := Self.Owner.left - Left - Spacing;
          end
          else
            if (abs(theLabel.Left - Left) > Width) and
              (Kind in [albTop,albTopCenter]) and
              Assigned(FocusControl) and
              (theLabel.FocusControl.Top = FocusControl.Top) then
              theLabel.Top := Top;
        theLabel.PopupMenu := PopupMenu;
        theLabel.ShowHint := ShowHint;
        theLabel.Transparent := Transparent;
      end
    end;
  // Since the Font properties do not automatically trigger an invalidate
  // we need to do it manually.
  if FDimsChanged or FFontChanged or theLabel.CaptionChanged then begin
    FFontChanged := False;
    theLabel.Invalidate;
  end;
end;

// Thought it was safer to keep the response to model changes separate
// in case special processing is required.

procedure TIB_AutoLabel.ModelChanged;
begin
  MakeLabel( false );
end;

procedure TIB_AutoLabel.Make;
begin
  MakeLabel( true );
end;

function TIB_AutoLabel.GetLabelRect: TRect;
var
  DC: HDC;

begin
  // This is a similar call to the AdjustBounds call in the TCustomLabel
  // allowing us to gather the autosized dimensions of the Label quickly.
  FillChar(Result, SizeOf(Result), 0);
  DC := GetDC(0);
  theLabel.Canvas.Handle := DC;
  theLabel.DoDrawText(Result, (DT_EXPANDTABS or DT_CALCRECT));
  theLabel.Canvas.Handle := 0;
  ReleaseDC(0, DC);
  FDimsChanged := not CompareMem(@Result, @FLastDims, SizeOf(Result));
  FLastDims := Result;
end;

procedure TIB_AutoLabel.OnFontChange(Sender : TObject);
begin
  FFontChanged := True;
  MakeLabel( false );
end;

procedure TIB_AutoLabel.OnLabelFontChange(Sender: TObject);
begin
  // This occurs when the TIB_Label itself is changed programatically
  // so we need to sync the FontShell properties
  if Assigned(FtheLabel) then begin
    FFont.OnChange := nil;
    FFont.Assign(theLabel.Font);
    FFont.OnChange := OnFontChange;
    FFontChanged := True;
    MakeLabel(false);
  end;
end;

procedure TIB_AutoLabel.SetKind(const K: TIB_AutoLabelKind);
begin
  if (FKind <> K) then
  begin
    FKind := K;
    MakeLabel( false );
  end;
end;

procedure TIB_AutoLabel.SetSuffix(const S: string);
begin
  if (S <> FSuffix) then
  begin
    FSuffix := S;
    if Assigned(theLabel) or (csDesigning in Owner.ComponentState) then
      MakeLabel( false );
  end;
end;

procedure TIB_AutoLabel.SetCaption(const S: string);
begin
  if (S <> FCaption) then
  begin
    FCaption := S;
    if Assigned(theLabel) or (csDesigning in Owner.ComponentState) then
      MakeLabel( false );
  end;
end;

procedure TIB_AutoLabel.SetRelativePosition(const P: Integer);
begin
  if (P <> FRelativePosition) then
  begin
    FRelativePosition := P;
    if Assigned(theLabel) or (csDesigning in Owner.ComponentState) then
      MakeLabel( false );
  end;
end;

procedure TIB_AutoLabel.SetMargin(const P: Integer);
begin
  if (P <> FMargin) then
  begin
    FMargin := P;
    if Assigned(theLabel) or (csDesigning in Owner.ComponentState) then
      MakeLabel( false );
  end;
end;

procedure TIB_AutoLabel.SetSpacing(const P: Integer);
begin
  if (P <> FSpacing) then
  begin
    FSpacing := P;
    if Assigned(theLabel) or (csDesigning in Owner.ComponentState) then
      MakeLabel( false );
  end;
end;

procedure TIB_AutoLabel.SetModel(const M: TControl);
var
  TmpLbl: TCustomLabel;
begin
  if (M <> nil) then
  begin
    // Prevent assignment of a model, if this instance is being
    // used as a model - prevents circular references.
    if (theLabel <> nil) and (theLabel is TIB_Label) and
      (TIB_Label(theLabel).FModelRefs <> nil) and
      (TIB_Label(theLabel).FModelRefs.Count > 0) then
      Exit;
    // Prevent assignment of self as the model
    if (M = theLabel) or (M = FOwner) then
      Exit;
  end;
  if (M <> FModel) then
  begin
    TmpLbl := GetModelLabel(false);
    if TmpLbl <> nil then
    begin
       // if RemoveFreeNotification is available (D5/BCB5 onwards)
       // then we use it, for the sake of completeness in the code.
      {$IFDEF IBO_VCL50_OR_GREATER}
      if TmpLbl is TIB_Label then
        TIB_Label(TmpLbl).RemoveModelRef(Self)
      else
        if Assigned(theLabel) then
          FModel.RemoveFreeNotification(theLabel);
      {$ELSE}
      if TmpLbl is TIB_Label then
        TIB_Label(TmpLbl).RemoveModelRef(Self);
      {$ENDIF}
    end;
    FModel := M;
    TmpLbl := GetModelLabel(true);
    if TmpLbl <> nil then
    begin
      if TmpLbl is TIB_Label then
        TIB_Label(TmpLbl).AddModelRef(Self)
      else
      begin
        CreateLabel; // Must have a reference for FreeNotification
        FModel.FreeNotification(theLabel);
      end;
    end;
    if Assigned(theLabel) or (csDesigning in Owner.ComponentState) then
      MakeLabel( false );
  end;
end;

procedure TIB_AutoLabel.SetOptions(const O: TIB_AutoLabelOptionsSet);
begin
  if (O <> FOptions) then
  begin
    FOptions := O;
    if Assigned(theLabel) or (csDesigning in Owner.ComponentState) then
      MakeLabel( false );
  end;
end;

procedure TIB_AutoLabel.SetTransparent(const Value : Boolean);
begin
  if (Value <> FTransparent) then
  begin
    FTransparent := Value;
    if Assigned(theLabel) or (csDesigning in Owner.ComponentState) then
      MakeLabel(False);
  end;
end;

procedure TIB_AutoLabel.SetColor(const Value : TColor);
begin
  if (Value <> FColor) then
  begin
    FColor := Value;
    if Assigned(theLabel) or (csDesigning in Owner.ComponentState) then
      MakeLabel(False);
  end;
end;

procedure TIB_AutoLabel.SetFont(const Value: TIB_FontShell);
begin
  FFont.Assign(Value);
end;

{ TIB_FontShell }

constructor TIB_FontShell.Create;
begin
  FColor := clWindowText;
  FPixelsPerInch := DefPixelsPerInch;
  Height := DefFontData.Height;
  Pitch := DefFontData.Pitch;
  Style := DefFontData.Style;
  Charset := DefFontData.Charset;
  Name := DefFontData.Name;
end;

procedure TIB_FontShell.Assign(Source: TPersistent);
begin
  // Allow either a TIB_FontShell or TFont assignment
  if Source is TIB_FontShell then begin
    FCharset := TIB_FontShell(Source).FCharset;
    FColor := TIB_FontShell(Source).FColor;
    FHeight := TIB_FontShell(Source).FHeight;
    FName := TIB_FontShell(Source).FName;
    FPitch := TIB_FontShell(Source).FPitch;
    FStyle := TIB_FontShell(Source).FStyle;
    FPixelsPerInch := TIB_FontShell(Source).FPixelsPerInch;
  end
  else if Source is TFont then begin
    FCharset := TFont(Source).Charset;
    FColor := TFont(Source).Color;
    FHeight := TFont(Source).Height;
    FName := TFont(Source).Name;
    FPitch := TFont(Source).Pitch;
    FStyle := TFont(Source).Style;
    FPixelsPerInch := TFont(Source).PixelsPerInch;
  end;
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

function TIB_FontShell.GetCharset: TFontCharset;
begin
  Result := FCharset;
end;

function TIB_FontShell.GetColor: TColor;
begin
  Result := FColor;
end;

function TIB_FontShell.GetHeight: Integer;
begin
  Result := FHeight;
end;

function TIB_FontShell.GetName: TFontName;
begin
  Result := FName;
end;

function TIB_FontShell.GetPitch: TFontPitch;
begin
  Result := FPitch;
end;

function TIB_FontShell.GetSize: Integer;
begin
  Result := -MulDiv(FHeight, 72, FPixelsPerInch);
end;

function TIB_FontShell.GetStyle: TFontStyles;
begin
  Result := FStyle;
end;

procedure TIB_FontShell.SetCharset(Value: TFontCharset);
begin
  if Value <> FCharset then begin
    FCharset := Value;
    if Assigned(FOnChange) then
      FOnChange(Self);
  end;
end;

procedure TIB_FontShell.SetColor(Value: TColor);
begin
  if Value <> FColor then begin
    FColor := Value;
    if Assigned(FOnChange) then
      FOnChange(Self);
  end;
end;

procedure TIB_FontShell.SetHeight(Value: Integer);
begin
  if Value <> FHeight then begin
    FHeight := Value;
    if Assigned(FOnChange) then
      FOnChange(Self);
  end;
end;

procedure TIB_FontShell.SetName(const Value: TFontName);
begin
  if (Value <> '') and (Value <> FName) then begin
    FName := Value;
    if Assigned(FOnChange) then
      FOnChange(Self);
  end;
end;

procedure TIB_FontShell.SetPitch(Value: TFontPitch);
begin
  if Value <> FPitch then begin
    FPitch := Value;
    if Assigned(FOnChange) then
      FOnChange(Self);
  end;
end;

procedure TIB_FontShell.SetSize(Value: Integer);
begin
  if Value <> Size then begin
    FHeight := -MulDiv(Value, FPixelsPerInch, 72);
    if Assigned(FOnChange) then
      FOnChange(Self);
  end;
end;

procedure TIB_FontShell.SetStyle(Value: TFontStyles);
begin
  if Value <> FStyle then begin
    FStyle := Value;
    if Assigned(FOnChange) then
      FOnChange(Self);
  end;
end;

procedure InitPixelsPerInch;
var
  DC: HDC;
begin
  DC := GetDC(0);
  DefPixelsPerInch := GetDeviceCaps(DC, LOGPIXELSY);
  ReleaseDC(0,DC);
end;

initialization
  InitPixelsPerInch;
  IB_AutoLabel_DefaultKind := albNone;
  IB_AutoLabel_DefaultSuffix := '';
  IB_AutoLabel_DefaultMargin := 3;
  IB_AutoLabel_DefaultSpacing := 3;
  IB_AutoLabel_DefaultPosition := 0;
  IB_AutoLabel_DefaultOptions := [];
  IB_AutoLabel_IgnoreZeroDefault := true;
  IB_AutoLabel_PreventFlicker := false;
  IB_AutoLabel_DefaultTransparent := True;
  IB_AutoLabel_DefaultColor := clBtnFace;

end.

