
{                                                                              }
{ IB_Controls                                                                  }
{                                                                              }

{***************************************************************}
{                                                               }
{          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.                  }
{------------------------------------------------------------------------------}
{                                                                              }
{  Salvatore Besso <s.besso@mclink.it>                                         }
{  15-Jan-2005                                                                 }
{     Completely rewritten TIB_CustomDateTimePicker.SysUpdateData to fix a     }
{     problem with field assignment when Kind = dtkTime. Amended with latest   }
{     version of original IB_Controls.pas as of version 4.5Ai Eval. To find it }
{     quickly, search for SB comments sorrounded by curly brackets             }
{                                                                              }
{  Rade Vojvodic <rvojvodic@rsdef.org>                                         }
{  11/25/2004                                                                  }
{      TIB_CustomEdit Windows XP Theme enabled. In uses clause added Theme unit}
{      In DrawButton  procedure added code to show button according to current }
{      Xp Theme. Added FHot private property to be able to find out if mouse   }
{      is over button for hot state of the button. If ellipsis type of button  }
{      pushbutton is shown, otherwise (dropdown) button looks like any other   }
{      combobox. Added CMMouseEnter and CMMouseLeave for determining Hot state }
{      of the button.                                                          }
{                                                                              }
{                                                                              }
{  Rade Vojvodic <rvojvodic@rsdef.org>                                         }
{  11/25/2004                                                                  }
{     TIB_CustomRadioGroup changed to be able to look like any other radiogroup}
{     in Windows. Added two more properties                                    }
{     property Caption;                                                        }
{     property DisplayLabelAsCaption: Boolean read FDisplayLabelAsCaption      }
{                                          write SetDisplayLabelAsCaption      }
{                                          default false;                      }
{     If borderStyle property is set to bsNone then TIB_RadioGroup looks like  }
{     TRadioGroup from Delphi VCL. Additionaly DisplayLabelAsCaption works     }
{     the same way as in TIB_CheckBox. Paint and ArrangeButtons procedures     }
{     required minor changes to achieve this. Every change is commented with   }
{     //RV?? so it can be easily found.                                        }
{                                                                              }
{******************************************************************************}

{$INCLUDE IB_Directives.inc}

{: This unit contains most of the standard data aware controls that come
with IB Objects.}
unit
  IB_Controls;

interface

uses
  SysUtils, Windows, Messages, Classes,
  {$IFDEF IBO_VCL70_OR_GREATER}
  //RV?? if using themed display in XP Themes unit is neccessary
  Themes,
  {$ENDIF}
  DatePick,

{$IFDEF IBO_VCL60_OR_GREATER}
  MaskUtils,
{$ENDIF}

  Controls, Forms, Graphics, Menus, StdCtrls, ExtCtrls, ComCtrls, Mask, Buttons,
  Dialogs, Clipbrd, CommCtrl,

  IB_Header,
  IB_Constants,
  IB_Components,
  IB_ControlInterface,
{$IFDEF IBO_VCL30_OR_GREATER}
  IBC_Label,
{$ENDIF}
  IB_FieldDataLink,
  uRounding,
  IB_Parse;

//IB_Editors
//IB_Grid
//IB_CGrid
//IB_Registration

//IB_Classes.INC
//IB_Control.INT
//IB_Control.PBL
//IB_WinControl.INT
//IB_WinControl.PBL

type
{$DEFINE IB_FieldControl}

{$DEFINE IBC_Text}
{                                                                              }
{ TIB_Text                                                                     }
{                                                                              }
{------------------------------------------------------------------------------}
{  Marco Menardi <mmenaz@lycosmail.com>                                        }
{  2002/07/26                                                                  }
{     Text position takes into account border and bever width                  }
{  2002/01/05                                                                  }
{     Added property for borders around the control like TPanel has            }
{  2001/10/25                                                                  }
{     Now if in design time and dataset active, if the field is empty or null  }
{     it shows '<EMPTY>' as a placeholder for the component                    }
{            Copyright (C) 2001 Marco Menardi                                  }
{                                                                              }
{******************************************************************************}

{: This control allows the string contents of a column to be displayed in a
standard label control. It has also borders property like TPanel.}

TIB_TextEvent = procedure (Sender: TObject;var AString: string) of object;

TIB_CustomText = class(TCustomLabel)
private
  FOnGetDisplayText: TIB_TextEvent;
{$I IB_Control.INT}
protected
  function GetLabelText: string; override;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
published
  property AutoSize default false;
{$IFDEF IBO_VCL30_OR_GREATER}
  property Layout;
{$ENDIF}
  property Transparent;
  property WordWrap;
  property OnGetDisplayText: TIB_TextEvent read FOnGetDisplayText write FOnGetDisplayText;
end;

TIB_Text = class(TIB_CustomText)
{$I IB_Control.PBL}
private
  FBevelInner: TPanelBevel;
  FBevelOuter: TPanelBevel;
  FBevelWidth: TBevelWidth;
  FBorderWidth: TBorderWidth;
  FBorderStyle: TBorderStyle;
  procedure SetBevelInner(Value: TPanelBevel);
  procedure SetBevelOuter(Value: TPanelBevel);
  procedure SetBevelWidth(Value: TBevelWidth);
  procedure SetBorderWidth(Value: TBorderWidth);
  procedure SetBorderStyle(Value: TBorderStyle);
protected
  procedure Paint; override;
published
  property BevelInner: TPanelBevel read FBevelInner write SetBevelInner default bvNone;
  property BevelOuter: TPanelBevel read FBevelOuter write SetBevelOuter default bvNone;
  property BevelWidth: TBevelWidth read FBevelWidth write SetBevelWidth default 1;
  property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 1;
  property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsNone;
public
  constructor Create(AOwner: TComponent); override;
end;
{$UNDEF IBC_Text}

{$DEFINE IBC_Edit}
{                                                                              }
{ TIB_Edit                                                                     }
{                                                                              }

TIB_EditButtonStyle = ( ebsNone, ebsEllipsis, ebsDropDown );

{: In this event it is possible to change the drawing of the Ellipsis or the
DropDown button.
<br>
One possibility is to change just the brush color of the canvas and then, with
DefaultDrawing enabled, let the default drawing proceed as usual.
<br>
It is possible to draw a completely different image into the rectangle of the
canvas.
<br>
For an example of drawing into the rectangle of the canvas, see the Draw method
of TCustomImageList in the Delphi help.}
TIB_EditButtonCustomDrawEvent = procedure(     ACanvas: TCanvas;
                                               Rect: TRect;
                                               Enabled,
                                               Pressed: boolean;
                                           var DefaultDraw: boolean ) of object;

TIB_IsValidCharEvent = procedure(     Sender: TObject;
                                  var AChar: Char;
                                  var IsValid: Boolean ) of object;

{: This control gives a very generic entry field for displaying and/or entering
data or search criteria.
<br><br>
It is aware of the dataset state and displays/accepts search criteria if the
state is dssSearch;  otherwise it displays/accepts data.}
TIB_CustomEdit = class(TCustomMaskEdit)
{$DEFINE IB_AutoLabel}
{$I IBC_CustomEdit.INT}
{$UNDEF IB_AutoLabel}
private
  {$IFDEF IBO_VCL70_OR_GREATER}
  //RV?? FHot is neccessery to get the Hot state of a button
  FHot: boolean;
  {$ENDIF}
  FFocused: boolean;
  FCanvas: TControlCanvas;
  FAlignment: TAlignment;
  FDrawButton: boolean;
  FButtonWidth: integer;
  FImageList: TImageList;
  FImageIndex: integer;
  FImageIndexDisabled: integer;
  FImageIndexPressed: integer;
  FButtonStyle: TIB_EditButtonStyle;
  FAlwaysShowButton: boolean;
  FPressed: boolean;
  FTracking: boolean;
  FMaskChanging: boolean;
  FAllowUnboundEdits: boolean;
  FOnButtonClick: TNotifyEvent;
  FOnButtonDraw:TIB_EditButtonCustomDrawEvent;
  FOnGetDisplayText,
  FOnGetEditText,
  FOnSetEditText:TIB_TextEvent;
  FOnIsValidChar:TIB_IsValidCharEvent;
  procedure SetFocused( AValue: boolean );
  procedure DrawButton;
  procedure DrawButtonStyle(ACanvas: TCanvas; ARect: TRect);
  function GetTextMargins: TPoint;
  procedure WMCut(var Message: TMessage); message WM_CUT;
  procedure WMPaste(var Message: TMessage); message WM_PASTE;
  procedure CMGotFocus(var Message: TCMGotFocus); message CM_GotFocus;
  procedure StopTracking;
  procedure CheckDrawButton(ForceRepaint: boolean);
  procedure SetPasswordChar(Value: Char);
  procedure SetButtonStyle(Value: TIB_EditButtonStyle);
  procedure SetAlwaysShowButton(Value: boolean);
  procedure SetImageList(Value: TImageList);
  procedure SetImageIndex(Value: integer);
  procedure SetImageIndexDisabled(Value: integer);
  procedure SetImageIndexPressed(Value: integer);
  procedure TrackButton(X,Y: Integer);
  procedure WMSetCursor(var Msg: TWMSetCursor); message WM_SETCURSOR;
  procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  {$IFDEF IBO_VCL70_OR_GREATER}
  //RV?? Added for theme support
  procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  {$ENDIF}
protected
  procedure BoundsChanged;
  procedure DoEditButtonClick; dynamic;
  procedure CreateParams(var Params: TCreateParams); override;
  procedure CreateWnd; override;
  procedure DoEnter; override;
  procedure DoExit; override;
  procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  procedure PaintWindow(DC: HDC); override;
  procedure DoCustomButtonDraw(     ACanvas: TCanvas;
                                    Rect: TRect;
                                    Enabled,
                                    Pressed: boolean;
                                var DefaultDraw:boolean ); virtual;
  function EditCanModify: Boolean; override;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure KeyPress(var Key: Char); override;
  procedure Reset; override;
  procedure Loaded; override;
  procedure Change; override;
  procedure UpdateMask( UnboundMask: string ); virtual;
  property MaskChanging: boolean read FMaskChanging write FMaskChanging;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  property PasswordChar write SetPasswordChar;
{: This property allows a button to be displayed in the edit control.
<br><br>
Note that the button will not show if PasswordChar is set, although
the OnButtonClick event will still be fired for CTRL+ENTER if the
ButtonStyle property is set to show a button.}
  property ButtonStyle: TIB_EditButtonStyle read FButtonStyle
                                            write SetButtonStyle
                                            default ebsNone;
{: This property can contain the IconList for the Ellipsis button.
<br>
Use the ImageIndex[ ] to select the required icon. If no ImageList has been set,
a default ellipsis button is drawn.
<br>
See also ButtonStyle.}
  property ImageList: TImageList read FImageList
                                 write SetImageList;
{: The index to the image in the imagelist for the ButtonGlyph.  See also
ImageIndexDisabled, ImageIndexPressed.}
  property ImageIndex: integer read FImageIndex
                               write SetImageIndex
                               default -1;
{: An optional index to the image in the Imagelist for the ButtonGlyph
   to display when the field is disabled.  See also ImageIndex,
   ImageIndexPressed.}
  property ImageIndexDisabled: integer read FImageIndexDisabled
                                       write SetImageIndexDisabled
                                       default -1;
{: An optional index to the image in the Imagelist for the ButtonGlyph
   when the button is pressed.  See also ImageIndex, ImageIndexDisabled.}
  property ImageIndexPressed: integer read FImageIndexPressed
                                      write SetImageIndexPressed
                                      default -1;
{: This property determines whether the control's button will show when the
control is not focused.}
  property AlwaysShowButton: boolean read FAlwaysShowButton
                                     write SetAlwaysShowButton
                                     default false;
{: This event will fire when the button is about to be drawn.}
  property OnButtonDraw: TIB_EditButtonCustomDrawEvent read FOnButtonDraw
                                                       write FOnButtonDraw;
{: This event will fire when the user presses the button in the edit control,
or when the user presses CTRL+ENTER and the ButtonStyle property is set to
show a button.}
  property OnButtonClick: TNotifyEvent read FOnButtonClick
                                       write FOnButtonClick;
  property OnGetDisplayText: TIB_TextEvent read FOnGetDisplayText
                                           write FOnGetDisplayText;
  property OnGetEditText: TIB_TextEvent read FOnGetEditText
                                        write FOnGetEditText;
  property OnSetEditText: TIB_TextEvent read FOnSetEditText
                                        write FOnSetEditText;
  property OnIsValidChar: TIB_IsValidCharEvent read FOnIsValidChar
                                               write FOnIsValidChar;
end;

{: Published class of TIB_CustomEdit.}
TIB_Edit = class(TIB_CustomEdit)
{$DEFINE IB_AutoLabel}
{$I IBC_CustomEdit.PBL}
{$UNDEF IB_AutoLabel}
end;
// IBC_Edit.IMP
{                                                                              }
{ TIB_Currency                                                                 }
{                                                                              }

{***************************************************************}
{                                                               }
{          IB Objects Components and Resources Library          }
{                                                               }
{          Copyright (C) 1996-2001 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.                  }
{------------------------------------------------------------------------------}
{                                                                              }
{  Original Author: Marco Menardi <mmenaz@mail.com>  2001/11/01                }
{           Copyright (C) 2001 Marco Menardi                                   }
{                                                                              }
{  Attention: since the control is finalized to the monetary input, it's good  }
{             for a number of decimal digits between 0 and 3. For 4 decimal    }
{             digits, internal rounding when formatting could be inaccurate.   }
{                                                                              }
{------------------------------------------------------------------------------}
{                                                                              }
{   Fixes needed: once the form is reloaded, the name of the control is no more}
{                 displayed.                                                   }
{                                                                              }
{   2004/07/06 Marco Menardi                                                   }
{     - fixed delete key working even if ReadOnly was True                     }
{                                                                              }
{   2002/08/31 Marco Menardi                                                   }
{     - fixed bad display formatting when control is unbound and data changed  }
{       with .Value                                                            }
{                                                                              }
{   2002/04/25 Marco Menardi                                                   }
{     - calculator now supports 'cascade' operations (like 1+2+4-6=)           }
{                                                                              }
{   2002/01/26 Marco Menardi                                                   }
{     - changed RoundDecimalPos default and interpretation as 'round to the    }
{       number of decimals taken from DisplayFormat' from -9 to -99, to avoid  }
{       conflicts if you really want to round to -9 position. Change your      }
{       program code replacing -9 with -99.                                    }
{     - RoundMode default value is now crmNearBool, the equivalent of standard }
{       delphi Round() function (it was crmNearUp). If you use crmNearUp (like }
{       me) you have to set it manually for the new components you create.     }
{       The change will reduce code bugs since Delphi and IBO_CURRENCY now have }
{       then same default behaviour.                                           }
{     - The value entered or resulting from a conversion is not more checked   }
{       to be less than 8999999999999.99, since IBO>4.2Fp handles currency far }
{       better, so no false overflow are raised. But if you have a domain for  }
{       your monetary values, since the database has some problems,  consider  }
{       adding a check to the range (i.e. AS NUMERIC(18,2)                     }
{       CHECK( VALUE BETWEEN -99999999999999.99 AND +99999999999999.99 );      }
{     - Value is no more stored/retrived with a forced AsCurrency, since IBO   }
{       4.2fp does it automatically if CURRENCY is in the ColumnAttributes.    }
{       Note that control .Value property always uses AsCurrency               }
{                                                                              }
{   2002/01/18 Marco Menardi                                                   }
{     - Exiting in unbound mode now correctly reformats using DisplayFormat    }
{       property, if set                                                       }
{                                                                              }
{   2001/12/06 Marco Menardi                                                   }
{     - Added DisplayFormat property that works in unbound mode or overrides   }
{       column definition                                                      }
{                                                                              }
{   2001/11/06 Marco Menardi                                                   }
{    - Added BeforeConversion event, so you can customize conversion rate/etc. }
{    - If value is 0 and no operation is pending, the first '-' is interpreted }
{      as sign, even if inline calculator is active                            }
{                                                                              }
{   2001/11/06 Marco Menardi                                                   }
{    - Runtime property 'Value' for getting or setting control value as        }
{      currency (useful when in unbound mode, since Text returns a formatted   }
{      string)                                                                 }
{    - Better handling of any literal chars of the DisplayFormat (like $, TL.  }
{      EUR) now everything is ignored.                                         }
{    - Currency is now stored with AsCurrency, not through AsFloat             }
{    - Basic calculation inside the control allowed (+-*/%)                    }
{    - 'Canc' key as 'CelarAll' for the control                                }
{    - CalculatorKind for none, inline, dropdown, both. If inline or both are  }
{      set, to enter negative numbers press '=' after (i.e. -12=) or TAB out   }
{      Inline is limited by the use of currency type for all the operation     }
{      involved, but it's fast and convenient for simple additions or subs.    }
{                                                                              }
{   2001/11/05 Marco Menardi                                                   }
{    - added support for cut/copy/paste in unbound mode, and editing of whole  }
{      numbers (',0'). Bugfix.                                                 }
{      Changed property name from ForeignToActualRatio to ConversionRatio      }
{      Digits edited forced to be inside max currency range (and not float     }
{      range as IBO <= 4.2Fb does). Needs to be improved.                      }
{                                                                              }
{   2001/11/04 Marco Menardi                                                   }
{      First beta of the calculator created. Thanks to TIB_Date.               }
{                                                                              }

{: These are the different kind of calculator allowed.
<br>
<br>cucNone no calculator used. The '-' is always interpreted as sign
<br>cucInline you can enter operators in the control, where results are displayed.
<br>          '-' is sign only if no calculation is pending and the actual value is 0
<br>cucDropDown operators can be entered only if in the embedded drop down calculator
<br>cucBoth you can enter operators inside the control and drop down the embedded calculator too.}
TIB_CurrencyCalcKind = (cucNone, cucInline, cucDropDown, cucBoth);

{: These are the different kind of rounding allowed.
<br>
<br>crmNearUp rounds x.5 always up
<br>crmDown
<br>crmUp
<br>crmTruncate
<br>crmNearBool is Delphi Round() equivalent.}
TIB_CurrencyRoundingMode = (crmNearUp, crmDown, crmUp, crmTruncate, crmNearBool);

{: This control is used for entry field of columns that store currency only or that are currency compatible.
<br>Right alignment, formatting while editing and settings of the number of decimals allowed, combined with optional inline calculator, simplifies and enhances
monetary data entry.
<br>The input is based on the DisplayFormat of the field. Tested formats are like ',0.00' or 'Lit ,0.00' and so on. Don't use literal chars on the right of the decimal separator (i.e. ',0.00 $'). Some formats have special meanings, though:
<br>   if no decimal separator is given, only whole number are allowed, even if the field is defined with them (i.e. Numeric(15,2)).
<br>   If the decimal separator is provided, but no '0' or '#' follows (like '$ ,0.'), then the lower between the global variable CurrencyDecimal and the field number of decimals is used.
<br>There is also the possibility to convert from a foreign currency to the actual stored. Just enter the foreign and press the conversion key (see property ConversionShortCut)
<br>
<br>The control works as unbound too, using a generic data entry mask or one provided with DisplayFormat property.
<br>
<br>Interbase has not 'currency' data type, but from version 6 a NUMERIC(p,s) with p between 10 and 18 and s between 1 and 4 are stored as INT64 to avoid rounding errors.
<br>This is roughly the same as Delphi currency data type, so using this control with above numeric type minimizes storage and manipulation rounding problems.
}
TIB_Currency = class(TIB_CustomEdit)
{$DEFINE IB_AutoLabel}
{$I IBC_CustomEdit.PBL}
{$UNDEF IB_AutoLabel}
private
  FDecimalPlaces: integer;
  FFormatting: boolean;
  FDisplayEditingFormat: string;
  FDisplayFormat: string;
  FUnboundDisplayFormat: string;
  FConversionRatio: extended;
  FConversionShortCut: TShortCut;
  FRoundMode: TIB_CurrencyRoundingMode;
  FRoundDecimalPos: integer;
  FCalcLastValue: extended;
  FCalcLastOp: Char;
  FCalcClearDisplay: boolean;
  FCalcPending: boolean;
  FCalculatorKind: TIB_CurrencyCalcKind;
  FBeforeConversion: TNotifyEvent;
  procedure CMEnter( var Message: TCMEnter ); message CM_ENTER;
  procedure CMExit(var Message: TCMExit); message CM_EXIT;
  function CheckCurrencyOverRange( S : string ) : boolean;
  function GetValue : currency;
  procedure SetValue( AValue : currency );
  procedure SetDisplayFormat(const AValue: string);
  procedure InLineCalc(var Key: Char);
  procedure ResetInLineCalcStatus;
  procedure UpdateDisplayFormat;
protected
  procedure CreateParams(var Params: TCreateParams); override;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure KeyPress(var Key: Char); override;
  function EditCanModify: Boolean; override;
  procedure UpdateMask( UnboundMask: string ); override;
  procedure SysUpdateData( AField: TIB_Column ); override;
  procedure FormatCurrentText; dynamic;
  procedure Change; override;
  procedure ConvertCurrency; dynamic;
public
{$IFDEF IBO_VCL40_OR_GREATER}
  procedure ValidateEdit; override;
{$ENDIF}
  constructor Create( AOwner: TComponent ); override;
{: Retrieves or sets the value in unbound mode as Currency type. If you use Text instead you get
the content with formatting.}
  property Value : Currency read GetValue write SetValue;
published
{: This event is fired before the conversion takes place, so you can change conversion
parameters 'on the fly'.}
  property BeforeConversion: TNotifyEvent read FBeforeConversion write FBeforeConversion;
{: This property determines the ratio of the conversion from foreign currency to
the actual one (stored). The formula is Actual = Foreign/Ratio.}
  property ConversionRatio : extended read FConversionRatio write FConversionRatio;
{: This property sets the key shortcut to perform the conversion of the actual
content using ConversionRatio. Default is 'c'.}
  property ConversionShortCut : TShortCut read FConversionShortCut write FConversionShortCut default 67; // 'C'
{: This property sets the mode rounding is performed when converting from one
currency to another.
<br> Note the existence of crmNearUp that rounds x.5 ALWAYS UP (contrary to the
Delphi round(), that performs a 'bankers round'), widely used, for instance,
in Italy and many other countries.}
  property RoundMode : TIB_CurrencyRoundingMode read FRoundMode write FRoundMode default crmNearUp;
{: This property determines the decimals position where rounding occurs when
converting from one currency to the actual. If negative, the rounding is
performed to the left side of the decimal separator, e. if -1, 206 -> 210
(assuming ConversionRatio = 1). This is useful for example when you have to
round a number for tax purpose. If set to -99 (default) the actual currency
decimals taken from DisplayFormat is used as position.
<br>In unbound mode and empty DisplayFormat, it sets the actual currency number
of decimals (if -99, CurrencyDecimals is assumed).}
  property RoundDecimalPos: integer read FRoundDecimalPos write FRoundDecimalPos default -99;
{: This property sets the kind of embedded calculator use. Default is none, since when any calculator is enabled, the '-' is unable to be used as a sign indicator (it's interpreted as the subtraction operator).
<br>DropDown calculator is not yet implemented, only inline is.
<br>For inline calculator, the following keys have special meanings:
<br>+-*/%   operations allowed
<br>CANC    clears the content and the operation buffer
<br>=       result of the operation. If a calculation is in progress,  when the control
looses focus (i.e. hitting TAB) the = is performed.
}
  property CalculatorKind : TIB_CurrencyCalcKind read FCalculatorKind write FCalculatorKind default cucNone;
{: This property overrides column DisplayFormat property. Fundamental when the control is used in unbound mode to specify a DisplayFormat different from the one that can be guess from locale settings }
  property DisplayFormat : string read FDisplayFormat write SetDisplayFormat;
end;
// IBC_Currency.IMP
{$UNDEF IBC_Edit}

{$DEFINE IBC_Date}
{                                                                              }
{ TIB_Date                                                                     }
{                                                                              }

{------------------------------------------------------------------------------}
{  Place your credits and information in the top of the section                }
{  below with any other descriptions or explanations desired.                  }
{------------------------------------------------------------------------------}
{  Marco Menardi <mmenaz@mail.com>                                             }
{  16-Oct-2003                                                                 }
{     Added support while unbound for date format like yyyy/mm/dd (year first) }
{     used in countries like Lithuanian and Latvian                            }
{                                                                              }
{  Marco Menardi <mmenaz@mail.com>                                             }
{  29-Jul-2003                                                                 }
{     Fixed keyboard ^C "copy to clipboard" to put dataset in edit mode        }
{                                                                              }
{  Guido Klaperich <guido.klapperich@t-online.de>                              }
{  03-May-2002                                                                 }
{     Added three new properties TopPanelColor, TopPanelFontColor and          }
{     ArrowColor                                                               }
{                                                                              }
{  Marco Menardi <mmenaz@mail.com>                                             }
{  05-may-2002                                                                 }
{     Fixed exit validation not working when control is unbound                }
{     Added property to enable/disable date autofill                           }
{                                                                              }
{  Marco Menardi <mmenaz@mail.com>                                             }
{  18-apr-2002                                                                 }
{     Added Value property particularly useful when control is unbound         }
{  17-apr-2002                                                                 }
{     Improved auto filling that now works also when the control contents is   }
{     selected, and generates a 2 year digit instead of 4 to avoid century     }
{     typing.                                                                  }
{                                                                              }
{  Marco Menardi <mmenaz@mail.com>                                             }
{  27-feb-2002                                                                 }
{     added special keys facilities: spacebar for current date; if you start   }
{     typing and control is empty, current date is automatically entered so    }
{     you have good chanches to have the desired date with few keystrokes      }
{                                                                              }
{  Marco Menardi <mmenaz@smail.com>                                            }
{  19-feb-2002                                                                 }
{     if unbound and a date is entered, the droppdown calendar now takes you on}
{     the corresponding day (like does when bound)                             }
{                                                                              }
{******************************************************************************}

{: This control is used for manipulating columns that store date only values.}
TIB_CustomDate = class;

TIB_CustomDateStrikeEvent = procedure(     Sender: TIB_CustomDate;
                                           CheckThisDate: TDateTime;
                                       var CrossColor : TColor ) of object;
TIB_CustomDate = class(TIB_CustomEdit)
private
  FAutoFill: boolean;
  FDatePick: TDatePick;
  procedure CMExit(var Message: TCMExit); message CM_EXIT;
  function GetNormalCellLineColor: TColor;
  function GetSelectedCellColor: TColor;
  function GetSelectedCellFontColor: TColor;
  function GetNormalCellColor: TColor;
  function GetDifMonthFontColor: TColor;
  function GetNormalCellFontColor: TColor;
  function GetTodayCellColor: TColor;
  function GetDayOfWeekStrLen: integer;
  procedure SetNormalCellLineColor( AValue: TColor );
  procedure SetSelectedCellColor( AValue: TColor );
  procedure SetSelectedCellFontColor( AValue: TColor );
  procedure SetNormalCellColor( AValue: TColor );
  procedure SetDifMonthFontColor( AValue: TColor );
  procedure SetNormalCellFontColor( AValue: TColor );
  procedure SetTodayCellColor( AValue: TColor );
  procedure SetDayOfWeekStrLen( AValue: integer );
  procedure DatePickChange( Sender: TDatePick; Value: TDatePickResult );
  procedure DatePickStrike(     Sender: TDatePick;
                                CheckThisDate : TDateTime;
                            var CrossColor : TColor );
  function GetFirstWeek: TDatePickFirstWeek;
  function GetOptions: TDatePickOptions;
  function GetStartDay: TDatePickStartDay;
  procedure SetFirstWeek( const Value: TDatePickFirstWeek );
  procedure SetOptions( const Value: TDatePickOptions );
  procedure SetStartDay( const Value: TDatePickStartDay );
  function GetValue : TDate;
  procedure SetValue( AValue : TDate );
  procedure SetTopPanelColor( AValue: TColor );
  function GetTopPanelColor: TColor;
  procedure SetTopPanelFontColor( AValue: TColor );
  function GetTopPanelFontColor: TColor;
  procedure SetArrowColor( AValue: TColor );
  function GetArrowColor: TColor; 
protected
  FOnStrike: TIB_CustomDateStrikeEvent;
  procedure KeyPress(var Key: Char); override;
  procedure WndProc(var Message: TMessage); override;
  procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
  function EditCanModify: Boolean; override;
  function GetTodayButtonCaption: string; virtual;
  function GetClearButtonCaption: string; virtual;
  procedure SetTodayButtonCaption( AValue : string ); virtual;
  procedure SetClearButtonCaption( AValue : string ); virtual;
  procedure CreateWnd; override;
  procedure DoEditButtonClick; override;
  procedure UpdateMask( UnboundMask: string ); override;
  function  GetIncCellHeight: Integer; virtual;
  function  GetIncCellWidth: Integer; virtual;
  procedure SetIncCellHeight( AValue: Integer ); virtual;
  procedure SetIncCellWidth( AValue: Integer ); virtual;
  function  GetDrawYearArrow: boolean;
  procedure SetDrawYearArrow( AValue: boolean );
  procedure DoStrike(     CheckThisDate : TDateTime;
                      var CrossColor : TColor ); dynamic;

public
{$IFDEF IBO_VCL40_OR_GREATER}
  procedure ValidateEdit; override;
{$ENDIF}
  constructor Create( AOwner: TComponent ); override;
  property AlwaysShowButton default true;
  property ButtonStyle default ebsDropDown;
  property FirstWeek: TDatePickFirstWeek read GetFirstWeek
                                         write SetFirstWeek
                                         default fwFirstJanuary;
  property Options: TDatePickOptions read GetOptions
                                     write SetOptions
                                     default [doClearButton,
                                              doTodayButton,
                                              doShowOverlap];
  property StartDay: TDatePickStartDay read GetStartDay
                                       write SetStartDay
                                       default sdMon;
  property TodayButtonCaption: string read GetTodayButtonCaption
                                      write SetTodayButtonCaption;
  property ClearButtonCaption: string read GetClearButtonCaption
                                      write SetClearButtonCaption;
  property Width default 100;
  property IncCellHeight: Integer read GetIncCellHeight
                                  write SetIncCellHeight;
  property IncCellWidth: Integer read GetIncCellWidth
                                 write SetIncCellWidth;
  property DrawYearArrow: boolean read GetDrawYearArrow
                                  write SetDrawYearArrow;

  property NormalCellLineColor: TColor read GetNormalCellLineColor
                                       write SetNormalCellLineColor
                                       default clDkGray;
                                       //clBlue MM 2002_02_28
  property SelectedCellColor: TColor read GetSelectedCellColor
                                     write SetSelectedCellColor
                                     default clSilver;
                                     //clNavy MM 2002_02_28
  property SelectedCellFontColor: TColor read GetSelectedCellFontColor
                                         write SetSelectedCellFontColor
                                         default clWhite;
  property NormalCellColor: TColor read GetNormalCellColor
                                   write SetNormalCellColor
                                   default clWhite;
  property DifMonthFontColor: TColor read GetDifMonthFontColor
                                     write SetDifMonthFontColor
                                     default clDkGray;
  property NormalCellFontColor: TColor read GetNormalCellFontColor
                                       write SetNormalCellFontColor
                                       default clBlack;
                                       //clNavy MM 2002_02_28
  property TodayCellColor: TColor read GetTodayCellColor
                                  write SetTodayCellColor
                                  default clMaroon;
                                  //clRed  MM 2002_02_28

  property DayOfWeekStrLen: integer read GetDayOfWeekStrLen
                                    write SetDayOfWeekStrLen
                                    default 1;
{: Retrieves or sets the value in unbound mode as Date type. Text property instead returns
the contents as a formatted string. If the control is empty, returns TDate(0) }
  property Value: TDate read GetValue write SetValue;
  property TopPanelColor: TColor read GetTopPanelColor
                                 write SetTopPanelColor
                                 default clSilver; //GK 2002-05-03
  property TopPanelFontColor: TColor read GetTopPanelFontColor
                                     write SetTopPanelFontColor
                                     default clBlack; //GK 2002-05-03
  property ArrowColor: TColor read GetArrowColor
                              write SetArrowColor
                              default clBlack; //GK 2002-05-03
{: gives you current date as soon as you start typing numbers in an empty or selected
control, probably saving you to type some part of the date (especially if the date
format is dd/mm/yy }
  property AutoFill: boolean read FAutoFill write FAutoFill default False;
end;

{: Published version of the custom date control.}
TIB_Date = class(TIB_CustomDate)
{$DEFINE IB_AutoLabel}
{$I IBC_CustomEdit.PBL}
{$UNDEF IB_AutoLabel}
published
  property AutoFill;
  property ClearButtonCaption;
  property FirstWeek;
  property Options;
  property StartDay;
  property TodayButtonCaption;
  property IncCellHeight;
  property IncCellWidth;
  property DrawYearArrow;
  property NormalCellLineColor;
  property SelectedCellColor;
  property SelectedCellFontColor;
  property NormalCellColor;
  property DifMonthFontColor;
  property NormalCellFontColor;
  property TodayCellColor;
  property DayOfWeekStrLen;
  property OnStrike: TIB_CustomDateStrikeEvent read FOnStrike write FOnStrike;
  property TopPanelColor;
  property TopPanelFontColor;
  property ArrowColor; 
end;
// IBC_Date.IMP
{$UNDEF IBC_Date}

{$IFDEF IBO_VCL30_OR_GREATER}
{$DEFINE IBC_DateTimePicker}
{                                                                              }
{ TIB_DateTimePicker                                                           }
{                                                                              }

{: This control is an IBO aware descendant of TDateTimePicker.
<br><br>
I plan to eventually replace this with a more functional and generic control
that will work with all supported versions of Delphi that IBO supports.
<br><br>
As it is right now I can only support D3, D4 and C3 with this control.}
TIB_CustomDateTimePicker = class(TDateTimePicker)
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.INT}
{$UNDEF IB_AutoLabel}
private
  procedure CNNotify( var Message: TWMNotify ); message CN_Notify;
protected
  FShowingCheckbox: boolean;
  procedure Loaded; override;
  procedure CreateParams( var Params: TCreateParams ); override;
public
  constructor Create( AOwner: TComponent ); override;
  destructor Destroy; override;
  property ShowCheckbox default true;
end;

{: Published class of TIB_CustomDate using the TDateTimePicker control.}
TIB_DateTimePicker = class(TIB_CustomDateTimePicker)
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.PBL}
{$UNDEF IB_AutoLabel}
{$IFNDEF HELPSCAN}
published
  property ShowCheckbox;
{$ENDIF}
end;
// IBC_DateTimePicker.IMP
{$UNDEF IBC_DateTimePicker}
{$ENDIF}

{$DEFINE IBC_Memo}
{                                                                              }
{ TIB_Memo                                                                     }
{                                                                              }

{: This control is designed to handle large amounts of text data from a BLOB
field or large VARCHAR field.
<br><br>
It is possible to have the contents of a BLOB loaded only when the user
wants to see the contents. This is controlled by the AutoDisplay property.}
TIB_CustomMemo = class(TCustomMemo)
{$DEFINE IB_AutoLabel}
{$I IBC_CustomMemo.INT}
{$UNDEF IB_AutoLabel}
end;

TIB_Memo = class(TIB_CustomMemo)
{$DEFINE IB_AutoLabel}
{$I IBC_CustomMemo.PBL}
{$UNDEF IB_AutoLabel}
end;
// IBC_Memo.IMP
{$UNDEF IBC_Memo}

{$DEFINE IBC_RichEdit}
{                                                                               }
{ TIB_RichEdit                                                                  }
{                                                                               }

{: This control allows the storage of rich text formatted data.}
TIB_CustomRichEdit = class(TCustomRichEdit)
{$DEFINE IB_AutoLabel}
{$I IBC_CustomMemo.INT}
{$UNDEF IB_AutoLabel}
end;

TIB_RichEdit = class(TIB_CustomRichEdit)
{$DEFINE IB_AutoLabel}
{$I IBC_CustomMemo.PBL}
{$UNDEF IB_AutoLabel}

{$IFNDEF HELPSCAN}

published

property HideScrollBars;
property PlainText;
property OnProtectChange;
property OnResizeRequest;
property OnSaveClipboard;
property OnSelectionChange;

{$ENDIF}

end;
// IBC_RichEdit.IMP
{$UNDEF IBC_RichEdit}

{$DEFINE IBC_CheckBox}
{                                                                              }
{ TIB_CheckBox                                                                 }
{                                                                              }

{: This control gives a boolean-style interface to a bound data column.}
TIB_CustomCheckBox = class(TCustomCheckBox)
{$I IB_WinControl.INT}
private
  FValueChecked: string;
  FValueUncheck: string;
  FAllowGrayed: boolean;
  FDisplayLabelAsCaption: Boolean;
  procedure SetDisplayLabelAsCaption( AValue: Boolean );
  function GetFieldState: TCheckBoxState; virtual;
  procedure SetAllowGrayed( AValue: boolean );
protected
  procedure CreateParams(var Params: TCreateParams); override;
  procedure Loaded; override;
  procedure Toggle; override;
  procedure KeyPress(var Key: Char); override;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  property Checked;
  property State;
published

{: Property determines whether the checkbox allows the grayed state when the
user is clicking on the control.
<br><br>
It will still show the grayed state when the AValue of the column is null or, in
search mode, when no criterion is entered.}
  property AllowGrayed: boolean read FAllowGrayed
                                write SetAllowGrayed
                                default false;
{: Use DisplayLabel of the data column and display it as Caption }
  property DisplayLabelAsCaption: Boolean read FDisplayLabelAsCaption
                                          write SetDisplayLabelAsCaption
                                          default false;
end;

TIB_CheckBox = class(TIB_CustomCheckBox)
{$I IB_WinControl.PBL}
{$IFNDEF HELPSCAN}
published
  property Alignment;
  property Caption;
{$ENDIF}
end;
// IBC_CheckBox.IMP
{$UNDEF IBC_CheckBox}

{$DEFINE IBC_ComboBox}
{                                                                              }
{ TIB_ComboBox                                                                 }
{                                                                              }
{  Geoff Worboys <geoff@telesiscomputing.com.au>                               }
{  20-Dec-2001                                                                 }
{     Added GetAutoLabel interface routine to support change to                }
{     IIB_GridWinControl                                                       }
{                                                                              }

{: This control allows a standard combo box to be bound to a data column.
<br><br>
The values of the drop-down list must be supplied by assigning them to the
Items property manually at design-time or run-time.
<br><br>
The ItemValues property can be used to provide a table of values to store
in the database instead of the entries listed in the Items property.  Note
that this property is ignored if the Style is csDropDown.
<br><br>
To use a list defined from a query try making use of the TIB_LookupCombo
control, which supports a data-aware list portion. Otherwise, pre-load the
values of the query into the Items property of this control at run-time.
<br><br>
If Style is csDropDownList and the value in the data column does not match
an item in the list then the control appears blank.}
TIB_CustomComboBox = class(TCustomComboBox, IIB_GridWinControl)
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.INT}
{$UNDEF IB_AutoLabel}
private
  FItemValues: TStrings;
protected
  function GetComboText: string;
  procedure SetComboText( const AValue: string );
  procedure SetEditReadOnly;
{$IFDEF IBO_VCL60_OR_GREATER}
  procedure SetItems( const AValue: TStrings ); override;
{$ELSE}
  procedure SetItems( const AValue: TStrings );
{$ENDIF}
  function GetValue: string;
  procedure SetValue( const AValue: string );
  function GetItemValues: TStrings;
  procedure SetItemValues( AValue: TStrings );
{$IFDEF IBO_VCL60_OR_GREATER}
  function GetItemIndex: Integer; override;
  procedure SetItemIndex( const Value: Integer ); override;
{$ELSE}
  function GetItemIndex: Integer;
  procedure SetItemIndex( const Value: Integer );
{$ENDIF}
  procedure Loaded; override;
  procedure CreateParams( var Params: TCreateParams ); override;
  procedure Change; override;
  procedure Click; override;
  procedure ComboWndProc( var Message: TMessage;
                              ComboWnd: HWnd;
                              ComboProc: Pointer ); override;
  procedure CreateWnd; override;
  procedure KeyDown( var Key: Word; Shift: TShiftState ); override;
  procedure KeyPress( var Key: Char ); override;
  procedure WndProc( var Message: TMessage ); override;

  // Implemented for IIB_GridWinControl - but generically for consistency
  // with other controls.
  procedure BoundsChanged;

  // Implementation of IIB_GridWinControl interface requirements
  // These are already defined
  //   procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  //   procedure BoundsChanged;
  //   function CanFocus: boolean;
  //   procedure SetFocus;
  //   procedure Invalidate;
  // These functions need to be defined - which I will do via
  // functions named IBG_* and redirect...
  function IIB_GridWinControl.DisplayColumn = IBG_DisplayColumn;
  function IIB_GridWinControl.GetText = IBG_GetText;
  function IIB_GridWinControl.TranslateText = IBG_TranslateText;
  function IIB_GridWinControl.HasActiveChild = IBG_HasActiveChild;
  procedure IIB_GridWinControl.SetBorderStyle = IBG_SetBorderStyle;
  function IIB_GridWinControl.GetFont = IBG_GetFont;
  procedure IIB_GridWinControl.SetFont = IBG_SetFont;
  procedure IIB_GridWinControl.SetColor = IBG_SetColor;
  procedure IIB_GridWinControl.SetVisible = IBG_SetVisible;
  function IIB_GridWinControl.GetAutoLabel = IBG_GetAutoLabel;
  function IBG_DisplayColumn: TObject;
  function IBG_GetText: string;
  function IBG_TranslateText(AVal: string): string;
  function IBG_HasActiveChild: boolean;
  procedure IBG_SetBorderStyle( AVal: TBorderStyle );
  function IBG_GetFont: TFont;
  procedure IBG_SetFont( const AFont: TFont );
  procedure IBG_SetColor( AColor: TColor );
  procedure IBG_SetVisible( AVal: boolean );
  function IBG_GetAutoLabel: TObject;
  property Value: string read GetValue write SetValue;
public
  constructor Create( AOwner: TComponent ); override;
  destructor Destroy; override;
  property Text;
  property ItemIndex: Integer read GetItemIndex write SetItemIndex;
public
{: I have overidden this method so that when it is called the ItemValues are
also cleared out.}
{$IFDEF IBO_VCL60_OR_GREATER}
  procedure Clear; override;
{$ELSE}
  procedure Clear; virtual; 
{$ENDIF}
{$IFNDEF HELPSCAN}
  property Items write SetItems;
  // make these public for easy access
  // ie. IB_Grid needs them to alter display properties dynamically
{$ENDIF}
{: This property provides a table of values to store in the database instead
of the entries listed in the Items property.
<br><br>
Property is ignored when Style is set to csDropDown, as the ComboBox
Items are used for text entry in that case.}
  property ItemValues: TStrings read GetItemValues write SetItemValues;
end;

TIB_ComboBox = class(TIB_CustomComboBox)
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.PBL}
{$UNDEF IB_AutoLabel}
{$IFNDEF HELPSCAN}
published
  property Style; {Must be published before Items}
  property DropDownCount;
  property ItemHeight;
  property Items;
  property ItemValues;
  property Sorted;
  property OnChange;
  property OnDrawItem;
  property OnDropDown;
  property OnMeasureItem;
{$ENDIF}
end;
// IBC_ComboBox.IMP
{$UNDEF IBC_ComboBox}

{$DEFINE IBC_ListBox}
{                                                                              }
{ TIB_ListBox                                                                  }
{                                                                              }

{: This control allows a standard list box to be bound to a column.
<br><br>
The values of the list must be supplied by assigning them to the
Items property manually.
<br><br>
To use a list defined from a query try making use of the IB_LookupList
control. Otherwise, pre-load the values of the query into the Items property
of this control at run-time.
<br><br>
If the value in the data column does not match an item in the list, the
ItemIndex is set to -1.}
TIB_CustomListBox = class(TCustomListBox)
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.INT}
{$UNDEF IB_AutoLabel}
private
  FItemValues: TStrings;
  function GetValue: string;
  procedure SetValue(const AValue: string);
  procedure SetItems(AValue: TStrings);
  procedure SetItemValues(AValue: TStrings);
  procedure ValuesChanged( Sender: TObject );
  procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
protected
  procedure Click; override;
// Moved to public by NVE 03/10/1999
//  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure KeyPress(var Key: Char); override;
// Added by NVE 03/10/1999
  procedure CreateWnd;override;
  procedure CreateParams(var Params: TCreateParams); override;
//
  procedure Loaded; override;
  property Value: string read GetValue write SetValue;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
// Moved to public by NVE 03/10/1999
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  property Items write SetItems;
{: This property provides a table of values to store in the database instead
of the entries listed in the Items property.}
  property ItemValues: TStrings read FItemValues write SetItemValues;
end;

TIB_ListBox = class(TIB_CustomListBox)
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.PBL}
{$UNDEF IB_AutoLabel}
{$IFNDEF HELPSCAN}
published
  property Style; {Must be published before Items}
  property Columns;
  property IntegralHeight;
  property ItemHeight;
  property Items;
  property ItemValues;
  property Sorted;
  property TabWidth;
  property OnMeasureItem;
// Added by NVE 03/10/1999
  property OnDrawItem;
{$ENDIF}
end;

// IBC_ListBox.IMP
{$UNDEF IBC_ListBox}

{$DEFINE IBC_RadioGroup}
{                                                                              }
{ TIB_RadioGroup                                                               }
{                                                                              }

{: This control has been designed to provide a selection from a set group of
options based on a mutually exclusive set of radio buttons.
<br><br>
Use the Items property to set the names of the buttons.
<br><br>
Use the Values property to specify alternative values that will correspond with
the values in the field to which the control is bound.  Notice that this control
cannot be used to select multiple options.
<br><br>
Here is a typical use of a gender field :
<br><br>
<p>
<br>object EditGENDER: TIB_RadioGroup
<br>  Width = 130
<br>  Height = 21
<br>  Columns = 2
<br>  Items.Strings = (
<br>    'Male'
<br>    'Female')
<br>  Values.Strings = (
<br>    'M'
<br>    'F')
<br>  DataField = 'GENDER'
<br>  DataSource = dsQuery
<br>end
</p>
<br><br>
The backspace key will toggle the current button on and off.}
TIB_CustomRadioGroup = class(TCustomGroupBox)
private
  FTabStop: boolean;
  procedure SetTabStop( AValue: boolean ); virtual;
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.INT}
{$UNDEF IB_AutoLabel}
private
  FButtons: TList;
  FItems: TStrings;
  FItemIndex: Integer;
  FColumns: Integer;
  FReading: Boolean;
  FEditing: Boolean;
  FValue: string;
  FValues: TStrings;
  FInSetValue: Boolean;
  FOnChange: TNotifyEvent;
  FDisplayLabelAsCaption: Boolean;
  procedure SetDisplayLabelAsCaption( AValue: Boolean );
  procedure ArrangeButtons;
  procedure ButtonClick(Sender: TObject);
  procedure ItemsChange(Sender: TObject);
  procedure SetButtonCount(AValue: Integer);
  procedure SetColumns(AValue: Integer);
  procedure SetItemIndex(AValue: Integer);
  procedure UpdateButtons;
  procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  procedure WMSize(var Message: TWMSize); message WM_SIZE;
  function GetItemValue(Index: Integer): string;
  procedure SetValue(const AValue: string);
  procedure SetItems(AValue: TStrings);
  procedure SetValues(AValue: TStrings);
protected
  procedure ReadState(Reader: TReader); override;
{$IFDEF IBO_VCL30_OR_GREATER}
  procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
{$ELSE}
  procedure GetChildren(Proc: TGetChildProc ); override;
{$ENDIF}
  procedure Loaded; override;
  procedure CreateParams(var Params: TCreateParams); override;
  procedure Paint; override;
  procedure Change; dynamic;
  procedure Click; override;
  procedure KeyPress(var Key: Char); override;
  procedure SetButtonTabStops;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
{: Index of the item that is currently selected in the list of buttons.  The
radiobutton corresponding to that item shows as "pushed in".
<br><br>
An index of -1 means that there is no selection made - no buttons appear
"pushed in".}
  property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
{: Value of the currently selected radiobutton, as read from the data column.}
  property Value: string read FValue write SetValue;
{: This property allows multiple vertical columns of buttons to be defined.}
  property Columns: Integer read FColumns write SetColumns default 1;
{: This property determines the number of items in the group of radiobutton
controls and the caption associated with each one.}
  property Items: TStrings read FItems write SetItems;
{: This property provides a table of values to store in the database instead
of the entries listed in the Items property.}
  property Values: TStrings read FValues write SetValues;
{: Property to notify when the contents of the control have been changed.}
  property OnChange: TNotifyEvent read FOnChange write FOnChange;
published
  property Caption;
  property DisplayLabelAsCaption: Boolean read FDisplayLabelAsCaption
                                          write SetDisplayLabelAsCaption
                                          default false;
end;

TIB_RadioGroup = class(TIB_CustomRadioGroup)
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.PBL}
{$UNDEF IB_AutoLabel}
{$IFNDEF HELPSCAN}
published
  property Columns;
  property Items;
  property Values;
  property OnChange;
{$ENDIF}
end;
// IBC_RadioGroup.IMP
{$UNDEF IBC_RadioGroup}

{                                                                              }
{ TIB_Image                                                                    }
{                                                                              }
type
  TIB_CustomPaint = procedure ( const ACanvas: TCanvas ) of object;

{: This control has been designed to display images from a BLOB column.
<br><br>
It is possible to change the image by assigning a new image to the Picture
property of the control. The clipboard has also been enabled to transfer
images in and out of the control.}
TIB_CustomImage = class(TCustomControl)
{$DEFINE IBC_Image}
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.INT}
{$UNDEF IB_AutoLabel}
{$UNDEF IBC_Image}
private
  FAutoSize: Boolean;
  FPicture: TPicture;
  FAutoDisplay: boolean;
  FStretch: boolean;
  FCenter: boolean;
  FKeepScale: boolean;
  FPictureLoaded: boolean;
  FQuickDraw: boolean;
  FIsUpdating: boolean;
  FIgnorePictureChange: integer;
  FOnCustomPaint: TIB_CustomPaint;
  procedure PictureChanged(Sender: TObject);
  procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK;
  procedure WMCut(var Message: TMessage); message WM_CUT;
  procedure WMCopy(var Message: TMessage); message WM_COPY;
  procedure WMPaste(var Message: TMessage); message WM_PASTE;
  procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
protected
  procedure InternalUpdateData; virtual;
  procedure InternalLoadPicture; virtual;
  procedure SysPictureChanged; virtual;
  procedure CreateParams(var Params: TCreateParams); override;
  function GetPalette: HPALETTE; override;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  procedure KeyPress(var Key: Char); override;
  procedure Paint; override;
  procedure Loaded; override;
  procedure SetName( const AValue: TComponentName ); override;
{$IFDEF IBO_VCL60_OR_GREATER}
  procedure SetAutoSize( AValue: boolean ); override;
{$ELSE}
  procedure SetAutoSize( AValue: boolean );
{$ENDIF}
  procedure SetAutoDisplay( AValue: boolean );
  procedure SetCenter( AValue: boolean );
  procedure SetPicture( AValue: TPicture );
  procedure SetStretch( AValue: boolean );
  procedure SetKeepScale( AValue: boolean );
  property PictureLoaded: boolean read FPictureLoaded;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
{: Place a copy the contents of the image onto the clipboard.}
  procedure CopyToClipboard; virtual;
{: Move the contents of the image onto the clipboard.}
  procedure CutToClipboard; virtual;
{: Copy the image data from the clipboard into the control.}
  procedure PasteFromClipboard; virtual;
{: Make sure that the image is loaded from the BLOB column.
<br><br>
This should not need to be called if AutoDisplay is true. }
  procedure LoadPicture;
{: This property gives access to the image data for runtime manipulation.}
  property Picture: TPicture read FPicture write SetPicture;

public

{: This property allows the choice of loading BLOB contents into the control
automatically or keeping them to be loaded until the user double-clicks on the
control or presses ENTER while the control has focus.}
  property AutoDisplay: Boolean read FAutoDisplay
                                write SetAutoDisplay
                                default True;
{: Automatically adjust the borders of the control in order to display the
image at its native dimensions and scale.}
  property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
{: Paint the image centered within the borders of the control.}
  property Center: Boolean read FCenter write SetCenter default true;
{: Use a quicker method of painting the image on the screen.}
  property QuickDraw: Boolean read FQuickDraw write FQuickDraw default true;
{: Stretch the contents of the image to fully occupy the bounds of the
control.}
  property Stretch: Boolean read FStretch write SetStretch default false;
{: NOT FULLY IMPLEMENTED YET!}
  property KeepScale: Boolean read FKeepScale write SetKeepScale default true;

{: Gives the ability to customize the appearance of the image.}
  property OnCustomPaint: TIB_CustomPaint read FOnCustomPaint
                                          write FOnCustomPaint;
end;

TIB_Image = class(TIB_CustomImage)
{$DEFINE IBC_Image}
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.PBL}
{$UNDEF IB_AutoLabel}
{$UNDEF IBC_Image}

{$IFNDEF HELPSCAN}
published
  property AutoDisplay;
  property AutoSize;
  property Center;
  property QuickDraw;
  property Stretch;
  property OnCustomPaint;
{$ENDIF}
end;

TIB_CustomTrackBar = class(TTrackBar)
{$DEFINE IBC_TrackBar}
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.INT}
{$UNDEF IB_AutoLabel}
{$UNDEF IBC_TrackBar}
private
  FDisplayLabelAsCaption: Boolean;
  FDataChanging: boolean;
  procedure SetDisplayLabelAsCaption( AValue: Boolean );
{$IFNDEF IBO_VCL50_OR_GREATER}
  procedure CNHScroll(var Message: TWMHScroll); message CN_HSCROLL;
  procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL;
{$ENDIF}
protected
  procedure CreateParams(var Params: TCreateParams); override;
  procedure Loaded; override;
{$IFDEF IBO_VCL50_OR_GREATER}
  procedure Changed; override;
{$ENDIF}
  procedure KeyPress(var Key: Char); override;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
published
  property DisplayLabelAsCaption: Boolean read FDisplayLabelAsCaption
                                          write SetDisplayLabelAsCaption
                                          default false;
end;

TIB_Trackbar = class(TIB_CustomTrackbar)
{$DEFINE IBC_TrackBar}
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.PBL}
{$UNDEF IB_AutoLabel}
{$UNDEF IBC_TrackBar}
published
  property Caption;
end;

implementation

uses
  IB_Utils;

// IBC_Text.INT

{$DEFINE IBC_Text}
{$I IB_Control.IMP}
{$UNDEF IBC_Text}

constructor TIB_CustomText.Create(AOwner: TComponent);
begin
  FIB_FieldDataLink := TIB_FieldDataLink.Create( Self );
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  inherited AutoSize := false;
  inherited ShowAccelChar := false;
  DataLink.OnDataChange := DataChange;
  DataLink.OnStateChanged := StateChanged;
end;

destructor TIB_CustomText.Destroy;
begin
  DataSource := nil;
  DataLink.OnDataChange := nil;
  DataLink.OnStateChanged := nil;
  inherited Destroy;
end;

procedure TIB_CustomText.SysStateChanged;
begin
// Abstract;
end;

procedure TIB_CustomText.SysDataChange;
begin
  with DataLink do
  begin
    if Alignment <> FieldAlignment then
      Alignment := FieldAlignment;
    Caption := FieldText
  end;
end;

function TIB_CustomText.GetLabelText: string;
begin
  if csPaintCopy in ControlState then
  begin
    if Assigned( DataLink.Field ) then
      Result := DataLink.Field.DisplayText
    else
      Result := '';
  end
  else
  begin
    Result := Caption;
    if ( Result = '' ) and ( csDesigning in ComponentState ) then
    begin
      if DataLink.Prepared then
        Result := '<EMPTY>' // don't know if empty or null, just a placeholder
      else
        Result := Name;
    end;
  end;
  if Assigned( FOnGetDisplayText ) then
     OnGetDisplayText( Self, Result );
end;

constructor TIB_Text.Create(AOwner: TComponent);
begin
  inherited;
  FBorderStyle := bsNone;
  FBevelInner := bvNone;
  FBevelOuter := bvNone;
  FBevelWidth := 1;
  FBorderWidth := 1;
end;

procedure TIB_Text.SetBevelInner(Value: TPanelBevel);
begin
  FBevelInner := Value;
//  Realign;
  Invalidate;
end;

procedure TIB_Text.SetBevelOuter(Value: TPanelBevel);
begin
  FBevelOuter := Value;
//  Realign;
  Invalidate;
end;

procedure TIB_Text.SetBevelWidth(Value: TBevelWidth);
begin
  FBevelWidth := Value;
//  Realign;
  Invalidate;
end;

procedure TIB_Text.SetBorderWidth(Value: TBorderWidth);
begin
  FBorderWidth := Value;
//  Realign;
  Invalidate;
end;

procedure TIB_Text.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    Invalidate; // in TPanel is RecreateWnd; but this is not a TWinControl
  end;
end;

procedure TIB_Text.Paint;
const
  Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
var
  Rect: TRect;
{$IFDEF IBO_VCL40_OR_GREATER}
  CalcRect: TRect;
  DrawStyle: Longint;
{$ENDIF}
  TopColor, BottomColor: TColor;
  OffsetX, OffsetY : integer;
  HasBorders: boolean;
  procedure AdjustColors(Bevel: TPanelBevel);
  begin
    TopColor := clBtnHighlight;
    if Bevel = bvLowered then TopColor := clBtnShadow;
    BottomColor := clBtnShadow;
    if Bevel = bvLowered then BottomColor := clBtnHighlight;
  end;
begin
  with Canvas do
  begin
    if not Transparent then
    begin
      Brush.Color := Color; // Background Color
      Brush.Style := bsSolid;
      FillRect(ClientRect);
    end;
    Brush.Style := bsClear;

    Rect := ClientRect;

    HasBorders := (BevelOuter <> bvNone) or (BevelInner <> bvNone) or (BorderStyle <> bsNone);

    // draw borders
    // (I've problems with Autosize=True: how can I leave space for borders? There is ClippingRegion...
    if HasBorders then
    begin
      if BorderStyle <> bsNone then //
        Frame3D(Canvas, Rect, clWindowFrame, clBtnHighlight, 2);
      if BevelOuter <> bvNone then
      begin
        AdjustColors(BevelOuter);
        Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
      end;
      Frame3D(Canvas, Rect, Color, Color, BorderWidth);
      if BevelInner <> bvNone then
      begin
        AdjustColors(BevelInner);
        Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
      end;
    end;

    Rect := ClientRect;

    // calculates rectangle dimensions for text considering active borders
    // N.B. since Canvas does clipping, how can I manage autosize=True and borders?
    OffsetX := 0;
    if HasBorders then
    begin
      Inc(OffsetX, BorderWidth + 3);
      if BevelOuter <> bvNone then Inc(OffsetX, BevelWidth);
      if BevelInner <> bvNone then Inc(OffsetX, BevelWidth);
    end;
    if Alignment = taCenter then
      OffsetX := 0
    else if Alignment = taRightJustify then
      OffsetX := -OffsetX;
    OffsetY := OffsetX;
    OffsetRect(Rect, OffsetX, OffsetY);
{$IFDEF IBO_VCL40_OR_GREATER}
    { DoDrawText takes care of BiDi alignments }
    DrawStyle := DT_EXPANDTABS or WordWraps[WordWrap] or Alignments[Alignment];
    { Calculate vertical layout }
    if Layout <> tlTop then
    begin
      CalcRect := Rect;
      DoDrawText(CalcRect, DrawStyle or DT_CALCRECT);
      if Layout = tlBottom then OffsetRect(Rect, 0, Height - CalcRect.Bottom - OffsetY)
      else OffsetRect(Rect, 0, (Height - CalcRect.Bottom - OffsetY) div 2);
    end;
    DoDrawText(Rect, DrawStyle);
{$ELSE}
    raise Exception.Create( 'Unsupported' );
{$ENDIF}
  end;
end;

{$DEFINE IBC_Edit}
{$DEFINE IB_AutoLabel}
{$I IBC_CustomEdit.IMP}
{$UNDEF IB_AutoLabel}

constructor TIB_CustomEdit.Create(AOwner: TComponent);
begin
  FIB_FieldDataLink := TIB_FieldDataLink.Create( Self );
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel := TIB_AutoLabel.Create( Self );
{$ENDIF}
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  DataLink.Control := Self;
  DataLink.OnStateChanged := StateChanged;
  DataLink.OnEditingChanged := EditingChanged;
  DataLink.OnDataChange := DataChange;
  DataLink.OnUpdateData := UpdateData;
  FButtonWidth := GetSystemMetrics(SM_CXVSCROLL) + 1;
  FButtonStyle := ebsNone;
  FImageList := nil;
  FImageindex := -1;
  FImageIndexDisabled := -1;
  FImageIndexPressed := -1;
  FAlwaysShowButton := false;
  FAllowUnboundEdits := false;
  UpdateMask( '' );
end;

destructor TIB_CustomEdit.Destroy;
begin
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel.Free;
  FAutoLabel := nil;
{$ENDIF}
  DataSource := nil;
  with DataLink do
  begin
    Control := nil;
    OnStateChanged := nil;
    OnEditingChanged := nil;
    OnDataChange := nil;
    OnUpdateData := nil;
  end;
  Destroying;
  if FCanvas <> nil then
  begin
    FCanvas.Free;
    FCanvas := nil;
  end;
  inherited Destroy;
end;

procedure TIB_CustomEdit.Loaded;
begin
  inherited Loaded;
  SysStateChanged;
  SysDataChange( nil );
{$IFDEF IBO_VCL30_OR_GREATER}
  RemakeAutoLabel;
{$ENDIF}
end;

{------------------------------------------------------------------------------}
{  Control specific processing                                                 }
{------------------------------------------------------------------------------}

procedure TIB_CustomEdit.SysDataChange;
var
  tmpText: string;
  tmpColor: TColor;
begin
  if DataLink.ColorScheme then
  begin
    tmpColor := DataLink.Color;
    if inherited Color <> tmpColor then
    begin
      inherited Color := tmpColor;
      Invalidate;
    end;
  end;
  UpdateMask( '' );
  if Assigned( Field ) or not FAllowUnboundEdits then
  begin
  if FAlignment <> DataLink.FieldAlignment then
  begin
    EditText := '';
    FAlignment := DataLink.FieldAlignment;
    if (ButtonStyle <> ebsNone) and
       (PasswordChar = #0) then
    begin
      if HandleAllocated then
        RecreateWnd;
      CheckDrawButton( true );
    end;
  end;
  if Focused then
  begin
    tmpText := DataLink.FieldText;
    if Assigned( OnGetEditText ) then
       OnGetEditText( Self, tmpText );
    Text := tmpText;
  end
  else
  begin
    tmpText := DataLink.FieldText;
    if Assigned( OnGetDisplayText ) then
       OnGetDisplayText( Self, tmpText );
    EditText := tmpText;
  end;
  Modified := false;
  Invalidate;
  end;
end;

procedure TIB_CustomEdit.SysStateChanged; { Handles LayoutChange event as well }
var
  tmpColor: TColor;
begin
  if DataLink.ColorScheme then
  begin
    tmpColor := DataLink.Color;
    if inherited Color <> tmpColor then
    begin
      inherited Color := tmpColor;
      Invalidate;
    end;
  end;
  case DataLink.FieldCharCase of
    ccUpper: CharCase := StdCtrls.ecUpperCase;
    ccLower: CharCase := StdCtrls.ecLowerCase;
    else     CharCase := StdCtrls.ecNormal;
  end;
  UpdateMask( '' );
  MaxLength := DataLink.FieldMaxLength;
  EditingChanged( DataLink, DataSource );
  UpdateTabStop;
end;

procedure TIB_CustomEdit.SysUpdateData;
var tmpText:string;
begin
  if Assigned( Field ) then
  begin
    if Modified then
    begin
      ValidateEdit;
      tmpText := Text;
      if Assigned( OnSetEditText ) then
         OnSetEditText( Self, tmpText );
      DataLink.FieldText := tmpText;
    end;
  end
  else
  if FAllowUnboundEdits then
    ValidateEdit;
  Modified := false;
end;

{------------------------------------------------------------------------------}

function TIB_CustomEdit.EditCanModify: Boolean;
begin
  Result := DataLink.Modify;
end;

procedure TIB_CustomEdit.Reset;
begin
  SysDataChange( nil );
  SelectAll;
end;

procedure TIB_CustomEdit.Change;
begin
  if not MaskChanging then
    with DataLink do
      if ( DataChangingLevel = 0 ) and ( NeedToPost or
                                         (State = dssSearch) or
                                         SearchAlways or
                                         IsParamEdit ) then
      begin
        ControlIsModified := true;
        Modified := true;
      end;
  inherited Change;
end;

procedure TIB_CustomEdit.UpdateMask( UnboundMask: string );
var
  tmpS: string;
  tmpM: string;
begin
  MaskChanging := true;
  try
    if Assigned( Field ) then
    begin
      if EditMask <> DataLink.FieldEditMask then
      begin
      // There is a bug in the VCL's mask processing.
      // Even though I've said the mask characters are a part of the text
      // it removes them when setting the EditMask to blank.
      // This appears to work around the problem but I am not totally sure.
        tmpS := Text;
        tmpM := EditMask;
        EditMask := DataLink.FieldEditMask;
        if ( tmpM = '' ) and ( tmpS <> Text ) then
        begin
          try
            Text := tmpS;
          except
            EditText := FormatMaskText( EditMask, tmpS );
          end;
        end;
      end;
    end
    else
    if FAllowUnboundEdits then
      EditMask := UnboundMask
    else
      EditMask := '';
  finally
    MaskChanging := false;
  end;
end;

procedure TIB_CustomEdit.KeyDown(var Key: Word; Shift: TShiftState);
var
  Msg: TMsg;
begin
  if ( ButtonStyle <> ebsNone ) and
     (( Key = VK_RETURN ) and ( Shift = [ssCtrl] ) or
     (( Key = VK_DOWN ) and ( Shift = [ssAlt] ))) then
  begin
    //NOTE// Always trap "VK_RETURN + ssCtrl", otherwise CTRL-ENTER can be
    //         used to put a carriage return into the text.
    //
    //NOTE// Call PeekMessage first!! (*before* inherited KeyDown)
    //
    // DoEditButtonClick or "inherited KeyDown()" can do things that
    // result in the message queue being scanned, e.g. "ShowMessage()".
    // Calling PeekMessage first makes sure that the WM_CHAR messages
    // (for CTRL-ENTER) do not leak thru to the windows control.
    //
    // Note that to test for this problem with CTRL-ENTER the dataset must be
    // placed out of dssBrowse (e.g. into dssEdit mode), otherwise the edit
    // control is readonly (see EditingChanged), and won't show the problem.
    //
    PeekMessage( Msg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE );
    inherited KeyDown( Key, Shift );
    if Key <> 0 then
    begin
      Key := 0;
      DoEditButtonClick;
    end;
  end
  else
  begin
    inherited KeyDown( Key, Shift );
    if ( Key = VK_DELETE ) or
       (( Key = VK_INSERT ) and ( ssShift in Shift )) then
      if not EditCanModify then
        Key := 0; // prevent the change
  end;
end;

procedure TIB_CustomEdit.KeyPress( var Key: Char );
var
  IsValid:Boolean;
begin
  inherited KeyPress(Key);
  //NOTE// This makes the control ignore return keypresses to make the
  //         control behave as if it were *not* a multi-line edit.
  //
  // Note that to test for this problem with ENTER keypress the dataset must be
  // placed out of dssBrowse (e.g. into dssEdit mode), otherwise the edit
  // control is readonly (see EditingChanged), and won't show the problem.
  if ( Key = #13 ) and ( ButtonStyle <> ebsNone ) then
  begin
    Key := #0;
    Exit;
  end;
  with DataLink do
  begin
    if (Field<>nil) then
    begin
      if ( not SearchAlways ) and
         ( State <> dssSearch ) then
      begin
        if ( Field.IsNumeric ) and
           ( Key = '.' ) and
           ( DecimalSeparator = ',' ) then
          Key := DecimalSeparator
        else
        if Field.IsDateTime and (Key = ':') and (DateSeparator <> Key) then
          Key := TimeSeparator;
      end;

      if Key in [#32..#255] then
      begin
        IsValid:=FieldIsValidChar(Key);
        if Assigned( OnIsValidChar ) then
           OnIsValidChar( Self, Key, IsValid );
        if not IsValid then
        begin
          MessageBeep(0);
          Key := #0;
        end;
      end;
    end;
    case Key of
      ^H, ^V, ^X, #32..#255:
      begin
        if EditCanModify then
        begin
          if ( Length( Text ) = 0 ) and
             ( Field <> nil) and
             ( FieldCharCase = ccProper ) then
            Key := AnsiUpperCase( Key )[1];
        end
        else
          Key := #0;  // dont allow change
      end;
      #27: begin
        Reset;
        SelectAll;
        Key := #0;
      end;
    end;
  end;
end;

procedure TIB_CustomEdit.WMPaste(var Message: TMessage);
begin
  if EditCanModify then inherited;
end;

procedure TIB_CustomEdit.WMCut(var Message: TMessage);
begin
  if EditCanModify then inherited;
end;

procedure TIB_CustomEdit.CMGotFocus(var Message: TCMGotFocus);
begin
  inherited;
  SysDataChange( nil );
end;

procedure TIB_CustomEdit.CMEnter(var Message: TCMEnter);
begin
  SetFocused( true );
  if AutoSelect and not (csLButtonDown in ControlState) then
    SelectAll;
  inherited;
  // This causes a value to be lost when the OnValidate event has an exception.
  // The call to SetFocused above will actually do a datachange already too.
//  SysDataChange( nil );
end;

procedure TIB_CustomEdit.CMExit(var Message: TCMExit);
begin
  try
    DataLink.UpdateData;
  except
    SelectAll;
    SetFocus;
    raise;
  end;
  SetFocused( false );
  CheckCursor;
  SysDataChange( nil );
  inherited;
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomEdit.WMPaint(var Message: TWMPaint);
var
  Left: Integer;
  Margins: TPoint;
  R: TRect;
  DC: HDC;
  PS: TPaintStruct;
  S: string;
  tmpBtnWidthAdj: integer;
begin
  //MODIFIED// 1999-04-14 CW: REMOVED...
  //                          CAN'T CALL PaintHandler() WHEN WE WANT OTHER
  //                          TEXT JUSTIFICATIONS, AS THE MULTILINE EDIT
  //                          IS NOW *ALWAYS* SET TO LEFT JUSTIFIED.
  //
  //if (FButtonStyle <> ebsNone) and
  //   (PasswordChar = #0) then begin
  //  PaintHandler(Message);
  //end;
  //
  //ENDMODIFIED//
  if ((FAlignment = taLeftJustify) or FFocused) and
    not (csPaintCopy in ControlState) then
  begin
    //MODIFIED// 1999-04-14 CW: CALL PaintHandler() INSTEAD OF inherited  TO
    //                          ALLOW THE BUTTON TO BE DRAWN.  NOTE THAT THE
    //                          CALL TO ExcludeClipRect() IN PaintWindow()
    //                          MAKES SURE THAT THE WIN CONTROL DOES NOT
    //                          DRAW OVER THE BUTTON.
    //inherited;
    PaintHandler( Message );
    Exit;
    //ENDMODIFIED//
  end;

  if FCanvas = nil then
  begin
    FCanvas := TControlCanvas.Create;
    FCanvas.Control := Self;
  end;
  DC := Message.DC;
  if DC = 0 then
    DC := BeginPaint( Handle, PS );
  FCanvas.Handle := DC;
  try
    if FDrawButton then
      DrawButton;
    FCanvas.Font := Font;
    if not Enabled then
      FCanvas.Font.Color := clInactiveCaption;
    with FCanvas do
    begin
      R := ClientRect;
      if not ( NewStyleControls and Ctl3D ) and
             ( BorderStyle = bsSingle ) then
      begin
        Brush.Color := clWindowFrame;
        FrameRect(R);
        InflateRect(R, -1, -1);
      end;
      Brush.Color := Color;
      if (csPaintCopy in ControlState) and
         (DataLink.Field <> nil) then
      begin
        S := DataLink.FieldText;
        case CharCase of
          StdCtrls.ecUpperCase: S := AnsiUpperCase(S);
          StdCtrls.ecLowerCase: S := AnsiLowerCase(S);
        end;
      end
      else
        S := EditText;
      if PasswordChar <> #0 then
        FillChar(S[1], Length(S), PasswordChar);
      Margins := GetTextMargins;
      if FDrawButton then
      begin
        Dec( R.Right, FButtonWidth );  //<=-adjust R for TextRect() call
        tmpBtnWidthAdj := FButtonWidth;
      end
      else
        tmpBtnWidthAdj := 0;
      case FAlignment of
        taLeftJustify: Left := Margins.X;
        taRightJustify: Left := (ClientWidth - tmpBtnWidthAdj) - TextWidth(S) -
                                                                 Margins.X - 1;
      else
        Left := ((ClientWidth - tmpBtnWidthAdj) - TextWidth(S)) div 2;
      end;
      TextRect( R, Left, Margins.Y, S );
    end;
  finally
    FCanvas.Handle := 0;
    if Message.DC = 0 then
      EndPaint( Handle, PS );
  end;
end;

function TIB_CustomEdit.GetTextMargins: TPoint;
var
  DC: HDC;
  SaveFont: HFont;
  I: Integer;
  SysMetrics, Metrics: TTextMetric;
begin
  if NewStyleControls then
  begin
    if BorderStyle = bsNone then
      I := 0
    else
    if Ctl3D then
      I := 1
    else
      I := 2;
    Result.X := ( SendMessage(Handle, EM_GETMARGINS, 0, 0) and $0000FFFF ) + I;
    Result.Y := I;
  end
  else
  begin
    if BorderStyle = bsNone then
      I := 0
    else
    begin
      DC := GetDC(0);
      GetTextMetrics(DC, SysMetrics);
      SaveFont := SelectObject(DC, Font.Handle);
      GetTextMetrics(DC, Metrics);
      SelectObject(DC, SaveFont);
      ReleaseDC(0, DC);
      I := SysMetrics.tmHeight;
      if I > Metrics.tmHeight then
        I := Metrics.tmHeight;
      I := I div 4;
    end;
    Result.X := I;
    Result.Y := I;
  end;
end;

procedure TIB_CustomEdit.CreateParams( var Params: TCreateParams );
const
  Alignments: array[TAlignment] of longint = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
  inherited CreateParams( Params );
  if ( ButtonStyle <> ebsNone ) and
     ( PasswordChar = #0 ) then
  begin
    {In order to use EM_SETRECT later, make the edit control type MULTILINE...}
    //NOTE// Alignment style setting only applies to MULTILINE control

    //MODIFIED// CW 1999-04-14  CW: ONLY ES_LEFT REQUIRED, AS IT SHOULD ALWAYS
    //                                SHOW LEFT JUSTIFIED WHEN EDITING TO KEEP
    //                                THE SAME STYLE OF INTERFACE REGARDLESS OF
    //                                BUTTON BEING DRAWN.
    //
    //Params.Style := longint(Params.Style) or ES_MULTILINE or
    //                Alignments[FAlignment];
    Params.Style := longint(Params.Style) or ES_MULTILINE or ES_LEFT;
    //ENDMODIFIED//
  end;
  {Set or clear the ES_READONLY style as required...}
  //
  //NOTE// Required for use of RecreateWnd, and also for cases where the
  //       control is created on an invisible parent window.
  //
  // EditingChanged updates "inherited ReadOnly".  If HandleAllocated=false,
  // setting "inherited ReadOnly" will not modify the READONLY style setting.
  // Hence the need to set ES_READONLY appropriately here.
  if Assigned( DataLink ) then
    EditingChanged( DataLink, DataSource );  //<=-update "inherited ReadOnly"
  if inherited ReadOnly then
    Params.Style := longint(Params.Style) or longint(ES_READONLY)
  else
    Params.Style := longint(Params.Style) and not longint(ES_READONLY);
end;

//MODIFIED// 1999-04-14 CW: ADDED THIS TO MAKE SURE THAT THE BOUNDS ARE SET
//                            FOR MULTI-LINE EDIT CONTROLS.  SOMETIMES THEY
//                            WERE BEING CREATED WITHOUT A CALL TO BoundsChanged
//                            WHICH ALLOWED THE BUTTON TO DRAW OVER THE TEXT.
procedure TIB_CustomEdit.CreateWnd;
begin
  inherited CreateWnd;
  if (ButtonStyle <> ebsNone) and
     (PasswordChar = #0) then
    //NOTE// MULTILINE edit, so set bounds...
    BoundsChanged;
end;
//ENDMODIFIED//

procedure TIB_CustomEdit.BoundsChanged;
var
  R: TRect;
begin
// Determine the size of the text area in the control
// it will be smaller by the width of the button if one is present
  SetRect( R, 0, 0, ClientWidth - 2, ClientHeight + 1 ); // +1 is workaround for
                                                         // windows paint bug
  if FDrawButton then
    Dec( R.Right, FButtonWidth );
  SendMessage( Handle, EM_SETRECTNP, 0, LongInt( @R ));
  Repaint;
end;

procedure TIB_CustomEdit.SetPasswordChar( Value: Char );
var
  OldValue: Char;
begin
  if inherited PasswordChar <> Value then
  begin
    OldValue := inherited PasswordChar;
    inherited PasswordChar := Value;
    if (OldValue = #0) or (Value = #0) then
    begin
      if HandleAllocated then
        RecreateWnd;
      CheckDrawButton( true );
    end;
  end;
end;

procedure TIB_CustomEdit.CheckDrawButton( ForceRepaint: boolean );
var
  TmpDrawBtn: boolean;
begin
  TmpDrawBtn := ((ButtonStyle <> ebsNone) or ( Assigned( FImageList )) and
                                              ( FImageIndex >= 0 )) and
                (PasswordChar = #0) and
                (
                  (FAlwaysShowButton or Focused) or
                  (csDesigning in ComponentState)
                );
  if (FDrawButton <> TmpDrawBtn) or ForceRepaint then
  begin
    FDrawButton := TmpDrawBtn;
    if (ButtonStyle <> ebsNone) and
       (PasswordChar = #0) and
       (HandleAllocated) then
      BoundsChanged;
  end;
end;

procedure TIB_CustomEdit.SetButtonStyle( Value: TIB_EditButtonStyle );
var
  OldValue: TIB_EditButtonStyle;
begin
  if FButtonStyle <> Value then
  begin
    OldValue := FButtonStyle;
    FButtonStyle := Value;
    if ( OldValue = ebsNone ) or ( Value = ebsNone ) then
      if HandleAllocated then RecreateWnd;
    CheckDrawButton(true);
  end;
end;

procedure TIB_CustomEdit.SetAlwaysShowButton(Value: boolean);
begin
  if FAlwaysShowButton <> Value then
  begin
    FAlwaysShowButton := Value;
    CheckDrawButton(false);
  end;
end;

procedure TIB_CustomEdit.SetImageList(Value: TImageList);
var
  OldWidth: Integer;
begin
  FImageList := Value;
  OldWidth := FButtonWidth;
  if FImageList <> nil then
    FButtonWidth := FImageList.Width + 8 // borderwidth (2*2) + space (2*2)
  else
    FButtonWidth := GetSystemMetrics( SM_CXVSCROLL ) + 1;
  if ( OldWidth <> FButtonWidth ) and HandleAllocated then
    RecreateWnd;
  CheckDrawButton( true );
end;

procedure TIB_CustomEdit.SetImageIndex(Value: integer);
begin
  if Value <> FImageIndex then
  begin
    FImageIndex := Value;
    CheckDrawButton( true );
  end;
end;

procedure TIB_CustomEdit.SetImageIndexDisabled(Value: integer);
begin
  if Value <> FImageIndexDisabled then
  begin
    FImageIndexDisabled := Value;
    CheckDrawButton( true );
  end;
end;

procedure TIB_CustomEdit.SetImageIndexPressed(Value: integer);
begin
  if Value <> FImageIndexPressed then
  begin
    FImageIndexPressed := Value;
    CheckDrawButton( true );
  end;
end;


procedure TIB_CustomEdit.DoEditButtonClick;
begin
  SysUpdateData( Field );
  if Assigned( FOnButtonClick ) then
    FOnButtonClick( Self );
end;

procedure TIB_CustomEdit.WMSetCursor(var Msg: TWMSetCursor);
var
  P: TPoint;
begin
{ Normally, the Edit control changes the Cursor to an I-bar when over
  the control.  We need to set it back to an arrow when over the button }
  if FDrawButton and
     PtInRect( Rect(Width - FButtonWidth - 4, 0, ClientWidth, ClientHeight),
               ScreenToClient( P )) then
  begin
    GetCursorPos( P );
    Windows.SetCursor( LoadCursor( 0, idc_Arrow ));
  end
  else
    inherited;
end;

procedure TIB_CustomEdit.TrackButton(X,Y: Integer);
var
  NewState: Boolean;
  R: TRect;
begin
// Check if the position passed is over the area of the button -
// if so then set the state to pressed and redraw the depressed button
  SetRect( R, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight );
  NewState := PtInRect( R, Point( X, Y ));
  if FPressed <> NewState then
  begin
    FPressed := NewState;
    InvalidateRect( Handle, @R, False );
  end;
end;

procedure TIB_CustomEdit.PaintWindow(DC: HDC);
begin
  if FDrawButton then
  begin
    if FCanvas = nil then
    begin
      FCanvas := TControlCanvas.Create;
      FCanvas.Control := Self;
    end;
    FCanvas.Handle := DC;
    try
      DrawButton;
    finally
      FCanvas.Handle := 0;
    end;
  end;
  inherited PaintWindow(DC);
end;

{$IFDEF IBO_VCL70_OR_GREATER}
//RV?? CMMouseEnter and CMMouseLeave just updates MouseOver state (HOT) state of the TIB_CustomEdit
procedure TIB_CustomEdit.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if PtInRect( Rect( Width - FButtonWidth,
                     0,
                     Width,
                     Height ),
                     Mouse.CursorPos) then
  begin
    FHot := True;
    invalidate;
  end
end;

procedure TIB_CustomEdit.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FHot := False;
  Invalidate;
end;
{$ENDIF}

procedure TIB_CustomEdit.DrawButton;
const
  arOuterColor: array[Boolean] of TColor = (clWhite, clBlack);
  arInnerColor: array[Boolean] of TColor = (TColor($00E6E6E6), clDkGray);
var
  R: TRect;
  tmpPressed: boolean;
  tmpPressN: boolean;
  {$IFDEF IBO_VCL70_OR_GREATER}
  //RV??  Variables neccessary to draw themed button in XP
  Box: TThemedComboBox;
  BoxE: TThemedButton;
  Details: TThemedElementDetails;
  {$ENDIF}
begin
  tmpPressed := FPressed and not DataLink.BoundToBuffer;
  tmpPressN := not tmpPressed;
  // fill button and draw border
  SetRect(R, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
  {$IFDEF IBO_VCL70_OR_GREATER}
  //RV?? If program running under winXP then use themes
  if ThemeServices.ThemesEnabled then
  begin
    //RV?? Ellipsis button requires drawing of points
    if ButtonStyle = ebsEllipsis then
    begin
      if not tmpPressed then
      begin
        if FHot then
          BoxE := tbPushButtonHot
        else
          BoxE := tbPushButtonNormal;
      end else
        BoxE := tbPushButtonPressed;
      Details := ThemeServices.GetElementDetails(BoxE);
      ThemeServices.DrawElement(FCanvas.Handle, Details, R);
      ThemeServices.DrawText(FCanvas.Handle, Details, '...', R, DT_CENTER, 1000);
    end else
    //RV?? dropdown style is using existing resources in Themes unit
    begin
      SetRect(R, ClientWidth - FButtonWidth + 2, -1, ClientWidth + 1, ClientHeight + 1);
      if not tmpPressed then
      begin
        if FHot then
          Box := tcDropDownButtonHot
        else
          Box := tcDropDownButtonNormal;
      end else
        Box := tcDropDownButtonPressed;
      Details := ThemeServices.GetElementDetails(Box);
      ThemeServices.DrawElement(FCanvas.Handle, Details, R);
    end
  end else
  //RV?? otherwise everything is working as usual
  begin
  {$ENDIF}
    FCanvas.Brush.Color := clBtnFace;
    FCanvas.FillRect(R);
    Frame3D(FCanvas, R, arOuterColor[tmpPressed], arOuterColor[tmpPressN],1);
    Frame3D(FCanvas, R, arInnerColor[tmpPressed], arInnerColor[tmpPressN],1);
    // draw either button image or predefined styles (e.g. ellipsis)
    if not Assigned( FImageList ) or ( FImageIndex < 0 ) then
      DrawButtonStyle( FCanvas, R )
    else
    begin
      with R do       // center bitmap vertically
        Inc(Top, ((Bottom - Top) - FImageList.Height) div 2);
      Inc(R.Left, 2); // left space (see SetImageList)
      if Enabled or ( FImageIndexDisabled < 0 ) then
      begin
        if not tmpPressed or ( FImageIndexPressed < 0 ) then
        begin
          FImageList.Draw( FCanvas, R.Left + Ord( tmpPressed ),
            R.Top + Ord( tmpPressed ), FImageIndex {, Enabled} );
        end
        else
        begin
          FImageList.Draw( FCanvas, R.Left + 1, R.Top + 1,
                           FImageIndexPressed {, Enabled} );
        end;
      end
      else
      begin
        //if enabled or (...)  then ...
        FImageList.Draw( FCanvas, R.Left, R.Top, FImageIndexDisabled{, True} );
      end;
    end;
  {$IFDEF IBO_VCL70_OR_GREATER}
  //RV?? end of theme support change
  end;
  {$ENDIF}

  // this ensures that the win control does not draw over the button...
  SetRect(R, ClientWidth - FButtonWidth, 0, ClientWidth, ClientHeight);
  ExcludeClipRect( FCanvas.Handle, R.Left, R.Top, R.Right, R.Bottom );
end;

procedure TIB_CustomEdit.DrawButtonStyle(ACanvas: TCanvas; ARect: TRect);

  procedure DrawEllipsisImage(AColor: TColor; X, Y: Integer);
  var
    W, W2: integer;
  begin
    W := FButtonWidth shr 3;
    if W = 0 then W := 1;
    with ACanvas do
    begin
      Pen.Color := AColor;
      Brush.Color := AColor;
      W2 := W + W shr 1;
      Ellipse( X - w2, Y, X + W - w2, Y + W );
      Ellipse( X     , Y, X + W     , Y + W );
      Ellipse( X + w2, Y, X + W + w2, Y + W );
    end;
  end;

  // Added 13 May 1999 by Lars George
  procedure DrawDropDown(AColor: TColor; ARect: TRect; X, Y: Integer);
  var
    nWdt, nHgt: Integer;
  begin
    with ACanvas, ARect do
    begin
      // calculate width of arrows
      nWdt := (Right - Left) - 6; // 8 = sum of gap left and right
      // make odd number to make arrow even
      if (nWdt mod 2) = 0 then Dec(nWdt);
      nHgt := nWdt div 2;
      // calculate new top position
      Inc(Top, Y + ((Bottom - Top) - nHgt) div 2);
      Inc(Left, 3 + X); // 3 = gap on left side
      // set colors and draw arrow with polyline
      Pen.Color := AColor;
      Brush.Color := AColor;
      Polygon([Point(Left, Top), Point(Left + nWdt - 1, Top),
               Point(Left + nWdt div 2, Top + nHgt)]);
    end;
  end;

var
  Z, Q: Integer;
  bDefaultDraw:boolean;
  tmpPressed: boolean;
begin
  tmpPressed := FPressed and not DataLink.BoundToBuffer;
  Z := ((ARect.Right - ARect.Left) shr 1) - 1 + Ord(tmpPressed);
  Q := ((ARect.Bottom - ARect.Top) shr 1) - 1 + Ord(tmpPressed);
  //setting the color now, so in the Eventhandler can it get changed...
  //at least for the enabled-status
  if Enabled then
  begin
    ACanvas.pen.color := clBlack;
    ACanvas.brush.color := clBlack;
  end;
  bDefaultDraw := true;
  DoCustomButtonDraw( ACanvas, ARect, Enabled, tmpPressed, bDefaultDraw );
  if bDefaultDraw then
  begin
    if Enabled then
    begin
      case ButtonStyle of
        ebsEllipsis: DrawEllipsisImage( ACanvas.Brush.Color,
                                        ARect.Left + Z,
                                        ARect.Top + Q );
        ebsDropDown: DrawDropDown( ACanvas.brush.color,
                                   ARect,
                                   Ord(tmpPressed),
                                   Ord(tmpPressed));
      end;
    end
    else
    begin
      case ButtonStyle of
        ebsEllipsis:
        begin
          DrawEllipsisImage( clBtnHighlight,
                             ARect.Left + Z+1,
                             ARect.Top + Q+1 );
          DrawEllipsisImage( clBtnShadow,
                             ARect.Left + Z,
                             ARect.Top + Q );
        end;
        ebsDropDown:
        begin
          DrawDropDown( clBtnHighlight, ARect, 1, 1 );
          DrawDropDown( clBtnShadow,    ARect, 0, 0 );
        end;
      end;
    end;
  end;
end;

procedure TIB_CustomEdit.DoCustomButtonDraw(     ACanvas: TCanvas;
                                                 Rect: TRect;
                                                 Enabled,
                                                 Pressed: boolean;
                                             var DefaultDraw: boolean );
begin
  if Assigned( FOnButtonDraw ) then
    FOnButtonDraw( ACanvas, Rect, Enabled, Pressed, DefaultDraw );
end;

procedure TIB_CustomEdit.WMLButtonDown( var Message: TWMLButtonDown );
begin
  if FDrawButton and
     PtInRect( Rect( Width - FButtonWidth, 0, Width, Height ),
               Point( Message.XPos, Message.YPos )) then
  begin
    SetFocus;
    MouseCapture := True;
    FTracking := True;
    TrackButton( Message.XPos, Message.YPos );
  end
  else
    inherited;
end;

procedure TIB_CustomEdit.WMLButtonUp(var Message: TWMLButtonUp);
var
  WasPressed: Boolean;
begin
  if FTracking then
  begin
    WasPressed := FPressed;  //<=-FPressed is set by TrackButton(X,Y)
    StopTracking;
    if (ButtonStyle <> ebsNone) and WasPressed then
      DoEditButtonClick;
  end
  else
    inherited;
end;

procedure TIB_CustomEdit.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if FDrawButton then
  begin
    if PtInRect( Rect( Width - FButtonWidth,
                       0,
                       Width,
                       Height ),
                 Point( X, Y )) then
    {$IFDEF IBO_VCL70_OR_GREATER}
    //RV?? Theme support - change to hot state
    begin
      Cursor := crHandPoint;
      FHot := True;
      invalidate;
    end else
    begin
      Cursor := crDefault;
      FHot := False;
      invalidate;
    end;
    {$ELSE}
      Cursor := crHandPoint
    else
      Cursor := crDefault;
    {$ENDIF}
  end;
  if FTracking then
    TrackButton(X, Y)
  else
    inherited MouseMove(Shift, X, Y);
end;

procedure TIB_CustomEdit.StopTracking;
begin
{ we are finished tracking the mouse over the control.  Reset everything }
  if FTracking then
  begin
    TrackButton( -1, -1 );
    FTracking := False;
    MouseCapture := False;
  end;
end;

procedure TIB_CustomEdit.DoEnter;
begin
  CheckDrawButton(false);
  inherited DoEnter;
end;

procedure TIB_CustomEdit.DoExit;
begin
  CheckDrawButton(false);
  inherited DoExit;
end;

procedure TIB_CustomEdit.SetFocused( AValue: boolean );
begin
  if FFocused <> AValue then
  begin
    FFocused := AValue;
    if ( FAlignment <> taLeftJustify ) and not IsMasked then
      DataLink.Reset;
    SysDataChange( Field );
  end;
end;

// IBC_Currency.INT

{***************************************************************}
{                                                               }
{          IB Objects Components and Resources Library          }
{                                                               }
{          Copyright (C) 1996-2001 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.                  }
{------------------------------------------------------------------------------}
{                                                                              }
{  Original Author: Marco Menardi <mmenaz@lycosmail.com>  2001/11/01           }
{           Copyright (C) 2001 Marco Menardi                                   }
{                                                                              }
{******************************************************************************}

function RoundCurrency(Value : currency; Places : integer; const ARoundMode: TIB_CurrencyRoundingMode ) : currency;
  function Power10Int( const Exponent : integer ) : Extended;
  var
    i : integer;
  begin
    if Exponent <> 0 then
    begin
      Result := 1;
      for i := 1 to abs(Exponent) do
        Result := 10 * Result;
      if Exponent < 0 then
        Result := 1 / Result;
    end
    else
      Result := 1;
  end;
var
  RoundLeftPosition : integer;
begin
  RoundLeftPosition := 0;
  if Places < 0 then
  begin
    RoundLeftPosition := Places;
    Value := Value * Power10Int( RoundLeftPosition );
    Places := 0;
  end;
  case ARoundMode of
    crmNearUp:
      Value := RoundNear(Value, Places);
    crmNearBool:
      Value := Round((Value * Power10Int(Places))) / Power10Int(Places);
    crmDown:
      Value := RoundDown(Value, Places);
    crmUp:
      Value := RoundUp(Value, Places);
    crmTruncate:
      begin
        Value := Trunc((Value * Power10Int(Places))) / Power10Int(Places);
      end;
    else
      ;
  end;
  if RoundLeftPosition < 0 then
    Value := Value / Power10Int( RoundLeftPosition );
  Result := Value;
end;

// deletes formatting chars that would prevent a StrToFloat() conversion
function TextToValText( const S : string ) : string;
var
  x : integer;
begin
  Result := '';
  for x := 1 to length( S ) do
  begin
    if (S[x] in ['0'..'9', '-', DecimalSeparator ]) then
      Result := Result + S[x];
  end;
end;

constructor TIB_Currency.Create( AOwner: TComponent );
begin
  inherited Create( AOwner );
  inherited AlwaysShowButton := True;
  inherited ButtonStyle := ebsNone; // ebsDropDown;
  FAllowUnboundEdits := True;

  FDecimalPlaces := 0;
  FFormatting := False;
  FDisplayEditingFormat := '';
  FDisplayFormat := '';
  FUnboundDisplayFormat := '';
  FConversionRatio := 0;
  FRoundMode := crmNearUp;
  FRoundDecimalPos := -99; // takes actual currency locale decimals
  FBeforeConversion := nil;
  FConversionShortCut := ShortCut( Word('C'), [] ); // #67
  FCalculatorKind := cucNone;
  ResetInLineCalcStatus;
end;

procedure TIB_Currency.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams( Params );
  // ES_MULTILINE necessary for right alignment? (Pre-Win98)
  if not (csDesigning in ComponentState) then
    Params.Style := Params.Style or ES_RIGHT;// or ES_MULTILINE;
end;

// gets number of decimal to use (is there a better event to chain with? Something fired when Column.DisplayFormat is changed?
procedure TIB_Currency.CMEnter( var Message: TCMEnter );
var
  x: integer;
  tmpStr: string;
begin
  inherited;
  ResetInLineCalcStatus;
  // don't put FDisplayEditingFormat := '', since for Unbound it's set by UpdateMask prior to this code
  UpdateDisplayFormat;

  tmpStr := TextToValText(Text);
  if FDecimalPlaces = 0 then
  begin
    // truncates eventual decimal part of the string, separator included
    x := pos( DecimalSeparator, tmpStr );
    if x > 0 then tmpStr := copy( tmpStr, 1, (x-1) );
  end;
  FFormatting := True; // Text := xx does not always do a FormatCurrentText, so we ensure that it's done almost one time, but not two
  Text := tmpStr;
  FFormatting := False;
  FormatCurrentText;
  if AutoSelect and not (csLButtonDown in ControlState) then SelectAll;
end;

procedure TIB_Currency.CMExit(var Message: TCMExit);
var
  Key: char;
begin
  Key := #0;
  if FCalcPending and (FCalculatorKind in [ cucInline, cucBoth ]) then
  begin
    Key := '=';
    InLineCalc( Key );
  end;
{$IFDEF IBO_VCL40_OR_GREATER}
  if not Assigned(Field) then
    ValidateEdit;
{$ENDIF};
  if (not Assigned(Field)) then
    inherited Text := FormatFloat(FUnboundDisplayFormat, Self.Value);

  inherited;
end;

{ Formats text
}
procedure TIB_Currency.FormatCurrentText;
  // deletes all substring occurrence from string
  // I could have used StringReplace, but I don't know if
  // it's available in all IBO supported Delphi versions.
  function RemoveAllSubstr( const Substring, S : string ) : string;
  var
    x : integer;
  begin
    Result := S;
    if Length(Substring) > 0 then
    begin
      repeat
        x := pos( Substring, Result );
        if x > 0 then Delete(Result, X, Length(Substring));
      until x < 1;
    end;
  end;
var
  S: string;
  D: string;
  ST : string;
  x: integer;
  IsEmpty: Boolean;
  OldLen, SelStart, SelStop: Integer;
begin
  FFormatting := True;
  try
    S := inherited Text;
    D := '';
    OldLen := Length(S);
    IsEmpty := (OldLen = 0) or (S = '-');
    if HandleAllocated then GetSel(SelStart, SelStop); // repositions cursor to the rightmost position
    if (not IsEmpty) then S := RemoveAllSubstr(ThousandSeparator, S);
    x := Pos(DecimalSeparator, S);
    if x > 0 then
    begin
      D := copy( S, x, (Length(S) - x)  + 1);
      S := copy( S, 1, x - 1 );
      if FDecimalPlaces = 0 then
        D := ''
      else
        D := copy(D, 1, (FDecimalPlaces + 1));
    end;
    if (S <> '') and (S <> '-') then
    begin
      try
        ST := TextToValText(s);
        if CheckCurrencyOverRange(ST) then // excessive number of digits!
        begin
          ST := copy(ST, 1, length(ST)-1);
          MessageBeep(0);
        end;
        if ST <> '' then
          { I don't use FormatCurr() since allows only the number of decimals defined in the Win locale, while we could manage foreign currency
            S := FormatCurr( FDisplayEditingFormat, StrToCurr(ST) ) }
          S := FormatFloat(FDisplayEditingFormat, StrToFloat(ST))
        else
          S := '';
      except
        S := '';
      end;
    end;
    if (S = '') and (D <> '') then S := '0';
    S := S + D;
    inherited Text := S;
    if HandleAllocated and (GetFocus = Handle) and not
      (csDesigning in ComponentState) then
    begin
      Inc(SelStart, Length(S) - OldLen);
      SetCursor(SelStart);
    end;
  finally
    FFormatting := False;
  end;
end;

procedure TIB_Currency.Change;
begin
  if (not FFormatting) then
  begin
    if (HandleAllocated) and (GetFocus = Handle) then
    begin
      FormatCurrentText;
      invalidate;
    end;
  end;
  inherited Change;
end;

procedure TIB_Currency.KeyDown(var Key: Word; Shift: TShiftState);
var
  Msg: TMsg;
begin
  if EditCanModify then
  begin
    if (Key = VK_DELETE) then // Canc key
    begin
      Self.Value := 0;
      Text := '';
      ResetInLineCalcStatus;
      Key := 0;
    end
    else if ShortCut( key, shift ) = FConversionShortCut then
    begin
      if Assigned( FBeforeConversion ) then
        FBeforeConversion( Self );
      ConvertCurrency;
      SetCursor(Length(Text));
      Key := 0; // stop further KeyDown processing (but does not avoids processing on KeyPress! VCL mystery)
      PeekMessage( Msg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE ); // stop eventual further processing by KeyPress (no, Key := 0 is not enough)
    end;
  end;
  inherited;
end;

procedure TIB_Currency.KeyPress(var Key: Char);
begin
  if (FCalculatorKind in [ cucInline, cucBoth ]) and
     (Key in ['0'..'9', '+', '-', '*', '/', '%', '=' ]) then
        InLineCalc( Key );
  if Key = '.' then Key := DecimalSeparator; // needed for pre-processing and for unbound mode
  // bound or unbound, reject decimal separator if we want a whole number
  if (Key = DecimalSeparator) and (FDecimalPlaces <= 0) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  if not Assigned( Field ) then
  begin
    if not (Key in [#0..#32, '0'..'9', '-', DecimalSeparator ]) then
    begin
      MessageBeep(0);
      Key := #0;
    end;
  end;
  inherited;
end;

function TIB_Currency.EditCanModify: Boolean;
begin
  if DataLink.IsParamEdit then
    Result := true
  else
    Result := ( not Assigned( Field ) and not ReadOnly ) or
              inherited EditCanModify;
end;

procedure TIB_Currency.UpdateMask( UnboundMask: string );
begin
  MaskChanging := true;
  try
    if (not Assigned(Field)) and (FDisplayEditingFormat = '') and (FDisplayFormat = '') then
    begin
      if RoundDecimalPos >= 0 then
        FDecimalPlaces := RoundDecimalPos
      else
        FDecimalPlaces := CurrencyDecimals;

      if FDecimalPlaces > 0 then
      begin
        FDisplayEditingFormat := ',0.' + StringOfChar('#', FDecimalPlaces);
        FUnboundDisplayFormat := ',0.' + StringOfChar('0', FDecimalPlaces);
      end
      else
      begin
        FDisplayEditingFormat := ',0';
        FUnboundDisplayFormat := FDisplayEditingFormat;
      end;
    end;
  finally
    MaskChanging := false;
  end;
  inherited;
end;

{$IFDEF IBO_VCL40_OR_GREATER}
procedure TIB_Currency.ValidateEdit;
var
  tmpVal: string;
begin
  if not Assigned( Field ) then
  begin
    tmpVal := TextToValText( Text );
    if tmpVal <> '' then
    begin
      try
        StrToCurr( tmpVal );
      except
        if CanFocus then
          SetFocus;
        raise;
      end;
    end;
  end;
  inherited ValidateEdit;
end;
{$ENDIF}

{ If in unbound mode, check if string has a value beyond currency range.
  This prevents that while typing huge numbers are converted in exponential
  notation and then back to numeric with wrong results
  (i.e. 15E8 -> exiting is interpreted like 158)
}
function TIB_Currency.CheckCurrencyOverRange( S : string ) : boolean;
begin
  Result := False;
  if not Assigned(Field) then
  begin
    try
      StrToCurr(TextToValText(S))
    except
      Result := True;
    end;
  end;
end;

{ here the most problematic part of the component: numeric conversion and rounding.
  I think I should avoid the use of extended types because there are some numbers that
  don't have exact binary rapresentation, and this brings (slight) confusion when rounding.
  Anyway provided rounding routine use extended, so we have to use them as well
}
procedure TIB_Currency.ConvertCurrency;
var
  ConvertedValue : currency;
  Decimals : integer;
  tmpStr : string;
begin
  if FConversionRatio <> 0 then
  begin
    //  actual := foreign / ratio
    if (RoundDecimalPos = -99) then
      Decimals := FDecimalPlaces
    else
      Decimals := RoundDecimalPos;
    tmpStr := TextToValText( Text );
    if tmpStr = '' then
      Self.Value := 0
    else
    begin
      ConvertedValue := RoundCurrency((StrToFloat(tmpStr) / FConversionRatio), Decimals, RoundMode);
      if not Assigned(Field) then
      begin
        tmpStr := CurrToStr( ConvertedValue );
        if CheckCurrencyOverRange(tmpStr) then // excessive number of digits!
          MessageBeep(0)
        else
          Self.Value := ConvertedValue;
      end
      else
        Self.Value := ConvertedValue;
    end;
  end;
end;

// writes control contents to the field
procedure TIB_Currency.SysUpdateData;
var
  tmpText: string;
begin
  if Assigned( Field ) then
  begin
    if Modified then
    begin
      ValidateEdit;
      tmpText := TextToValText( Text );
      if tmpText = '' then tmpText := '0';
      if Assigned(OnSetEditText) then
         OnSetEditText(Self, tmpText);
      DataLink.FieldText := tmpText;
    end;
  end
  else if FAllowUnboundEdits then
    ValidateEdit;
  Modified := False;
end;

function TIB_Currency.GetValue : currency;
var
  tmpStr: string;
begin
  tmpStr := TextToValText( Text );
  if tmpStr <> '' then
    Result := StrToCurr( TextToValText( Text ) )
  else
    Result := 0;
end;

procedure TIB_Currency.SetValue( AValue : currency );
begin
  Text := CurrToStr( AValue );
  if Assigned( Field ) then
  begin
    Field.AsCurrency := AValue; // enters in edit state, if in browse
    Modified := true;
    DataLink.ControlIsModified := true;
    SysUpdateData( Field ); // calls OnSetEdit
  end
  else
    inherited Text := FormatFloat(FUnboundDisplayFormat, Self.Value);
  SetCursor(99); // cursor to rightmost position
end;

procedure TIB_Currency.SetDisplayFormat(const AValue: string);
begin
  if FDisplayFormat <> AValue then
  begin
    FDisplayFormat := AValue;
    UpdateDisplayFormat;
  end;
end;

procedure TIB_Currency.UpdateDisplayFormat;
var
  x: integer;
begin
  FDecimalPlaces := 0;
  if (FDisplayFormat = '') and (Assigned(Field)) then
    FDisplayEditingFormat := Field.DisplayFormat
  else if (FDisplayFormat <> '') then
  begin
    FDisplayEditingFormat := FDisplayFormat;
    FUnboundDisplayFormat := FDisplayFormat; // used for display (not while editing) format when unbound: no subsequent .00 -> .## change
  end;
  x := pos( '.', FDisplayEditingFormat );
  if x > 0 then
  begin
    Inc(x);
    while (length(FDisplayEditingFormat) >= x) and (FDisplayEditingFormat[x] in ['#', '0', '9']) do
    begin
      Inc(FDecimalPlaces);
      // translates i.e. '.00' to '.##', since the former is bad for formatting during input
      FDisplayEditingFormat[x] := '#';
      Inc(x);
    end;
    // conventional (for IBO_CURRENCY) mask format like ',0.' interpreted as requiring Default or Field Scale number of decimals
    if (FDecimalPlaces = 0) and (Assigned(Field)) then
    begin
      if CurrencyDecimals <= (-Field.SQLScale) then
        FDecimalPlaces := CurrencyDecimals
      else
        FDecimalPlaces := -Field.SQLScale;
      FDisplayEditingFormat := FDisplayEditingFormat + StringOfChar('#', FDecimalPlaces);
    end;
  end
  else // No decimal separator included, I interpret this as a Whole number request
    FDecimalPlaces := 0;
end;

// calculation, due to % calcs, have to be performed in extended and then rounded and converted to currency
procedure TIB_Currency.InLineCalc( var Key: Char );
var
  FCurrentValue: extended;
begin
  try
  case Key of
    '0'..'9':
    begin
      if (FCalcClearDisplay) and (FCalcLastOp <> #0) then
      begin
        Text := '';
        FCalcClearDisplay := False;
        FCalcPending := True;
      end;
    end;
  end;

  // also checks if '-' is to be considered the sign or the subtraction operand
  if (Key in ['=', '+', '-', '*', '/', '%']) and (not ((Key = '-') and (FCalcLastOp = #0) and (Self.Value = 0))) then
  begin
    if (FCalcLastOp <> #0) then  // Equals
    begin
      FCurrentValue := Self.Value;
      if Key = '%' then
      begin
        case FCalcLastOp of
          '+', '-': FCurrentValue := FCalcLastValue * FCurrentValue / 100.0;
          '*', '/': FCurrentValue := FCurrentValue / 100.0;
        end;
      end;
      case FCalcLastOp of
        '+': FCurrentValue := FCalcLastValue + FCurrentValue;
        '-': FCurrentValue := FCalcLastValue - FCurrentValue;
        '*': FCurrentValue := FCalcLastValue * FCurrentValue;
        '/': FCurrentValue := FCalcLastValue / FCurrentValue;
      end;
      FCalcPending := False;
      Self.Value := RoundNear(FCurrentValue, FDecimalPlaces);
    end;
    FCalcLastValue := Self.Value;
    FCalcClearDisplay := True;
    FCalcLastOp := Key;
    Key := #0;
  end;

  except
    on E: Exception do
    begin
      ResetInLineCalcStatus;
      MessageBeep(0);
    end;
  end;
end;

procedure TIB_Currency.ResetInLineCalcStatus;
begin
  FCalcLastValue := 0;
  FCalcLastOp := #0;
  FCalcClearDisplay := True;
  FCalcPending := False;
end;
{$UNDEF IBC_Edit}

{$DEFINE IBC_Date}
// IBC_Date.INT
// Datepick

constructor TIB_CustomDate.Create( AOwner: TComponent );
begin
  FDatePick := TDatePick.Create( Self );
  FDatePick.Hidden := True;
  FDatePick.OnChange := DatePickChange;
  FDatePick.OnStrike := DatePickStrike;
  inherited Create( AOwner );
  inherited AlwaysShowButton := True;
  inherited ButtonStyle := ebsDropDown;
  inherited Width := 100;
  FirstWeek := fwFirstJanuary;
  Options := [ doClearButton, doTodayButton, doShowOverlap ];
  StartDay := sdMon;
  FAllowUnboundEdits := True;
  FAutoFill := False;
  IncCellHeight := 1;
  IncCellWidth := 2; 
end;

function TIB_CustomDate.GetNormalCellLineColor: TColor;
begin
  Result := FDatePick.NormalCellLineColor;
end;
function TIB_CustomDate.GetSelectedCellColor: TColor;
begin
  Result := FDatePick.SelectedCellColor;
end;
function TIB_CustomDate.GetSelectedCellFontColor: TColor;
begin
  Result := FDatePick.SelectedCellFontColor;
end;
function TIB_CustomDate.GetNormalCellColor: TColor;
begin
  Result := FDatePick.NormalCellColor;
end;
function TIB_CustomDate.GetDifMonthFontColor: TColor;
begin
  Result := FDatePick.DifMonthFontColor;
end;
function TIB_CustomDate.GetNormalCellFontColor: TColor;
begin
  Result := FDatePick.NormalCellFontColor;
end;
function TIB_CustomDate.GetTodayCellColor: TColor;
begin
  Result := FDatePick.TodayCellColor;
end;
function TIB_CustomDate.GetDayOfWeekStrLen: integer;
begin
  Result := FDatePick.DayOfWeekStrLen;
end;
procedure TIB_CustomDate.SetNormalCellLineColor( AValue: TColor );
begin
  FDatePick.NormalCellLineColor := AValue;
end;
procedure TIB_CustomDate.SetSelectedCellColor( AValue: TColor );
begin
  FDatePick.SelectedCellColor := AValue;
end;
procedure TIB_CustomDate.SetSelectedCellFontColor( AValue: TColor );
begin
  FDatePick.SelectedCellFontColor := AValue;
end;
procedure TIB_CustomDate.SetNormalCellColor( AValue: TColor );
begin
  FDatePick.NormalCellColor := AValue;
end;
procedure TIB_CustomDate.SetDifMonthFontColor( AValue: TColor );
begin
  FDatePick.DifMonthFontColor := AValue;
end;
procedure TIB_CustomDate.SetNormalCellFontColor( AValue: TColor );
begin
  FDatePick.NormalCellFontColor := AValue;
end;
procedure TIB_CustomDate.SetTodayCellColor( AValue: TColor );
begin
  FDatePick.TodayCellColor := AValue;
end;
procedure TIB_CustomDate.SetDayOfWeekStrLen( AValue: integer );
begin
  FDatePick.DayOfWeekStrLen := AValue;
end;

procedure TIB_CustomDate.SetTopPanelColor( AValue: TColor ); 
begin
  FDatePick.TopPanelColor := AValue;
end;

function TIB_CustomDate.GetTopPanelColor: TColor; 
begin
  Result := FDatePick.TopPanelColor;
end;

procedure TIB_CustomDate.SetTopPanelFontColor( AValue: TColor ); 
begin
  FDatePick.TopPanelFontColor := AValue;
end;

function TIB_CustomDate.GetTopPanelFontColor: TColor; 
begin
  Result := FDatePick.TopPanelFontColor;
end;

procedure TIB_CustomDate.SetArrowColor( AValue: TColor ); 
begin
  FDatePick.ArrowColor := AValue;
end;

function TIB_CustomDate.GetArrowColor: TColor; 
begin
  Result := FDatePick.ArrowColor;
end;

procedure TIB_CustomDate.DatePickStrike(     Sender: TDatePick;
                                             CheckThisDate: TDateTime;
                                         var CrossColor : TColor );
begin
  DoStrike( CheckThisDate, CrossColor );
end;

procedure TIB_CustomDate.DoStrike(     CheckThisDate: TDateTime;
                                   var CrossColor : TColor );
begin
  if Assigned( FOnStrike ) then
    FOnStrike( Self, CheckThisDate, CrossColor );
end;

procedure TIB_CustomDate.CreateWnd;
begin
  inherited CreateWnd;
  FDatePick.Parent := Self;
  // This avoids a painting glitch in the TIB_CtrlGrid control.
  FDatePick.SetBounds( Height, Width, FDatePick.Height, FDatePick.Width );
end;

procedure TIB_CustomDate.DatePickChange( Sender: TDatePick;
  Value: TDatePickResult );
begin
  // hide calendar first
  FDatePick.HideCalendar;
  if Value = dpNoChanges then Exit;
  // check return value and do corresponding action
  if Assigned( Field ) then
  begin
    // check if update possible
    if not DataLink.Modify then
      Exit;
    case Value of
      dpClear:
      if ( DataLink.State = dssSearch ) or SearchAlways then
        DataLink.FieldText := ''
      else
      begin
        Field.Clear;
        Text := '';  //<=-make sure control gets cleared
      end;
      dpOk:
      if ( DataLink.State = dssSearch ) or SearchAlways then
        DataLink.FieldText := DateToStr( FDatePick.Date )
      else
        Field.AsDateTime := FDatePick.Date;
    end;
  end
  else
  begin
    case Value of
      dpClear: Text := '';
      dpOk: if EditCanModify then
        Text := DateToStr( FDatePick.Date )
      else
        Exit;
      else Exit;
    end;
    // reflect changes
    Modified := true;
    DataLink.ControlIsModified := true;
    SysUpdateData( Field );
  end;
end;

procedure TIB_CustomDate.DoEditButtonClick;
begin
  inherited DoEditButtonClick;
  if FDatePick.IsActive then
    FDatePick.HideCalendar
  else
  begin
    FDatePick.Date := SysUtils.Date;
    try
      if DataLink.State = dssSearch then
      begin
        if SearchBuffer <> '' then
          FDatePick.Date := Trunc( StrToDateTime( SearchBuffer ));
      end
      else
      begin
        if Assigned( Field ) and Field.IsNotNull then
          FDatePick.Date := Field.AsDate
        else
        if (Text <> FormatMaskText( EditMask, '' )) then
          FDatePick.Date := StrToDate( Text );
      end;
    except
    // Ignore any exceptions above.
    end;
    FDatePick.ShowCalendar( Parent.ClientToScreen(Point( Left, Top + Height )));
  end;
end;

function TIB_CustomDate.GetFirstWeek: TDatePickFirstWeek;
begin Result := FDatePick.FirstWeek; end;
function TIB_CustomDate.GetOptions: TDatePickOptions;
begin Result := FDatePick.Options; end;
function TIB_CustomDate.GetStartDay: TDatePickStartDay;
begin Result := FDatePick.StartDay; end;
procedure TIB_CustomDate.SetFirstWeek( const Value: TDatePickFirstWeek );
begin FDatePick.FirstWeek := Value; end;
procedure TIB_CustomDate.SetOptions( const Value: TDatePickOptions );
begin FDatePick.Options := Value; end;
procedure TIB_CustomDate.SetStartDay( const Value: TDatePickStartDay );
begin FDatePick.StartDay := Value; end;
function TIB_CustomDate.GetTodayButtonCaption: string;
begin Result := FDatePick.TodayButtonCaption; end;
function TIB_CustomDate.GetClearButtonCaption: string;
begin Result := FDatePick.ClearButtonCaption; end;
procedure TIB_CustomDate.SetTodayButtonCaption( AValue : string );
begin FDatePick.TodayButtonCaption := AValue; end;
procedure TIB_CustomDate.SetClearButtonCaption( AValue : string );
begin FDatePick.ClearButtonCaption := AValue; end;

function  TIB_CustomDate.GetIncCellHeight: Integer; 
begin
  Result := FDatePick.IncCellHeight;
end;

function  TIB_CustomDate.GetIncCellWidth: Integer;
begin
  Result := FDatePick.IncCellWidth;
end;

procedure TIB_CustomDate.SetIncCellHeight(AValue: Integer); 
begin
  FDatePick.IncCellHeight := AValue;
end;

procedure TIB_CustomDate.SetIncCellWidth(AValue: Integer); 
begin
  FDatePick.IncCellWidth := AValue;
end;

function  TIB_CustomDate.GetDrawYearArrow: boolean; 
begin
  result := FDatePick.DrawYearArrow;
end;

procedure TIB_CustomDate.SetDrawYearArrow(AValue: boolean); 
begin
  FDatePick.DrawYearArrow := AValue;
end;

procedure TIB_CustomDate.WMKillFocus( var Message: TWMKillFocus );
begin
  // hide the dropdown (control has lost focus)
  if FDatePick.IsActive then
    FDatePick.HideCalendar;
  inherited;
end;

procedure TIB_CustomDate.WMKeyDown( var Message: TWMKeyDown );
begin
  // allow keydown message to be processed by FDatePick
  FDatePick.ProcessKeyDown( Message );
  // allow default keydown handling to proceed if needed
  if ( Message.CharCode <> 0 ) then
    inherited;
end;

procedure TIB_CustomDate.WndProc( var Message: TMessage );
var
  ShiftState: TShiftState;
begin
  if not (csDesigning in ComponentState) then
  begin
    case Message.Msg of
      WM_CHAR: begin
        with TWMKey(Message) do
        begin
          ShiftState := KeyDataToShiftState(KeyData);
          // trap WM_CHAR messages when the datepick is active to
          //   prevent characters going into the edit text
          if FDatePick.IsActive then
            if (ShiftState = []) or (ShiftState = [ssShift]) then
              Exit;
          // trap CTRL+SPACE (a space was somehow leaking thru for this msg)
          if CharCode = VK_SPACE then
            if ShiftState = [ssCtrl] then
              Exit;
          // handle TAB and SHIFT+TAB
          if CharCode = VK_TAB then
          begin
{$IFDEF IBO_VCL40_OR_GREATER}
            ValidateEdit;
{$ENDIF}
            if (ShiftState = []) or (ShiftState = [ssShift]) then
            begin
              // move to next/prior control in tab order
              if ssShift in ShiftState then
                PostMessage( GetParentForm(Self).Handle, WM_NEXTDLGCTL, 1, 0 )
              else
                PostMessage( GetParentForm(Self).Handle, WM_NEXTDLGCTL, 0, 0 );
              // trap TAB and SHIFT+TAB to prevent a TAB going into edit text
              Exit;
            end;
          end;
        end;
      end;
    end;
  end;
  inherited WndProc( Message );
end;

function TIB_CustomDate.EditCanModify: Boolean;
begin
  Result := ( not Assigned( Field ) and not ReadOnly ) or
            inherited EditCanModify;
end;

{$IFDEF IBO_VCL40_OR_GREATER}
procedure TIB_CustomDate.ValidateEdit;
var
  tmpStr: string;
begin
  if not Assigned( Field ) then
  begin
    tmpStr := FormatMaskText( EditMask, '' );
    if Text <> tmpStr then
      try
        StrToDate( Text );
      except
        if CanFocus then
          SetFocus;
        raise;
      end;
  end;
  inherited ValidateEdit;
end;
{$ENDIF}

procedure TIB_CustomDate.CMExit(var Message: TCMExit);
begin
{$IFDEF IBO_VCL40_OR_GREATER}
  if not Assigned( Field ) then
    ValidateEdit;
{$ENDIF}
  inherited;
end;

procedure TIB_CustomDate.KeyPress(var Key: Char);
var
  strTmp, T: string;
begin
  // special keys for simplified date entry
  if ((((Key = char(VK_SPACE))) and ((Text = FormatMaskText( EditMask, '' )) or (EditText = SelText))) or
      (AutoFill and ((Text = FormatMaskText( EditMask, '' )) or (EditText = SelText)) and (Key in [ '0'..'9' ]))) and
     (not Assigned( Field ) or EditCanModify) then
  begin
    strTmp := AnsiLowerCase(ShortDateFormat);
    // check if short date format has final 4 year digits, if so assign 2 year digits and avoid blanks
    if (length(strTmp) >= 4) and (copy(strTmp, length(strTmp) -3, 4) = 'yyyy') then // try to convert to a 2 digit year
    begin
      replace_string( strTmp, 'yyyy', 'yy' );
      DateTimeToString( T, strTmp, Date );
      Text := T;
      if (length(Text) > 4) and (copy(Text, length(Text) -3, 2)= '  ') then // like: xx/xx/__yy
        Text := T + '  ';  // becomes xx/xx/yy__
    end
    else
      Text := DateToStr( Date );
    // assigning text makes unnecessary to explicitly reflect changes
    // i.e. Modified:=True; DataLink.ControlIsModified:=True; Avoid if Key = char(VK_SPACE) then SysUpdateData( Field );

    if Key = char(VK_SPACE) then
      Key := #0;
  end;

  if not Assigned( Field ) then
  begin
    if not (Key in [ #0..#32, '0'..'9', DateSeparator ]) then
    begin
      MessageBeep(0);
      Key := #0;
    end;
  end;
  inherited KeyPress(Key);
end;

procedure TIB_CustomDate.UpdateMask( UnboundMask: string );
begin
  if UnboundMask = '' then
  begin
    if Copy( AnsiLowerCase( ShortDateFormat ), 1, 1 ) = 'y' then
      UnboundMask := '!9999' + DateSeparator + '99' + DateSeparator + '99;1; '
    else
      UnboundMask := '!99' + DateSeparator + '99' + DateSeparator + '9999;1; ';
  end;
  inherited UpdateMask( UnboundMask );
end;

function TIB_CustomDate.GetValue: TDate;
var
  x: integer;
begin
  if Assigned( Field ) then
    Result := Field.AsDate
  else
  begin
    Result := 0;
    for x := 1 to length(Text) do
    begin
      if (Text[x] in [ '0'..'9' ]) then
      begin
        Result := StrToDate( Text );
        break;
      end
      else if Text[x] = DateSeparator then
        break;
    end;
  end;
end;

procedure TIB_CustomDate.SetValue( AValue : TDate );
begin
  if Assigned( Field ) then
  begin
    Field.AsDate := AValue; // enters in edit state, if in browse
    Modified := true;
    DataLink.ControlIsModified := true;
    // SysUpdateData( Field ); // calls OnSetEdit // removed: conversion error with sophisticated display formats (i.e. with day of the week)
  end
  else
    Text := DateToStr( AValue );
end;
{$UNDEF IBC_Date}

{$IFDEF IBO_VCL30_OR_GREATER}
{$DEFINE IBC_DateTimePicker}
// IBC_DateTimePicker.INT

{$DEFINE IB_AutoLabel}
{$I IB_WinControl.IMP}
{$UNDEF IB_AutoLabel}

constructor TIB_CustomDateTimePicker.Create(AOwner: TComponent);
begin
  FIB_FieldDataLink := TIB_FieldDataLink.Create( Self );
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel := TIB_AutoLabel.Create( Self );
{$ENDIF}
  inherited Create(AOwner);
  inherited ShowCheckbox := true;
  ControlStyle := ControlStyle + [csReplicatable];
  DataLink.Control := Self;
  DataLink.OnStateChanged := StateChanged;
  DataLink.OnDataChange := DataChange;
  DataLink.OnUpdateData := UpdateData;
  FBorderStyle := bsSingle;
end;

destructor TIB_CustomDateTimePicker.Destroy;
begin
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel.Free;
  FAutoLabel := nil;
{$ENDIF}
  DataSource := nil;
  with DataLink do begin
    Control := nil;
    OnStateChanged := nil;
    OnEditingChanged := nil;
    OnDataChange := nil;
    OnUpdateData := nil;
  end;
  inherited Destroy;
end;

procedure TIB_CustomDateTimePicker.Loaded;
begin
  inherited;
{$IFDEF IBO_VCL30_OR_GREATER}
  RemakeAutoLabel;
{$ENDIF}
end;

procedure TIB_CustomDateTimePicker.CreateParams( var Params: TCreateParams );
begin
  inherited CreateParams( Params );
  with Params do
  begin
    if ( DataLink.State = dssSearch ) or SearchAlways then
      Style := Style or DTS_SHOWNONE;
    FShowingCheckbox := ( Style = ( Style or DTS_SHOWNONE ));
  end;
end;

procedure TIB_CustomDateTimePicker.SysDataChange;
var
  tmpColor: TColor;
begin
  if DataLink.ColorScheme then
  begin
    tmpColor := DataLink.Color;
    if inherited Color <> tmpColor then
    begin
      inherited Color := tmpColor;
      Invalidate;
    end;
  end;
  with DataLink do begin
    if ( FieldText <> '' ) and ( FieldText <> Name ) then begin
      try
        if Kind = dtkTime then
          Time := StrToDateTime( FieldText )
        else
          Date := StrToDateTime( FieldText );
      except
        Date := Trunc( now );
      end;
      Checked := true;
    end else begin
      Date := Trunc( now );
      Checked := false;
    end;
  end;
end;

procedure TIB_CustomDateTimePicker.SysStateChanged;
var
  tmpColor: TColor;
begin
  if DataLink.ColorScheme then
  begin
    tmpColor := DataLink.Color;
    if inherited Color <> tmpColor then
    begin
      inherited Color := tmpColor;
      Invalidate;
    end;
  end;
  if SearchAlways or ( DataLink.State = dssSearch ) then begin
    if not FShowingCheckbox then begin
      RecreateWnd;
    end;
  end else if not ShowCheckBox and FShowingCheckbox then begin
    RecreateWnd;
  end;
  UpdateTabStop;
end;

procedure TIB_CustomDateTimePicker.SysUpdateData(IB_Field: TIB_Column);
{$IFDEF IBO_VCL70_OR_GREATER}
var
  FS: TFormatSettings; {SB}
{$ENDIF}
begin
//  Original code left commented {SB}
//  if Checked then begin
//    DataLink.FieldText := DateTimeToStr( Trunc( Date ));
//  end else begin
//    DataLink.FieldText := '';
//  end;

//  Begin of amended code {SB}
  { As per Delphi help, I have used the second form of DateToStr and TimeToStr
    specifying format settings because this second form is thread-safe }
  if Checked then
  begin
{$IFDEF IBO_VCL70_OR_GREATER}
    GetLocaleFormatSettings(GetThreadLocale, FS);
{$ENDIF}
    if Kind = dtkDate then
{$IFDEF IBO_VCL70_OR_GREATER}
      DataLink.FieldText := DateToStr(Date, FS)
{$ELSE}
      DataLink.FieldText := DateToStr(Date)
{$ENDIF}
    else
{$IFDEF IBO_VCL70_OR_GREATER}
      DataLink.FieldText := TimeToStr(Time, FS)
{$ELSE}
      DataLink.FieldText := TimeToStr(Time)
{$ENDIF}
  end
  else DataLink.FieldText := ''
//  End of amended code {SB}
end;

procedure TIB_CustomDateTimePicker.CMEnter(var Message: TCMEnter);
begin
//  DataLink.SetFocused( true );
  inherited;
  SysDataChange( nil );
end;

procedure TIB_CustomDateTimePicker.CMExit(var Message: TCMExit);
begin
  try
    DataLink.UpdateData;
  except
    SetFocus;
    raise;
  end;
  inherited;
  SysDataChange( nil );
end;

procedure TIB_CustomDateTimePicker.CNNotify(var Message: TWMNotify);
begin
  with Message, Message.NMHdr^ do
  begin
    Result := 0;
    case code of
    DTN_DATETIMECHANGE: if DataLink.IsParamEdit or DataLink.Modify then
      begin
        inherited;
        DataLink.ControlIsModified := true;
        SysUpdateData( nil );
      end;
    DTN_WMKEYDOWN: if DataLink.IsParamEdit or DataLink.Modify then
      begin
        inherited;
        DataLink.ControlIsModified := true;
        SysUpdateData( nil );
      end
      else
        inherited;
    else
      inherited;
    end;
  end;
end;
{$UNDEF IBC_DateTimePicker}
{$ENDIF}

{$DEFINE IBC_Memo}
{$DEFINE IB_AutoLabel}
{$I IBC_CustomMemo.IMP}
{$UNDEF IB_AutoLabel}
{$UNDEF IBC_Memo}

{$DEFINE IBC_RichEdit}
{$DEFINE IB_AutoLabel}
{$I IBC_CustomMemo.IMP}
{$UNDEF IB_AutoLabel}
{$UNDEF IBC_RichEdit}

{$DEFINE IBC_CheckBox}
// IBC_CheckBox.INT

{$I IB_WinControl.IMP}

constructor TIB_CustomCheckBox.Create(AOwner: TComponent);
begin
  FIB_FieldDataLink := TIB_FieldDataLink.Create( Self );
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  DataLink.Control := Self;
  DataLink.OnStateChanged := StateChanged;
  DataLink.OnDataChange := DataChange;
  DataLink.OnUpdateData := Self.UpdateData;
  FBorderStyle := bsSingle;
  FDisplayLabelAsCaption := false;
  State := cbGrayed;
end;

destructor TIB_CustomCheckBox.Destroy;
begin
  DataSource := nil;
  DataLink.Control := nil;
  DataLink.OnStateChanged := nil;
  DataLink.OnDataChange := nil;
  DataLink.OnUpdateData  := nil;
  inherited Destroy;
end;

procedure TIB_CustomCheckBox.Loaded;
begin
  inherited Loaded;
  SysStateChanged;
  SysDataChange( nil );
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomCheckBox.SysStateChanged;
begin
  with DataLink do
  begin
    if Assigned( Field ) then
    begin
      FValueChecked := Field.BooleanTrue;
      FValueUncheck := Field.BooleanFalse;
    end
    else
    begin
      FValueChecked := 'T';
      FValueUncheck := 'F';
    end;
    if ColorScheme then
      inherited Color := Color;
    inherited AllowGrayed := ( State = dssSearch ) or
                             ( FAllowGrayed and
                               Assigned( Field ) and
                               Field.IsNullable );
    if DisplayLabelAsCaption and Assigned( Field ) then
      Caption := Field.DisplayLabel;
  end;
  UpdateTabStop;
end;

procedure TIB_CustomCheckBox.SysDataChange;
var
  tmpColor: TColor;
begin
  if DataLink.ColorScheme then
  begin
    tmpColor := DataLink.Color;
    if inherited Color <> tmpColor then
    begin
      inherited Color := tmpColor;
      Invalidate;
    end;
  end;
  State := GetFieldState;
end;

procedure TIB_CustomCheckBox.SysUpdateData;
begin
  if Assigned( Field ) then
    with DataLink do
      if Field.IsDateTime or Field.IsBlob or Field.IsArray then
      begin
        if ( State = dssSearch ) or SearchAlways then
        begin
          if Self.State = cbUnchecked then
            SearchBuffer := 'IS NULL'
          else if Self.State = cbChecked then
            SearchBuffer := 'IS NOT NULL'
          else
            SearchBuffer := '';
        end;
      end
      else
        if Self.State = cbGrayed then
          FieldText := ''
        else
        if Checked then
          FieldText := FValueChecked
        else
          FieldText := FValueUncheck;
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomCheckBox.SetDisplayLabelAsCaption( AValue: boolean );
begin
  if DisplayLabelAsCaption <> AValue then
  begin
    FDisplayLabelAsCaption := AValue;
    if DisplayLabelAsCaption then
      SysStateChanged;
  end;
end;

function TIB_CustomCheckBox.GetFieldState: TCheckBoxState;
begin
  with DataLink do 
    if not Assigned( Field ) then
      Result := cbGrayed
    else
    if Field.IsDateTime or Field.IsBlob or Field.IsArray then
    begin
      if ( State = dssSearch ) or SearchAlways then
      begin
        if SearchBuffer = 'IS NULL' then
          Result := cbUnchecked
        else if SearchBuffer = 'IS NOT NULL' then
          Result := cbChecked
        else
          Result := cbGrayed;
      end
      else
      begin
        if Field.IsNull then
          Result := cbUnchecked
        else
          Result := cbChecked
      end;          
    end
    else
      if FValueChecked = FieldText then
        Result := cbChecked
      else if FValueUncheck = FieldText then
        Result := cbUnchecked
      else
        Result := cbGrayed;
end;

procedure TIB_CustomCheckBox.Toggle;
begin
  with DataLink do 
    if Assigned( Field ) and
       Field.IsBoolean and
       Modify then
    begin
      inherited Toggle;
      DataLink.ControlIsModified := true;
    end;
end;

procedure TIB_CustomCheckBox.SetAllowGrayed( AValue: boolean );
begin
  if FAllowGrayed <> AValue then
  begin
    FAllowGrayed := AValue;
    SysStateChanged;
  end;
end;

procedure TIB_CustomCheckBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    #8, ' ':
      if DataLink.Modify then
        DataLink.ControlIsModified := true;
    #27:
      SysDataChange( nil );
  end;
end;

procedure TIB_CustomCheckBox.CMEnter(var Message: TCMEnter);
begin
  inherited;
end;

procedure TIB_CustomCheckBox.CMExit(var Message: TCMExit);
begin
  try
    DataLink.UpdateData;
  except
    SetFocus;
    raise;
  end;
  inherited;
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomCheckBox.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of integer = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := longint(Style) or longint(BorderStyles[FBorderStyle]);
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;
{$UNDEF IBC_CheckBox}

{$DEFINE IBC_ComboBox}

// IBC_ComboBox.INT
{                                                                              }
{  Marco Menardi <mmenaz@mail.com>                                             }
{  25-Jul-02                                                                   }
{     TIB_CustomComboBox.Destroy fix errors because missing parent window      }
{     under particular situations                                              }
{                                                                              }
{  Geoff Worboys <geoff@telesiscomputing.com.au>                               }
{  20-Dec-2001                                                                 }
{     Added GetAutoLabel interface routine to support change to                }
{     IIB_GridWinControl                                                       }
{                                                                              }
{  Geoff Worboys <geoff@telesiscomputing.com.au>                               }
{  11-Oct-2001                                                                 }
{     Improve support for csDropDown mode.                                     }
{                                                                              }

{$DEFINE IB_AutoLabel}
{$I IB_WinControl.IMP}
{$UNDEF IB_AutoLabel}

constructor TIB_CustomComboBox.Create(AOwner: TComponent);
begin
  FIB_FieldDataLink := TIB_FieldDataLink.Create( Self );
  {$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel := TIB_AutoLabel.Create( Self );
  {$ENDIF}
  inherited Create( AOwner );
  ControlStyle := ControlStyle + [csReplicatable];
  ControlStyle := ControlStyle - [csFramed];
  DataLink.Control := Self;
  DataLink.OnStateChanged := StateChanged;
  DataLink.OnDataChange := DataChange;
  DataLink.OnUpdateData := UpdateData;
  FBorderStyle := bsSingle;
end;

destructor TIB_CustomComboBox.Destroy;
begin
  {$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel.Free;
  FAutoLabel := nil;
  {$ENDIF}
//  DataSource := nil; // --- old position
  with DataLink do
  begin
    Control := nil;
    OnStateChanged := nil;
    OnDataChange := nil;
    OnUpdateData := nil;
  end;
  DataSource := nil; // marco menardi 2002/07/25
  if Assigned( FItemValues ) then
  begin
    FItemValues.Free;
    FItemValues := nil;
  end;
  inherited Destroy;
end;

procedure TIB_CustomComboBox.Loaded;
begin
  inherited;
  {$IFDEF IBO_VCL30_OR_GREATER}
  RemakeAutoLabel;
  {$ENDIF}
end;

procedure TIB_CustomComboBox.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of Longint = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
{
  if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
  begin
    Params.Style := Params.Style and not WS_BORDER;
    Params.ExStyle := Params.ExStyle or WS_EX_CLIENTEDGE;
  end
  else
}
  Params.Style := longint(Params.Style) or longint(BorderStyles[FBorderStyle]);
end;

procedure TIB_CustomComboBox.Clear;
begin
  if Assigned( FItemValues ) then
    FItemValues.Clear;
  inherited Clear;
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomComboBox.SysDataChange;
var
  tmpStr: string;
var
  tmpColor: TColor;
begin
  if DataLink.ColorScheme then
  begin
    tmpColor := DataLink.Color;
    if inherited Color <> tmpColor then
    begin
      inherited Color := tmpColor;
      Invalidate;
    end;
  end;
  with DataLink do
  begin
    MaxLength := FieldMaxLength;
    tmpStr := FieldText;
    if Value <> tmpStr then
      Value := tmpStr;
  end;
end;

procedure TIB_CustomComboBox.SysStateChanged;
begin
  if DataLink.ColorScheme then
    inherited Color := DataLink.Color;
  SetEditReadOnly;
  UpdateTabStop;
end;

procedure TIB_CustomComboBox.SysUpdateData;
begin
  DataLink.FieldText := Value;
end;

{------------------------------------------------------------------------------}

function TIB_CustomComboBox.GetValue: string;
begin
  if Style <> csDropDown then
  begin
    Result := '';
    if ( ItemIndex >= 0 ) then
    begin
      if Assigned( FItemValues ) and ( ItemIndex < FItemValues.Count ) then
        Result := FItemValues.Strings[ItemIndex]
      else
        Result := Text;
    end;
  end
  else
    Result := Text;
end;

procedure TIB_CustomComboBox.SetValue( const AValue: string );
var
  ii: Integer;
begin
  if Style <> csDropDown then
  begin
    if AValue = '' then
    begin
      SetItemIndex( -1 );
      Exit;
    end;
    if Assigned( FItemValues ) and ( FItemValues.Count > 0 ) then
      for ii := 0 to FItemValues.Count - 1 do
        //NOTE// Use case-sensitive comparison here
        if CompareStr( FItemValues.Strings[ii], AValue ) = 0 then
        begin
          if ii < Items.Count then
          begin
            SetItemIndex( ii );
            Exit;
          end;
          Break;
        end;
  end;
  SetComboText( AValue );
end;

{------------------------------------------------------------------------------}

function TIB_CustomComboBox.GetItemIndex: Integer;
begin
{$IFDEF IBO_VCL60_OR_GREATER}
  Result := inherited GetItemIndex;
{$ELSE}
  Result := inherited ItemIndex;
{$ENDIF}
end;

procedure TIB_CustomComboBox.SetItemIndex( const Value: Integer );
var
  Redraw: Boolean;
begin
{$IFDEF IBO_VCL60_OR_GREATER}
  if inherited GetItemIndex <> Value then
{$ELSE}
  if inherited ItemIndex <> Value then
{$ENDIF}
  begin
    Redraw := ( Style <> csSimple ) and HandleAllocated;
    if Redraw then
      SendMessage( Handle, WM_SETREDRAW, 0, 0 );
    try
{$IFDEF IBO_VCL60_OR_GREATER}
      inherited SetItemIndex( Value );
{$ELSE}
      inherited ItemIndex := Value;
{$ENDIF}
    finally
      if Redraw then
      begin
        SendMessage( Handle, WM_SETREDRAW, 1, 0 );
        Invalidate;
      end;
    end;
  end;
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomComboBox.SetComboText( const AValue: string );
var
  I: Integer;
begin
  if AValue <> GetComboText then
  begin
    if Style <> csDropDown then
    begin
      if AValue = '' then
        I := -1
      else
        I := Items.IndexOf( AValue );
      SetItemIndex( I );
      if I >= 0 then
        Exit;
    end;
    if ( Style in [csDropDown, csSimple] ) or
       ( csDesigning in ComponentState ) then
      Text := AValue;
  end;
end;

function TIB_CustomComboBox.GetComboText: string;
var
  I: Integer;
begin
  if ( Style in [csDropDown, csSimple] ) or
     ( csDesigning in ComponentState ) then
    Result := Text
  else
  begin
    I := ItemIndex;
    if I < 0 then
      Result := ''
    else
      Result := Items[ I ];
  end;
end;

procedure TIB_CustomComboBox.Change;
begin
// **************** start change by Wassim Haddad 11-Aug-2001 **************
  if ( DataLink.State <> dssSearch ) and not SearchAlways then
  begin
    if ((Style <> csDropDownList) or (DataLink.FieldText <> Value )) and
       DataLink.Modify then
    begin
      DataLink.ControlIsModified := true;
      if Style = csDropDownList then
        DataLink.FieldText := Value;
      inherited Change;
      if Style <> csDropDownList then
        DataLink.ControlIsModified := true;
    end;
  end
  else
    DataLink.FieldText:=Value;
// **************** end change *********************************************
end;

procedure TIB_CustomComboBox.Click;
begin
  if DataLink.CanModify then
    inherited Click;
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomComboBox.CreateWnd;
begin
  inherited CreateWnd;
  if not Focused then
  begin
    SysStateChanged;
    SysDataChange( nil );
  end;
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomComboBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if Key in [VK_BACK, VK_DELETE, VK_UP, VK_DOWN] then
    if not DataLink.Modify and (Key in [VK_UP, VK_DOWN]) then
      Key := 0;
  if Key = VK_ESCAPE then
  begin
    if ( DataLink.State = dssSearch ) or SearchAlways then
      DataLink.FieldText := ''
    else
      Field.Revert;
  end;
end;

procedure TIB_CustomComboBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and (DataLink.Field <> nil) and
    not DataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    ^H, ^V, ^X, #32..#255:
      DataLink.Modify;
    #27:
    begin
      if DroppedDown and (not (Style = csSimple)) then
        DroppedDown := False
      else
      begin
        SysDataChange( nil );
        SelectAll;
      end;
      Key := #0;
    end;
  end;
end;

procedure TIB_CustomComboBox.SetEditReadOnly;
begin
  if (Style in [ csDropDown, csSimple ]) and HandleAllocated then
    SendMessage( EditHandle, EM_SETREADONLY, Ord( not DataLink.Editing ), 0 );
end;

procedure TIB_CustomComboBox.WndProc(var Message: TMessage);
begin
  if not (csDesigning in ComponentState) then
  if not (csDestroying in ComponentState) then
    case Message.Msg of
      WM_COMMAND:
        if TWMCommand( Message ).NotifyCode = CBN_SELCHANGE then
// ********* start change by Wassim Haddad 11-Aug-2001 *********
          if not DataLink.CanModify then      // not DataLink.Modify
// ********* end change ****************************************
          begin
            if Style <> csSimple then
              PostMessage(Handle, CB_SHOWDROPDOWN, 0, 0);
            Exit;
          end;
      CB_SHOWDROPDOWN: begin
        if Message.WParam <> 0 then
// ********* start change by Wassim Haddad 11-Aug-2001 *********
//          DataLink.Modify
// ********* end change ****************************************
        else
        if not DataLink.Editing then
          SysDataChange( nil ); //Restore text
      end;
    end;

  inherited WndProc( Message );
end;

procedure TIB_CustomComboBox.ComboWndProc( var Message: TMessage;
  ComboWnd: HWnd; ComboProc: Pointer );
begin
  if not ( csDesigning in ComponentState ) then
    case Message.Msg of
      WM_LBUTTONDOWN:
        if ( Style = csSimple ) and ( ComboWnd <> EditHandle ) then
// ********* start change by Wassim Haddad 11-Aug-2001 *********
          if not DataLink.CanModify then      //if not DataLink.Modify then
// ********* end change ****************************************
              Exit;
    end;
  inherited ComboWndProc( Message, ComboWnd, ComboProc );
end;

procedure TIB_CustomComboBox.CMEnter( var Message: TCMEnter );
begin
  inherited;
  SysDataChange( nil );
end;

procedure TIB_CustomComboBox.CMExit( var Message: TCMExit );
begin
  try
    DataLink.UpdateData;
  except
    SelectAll;
    SetFocus;
    raise;
  end;
  inherited;
  SysDataChange( nil );
end;

procedure TIB_CustomComboBox.SetItems( const AValue: TStrings );
begin
  Items.Assign( AValue );
  SysDataChange( nil );
end;

function TIB_CustomComboBox.GetItemValues: TStrings;
begin
  if not Assigned( FItemValues ) then
    FItemValues := TIB_StringList.Create;
  Result := FItemValues;
end;

procedure TIB_CustomComboBox.SetItemValues(AValue: TStrings);
begin
  if not Assigned( FItemValues ) then
    FItemValues := TIB_StringList.Create;
  FItemValues.Assign( AValue );
  SysDataChange( nil );
end;

procedure TIB_CustomComboBox.BoundsChanged;
begin
  // ComboBoxes are a bit weird - in that their sizing is contrainted.
  // so all we do is repaint to see what happened.
  Repaint;
end;

// IIB_GridWinControl interface functions

function TIB_CustomComboBox.IBG_DisplayColumn: TObject;
begin
  Result := Field;
end;

function TIB_CustomComboBox.IBG_GetText: string;
begin
  // GetText is supposed to return the untranslated value of the field
  if Assigned( Field ) then
  begin
    Result := Field.DisplayText;
    // If the style restricts to the list then only return a value if
    // we find the it in the list...
    if (Style = csDropDownList) then
    begin
      if ItemValues.Count > 0 then
      begin
        if ItemValues.IndexOf( Field.DisplayText ) < 0 then
          Result := '';
      end
      else
      begin
        if Items.IndexOf( Field.DisplayText ) < 0 then
          Result := '';
      end;
    end;
  end
  else
    Result := '';
end;

function TIB_CustomComboBox.IBG_TranslateText(AVal: string): string;
var
  tmpIndex: integer;
begin
  // Result := Items.Strings[ ItemValues.IndexOf( AVal ) ];
  Result := AVal;
  // With csDropDown style any value is acceptable and so
  // ItemValues is ignored and no translation performed.
  if Style = csDropDownList then
  begin
    // let blank values pass straight through
    if Length(AVal) > 0 then
    begin
      // if separate itemvalues provided ensure given
      // value exists in that list.
      if ItemValues.Count > 0 then
      begin
        // If given value not found in ItemValues then
        // return blank, otherwise return corresponding
        // display value from Items list.
        tmpIndex := ItemValues.IndexOf( AVal );
        if tmpIndex >= 0 then
          Result := Items.Strings[ tmpIndex ]
        else
          Result := '';
      end
      else  // if no separate ItemValues defined
      begin
        // If given value not found in Items list then
        // return blank.  Otherwise the item will be
        // returned directly (already assigned to result)
        tmpIndex := Items.IndexOf( AVal );
        if tmpIndex < 0 then
          Result := '';
      end;
    end;
  end;
end;

function TIB_CustomComboBox.IBG_HasActiveChild: boolean;
begin
  Result := DroppedDown;
end;

procedure TIB_CustomComboBox.IBG_SetBorderStyle( AVal: TBorderStyle );
begin
  BorderStyle := AVal;
end;

function TIB_CustomComboBox.IBG_GetFont: TFont;
begin
  Result := Font;
end;

procedure TIB_CustomComboBox.IBG_SetFont( const AFont: TFont );
begin
  Font.Assign( AFont );
end;

procedure TIB_CustomComboBox.IBG_SetColor( AColor: TColor );
begin
  if Color <> AColor then
    Color := AColor;
end;

procedure TIB_CustomComboBox.IBG_SetVisible( AVal: boolean );
begin
  Visible := AVal;
end;

function TIB_CustomComboBox.IBG_GetAutoLabel: TObject;
begin
  Result := FAutoLabel;
end;
{$UNDEF IBC_ComboBox}

{------------------------------------------------------------------------------}

{$DEFINE IBC_ListBox}
// IBC_ListBox.INT

{$DEFINE IB_AutoLabel}
{$I IB_WinControl.IMP}
{$UNDEF IB_AutoLabel}

constructor TIB_CustomListBox.Create(AOwner: TComponent);
begin
  FIB_FieldDataLink := TIB_FieldDataLink.Create( Self );
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel := TIB_AutoLabel.Create( Self );
{$ENDIF}
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  DataLink.Control := Self;
  DataLink.OnStateChanged := StateChanged;
  DataLink.OnDataChange := DataChange;
  DataLink.OnUpdateData := Self.UpdateData;
  FItemValues := TIB_StringList.Create;
  TIB_StringList(FItemValues).OnChange := ValuesChanged;
end;

destructor TIB_CustomListBox.Destroy;
begin
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel.Free;
  FAutoLabel := nil;
{$ENDIF}
  DataSource := nil;
  DataLink.Control := nil;
  DataLink.OnStateChanged := nil;
  DataLink.OnDataChange := nil;
  DataLink.OnUpdateData := nil;
  FItemValues.Free;
  FItemValues := nil;
  inherited Destroy;
end;

procedure TIB_CustomListBox.Loaded;
begin
  inherited Loaded;
  SysStateChanged;
  SysDataChange( nil );
{$IFDEF IBO_VCL30_OR_GREATER}
  RemakeAutoLabel;
{$ENDIF}
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomListBox.SysStateChanged;
begin
  with DataLink do
    if ColorScheme then
      inherited Color := Color;
  UpdateTabStop;
end;

procedure TIB_CustomListBox.SysDataChange;
var
  tmpColor: TColor;
begin
  if DataLink.ColorScheme then
  begin
    tmpColor := DataLink.Color;
    if inherited Color <> tmpColor then
    begin
      inherited Color := tmpColor;
      Invalidate;
    end;
  end;
  Value := DataLink.FieldText;
end;

procedure TIB_CustomListBox.SysUpdateData;
begin
  DataLink.FieldText := Value;
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomListBox.Click;
begin
  if DataLink.Modify then
  begin
    inherited Click;
    DataLink.ControlIsModified := true;
// Added by NVE 29/07/1999
// without this changes are not immediately visible in other datalinked controls
// test : have several data-aware components linked to the same field as the
// component based on TIB_CustomListbox, click on a new value in the listbox and
// the change should be visible in the other components too
    try
      SysUpdateData( Field );
    except
      SetFocus;
      raise;
    end;
//
  end;
end;

procedure TIB_CustomListBox.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  if Key in [VK_PRIOR, VK_NEXT, VK_END, VK_HOME, VK_LEFT, VK_UP,
    VK_RIGHT, VK_DOWN] then
// Modified by NVE 29/07/1999
// without this changes are not immediately visible in other datalinked controls
//    if not DataLink.Modify then Key := 0;
    if not DataLink.Modify then
      Key := 0
    else
    begin
      try
        SysUpdateData( Field );
      except
        SetFocus;
        raise;
      end;
    end;
//
end;

procedure TIB_CustomListBox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    #32..#255: if not DataLink.Modify then Key := #0;
    #27: SysDataChange( nil );
  end;
end;

procedure TIB_CustomListBox.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if DataLink.Modify then begin
    inherited
  end else begin
    SetFocus;
    with Message do MouseDown(mbLeft, KeysToShiftState(Keys), XPos, YPos);
  end;
end;

procedure TIB_CustomListBox.CMEnter(var Message: TCMEnter);
begin
  inherited;
end;

procedure TIB_CustomListBox.CMExit(var Message: TCMExit);
begin
  try
    SysUpdateData( Field );
  except
    SetFocus;
    raise;
  end;
  inherited;
end;

procedure TIB_CustomListBox.SetItems( AValue: TStrings );
begin
  Items.Assign( AValue );
  SysDataChange( nil );
end;

procedure TIB_CustomListBox.SetItemValues(AValue: TStrings);
begin FItemValues.Assign(AValue); end;
procedure TIB_CustomListBox.ValuesChanged( Sender: TObject );
begin SysDataChange( nil ); end;

function TIB_CustomListBox.GetValue: string;
begin
  Result := '';
  if (ItemIndex >= 0) then
  begin
    if Assigned(FItemValues) and (ItemIndex < FItemValues.Count) then
      Result := FItemValues.Strings[ItemIndex]
    else
      Result := Items.Strings[ItemIndex];
  end;
end;

procedure TIB_CustomListBox.SetValue( const AValue: string );
var
  ii: Integer;
begin
  if AValue = '' then
  begin
    ItemIndex := -1;
  end
  else
  begin
    if Assigned( FItemValues ) and ( FItemValues.Count > 0 ) then
    begin
      for ii := 0 to FItemValues.Count - 1 do
      begin
        //NOTE// Use case-sensitive comparison here
        if CompareStr( FItemValues.Strings[ii], AValue ) = 0 then
        begin
          if ii < Items.Count then
          begin
            ItemIndex := ii;
            Exit;
          end;
          Break;
        end;
      end;
    end;
    ItemIndex := Items.IndexOf(AValue);
  end;
end;

//Added by NVE 21/07/1999
procedure TIB_CustomListBox.CreateWnd;
begin
  inherited;
  if not (csDesigning in ComponentState) and
     Parent.InheritsFrom(TCustomEdit) then
  begin
    Windows.SetParent( Handle, 0 );
    CallWindowProc( DefWndProc, Handle, WM_SETFOCUS, 0, 0 );
  end;
end;

procedure TIB_CustomListBox.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if not (csDesigning in ComponentState) then
  begin
    if Parent.InheritsFrom(TCustomEdit) then
    begin
      with Params do
      begin
        Style := Style or WS_BORDER;
        ExStyle := WS_EX_TOOLWINDOW;
        WindowClass.Style := CS_SAVEBITS;
      end;
    end;
  end;
end;
{$UNDEF IBC_ListBox}

{$DEFINE IBC_RadioGroup}
// IBC_RadioGroup.INT

{$DEFINE IB_AutoLabel}
{$I IB_WinControl.IMP}
{$UNDEF IB_AutoLabel}

constructor TIB_CustomRadioGroup.Create(AOwner: TComponent);
begin
  FIB_FieldDataLink := TIB_FieldDataLink.Create( Self );
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel := TIB_AutoLabel.Create( Self );
{$ENDIF}
  inherited Create(AOwner);
  inherited TabStop := false;
  ControlStyle := [csSetCaption, csDoubleClicks, csReplicatable];
  FIB_FieldDataLink.Control := Self;
  FIB_FieldDataLink.OnStateChanged := StateChanged;
  FIB_FieldDataLink.OnDataChange := DataChange;
  FIB_FieldDataLink.OnUpdateData := UpdateData;
  FButtons := TList.Create;
  FItems := TIB_StringList.Create;
  FValues := TIB_StringList.Create;
  TIB_StringList(FItems).OnChange := ItemsChange;
  TIB_StringList(FValues).OnChange := ItemsChange;
  FItemIndex := -1;
  FColumns := 1;
  FBorderStyle := bsSingle;
  FTabStop := true;
  ArrangeButtons;
end;

destructor TIB_CustomRadioGroup.Destroy;
begin
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel.Free;
  FAutoLabel := nil;
{$ENDIF}
  DataSource := nil;
  with DataLink do
  begin
    Control := nil;
    OnStateChanged := nil;
    OnDataChange := nil;
    OnUpdateData := nil;
  end;
  TStringList(FItems).OnChange := nil;
  TStringList(FValues).OnChange := nil;
  Destroying;
  SetButtonCount( 0 );
  FValues.Free;
  FValues := nil;
  FItems.Free;
  FItems := nil;
  FButtons.Free;
  FButtons := nil;
  inherited Destroy;
end;

procedure TIB_CustomRadioGroup.Loaded;
begin
  inherited Loaded;
  if BorderStyle = bsNone then
    With Datalink do
    begin
      if DisplayLabelAsCaption and Assigned( Field ) then
        Caption := Field.DisplayLabel;
    end;
  SysStateChanged;
  SysDataChange( nil );
{$IFDEF IBO_VCL30_OR_GREATER}
  RemakeAutoLabel;
{$ENDIF}
end;

procedure TIB_CustomRadioGroup.SetDisplayLabelAsCaption( AValue: boolean );
begin
  if DisplayLabelAsCaption <> AValue then
  begin
    FDisplayLabelAsCaption := AValue;
    if DisplayLabelAsCaption then
      SysStateChanged;
  end;
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomRadioGroup.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of Longint = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do begin
    Style := longint(Style) or longint(BorderStyles[FBorderStyle]);
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

procedure TIB_CustomRadioGroup.Paint;
begin
// Cause no default painting to occur.
// This is to remove the internal caption and box.
  //RV?? this will show TIB_radioGroup the samee way as TRadioGroup
  if BorderStyle = bsNone then
  begin
    inherited;
    With Datalink do
    begin
      if DisplayLabelAsCaption and Assigned( Field ) then
        Caption := Field.DisplayLabel;
    end;
  end;
end;

procedure TIB_CustomRadioGroup.ArrangeButtons;
var
  ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer;
  DC: HDC;
  SaveFont: HFont;
  Metrics: TTextMetric;
begin
  if (FButtons.Count <> 0) and not FReading then begin
    DC := GetDC(0);
    SaveFont := SelectObject(DC, Font.Handle);
    GetTextMetrics(DC, Metrics);
    SelectObject(DC, SaveFont);
    ReleaseDC(0, DC);
    ButtonsPerCol := (FButtons.Count + Columns - 1) div Columns;
    ButtonWidth := (Width - 10) div Columns;
    //I := Height - 5;
    //RV?? Change according to TRadioGroup components from Delphi
    if Borderstyle = bsSingle then
      I := Height - 5
    else
      I := Height - Metrics.tmHeight - 5;
    ButtonHeight := I div ButtonsPerCol;
    //TopMargin := (I mod ButtonsPerCol) div 2 + 1;
    //RV?? Change according to TRadioGroup components from Delphi
    if Borderstyle = bsSingle then
      TopMargin := (I mod ButtonsPerCol) div 2 + 5
    else
      TopMargin := Metrics.tmHeight + 1 + (I mod ButtonsPerCol) div 2;
    for I := 0 to FButtons.Count - 1 do begin
      with TRadioButton(FButtons[I]) do begin
        SetBounds((I div ButtonsPerCol) * ButtonWidth + 8,
          (I mod ButtonsPerCol) * ButtonHeight + TopMargin,
          ButtonWidth, ButtonHeight);
        Visible := True;
      end;
    end;
    SetButtonTabStops;
  end;
end;

procedure TIB_CustomRadioGroup.SetButtonTabStops;
var
  I: Integer;
begin
  for I := 0 to FButtons.Count - 1 do begin
    with TRadioButton(FButtons[I]) do begin
      TabStop := Self.TabStop and
                 ((( I = 0 ) and ( ItemIndex < 0 )) or ( I = ItemIndex ));
    end;
  end;
end;

{------------------------------------------------------------------------------}
{ TIB_GroupButton                                                              }
{------------------------------------------------------------------------------}

type
  TIB_GroupButton = class(TRadioButton)
  private
    FInClick: Boolean;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  protected
    procedure ChangeScale(M, D: Integer); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
  public
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
  end;

constructor TIB_GroupButton.Create( AOwner: TComponent );
begin
  inherited Create( AOwner );
  ControlStyle := ControlStyle + [csReplicatable];
  if AOwner is TIB_RadioGroup then begin
    (AOwner as TIB_RadioGroup).FButtons.Add(Self);
    Enabled := (AOwner as TIB_RadioGroup).Enabled;
    OnClick := (AOwner as TIB_RadioGroup).ButtonClick;
  end;
  Visible := false;
  ParentShowHint := false;
  Parent := AOwner as TIB_RadioGroup;
end;

destructor TIB_GroupButton.Destroy;
begin
  TIB_RadioGroup(Owner).FButtons.Remove(Self);
  inherited Destroy;
end;

procedure TIB_GroupButton.CNCommand(var Message: TWMCommand);
begin
  if not TIB_RadioGroup(Parent).FInSetValue then
  if not FInClick then begin
    FInClick := True;
    try
      if ((Message.NotifyCode = BN_CLICKED      ) or
          (Message.NotifyCode = BN_DOUBLECLICKED)) and
         TIB_RadioGroup(Parent).CanModify then begin
{
with Message do begin
  ShowMessage( 'Msg: '    + IntToStr( Msg )    + #13#10 +
               'ItemID: ' + IntToStr( ItemID ) + #13#10 +
               'Ctl: '    + IntToStr( Ctl )    + #13#10 +
               'Result: ' + IntToStr( Result ));
end;
}
//        if not TIB_RadioGroup(Parent).FInSetValue then
        inherited;
      end;
    except
      Application.HandleException(Self);
    end;
    FInClick := False;
  end;
end;

procedure TIB_GroupButton.ChangeScale(M, D: Integer);
begin
// Disable ScaleBy for the child controls.
end;

procedure TIB_GroupButton.KeyPress(var Key: Char);
begin
  TIB_RadioGroup(Parent).KeyPress(Key);
  if Key in [ ^H, ' ' ] then
    if TIB_RadioGroup(Parent).CanModify then
    begin
      Key := #0;
      if Checked then
        TIB_RadioGroup(Parent).Value := '' // Don't set Checked := false!
      else
        Checked := true;
    end;
  inherited KeyPress(Key);
end;

procedure TIB_GroupButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  TIB_RadioGroup(Parent).KeyDown(Key, Shift);
  inherited KeyDown(Key, Shift);
end;

procedure TIB_GroupButton.KeyUp(var Key: Word; Shift: TShiftState);
begin
  TIB_RadioGroup(Parent).KeyUp(Key, Shift);
  inherited KeyUp(Key, Shift);
end;

{------------------------------------------------------------------------------}
{ TIB_RadioGroup                                                               }
{------------------------------------------------------------------------------}

procedure TIB_CustomRadioGroup.ButtonClick(Sender: TObject);
begin
  if not TabStop then begin
  // Keep a TabStop false RadioGroup with all its buttons set to false.
    (Sender as TWinControl).TabStop := false;
  end;
  if not FEditing then begin
    FItemIndex := FButtons.IndexOf(Sender);
    Click;
  end;
end;

procedure TIB_CustomRadioGroup.ItemsChange(Sender: TObject);
begin
  if ( Sender = FItems ) and not FReading then begin
    if FItemIndex >= FItems.Count then begin
      FItemIndex := FItems.Count - 1;
    end;
    UpdateButtons;
  end;
  SysDataChange( nil );
end;

procedure TIB_CustomRadioGroup.ReadState(Reader: TReader);
begin
  FReading := True;
  try
    inherited ReadState(Reader);
  finally
    FReading := False;
  end;
  UpdateButtons;
end;

procedure TIB_CustomRadioGroup.SetButtonCount(AValue: Integer);
begin
  while FButtons.Count < AValue do TIB_GroupButton.Create(Self);
  while FButtons.Count > AValue do TIB_GroupButton(FButtons.Last).Free;
end;

procedure TIB_CustomRadioGroup.SetItemIndex(AValue: Integer);
begin
  if FReading then begin
    FItemIndex := AValue;
  end else begin
    if AValue < -1 then begin
      AValue := -1;
    end;
    if AValue >= FButtons.Count then begin
      AValue := FButtons.Count - 1;
    end;
    if FItemIndex <> AValue then begin
      if FItemIndex >= 0 then begin
        TIB_GroupButton(FButtons[FItemIndex]).Checked := False;
      end;
      FItemIndex := AValue;
      if FItemIndex >= 0 then begin
        TIB_GroupButton(FButtons[FItemIndex]).Checked := True;
      end;
    end;
  end;
end;

procedure TIB_CustomRadioGroup.SetColumns(AValue: Integer);
begin
  if AValue < 1 then begin
    AValue := 1;
  end;
  if AValue > 16 then begin
    AValue := 16;
  end;
  if FColumns <> AValue then begin
    FColumns := AValue;
    ArrangeButtons;
  end;
end;

procedure TIB_CustomRadioGroup.UpdateButtons;
var
  I: Integer;
begin
  SetButtonCount(FItems.Count);
  for I := 0 to FButtons.Count - 1 do begin
    TIB_GroupButton(FButtons[I]).Caption := FItems[I];
  end;
  if FItemIndex >= 0 then begin
    FEditing := True;
    try
      TIB_GroupButton(FButtons[FItemIndex]).Checked := True;
    finally
      FEditing := False;
    end;
  end;
  ArrangeButtons;
end;

procedure TIB_CustomRadioGroup.CMFontChanged(var Message: TMessage);
begin
  inherited;
  ArrangeButtons;
end;

procedure TIB_CustomRadioGroup.WMSize(var Message: TWMSize);
begin
  inherited;
  ArrangeButtons;
end;

{$IFDEF IBO_VCL30_OR_GREATER}
procedure TIB_CustomRadioGroup.GetChildren(Proc:TGetChildProc; Root:TComponent);
{$ELSE}
procedure TIB_CustomRadioGroup.GetChildren(Proc: TGetChildProc );
{$ENDIF}
begin
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomRadioGroup.SysDataChange;
var
  tmpColor: TColor;
begin
  if DataLink.ColorScheme then
  begin
    tmpColor := DataLink.Color;
    if inherited Color <> tmpColor then
    begin
      inherited Color := tmpColor;
      Invalidate;
    end;
  end;
  Value := DataLink.FieldText;
end;

procedure TIB_CustomRadioGroup.SysStateChanged;
var
  ii: Integer;
begin
  for ii := 0 to FButtons.Count - 1 do 
    TIB_GroupButton(FButtons[ii]).Enabled := Enabled;
  if DataLink.ColorScheme then
    inherited Color := DataLink.Color;
  UpdateTabStop;
end;

procedure TIB_CustomRadioGroup.SysUpdateData;
begin
  if DataLink.ControlIsModified then
  begin
    DataLink.FieldText := Value;
  end;
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomRadioGroup.CMEnter( var Message: TCMEnter );
begin
  inherited;
  SysDataChange( nil );
end;

procedure TIB_CustomRadioGroup.CMExit( var Message: TCMExit );
begin
  try
    SysUpdateData( Field );
  except
    if ItemIndex >= 0 then begin
      TRadioButton(Controls[ItemIndex]).SetFocus;
    end else begin
      TRadioButton(Controls[0]).SetFocus;
    end;
    raise;
  end;
  inherited;
end;

procedure TIB_CustomRadioGroup.Click;
var
  NewItemIndex: integer;
begin
  if not FInSetValue then
  begin
    NewItemIndex := ItemIndex;
    if DataLink.Modify then
    begin
      inherited Click;
      Value := GetItemValue(NewItemIndex);
      SysUpdateData( Field );
    end;
  end;
end;

procedure TIB_CustomRadioGroup.Change;
begin
  with DataLink do
  begin
    if Editing or ( ParamName <> '' ) then
      ControlIsModified := true;
  end;
  if Assigned( FOnChange ) then
    FOnChange(Self);
end;

procedure TIB_CustomRadioGroup.KeyPress(var Key: Char);
begin
  inherited KeyPress( Key );
  if not ReadOnly then
    case Key of
      #8, ' ': DataLink.Modify;
      #27: SysDataChange( nil );
    end;
end;

{------------------------------------------------------------------------------}

function TIB_CustomRadioGroup.GetItemValue( Index: Integer ): string;
begin
  if ( Index < FValues.Count ) and ( FValues[Index] <> ''  ) then
    Result := FValues[Index]
  else
  if Index < Items.Count then
    Result := Items[Index]
  else
    Result := '';
end;

procedure TIB_CustomRadioGroup.SetValue( const AValue: string );
var
  ii, Index: Integer;
begin
   if ( FValue <> AValue ) and
      (( not ReadOnly ) or Datalink.DataChanging ) then
   begin
    FInSetValue := True;
    try
      Index := -1;
      for ii := 0 to Items.Count - 1 do
      begin
        if AValue = GetItemValue(ii) then
        begin
          Index := ii;
          Break;
        end;
      end;
      ItemIndex := Index;
      if Index > -1 then
      begin
        if Focused then
        begin
          TRadioButton(FButtons[ Index ]).SetFocus;
        end
        else
        for ii := 0 to FButtons.Count - 1 do
        begin
          if TRadioButton(FButtons[ii]).Focused then
          begin
            TRadioButton(FButtons[ Index ]).SetFocus;
            Break;
          end;
        end;
      end
      else
      for ii := 0 to FButtons.Count - 1 do
      begin
        if TRadioButton(FButtons[ii]).Checked then
        begin
          TRadioButton(FButtons[ Index ]).Checked := false;
          Break;
        end;
      end;
    finally
      FInSetValue := False;
    end;
    FValue := AValue;
    Change;
  end;
  SetButtonTabStops;
end;

procedure TIB_CustomRadioGroup.SetItems(AValue: TStrings);
begin
  Items.Assign(AValue);
end;

procedure TIB_CustomRadioGroup.SetValues(AValue: TStrings);
begin
  FValues.Assign(AValue);
end;

procedure TIB_CustomRadioGroup.SetTabStop( AValue: boolean );
begin
  if TabStop <> AValue then
  begin
    FTabStop := AValue;
    SetButtonTabStops;
  end;
end;
{$UNDEF IBC_RadioGroup}

{$DEFINE IBC_Image}
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.IMP}
{$UNDEF IB_AutoLabel}
{$UNDEF IBC_Image}

constructor TIB_CustomImage.Create(AOwner: TComponent);
begin
  FIB_FieldDataLink := TIB_FieldDataLink.Create( Self );
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel := TIB_AutoLabel.Create( Self );
{$ENDIF}
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csFramed, csOpaque, csReplicatable];
  Width := 105;
  Height := 105;
  TabStop := true;
  ParentColor := false;
  FPicture := TPicture.Create;
  FPicture.OnChange := PictureChanged;
  FBorderStyle := bsSingle;
  FAutoDisplay := true;
  FCenter := true;
  FQuickDraw := true;
  FKeepScale := true;
  DataLink.Control := Self;
  DataLink.OnStateChanged := StateChanged;
  DataLink.OnDataChange := DataChange;
  DataLink.OnUpdateData := UpdateData;
end;

destructor TIB_CustomImage.Destroy;
begin
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel.Free;
  FAutoLabel := nil;
{$ENDIF}
  DataSource := nil;
  with DataLink do begin
    Control := nil;
    OnStateChanged := nil;
    OnDataChange := nil;
    OnUpdateData := nil;
  end;
  Destroying;
  FPicture.Free;
  FPicture := nil;
  inherited Destroy;
end;

procedure TIB_CustomImage.Loaded;
begin
  inherited Loaded;
  SysDataChange( nil );
{$IFDEF IBO_VCL30_OR_GREATER}
  RemakeAutoLabel;
{$ENDIF}
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomImage.SysStateChanged;
begin
  with DataLink do
    if ColorScheme then
      inherited Color := Color;
  UpdateTabStop;
end;

procedure TIB_CustomImage.SysDataChange;
begin
  if not FIsUpdating and ( FIgnorePictureChange = 0 ) then
    if Assigned( Field ) and Field.IsBlob then
      with Field as TIB_ColumnBlob do
      begin
        Inc( FIgnorePictureChange );
        try
          Picture.Graphic := nil;
        finally
          Dec( FIgnorePictureChange );
        end;
        FPictureLoaded := false;
        if IsNull or AutoDisplay then
          LoadPicture;
        if IsNull or IsLoaded and not FPictureLoaded then
          LoadPicture
        else
          Invalidate;
      end;
end;

procedure TIB_CustomImage.SysUpdateData;
begin
  with DataLink do
  begin
    if ControlIsModified then
    begin
      if Assigned( Field ) and Field.IsBlob and not FIsUpdating then
      begin
        with Field as TIB_ColumnBlob do
        begin
          FIsUpdating := true;
          try
            InternalUpdateData;
          finally
            FPictureLoaded := true;
            FIsUpdating := false;
          end;
        end;
      end;
    end;
  end;
end;

procedure TIB_CustomImage.InternalUpdateData;
begin
  if Assigned( Picture.Graphic ) and ( not Picture.Graphic.Empty ) then
    Field.Assign( Picture.Graphic )
  else
    Field.Clear;
end;

procedure TIB_CustomImage.LoadPicture;
begin
  if not FPictureLoaded and ( FIgnorePictureChange = 0 ) then
  begin
    Inc( FIgnorePictureChange );
    try
      if Assigned( Field ) and not Field.IsNull and Field.IsBlob then
        InternalLoadPicture
      else
        Picture.Graphic := nil;
    finally
      Dec( FIgnorePictureChange );
    end;
    FPictureLoaded := true;
  end;
end;

procedure TIB_CustomImage.InternalLoadPicture;
begin
  try
    Field.AssignTo( Picture.Bitmap );
  except
    try
      Field.AssignTo( Picture.MetaFile );
    except
      try
         Field.AssignTo( Picture.Icon );
       except
         raise Exception.Create( 'Not a Bitmap, Metafile or Icon' );
       end;
    end;
  end;
end;

procedure TIB_CustomImage.PictureChanged(Sender: TObject);
begin
  SysPictureChanged;
  if FIgnorePictureChange = 0 then
  begin
    with DataLink do
    begin
      if Modify then
      begin
        ControlIsModified := true;
        FPictureLoaded := true;
        if not Focused then
          UpdateData;
      end;
    end;
  end;
  Invalidate;
end;

procedure TIB_CustomImage.SysPictureChanged;
begin
  if AutoSize and ( Align <> alClient ) then
  begin
    if (Picture.Width > 0) and (Picture.Height > 0) then
      SetBounds(Left, Top, Picture.Width, Picture.Height)
    else
      SetBounds(Left, Top, 100, 100);
  end;
end;

{------------------------------------------------------------------------------}

function TIB_CustomImage.GetPalette: HPALETTE;
begin
  Result := 0;
  if FPicture.Graphic is TBitmap then
    Result := TBitmap(FPicture.Graphic).Palette;
end;

procedure TIB_CustomImage.SetAutoDisplay( AValue: Boolean );
begin
  if AutoDisplay <> AValue then
  begin
    FAutoDisplay := AValue;
    if AValue then
      LoadPicture;
  end;
end;

procedure TIB_CustomImage.SetCenter( AValue: boolean );
begin
  if FCenter <> AValue then
  begin
    FCenter := AValue;
    Invalidate;
  end;
end;

procedure TIB_CustomImage.SetPicture( AValue: TPicture );
begin
  FPicture.Assign( AValue );
end;

procedure TIB_CustomImage.SetStretch( AValue: boolean );
begin
  if FStretch <> AValue then
  begin
    FStretch := AValue;
    Invalidate;
  end;
end;

procedure TIB_CustomImage.SetKeepScale( AValue: boolean );
begin
  if FKeepScale <> AValue then
  begin
    FKeepScale := AValue;
    Invalidate;
  end;
end;

procedure TIB_CustomImage.SetAutoSize( AValue: boolean );
begin
  if AutoSize <> AValue then
  begin
    FAutoSize := AValue;
    if AutoSize then
      Align := alNone;
    Inc( FIgnorePictureChange );
    try
      PictureChanged( Picture );
    finally
      Dec( FIgnorePictureChange );
    end;
  end;
end;

{------------------------------------------------------------------------------}

procedure TIB_CustomImage.CopyToClipboard;
begin
  if Picture.Graphic <> nil then
    Clipboard.Assign(Picture);
end;

procedure TIB_CustomImage.CutToClipboard;
begin
  if Picture.Graphic <> nil then
  begin
    if DataLink.Modify then
    begin
      CopyToClipboard;
      Picture.Graphic := nil;
    end;
  end;
end;

procedure TIB_CustomImage.PasteFromClipboard;
begin
  if ( Clipboard.HasFormat( CF_BITMAP )) and
     ( DataLink.Modify ) then
    Picture.Bitmap.Assign( Clipboard );
end;

procedure TIB_CustomImage.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  if FBorderStyle = bsSingle then
    Params.Style := Params.Style or WS_BORDER;
end;

procedure TIB_CustomImage.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);
  case Key of
  VK_INSERT:
    if ssShift in Shift then
      PasteFromClipBoard
    else
      if ssCtrl in Shift then
        CopyToClipBoard;
  VK_DELETE:
    if ssShift in Shift then
      CutToClipBoard
    else
      Picture.Graphic := nil;
  end;
end;

procedure TIB_CustomImage.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    ^X: CutToClipBoard;
    ^C: CopyToClipBoard;
    ^V: PasteFromClipBoard;
    #13: if not FPictureLoaded then LoadPicture
                               else DataLink.UpdateData;
    #27: SysDataChange( nil );
  end;
end;

procedure TIB_CustomImage.CMEnter(var Message: TCMEnter);
begin
  Invalidate;
  inherited;
end;

procedure TIB_CustomImage.CMExit(var Message: TCMExit);
begin
  DataLink.UpdateData;
  Invalidate;
  inherited;
end;

procedure TIB_CustomImage.CMTextChanged(var Message: TMessage);
begin
  inherited;
  if not FPictureLoaded then Invalidate;
end;

procedure TIB_CustomImage.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if TabStop and CanFocus then SetFocus;
  inherited;
end;

procedure TIB_CustomImage.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  LoadPicture;
  inherited;
end;

procedure TIB_CustomImage.WMCut(var Message: TMessage);
begin
  CutToClipboard;
end;

procedure TIB_CustomImage.WMCopy(var Message: TMessage);
begin
  CopyToClipboard;
end;

procedure TIB_CustomImage.WMPaste(var Message: TMessage);
begin
  PasteFromClipboard;
end;

procedure TIB_CustomImage.Paint;
var
  cx: integer;
  ratio: double;
  R: TRect;
  S: string;
  DrawPict: TPicture;
  Pal: HPalette;
{$IFDEF IBO_VCL30_OR_GREATER}
  Form: TCustomForm;
{$ELSE}
  Form: TForm;
{$ENDIF}
begin
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := Color;
    if Assigned( Field ) and
       ( FPictureLoaded or (csPaintCopy in ControlState)) then
    begin
      DrawPict := TPicture.Create;
      Pal := 0;
      try
        if (csPaintCopy in ControlState) and
           Assigned(Field) and Field.IsBlob then
        begin
          Field.AssignTo( DrawPict );
          if DrawPict.Graphic is TBitmap then
          begin
            DrawPict.Bitmap.IgnorePalette := QuickDraw;
          end;
        end
        else
        begin
          DrawPict.Assign( Picture );
          if Focused and ( DrawPict.Graphic is TBitmap ) and
            ( DrawPict.Bitmap.Palette <> 0 ) then
          begin
          { Control has focus, so realize the bitmap palette in foreground }
            Pal := SelectPalette(Handle, DrawPict.Bitmap.Palette, False);
            RealizePalette(Handle);
          end;
        end;
        SetRect( R, 0, 0, DrawPict.Width, DrawPict.Height );
        if Stretch and KeepScale then
        begin
          // *** Make sure the rectangle is setup as (0, 0, width, height)
          // when you enter here, we use the R.Right and R.Bottom directly
          //
          // dont draw anything except background if nothing to draw OR
          // if the right/bottom is zero (empty rectangle would cause zero div)
          if (DrawPict.Graphic = nil) or DrawPict.Graphic.Empty or
            (R.Right <= 0) or (R.Bottom <= 0) then
            FillRect(ClientRect)
          else
          begin
            ratio := R.Right / R.Bottom;
            if ratio > 1.0 then // if wider than high, try filling width-wise
            begin
              R.Right := ClientWidth;
              R.Bottom := Trunc(R.Right / ratio);
              cx := ClientHeight;
              if R.Bottom > cx then // if too high, fill height-wise
              begin
                R.Bottom := cx;
                R.Right := Trunc(cx * ratio);
              end;
            end
            else    // if higher than wide (or square), try filling height-wise
            begin
              R.Bottom := ClientHeight;
              R.Right := Trunc(R.Bottom * ratio);
              cx := ClientWidth;
              if R.Right > cx then  // if too wide, fill width-wise
              begin
                R.Right := cx;
                R.Bottom := Trunc(cx / ratio);
              end;
            end;
            if Center then
              OffsetRect( R, (ClientWidth  - R.Right ) div 2,
                             (ClientHeight - R.Bottom) div 2);
            StretchDraw( R, DrawPict.Graphic );
            // clear any area not used
            ExcludeClipRect(Handle, R.Left, R.Top, R.Right, R.Bottom);
            FillRect(ClientRect);
            SelectClipRgn(Handle, 0);
          end;
        end
        else if Stretch or AutoSize then
        begin
          if ( DrawPict.Graphic = nil ) or DrawPict.Graphic.Empty then
            FillRect(ClientRect)
          else
            StretchDraw( ClientRect, DrawPict.Graphic );
        end
        else
        begin
          if Center then
            OffsetRect( R, (ClientWidth  - DrawPict.Width ) div 2,
                           (ClientHeight - DrawPict.Height) div 2);
          StretchDraw( R, DrawPict.Graphic );
          ExcludeClipRect(Handle, R.Left, R.Top, R.Right, R.Bottom);
          FillRect(ClientRect);
          SelectClipRgn(Handle, 0);
        end;
      finally
        if Pal <> 0 then SelectPalette(Handle, Pal, True);
        DrawPict.Free;
      end;
    end
    else
    begin
      Font := Self.Font;
      S := DataLink.FieldText;
      R := ClientRect;
      FillRect( R );
      TextRect( R, (R.Right  - TextWidth (S)) div 2,
                   (R.Bottom - TextHeight(S)) div 2, S );
    end;
    if Assigned( FOnCustomPaint ) then
      FOnCustomPaint( Canvas ); 
    Form := GetParentForm(Self);
    if (Form <> nil) and (Form.ActiveControl = Self) and
      not (csDesigning in ComponentState) and
      not (csPaintCopy in ControlState) then
    begin
      Brush.Color := clWindowFrame;
      FrameRect(ClientRect);
    end;
  end;
end;

procedure TIB_CustomImage.SetName( const AValue: TComponentName );
begin
  inherited SetName( AValue );
  if csDesigning in ComponentState then
  begin
    Invalidate;
  end;
end;

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

{$DEFINE IBC_TrackBar}
{$DEFINE IB_AutoLabel}
{$I IB_WinControl.IMP}
{$UNDEF IB_AutoLabel}
{$UNDEF IBC_TrackBar}

constructor TIB_CustomTrackbar.Create(AOwner: TComponent);
begin
  FIB_FieldDataLink := TIB_FieldDataLink.Create( Self );
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel := TIB_AutoLabel.Create( Self );
{$ENDIF}
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  DataLink.Control := Self;
  DataLink.OnStateChanged := StateChanged;
  DataLink.OnDataChange := DataChange;
  DataLink.OnUpdateData := UpdateData;
  FBorderStyle := bsNone;
  FDisplayLabelAsCaption := false;
  Position := 0;
  FDataChanging := false;
end;

destructor TIB_CustomTrackbar.Destroy;
begin
{$IFDEF IBO_VCL30_OR_GREATER}
  FAutoLabel.Free;
  FAutoLabel := nil;
{$ENDIF}
  DataSource := nil;
  DataLink.Control := nil;
  DataLink.OnStateChanged := nil;
  DataLink.OnDataChange := nil;
  DataLink.OnUpdateData := nil;
  inherited Destroy;
end;

procedure TIB_CustomTrackbar.Loaded;
begin
  inherited Loaded;
  SysStateChanged;
  SysDataChange( nil );
end;

procedure TIB_CustomTrackbar.SysStateChanged;
begin
  if Field is TIB_ColumnNumBase then
    with Field as TIB_ColumnNumBase do
    begin
      if CheckMinVal then Self.Min := Trunc( MinVal );
      if CheckMaxVal then Self.Max := Trunc( MaxVal );
    end;
  if Enabled and not ( csDesigning in ComponentState ) then
    EnableWindow( Handle, DataLink.CanModify );
  if DisplayLabelAsCaption and Assigned( Field ) then
    Caption := Field.DisplayName
  else
  if csDesigning in ComponentState then
    Caption := Name;
  if ( BorderStyle = bsSingle ) and DataLink.ColorScheme then
  begin
    if Color <> DataLink.Color then
    begin
      Color := DataLink.Color;
      RecreateWnd;
    end;
  end;
end;

procedure TIB_CustomTrackbar.SysDataChange( IB_Field: TIB_Column );
begin
  Position := StrToIntDef( DataLink.FieldText, 0 );
end;

procedure TIB_CustomTrackbar.SysUpdateData(IB_Field: TIB_Column);
begin
  DataLink.FieldText := IntToStr( Position );
end;

{$IFNDEF IBO_VCL50_OR_GREATER}

procedure TIB_CustomTrackBar.CNHScroll(var Message: TWMHScroll);
begin
  inherited;
  DataLink.ControlIsModified := true;
end;

procedure TIB_CustomTrackBar.CNVScroll(var Message: TWMVScroll);
begin
  inherited;
  DataLink.ControlIsModified := true;
end;

{$ELSE}

procedure TIB_CustomTrackbar.Changed;
begin
  inherited Changed;
  DataLink.ControlIsModified := true;
end;

{$ENDIF}

procedure TIB_CustomTrackbar.CMEnter(var Message: TCMEnter);
begin
  inherited;
end;

procedure TIB_CustomTrackbar.CMExit(var Message: TWMNoParams);
begin
  try
    DataLink.UpdateData;
  except
    SetFocus;
    raise;
  end;
  inherited;
end;

procedure TIB_CustomTrackbar.KeyPress(var Key: Char);
begin
  case Ord(key) of
    VK_ESCAPE:
    begin
      if DataLink.CanModify then
      begin
        DataLink.Reset;
        Key := #0;
      end;
      if (( DataLink.State = dssSearch ) or SearchAlways ) and
         ( DataLink.FieldText <> '' ) then
      begin
        Position := Min;
        DataLink.FieldText := '';
      end;
    end;
    VK_UP,
    VK_DOWN,
    VK_LEFT,
    VK_RIGHT,
    VK_END,
    VK_HOME,
    VK_PRIOR,
    VK_NEXT: if not DataLink.CanModify then
      Key := #0;
  end;
  inherited KeyPress(Key);
end;

procedure TIB_CustomTrackbar.SetDisplayLabelAsCaption( AValue: boolean );
begin
  if DisplayLabelAsCaption <> AValue then
  begin
    FDisplayLabelAsCaption := AValue;
    if DisplayLabelAsCaption then
      SysStateChanged;
  end;
end;

procedure TIB_CustomTrackBar.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of integer = (0, WS_BORDER);
begin
  inherited CreateParams( Params );
  with Params do
  begin
    Style := longint(Style) or longint(BorderStyles[FBorderStyle]);
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
  end;
end;

{$UNDEF IB_FieldControl}

end.
