{*************************************************************************}
{ TCloudLookupEdit component                                              }
{ for Delphi & C++Builder                                                 }
{                                                                         }
{ written by TMS Software                                                 }
{           copyright © 2012                                              }
{           Email : info@tmssoftware.com                                  }
{           Web : http://www.tmssoftware.com                              }
{                                                                         }
{ The source code is given as is. The author is not responsible           }
{ for any possible damage done due to the use of this code.               }
{ The component can be freely used in any application. The complete       }
{ source code remains property of the author and may not be distributed,  }
{ published, given or sold in any form as such. No parts of the source    }
{ code can be included in any other component or application without      }
{ written authorization of the author.                                    }
{*************************************************************************}

unit CloudLookupEdit;

{$I TMSDEFS.INC}

interface

uses
  Windows, Dialogs, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, Character, CloudBase;

const
  MAJ_VER = 1; // Major version nr.
  MIN_VER = 0; // Minor version nr.
  REL_VER = 0; // Release nr.
  BLD_VER = 0; // Build nr.

  // version history
  // v1.0.0.0 : First release

const
  LOOKUPITEMHEIGHT = 12;

type
  {$IFDEF DELPHI_UNICODE}
  THintInfo = Controls.THintInfo;
  PHintInfo = Controls.PHintInfo;
  {$ENDIF}

  TLabelPosition = (lpLeftTop, lpLeftCenter, lpLeftBottom, lpTopLeft, lpBottomLeft,
    lpLeftTopLeft, lpLeftCenterLeft, lpLeftBottomLeft, lpTopCenter, lpBottomCenter,
    lpRightTop, lpRightCenter, lpRighBottom, lpTopRight, lpBottomRight);

  TValueValidateEvent = procedure(Sender: TObject; value: string; var IsValid: Boolean) of object;

  TClipboardEvent = procedure(Sender: TObject; value: string; var allow: Boolean) of object;

  TLookupSelectEvent = procedure(Sender: TObject; var Value: string) of object;

  TLookupIndexSelectEvent = procedure(Sender: TObject; Index: Integer; var Value: string) of object;

  TWinCtrl = class(TWinControl)
  public
    procedure PaintCtrls(DC: HDC; First: TControl);
  end;


  TItemClickEvent = procedure(Sender: TObject; Index: Integer) of object;

  TListBoxTab = class(TListBox)
  private
    FHandleTab: boolean;
    procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
  published
    property HandleTab: boolean read FHandleTab write FHandleTab;
  end;

  { TListHintWindow }
  TListHintWindow = class(THintWindow)
  private
    FListControl: TListBox;
    procedure WMNCButtonDown(var Message: TMessage); message WM_NCLBUTTONDOWN;
    procedure WMActivate(var Message: TMessage); message WM_ACTIVATE;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property BorderWidth;
    property Text;
  published
    property ListControl: TListBox read FListControl write FListControl;
  end;

  TLookupSettings = class(TPersistent)
  private
    FDisplayCount: Integer;
    FColor: TColor;
    FEnabled: Boolean;
    FNumChars: Integer;
    FAcceptOnTab: boolean;
    FValues: TStringList;
    FProvider: TCloudLookupProvider;
    procedure SetNumChars(const Value: Integer);
    procedure SetValues(const Value: TStringList);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property Values: TStringList read FValues write SetValues;
  published
    property AcceptOnTab: boolean read FAcceptOnTab write FAcceptOnTab default False;
    property Color: TColor read FColor write FColor default clWindow;
    property DisplayCount: Integer read FDisplayCount write FDisplayCount default 4;
    property Enabled: Boolean read FEnabled write FEnabled default False;
    property NumChars: Integer read FNumChars write SetNumChars default 2;
    property Provider: TCloudLookupProvider read FProvider write FProvider;
  end;

  TURLClickEvent = procedure(Sender: TObject; URL: string; var Show: Boolean) of object;

  TEditLabel = class(TLabel)
  private
    FAlwaysEnable: boolean;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
  published
    property AlwaysEnable: boolean read FAlwaysEnable write FAlwaysEnable;
  end;


  {$IFDEF DELPHIXE2_LVL}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64)]
  {$ENDIF}
  TAdvCloudLookupEdit = class(TCustomEdit)
  private
    { Private declarations }
    FLabel: TEditLabel;
    FLabelFont: TFont;
    FLabelPosition: TLabelPosition;
    FLabelMargin: Integer;
    FLabelTransparent: Boolean;
    FAutoFocus: Boolean;
    FCanUndo: Boolean;
    FOldBorder: TBorderStyle;
    FExcelStyleDecimalSeparator: Boolean;
    FTabOnFullLength: Boolean;
    FDisabledColor: TColor;
    FDisabledBorder: boolean;
    FNormalColor: TColor;
    FFocusColor: TColor;
    FFocusFontColor: TColor;
    FErrorColor: TColor;
    FErrorFontColor: TColor;
    FError: Boolean;
    FFocusLabel: Boolean;
    FFontColor: TColor;
    FModifiedColor: TColor;
    FShowModified: Boolean;
    FIsModified: Boolean;
    FShowURL: Boolean;
    FURLColor: TColor;
    FFocusWidthInc: Integer;
    FLengthLimit: SmallInt;
    FPrefix: string;
    FSuffix: string;
    FOldString: string;
    FIsUrl: Boolean;
    FFlat: Boolean;
    FMouseInControl: Boolean;
    FFlatLineColor: TColor;
    FOnValueValidate: TValueValidateEvent;
    FOnClipboardCut: TClipboardEvent;
    FOnClipboardPaste: TClipboardEvent;
    FOnClipboardCopy: TClipboardEvent;
    FBlockCopy: boolean;
    FFlatParentColor: Boolean;
    FTransparent: Boolean;
    FCaretPos: TPoint;
    FButtonDown: Boolean;
    FFocusBorder: Boolean;
    FFocusBorderColor: TColor;
    FBorderColor: TColor;
    FHintShowLargeText: Boolean;
    FShowError: Boolean;
    FEmptyText: string;
    FEmptyTextFocused: boolean;
    FEmptyTextStyle: TFontStyles;
    FSoftBorder: Boolean;
    FLabelAlwaysEnabled: Boolean;
    FBorder3D: Boolean;
    FErrorMarkerLen: Integer;
    FErrorMarkerPos: Integer;
    FIndentR: Integer;
    FIndentL: Integer;
    FLoadedHeight: Integer;
    FLookupList: TListHintWindow;
    FLookupListBox: TListboxTab;
    FLookup: TLookupSettings;
    FOnLookupSelect: TLookupSelectEvent;
    FOnLookupIndexSelect: TLookupIndexSelectEvent;
    FIsValidating: Boolean;
    FOnMouseEnter: TNotifyEvent;
    FOnMouseLeave: TNotifyEvent;
    FOnURLClick: TURLClickEvent;
    FOnLabelClick: TNotifyEvent;
    FOnLabelDblClick: TNotifyEvent;
    FIsWinXP: Boolean;
    FIsThemed: Boolean;
    FParentFnt: boolean;
    FFullTextSearch: boolean;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure WMActivate(var Message: TMessage); message WM_ACTIVATE;
    procedure CNCtlColorEdit(var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;
    procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMCancelMode(var Message: TMessage); message CM_CANCELMODE;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure CMHintShow(var Msg: TMessage); message CM_HINTSHOW;
    procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
    procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
    procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
    procedure WMChar(var Msg: TWMKey); message WM_CHAR;
    procedure WMPaste(var Msg: TMessage); message WM_PASTE;
    procedure WMCut(var Message: TWMCut); message WM_CUT;
    procedure WMCopy(var Message: TWMCopy); message WM_COPY;
    procedure WMKeyDown(var Msg: TWMKeydown); message WM_KEYDOWN;
    procedure WMSysKeyDown(var Msg: TMessage); message WM_SYSKEYDOWN;
    procedure WMLButtonUp(var Msg: TWMMouse); message WM_LBUTTONUP;
    procedure WMLButtonDown(var Msg: TWMMouse); message WM_LBUTTONDOWN;
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
    procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure WMDestroy(var Msg: TMessage); message wm_Destroy; //***
    procedure WMMouseMove(var Msg: TWMMouse); message WM_MOUSEMOVE;
    procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
    function GetText: string;
    procedure SetText(value: string);
    procedure SetPrefix(const Value: string);
    procedure SetSuffix(const Value: string);
    procedure SetLabelCaption(const value: string);
    function GetLabelCaption: string;
    procedure SetLabelPosition(const value: TLabelPosition);
    procedure SetLabelMargin(const value: integer);
    procedure SetLabelTransparent(const value: boolean);
    procedure SetFlat(const value: boolean);
    procedure SetFlatRect(const Value: Boolean);
    procedure UpdateLabel;
    procedure UpdateLabelPos;
    function GetModified: boolean;
    procedure SetModified(const Value: boolean);
    function GetVisible: boolean;
    procedure SetVisible(const Value: boolean);
    procedure PaintEdit;
    procedure DrawControlBorder(DC: HDC);
    procedure DrawBorder;
    function Is3DBorderButton: Boolean;
    procedure SetDisabledColor(const Value: TColor);
    procedure SetDisabledBorder(const Value: boolean);
    procedure SetCanUndo(const Value: boolean);
    function GetColorEx: TColor;
    procedure SetColorEx(const Value: TColor);
    procedure SetTransparent(const Value: boolean);
    procedure SetFlatLineColor(const Value: TColor);
    procedure SetFlatParentColor(const Value: boolean);
    procedure LabelFontChange(Sender: TObject);
    procedure SetLabelFont(const Value: TFont);
    procedure ApplyErrorColor;
    function GetError: Boolean;
    procedure SetError(const Value: Boolean);
    procedure ApplyURL(const Value: Boolean);
    procedure DrawErrorLines(Canvas: TCanvas; ErrPos, ErrLen: Integer);
    function GetVersion: string;
    procedure SetVersion(const Value: string);
    procedure CloseLookup;
    procedure DoneLookup;
    function GetHeightEx: Integer;
    procedure ListKeyPress(Sender: TObject; var Key: Char);
    procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SetBorder3D(const Value: Boolean);
    procedure SetEmptyText(const Value: string);
    procedure SetErrorMarkerLen(const Value: Integer);
    procedure SetErrorMarkerPos(const Value: Integer);
    procedure SetFocusBorder(const Value: Boolean);
    procedure SetHeightEx(const Value: Integer);
    procedure SetLabelAlwaysEnabled(const Value: Boolean);
    procedure SetSoftBorder(const Value: Boolean);
    procedure UpdateLookup;
    procedure SetBorderColor(const Value: TColor);
    procedure SetEmptyTextStyle(const Value: TFontStyles);
    function GetLookupVisible: boolean;
  protected
    procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
    function GetVersionNr: Integer; virtual;
    { Protected declarations }
    procedure Change; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    function CreateLabel: TEditLabel;
    procedure Loaded; override;
    procedure InvalidateCaret(pt: tpoint);
    procedure EraseCaret;
    procedure DrawCaretByCursor;
    procedure SetCaretByCursor;
    property IndentR: Integer read FIndentR write FIndentR;
    property IndentL: Integer read FIndentL write FIndentL;
    function DoValidate(value: string): Boolean; virtual;
    procedure ValidateEvent(Value: string; var IsValid: Boolean); virtual;
    procedure LabelClick(Sender: TObject);
    procedure LabelDblClick(Sender: TObject);
    procedure SetParent(AParent: TWinControl); override;
    procedure SetEnabled(Value: Boolean); override;
    procedure SetTextDirect(s:string);
    function TestURL: Boolean; virtual;
    {$IFDEF DELPHI_UNICODE}
    procedure ChangeScale(M, D: Integer); override;
    {$ENDIF}
  public
    { Public declarations }
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure SelectAll;
    procedure SelectBeforeDecimal;
    procedure SelectAfterDecimal;
    procedure Init;
    procedure Clear; override;
    function GetTextSize: integer;
    function CharFromPos(pt: TPoint): Integer;
    function PosFromChar(uChar: word): TPoint;
    property Modified: Boolean read GetModified write SetModified;
    property IsError: Boolean read GetError write SetError;
    procedure SetEditText(AValue: string);
    property OrigText: string read FOldString write FOldString;
    property LookupVisible: boolean read GetLookupVisible;
    property EditLabel: TEditLabel read FLabel;
    property Border3D: Boolean read FBorder3D write SetBorder3D;
  published
    { Published declarations }
    property OnValueValidate: TValueValidateEvent read FOnValueValidate write FOnValueValidate;
    property OnClipboardCopy: TClipboardEvent read FOnClipboardCopy write FOnClipboardCopy;
    property OnClipboardCut: TClipboardEvent read FOnClipboardCut write FOnClipboardCut;
    property OnClipboardPaste: TClipboardEvent read FOnClipboardPaste write FOnClipboardPaste;
    property AutoFocus: boolean read FAutoFocus write FAutoFocus default False;
    property BorderColor: TColor read FBorderColor write SetBorderColor default clNone;
    property EmptyText: string read FEmptyText write SetEmptyText;
    property EmptyTextFocused: boolean read FEmptyTextFocused write FEmptyTextFocused default false;
    property EmptyTextStyle: TFontStyles read FEmptyTextStyle write SetEmptyTextStyle;
    property ErrorMarkerPos: Integer read FErrorMarkerPos write SetErrorMarkerPos default 0;
    property ErrorMarkerLen: Integer read FErrorMarkerLen write SetErrorMarkerLen default 0;
    property ErrorColor: TColor read FErrorColor write FErrorColor default clRed;
    property ErrorFontColor: TColor read FErrorFontColor write FErrorFontColor default clWhite;
    property Flat: boolean read FFlat write SetFlat default False;
    property FlatLineColor: TColor read fFlatLineColor write SetFlatLineColor default clBlack;
    property FlatParentColor: boolean read fFlatParentColor write SetFlatParentColor default true;
    property FocusBorder: Boolean read FFocusBorder write SetFocusBorder default False;
    property FocusBorderColor: TColor read FFocusBorderColor write FFocusBorderColor default clNone;
    property FocusColor: TColor read FFocusColor write FFocusColor default clNone;
    property FocusFontColor: TColor read FFocusFontColor write FFocusFontColor default clWindowText;
    property FocusLabel: Boolean read FFocusLabel write FFocusLabel default false;
    property FocusWidthInc: Integer read FFocusWidthInc write FFocusWidthInc default 0;
    property FullTextSearch: boolean read FFullTextSearch write FFullTextSearch default false;
    property Height: Integer read GetHeightEx write SetHeightEx;
    property ModifiedColor: TColor read FModifiedColor write FModifiedColor default clHighlight;
    property DisabledBorder: Boolean read FDisabledBorder write SetDisabledBorder default true;
    property DisabledColor: TColor read FDisabledColor write SetDisabledColor default clSilver;
    property ShowError: Boolean read FShowError write FShowError default False;
    property ShowModified: Boolean read FShowModified write FShowModified default False;
    property ShowURL: Boolean read FShowURL write FShowURL default False;
    property SoftBorder: Boolean read FSoftBorder write SetSoftBorder default False;
    property URLColor: TColor read FURLColor write FURLColor default clBlue;
    property LengthLimit: smallint read fLengthLimit write FLengthLimit default 0;
    property TabOnFullLength: boolean read fTabOnFullLength write FTabOnFullLength default False;
    property Prefix: string read FPrefix write SetPrefix;
    property Suffix: string read FSuffix write SetSuffix;
    property LabelCaption: string read GetLabelCaption write SetLabelCaption;
    property LabelPosition: TLabelPosition read FLabelPosition write SetLabelPosition default lpLeftTop;
    property LabelMargin: Integer read FLabelMargin write SetLabelMargin default 4;
    property LabelTransparent: Boolean read FLabelTransparent write SetLabelTransparent default False;
    property LabelAlwaysEnabled: Boolean read FLabelAlwaysEnabled write SetLabelAlwaysEnabled default False;
    property LabelFont: TFont read FLabelFont write SetLabelFont;
    property Lookup: TLookupSettings read FLookup write FLookup;
    property BevelEdges;
    property BevelInner;
    property BevelKind;
    property BevelOuter;
    property Align;
    property Anchors;
    property BiDiMode;
    property ParentBiDiMode;
    property Constraints;
    property DragKind;
    property OnEndDock;
    property OnStartDock;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property CanUndo: boolean read FCanUndo write SetCanUndo default True;
    property CharCase;
    property Color: TColor read GetColorEx write SetColorEx;
    property Ctl3D;
{$IFDEF DELPHI_UNICODE}
    property DoubleBuffered;
{$ENDIF}
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property Hint;
    property HintShowLargeText: boolean read FHintShowLargeText write FHintShowLargeText default False;
    property ImeMode;
    property ImeName;
    property MaxLength;
    property OEMConvert;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
{$IFDEF WIN32}
    property PopupMenu;
{$ENDIF}
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text: string read GetText write SetText;
    property Transparent: boolean read FTransparent write SetTransparent default False;
    property Visible: Boolean read GetVisible write SetVisible;
    property OnChange;
    property OnClick;
    property OnDblClick;
{$IFDEF WIN32}
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnStartDrag;
{$ENDIF}
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
    property OnMouseUp;
    property OnContextPopup;
    property OnLookupSelect: TLookupSelectEvent read FOnLookupSelect write FOnLookupSelect;
    property OnLookupIndexSelect: TLookupIndexSelectEvent read FOnLookupIndexSelect write FOnLookupIndexSelect;
    property OnLabelClick: TNotifyEvent read FOnLabelClick write FOnLabelClick;
    property OnLabelDblClick: TNotifyEvent read FOnLabelDblClick write FOnLabelDblClick;
    property OnURLClick: TURLClickEvent read FOnURLClick write FOnURLClick;

    property Version: string read GetVersion write SetVersion;
  end;

  PQueryParams = ^TQueryParams;
  TQueryParams = record
    Precision: Integer;
    Flat: Boolean;
    Lengthlimit: Integer;
    Prefix: string;
    Suffix: string;
  end;

const
  BorderRec: array[TBorderStyle] of Integer = (1, -1);

implementation

uses
  Shellapi, ActiveX, Consts, Inifiles, Registry, Clipbrd, Math;

const
  Ctrl_Codes = [vk_back, vk_tab, vk_return];
  Numeric_Codes = [ord('0')..ord('9'), ord('-')];
  Money_Codes = Numeric_Codes;
  Float_Codes = Numeric_Codes + [ord(','), ord('.')];
  Range_Codes = Numeric_Codes + [ord(','), ord(';')];
  Hex_Codes = Numeric_Codes + [ord('A')..ord('F'), ord('a')..ord('f')];
  Bin_Codes = ['0', '1'];
  AlphaNum_Codes = [ord('0')..ord('9')] + [ord('a')..ord('z'), ord('A')..ord('Z')];

{$I DELPHIXE.INC}

{$IFNDEF DELPHI7_LVL}
function GetFileVersion(FileName:string): Integer;
var
  FileHandle:dword;
  l: Integer;
  pvs: PVSFixedFileInfo;
  lptr: uint;
  querybuf: array[0..255] of char;
  buf: PChar;
begin
  Result := -1;

  StrPCopy(querybuf,FileName);
  l := GetFileVersionInfoSize(querybuf,FileHandle);
  if (l>0) then
  begin
    GetMem(buf,l);
    GetFileVersionInfo(querybuf,FileHandle,l,buf);
    if VerQueryValue(buf,'\',Pointer(pvs),lptr) then
    begin
      if (pvs^.dwSignature=$FEEF04BD) then
      begin
        Result := pvs^.dwFileVersionMS;
      end;
    end;
    FreeMem(buf);
  end;
end;
{$ENDIF}

function IsVista: boolean;
var
  hKernel32: HMODULE;
begin
  hKernel32 := GetModuleHandle('kernel32');
  if (hKernel32 > 0) then
  begin
    Result := GetProcAddress(hKernel32, 'GetLocaleInfoEx') <> nil;
  end
  else
    Result := false;
end;

function RangeListCompare(Item1, Item2: Pointer): Integer;
begin
  if integer(Item1) > integer(Item2) then Result := 1 else
    if integer(Item1) = integer(Item2) then Result := 0 else Result := -1;
end;

function CheckTerminator(ch: char): boolean;
const
  Terminators = [' ', ',', '.', '/', '\', ':', '*', '$', '-', '(', ')', '[', ']', '"','''','&'];
begin
  {$IFNDEF DELPHI_UNICODE}
  Result := ch in Terminators;
  {$ENDIF}
  {$IFDEF DELPHI_UNICODE}
  Result := (ch = ' ') or (ch = ',') or (ch = '.') or (ch = '-') or (ch = '''') or
    (ch = '\') or (ch = '/') or (ch = ':') or (ch = '*') or (ch = '$') or (ch = ')') or (ch = ')') or (ch = '"');
  {$ENDIF}
end;

function ShiftCase(Name: string): string;

  {$IFNDEF DELPHI_UNICODE}
  function LowCase(C: char): char;
  begin
    if C in ['A'..'Z'] then
      LowCase := Chr(Ord(C) - Ord('A') + Ord('a'))
    else
      Lowcase := C;
  end;
  {$ENDIF}


var
  I, L: Integer;
  NewName: string;
  First: Boolean;
begin
  First := true;
  NewName := Name;
  L := Length(Name);
  for I := 1 to L do
  begin
    if CheckTerminator(NewName[I]) then
      First := true
    else
      if First then
      begin
        {$IFNDEF DELPHI_UNICODE}
        NewName[I] := Upcase(Name[I]);
        {$ENDIF}
        {$IFDEF DELPHI_UNICODE}
        NewName[I] := character.ToUpper(Name[I]);
        {$ENDIF}
        First := false;
      end
      else
      begin
        {$IFNDEF DELPHI_UNICODE}
        NewName[I] := Lowcase(Name[I]);
        {$ENDIF}
        {$IFDEF DELPHI_UNICODE}
        NewName[I] := character.ToLower(Name[I]);
        {$ENDIF}
      end;

    if (Copy(NewName, 1, I) = 'Mc') or (Copy(NewName, 1, I) = 'Mac') or
      ((Pos(' Mc', NewName) = I - 2) and (I > 2)) or
      ((I > L - 3) and ((Copy(NewName, I - 1, 2) = ' I') or
      (Copy(NewName, I - 2, 3) = ' II'))) then
      First := true;
  end;
  ShiftCase := NewName;
end;


function StripThousandSep(s: string): string;
begin
  while (Pos(ThousandSeparator, s) > 0) do
    Delete(s, Pos(ThousandSeparator, s), 1);
  Result := s;
end;

{$IFNDEF DELPHI6_LVL}
function TryStrToFloat(s: string; var f: extended): boolean;
begin
  Result := false;
  try
    f := StrToFloat(s);
    Result := true;
  except
    f := 0;
  end;
end;
{$ENDIF}


function HexToInt(s: string): Integer;
var
  i: Integer;
  r, m: Integer;

  function CharVal(c: char): Integer;
  begin
    Result := 0;
    if ((c >= '0') and (c <= '9')) then Result := ord(c) - ord('0');
    if ((c >= 'A') and (c <= 'F')) then Result := ord(c) - ord('A') + 10;
    if ((c >= 'a') and (c <= 'f')) then Result := ord(c) - ord('a') + 10;
  end;

begin
  r := 0;
  m := 1;
  for i := Length(s) downto 1 do
  begin
    r := r + m * CharVal(s[i]);
    m := m shl 4;
  end;
  Result := r;
end;

procedure TWinCtrl.PaintCtrls(DC: HDC; First: TControl);
begin
  PaintControls(DC, First);
end;

function TAdvCloudLookupEdit.CharFromPos(pt: TPoint): Integer;
begin
  Result := Loword(SendMessage(self.Handle, EM_CHARFROMPOS, 0, makelparam(pt.x, pt.y)));
end;

procedure TAdvCloudLookupEdit.Clear;
begin
  Text := '';
end;

function TAdvCloudLookupEdit.PosFromChar(uChar: word): TPoint;
var
  pt: tpoint;
  l: Integer;
  DC: HDC;
  s: string;
  sz: TSize;
  FLastChar: boolean;
begin
  s := inherited Text;

  if (uChar > Length(s)) then
    uChar := Length(s);

  FLastChar := (uChar >= Length(s));

  if FLastChar and (uChar = 0) then
  begin
    // empty text
    Result := Point(0, 0);
    Exit;
  end;

  if FLastChar then
    Dec(uChar);

  l := SendMessage(Handle, EM_POSFROMCHAR, uChar, 0);

  pt := Point(SmallInt(loword(l)), SmallInt(hiword(l)));
  if FLastChar then
  begin
    s := 'w' + Copy(s, Length(s), 1);
    DC := GetDC(Handle);
    try
      GetTextExtentPoint32(DC, PChar(s), 2, sz);
      pt.x := pt.x + sz.cx;
      GetTextExtentPoint32(DC, PChar(s), 1, sz);
      pt.x := pt.x - sz.cx;
    finally
      ReleaseDC(Handle, DC);
    end;
  end;
  Result := pt;
end;

function TAdvCloudLookupEdit.GetTextSize: Integer;
var
  DC: HDC;
  sz: TSize;
  holdFont: THandle;
begin
  DC := GetDC(Handle);
  holdFont := SelectObject(DC, Font.Handle);
  GetTextExtentPoint32(DC, pchar(Text), Length(Text), sz);
  result := sz.CX;
  SelectObject(DC, holdFont);
  ReleaseDC(Handle, DC);
end;


procedure TAdvCloudLookupEdit.InvalidateCaret(pt: TPoint);
var
  r: TRect;
begin
  r := rect(pt.x, pt.y, pt.x + 1, pt.y - Font.Height);
  InvalidateRect(self.Handle, @r, true);
end;

procedure TAdvCloudLookupEdit.EraseCaret;
var
  pt: TPoint;
begin
  pt := FCaretPos;
  FCaretPos := Point(-1, -1);
  InvalidateCaret(pt);
end;

procedure TAdvCloudLookupEdit.DrawCaretByCursor;
var
  nChar: Integer;
  pt, ptCursor: TPoint;
begin
  GetCursorPos(ptCursor);
  ptCursor := ScreenToClient(ptCursor);

  nChar := CharFromPos(ptCursor);

  pt := PosFromChar(nChar);

  if (fCaretPos.x <> pt.x) or (fCaretPos.y <> pt.y) then
  begin
    InvalidateCaret(fCaretPos);
    InvalidateCaret(pt);
    FCaretPos := pt;
  end;
end;

procedure TAdvCloudLookupEdit.SetCaretByCursor;
var
  ptCursor: TPoint;
  nChar: integer;
begin
  GetCursorPos(ptCursor);
  ptCursor := ScreenToClient(ptCursor);
  nChar := loword(SendMessage(self.Handle, EM_CHARFROMPOS, 0, makelong(ptCursor.x, ptCursor.y)));
  SelStart := nChar;
  SelLength := 0;
end;

function CheckSeparator(ch: char): boolean;
begin
  {$IFNDEF DELPHI_UNICODE}
  Result := ch in ['-', ',', ';'];
  {$ENDIF}

  {$IFDEF DELPHI_UNICODE}
  Result := (ch = '-') or (ch = ',') or (ch = ';');
  {$ENDIF}
end;

procedure TAdvCloudLookupEdit.WMChar(var Msg: TWMKey);
var
  s: string;
  isCtrl,ismod: Boolean;
  cf: TCustomForm;
  key: char;
begin
  IsCtrl := GetKeyState(VK_CONTROL) and $8000 = $8000;

  if (Msg.CharCode = VK_RETURN) and IsCtrl then
  begin
    Msg.CharCode := 0;
    Msg.Result := 1;
    Exit;
  end;

  // handle Ctrl-A
  if IsCtrl and (Msg.CharCode = 1) then
  begin
    SelectAll;
    Msg.CharCode := 0;
    Exit;
  end;

  // handle Ctrl-C, Ctrl-X, Ctrl-V
  if IsCtrl and (Msg.CharCode in [1, 3, 22, 24]) then
  begin
    inherited;
    Exit;
  end;

  if (msg.charcode = ord('.')) and (FExcelStyleDecimalSeparator) and (msg.keydata and $400000 = $400000) then
  begin
    msg.charcode := ord(decimalseparator);
  end;

  if (msg.charcode = ord(',')) and (FExcelStyleDecimalSeparator) and (msg.keydata and $400000 = $400000) then
  begin
    msg.charcode := ord(decimalseparator);
  end;

  if (msg.CharCode = vk_back) and (FPrefix <> '') then
    if (SelStart <= Length(FPrefix)) and (SelLength = 0) then Exit;


  if (msg.charcode = VK_BACK) then
  begin
    s := self.Text;

    if SelLength = 0 then
      delete(s, SelStart - Length(fprefix), 1)
    else
      delete(s, Max(1, SelStart - Length(fprefix)), SelLength);

    ismod := (s <> Text) or Modified;
    Modified := ismod;

    inherited;

    if (Text = '') and ((s <> '') or ismod) then
      Change;

    Modified := ismod;

    //if (lengthlimit > 0) and (fixedLength(s) - 1 > lengthlimit) then
    UpdateLookup;
    Exit;
  end;

  if IsCtrl and (Msg.CharCode = 10) then
    Exit;

  if (Msg.CharCode = VK_RETURN) then
  begin
    key := #13;
    if Assigned(OnKeyPress) then
      OnKeyPress(Self, key);

    Msg.CharCode := 0;
    Exit;
  end;

  SetModified(true);
  inherited;

  if (FTabOnFullLength) then
  begin
    if (FLengthlimit > 0) and (Length(Text) > FLengthLimit) and
      (SelLength = 0) and (SelStart = FLengthlimit) then
      begin
        cf := GetParentForm(self);
        if Assigned(cf) then
          cf.Perform(WM_NEXTDLGCTL, 0, 0);
      end;
  end;

  if inherited Modified then
    SetModified(true);

  UpdateLookup;
end;

procedure TAdvCloudLookupEdit.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(params);
    Params.Style := Params.Style or ES_MULTILINE;
end;

procedure TAdvCloudLookupEdit.CMFontChanged(var Message: TMessage);
begin
  if (csDesigning in ComponentState) or (csLoading in ComponentState) then
    if (FLabel <> nil) and ParentFont and not ShowError then
    begin
      FLabel.Font.Assign(Font);
    end;

  inherited;
  SetFlatRect(FFlat);
end;

procedure TAdvCloudLookupEdit.CMCancelMode(var Message: TMessage);
begin
  inherited;
  if FLookupList.Visible then
    FLookupList.Hide;
end;

procedure TAdvCloudLookupEdit.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if IsError and Enabled then
  begin
    ApplyErrorColor;
  end;
end;

procedure TAdvCloudLookupEdit.SetFlatRect(const Value: Boolean);
var
  loc: TRect;
  lft: integer;
begin
  if HandleAllocated then
  begin
    lft := 0;
    if not Ctl3D then
      lft := Font.Size div 3;

    if Value then
    begin
      loc.Left := lft + 4 + IndentL;
      loc.Top := 3;
      loc.Right := Clientrect.Right - 4 - IndentR - lft;
      loc.Bottom := Clientrect.Bottom - 4;
    end
    else
    begin
      loc.Left := lft + IndentL;
      loc.Top := 0;
      loc.Right := ClientRect.Right - IndentR - lft;
      loc.Bottom := ClientRect.Bottom;
    end;

    if not Ctl3D then
    begin
      loc.Left := Loc.Left + 1;
      loc.Right := loc.Right - 1;
    end;

    SendMessage(Handle, EM_SETRECTNP, 0, longint(@loc));
  end;
end;

procedure TAdvCloudLookupEdit.SetFlat(const value: boolean);
var
  OldColor: TColor;

begin
  if (csLoading in ComponentState) then
  begin
    FFlat := Value;
    Exit;
  end;

  if FFlat <> Value then
  begin
    FFlat := Value;
    if FFlat then
    begin
      OldColor := Color;
      if FFlatParentColor then
      begin
        Color := (Parent as TWinControl).Brush.Color;
        FocusColor := Color;
      end
      else
      begin
        Color := FNormalColor;
        FocusColor := FFocusColor;
      end;

      FNormalColor := OldColor;
      BorderStyle := bsNone;
      SetFlatRect(True);
    end
    else
    begin
      Color := FNormalColor;
      FocusColor := FFocusColor;
      BorderStyle := FOldBorder;
      SetFlatRect(False);
    end;
    Invalidate;
  end;
end;

procedure TAdvCloudLookupEdit.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
  inherited;
  if FTransparent then
    SetBkMode(Message.ChildDC, Windows.TRANSPARENT);
end;

procedure TAdvCloudLookupEdit.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
  inherited;
  if FTransparent then
    SetBkMode(Message.ChildDC, Windows.TRANSPARENT);
end;


procedure TAdvCloudLookupEdit.SetTransparent(const Value: boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    Invalidate;
  end;
end;

procedure TAdvCloudLookupEdit.SetFlatLineColor(const Value: TColor);
begin
  FFlatLineColor := Value;
  Invalidate;
end;

procedure TAdvCloudLookupEdit.SetFlatParentColor(const Value: boolean);
begin
  FFlatParentColor := Value;
  Invalidate;
end;

procedure TAdvCloudLookupEdit.SetEditText(AValue: string);
begin
  OrigText := AValue;
  Text := AValue;
end;

procedure TAdvCloudLookupEdit.SetCanUndo(const Value: boolean);
begin
  if FCanUndo <> Value then
  begin
    FCanUndo := Value;
  //CanUndo is not compatible with etPassword style
    ReCreateWnd;
  {force a proper re-alignment}
    self.Width := self.Width + 1;
    self.Width := self.Width - 1;
  end;
end;

procedure TAdvCloudLookupEdit.WMActivate(var Message: TMessage);
begin
  inherited;
end;

procedure TAdvCloudLookupEdit.WMKillFocus(var Msg: TWMKillFocus);
var
  IsValid: Boolean;
  TT: string;
begin
  if (csLoading in ComponentState) then
    Exit;

  if FLookupList.Visible and not (msg.FocusedWnd = FLookupList.Handle) then
    FLookupList.Hide;

  if not IsError then
  begin
    if (Color <> FNormalColor) then
    begin
      Color := FNormalColor;
      if FIsWinXP then
      begin
        Width := Width - 1;
        Width := Width + 1;
      end;
    end;
  end;

  if not ((IsError and ShowError) or (ShowModified)) then
  begin
    if not (TestURL and ShowURL) then
      Font.Color := FFontColor;
  end;

  if FFocusLabel and (FLabel <> nil) then
  begin
    FLabel.Font.Style := FLabel.Font.Style - [fsBold];
    UpdateLabelPos;
  end;

  IsValid := DoValidate(Self.Text);

  if not IsValid then
  begin
    Msg.Result := 0;
  end;

  inherited;

  if FFocusBorder then
  begin
    Width := Width - 1;
    Width := Width + 1;
  end;

  if FFocusWidthInc > 0 then
    Width := Width - FFocusWidthInc;

  if (EmptyText <> '') and (Text = '') then
    Invalidate;

  TT := Trim(Text);

  if (FFocusBorderColor <> clNone) or (FBorderColor <> clNone) then
    SendMessage(self.Handle, WM_NCPAINT, 0,0);

  if (ErrorMarkerLen > 0) then
    Invalidate;
end;

procedure TAdvCloudLookupEdit.SelectAll;
begin
  SelStart := 0;
  SelLength := Length(self.text);

  if (fPrefix <> '') then
  begin
    if (SelStart < Length(fPrefix)) then
    begin
      SelStart := Length(fPrefix);
      SelLength := Length(self.Text);
    end;
  end;

  if (fSuffix <> '') then
  begin
    SelStart := Length(fPrefix);
    SelLength := Length(self.Text);
  end;

  if (Pos('://', self.Text) > 0) and FShowURL then
  begin
    SelStart := Pos('://', self.text) + 2;
    SelLength := Length(self.text);
  end;

  if (Pos('mailto:', self.text) > 0) and FShowURL then
  begin
    SelStart := Pos('mailto:', self.text) + 6;
    SelLength := Length(self.text);
  end;
end;

procedure TAdvCloudLookupEdit.SelectBeforeDecimal;
var
  i: Integer;
begin
  i := Pos(decimalseparator, self.text);
  if (i > 0) then
    SelStart := i + Length(fPrefix) - 1
  else
    SelStart := Length(fPrefix);
end;

procedure TAdvCloudLookupEdit.SelectAfterDecimal;
var
  i: Integer;
begin
  i := Pos(decimalseparator, self.Text);

  if (i > 0) then
    SelStart := i + Length(fPrefix)
  else
    SelStart := Length(fPrefix);
end;


procedure TAdvCloudLookupEdit.WMSetFocus(var Msg: TWMSetFocus);
begin
  if csLoading in ComponentState then
    Exit;

  inherited;

  FOldString := Self.Text;

  if (FFocusColor <> clNone) and DoValidate(Self.Text) then
  begin
    inherited Color := FFocusColor;
    if FIsWinXP then
    begin
      Width := Width - 1;
      Width := Width + 1;
    end;
  end;

  if not ((IsError and ShowError) or (ShowModified)) then
  begin
    if (Font.Color <> FFontColor) then
      FFontColor := Font.Color;

    if not (TestURL and ShowURL) and (FFocusFontColor <> clNone) then
      Font.Color := FFocusFontColor;
  end;

  if AutoSelect then
    SelectAll;

  if FFocusLabel and (FLabel <> nil) then
  begin
    FLabel.Font.Style := FLabel.Font.Style + [fsBold];
    UpdateLabelPos;
  end;

  if (FFocusWidthInc > 0) then
    Width := Width + FFocusWidthInc;

  if ((EmptyText <> '') and (Text = '')) or (FocusBorder) or (FFocusBorderColor <> clNone) then
  begin
    if BorderStyle = bsNone then
      SetFlatRect(true);
    Invalidate;
  end;
end;

procedure TAdvCloudLookupEdit.WMSysKeyDown(var Msg: TMessage);
begin
  if Msg.WParam = VK_MENU then
  begin
    CloseLookup;
  end;

  inherited;
end;

constructor TAdvCloudLookupEdit.Create(AOwner: TComponent);
var
  VerInfo: TOSVersioninfo;
  i: integer;

begin
  inherited Create(aOwner);
  FFocusColor := clNone;
  FFocusFontColor := clWindowText;
  FNormalColor := clWindow;
  FFontColor := self.Font.Color;
  FBorderColor := clNone;
  FModifiedColor := clHighLight;
  FErrorColor := clRed;
  FErrorFontColor := clWhite;
  FError := False;
  FLabel := nil;
  FLabelMargin := 4;
  FURLColor := clBlue;
  FDisabledColor := clSilver;
  FDisabledBorder := true;
  FFlatParentColor := True;
  FFlatLineColor := clBlack;
  FCaretPos := point(-1, -1);
  FButtonDown := false;
  FMouseInControl := false;
  FCanUndo := True;
  FLabelFont := TFont.Create;
  FLabelFont.OnChange := LabelFontChange;
  FOldBorder := bsSingle;
  FFocusBorderColor := clNone;
  FIndentL := 0;
  FIndentR := 0;
  FEmptyTextFocused := false;
  VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  GetVersionEx(verinfo);

  FIsWinXP := (verinfo.dwMajorVersion > 5) or
    ((verinfo.dwMajorVersion = 5) and (verinfo.dwMinorVersion >= 1));

  // app is linked with COMCTL32 v6 or higher -> xp themes enabled
  i := GetFileVersion('COMCTL32.DLL');
  i := (i shr 16) and $FF;
  FIsThemed := (i > 5);

  if not (csDesigning in ComponentState) then
  begin
    FLookupList := TListHintWindow.Create(Self);
    FLookupList.Visible := False;
    FLookupList.Width := 0;
    FLookupList.Height := 0;
    //FLookupList.Parent := Self;
    FLookupList.BorderWidth := 1;
    FLookupList.ControlStyle := FLookupList.ControlStyle + [csReplicatable];
    FLookupListbox := TListBoxTab.Create(FLookupList);

    with FLookupListBox do
    begin
      Parent := FLookupList;
      Align := alClient;
      Style := lbOwnerDrawFixed;
      ItemHeight := LOOKUPITEMHEIGHT;
      Ctl3D := false;
      TabStop := true;
      BorderStyle := bsNone;
      TabOrder := 0;
      OnKeyPress := ListKeyPress;
      OnMouseUp := ListMouseUp;
      ControlStyle := Controlstyle + [csReplicatable];
    end;

    FLookupList.ListControl := FLookupListBox;
  end;

  FLookup := TLookupSettings.Create;

  FParentFnt := false;
end;

destructor TAdvCloudLookupEdit.Destroy;
begin
  if (FLabel <> nil) then
  begin
    FLabel.Parent := nil;
    FLabel.Free;
    FLabel := nil;
  end;

  FLabelFont.Free;
  FLookup.Free;

  inherited Destroy;
end;

procedure TAdvCloudLookupEdit.SetParent(AParent: TWinControl);
begin
  inherited;
  if FLabel <> nil then
    FLabel.Parent := AParent;
end;

procedure TAdvCloudLookupEdit.ApplyURL(const Value: Boolean);
begin
  if Value then
  begin
    FParentFnt := false;  
    Font.Style := Font.Style + [fsUnderline];
    Font.Color := FURLColor;
    FIsUrl := True;
    Cursor := crHandPoint;
    Invalidate;
  end
  else
  begin
    Font.Style := Font.Style - [fsUnderline];
    Font.Color := FFontColor;
    FIsUrl := False;
    Cursor := crDefault;
  end;
end;

procedure TAdvCloudLookupEdit.CNCommand(var Message: TWMCommand);
begin
  if (Message.NotifyCode = EN_CHANGE) then
    if FTransparent then
    begin
      Invalidate;
    end;

  if (Message.NotifyCode = EN_CHANGE) and (FShowURL) then
  begin
    if TestURL and not FIsUrl then
    begin
      ApplyURL(True);
    end
    else
      if FIsUrl and not TestURL then
      begin
        ApplyURL(False);
      end;
  end;

  inherited;
end;


procedure TAdvCloudLookupEdit.WMKeyDown(var Msg: TWMKeydown);
var
  selp: Integer;
  s: string;
  isCtrl: Boolean;
begin
  IsCtrl := GetKeyState(VK_CONTROL) and $8000 = $8000;

  if not FLookupList.Visible then
  begin
    if (msg.CharCode = VK_UP) or (msg.CharCode = VK_DOWN)  then
    begin
      DoKeyDown(Msg);
      msg.Result := 1;
      Exit;
    end;
  end;

  if (msg.CharCode = VK_RETURN) and FLookupList.Visible then
  begin
    DoneLookup;
    Exit;
  end;

  if (msg.CharCode in [VK_TAB, VK_RETURN]) and IsCtrl then
  begin
//    if msg.CharCode = VK_RETURN then
//      Msg.CharCode := 0;
//    Msg.Result := 1;
    inherited;
    Exit;
  end;

  if (msg.CharCode = VK_HOME) and FLookupList.Visible then
  begin
    FLookupListBox.ItemIndex := 0;
    Msg.result := 1;
    Exit;
  end;

  if (msg.CharCode = VK_END) and FLookupList.Visible then
  begin
    FLookupListBox.ItemIndex := FLookupListBox.Items.Count - 1;
    Msg.result := 1;
    Exit;
  end;

  if (msg.CharCode = VK_NEXT) and FLookupList.Visible then
  begin
    if FLookupListBox.ItemIndex + FLookup.DisplayCount < FLookupListBox.Items.Count then
      FLookupListBox.ItemIndex := FLookupListBox.ItemIndex + FLookup.DisplayCount
    else
      FLookupListBox.ItemIndex := FLookupListBox.Items.Count - 1;
    Msg.result := 1;
    Exit;
  end;

  if (msg.CharCode = VK_PRIOR) and FLookupList.Visible then
  begin
    if FLookupListBox.ItemIndex > FLookup.DisplayCount then
      FLookupListBox.ItemIndex := FLookupListBox.ItemIndex - FLookup.DisplayCount
    else
      FLookupListBox.ItemIndex := 0;
    Msg.result := 1;
    Exit;
  end;

  if (msg.charcode = VK_RIGHT) and (FSuffix <> '') then
  begin
    selp := hiword(SendMessage(self.handle, EM_GETSEL, 0, 0));
    if selp >= Length(self.text) then
    begin
      msg.CharCode := 0;
      msg.Result := 0;
      Exit;
    end;
  end;

  if (msg.charcode = VK_DELETE) and (FSuffix <> '') then
  begin
    selp := hiword(SendMessage(self.handle, EM_GETSEL, 0, 0));
    if (selp >= Length(self.text)) and (SelLength = 0) then
    begin
      msg.CharCode := 0;
      msg.Result := 0;
      Exit;
    end;
    SetModified(true);
  end;

  if (msg.charcode = VK_LEFT) and (FPrefix <> '') then
  begin
    selp := hiword(SendMessage(self.handle, EM_GETSEL, 0, 0));

    if selp <= Length(FPrefix) then
    begin
      msg.charcode := 0;
      msg.Result := 0;
      Exit;
    end;
  end;

  if (msg.charcode = VK_END) and (FSuffix <> '') then
  begin
    if (GetKeyState(VK_SHIFT) and $8000 = 0) then
    begin
      SelStart := Length(self.text);
      SelLength := 0;
    end
    else
      SelLength := Length(self.text) - SelStart;
    msg.charcode := 0;
    msg.Result := 0;
    Exit;
  end;

  if (msg.charcode = VK_HOME) and (FPrefix <> '') then
  begin
    if (getkeystate(VK_SHIFT) and $8000 = 0) then
    begin
      SelStart := Length(fPrefix);
      SelLength := 0;
    end
    else
    begin
      SendMessage(self.handle, EM_SETSEL, Length(fprefix) + Length(self.text), Length(fprefix));
    end;
    msg.Charcode := 0;
    msg.Result := 0;
    Exit;
  end;

  if (msg.charcode = VK_BACK) and (FPrefix <> '') then
  begin
    if (SelStart <= Length(FPrefix) + 1) then
    begin
      if Assigned(OnKeyDown) then
        OnKeyDown(Self, msg.CharCode,[]);
      msg.CharCode := 0;
      msg.Result := 0;
      Exit;
    end;
    SetModified(true);
  end;

  if (msg.CharCode = VK_DELETE) and (SelStart >= Length(FPrefix)) then
  begin
    s := self.text;
    if SelLength = 0 then
      Delete(s, SelStart - Length(fprefix) + 1, 1)
    else
      Delete(s, SelStart - Length(fprefix) + 1, SelLength);

    if (lengthlimit > 0) and (Length(s) - 1 > lengthlimit) then
    begin
      msg.CharCode := 0;
      msg.Result := 0;
      exit;
    end;
    SetModified(true);
  end;

  if (msg.CharCode = VK_UP) and FLookupList.Visible then
  begin
    if FLookupListBox.ItemIndex > 0 then
      FLookupListBox.ItemIndex := FLookupListBox.ItemIndex - 1;
    msg.CharCode := 0;
  end;

  if (msg.CharCode = VK_DOWN) and FLookupList.Visible then
  begin
    if FLookupListBox.ItemIndex + 1 < FLookupListBox.Items.Count then
      FLookupListBox.ItemIndex := FLookupListBox.ItemIndex + 1;
    msg.CharCode := 0;
  end;

  inherited;

  if (fPrefix <> '') and (SelStart < Length(fPrefix)) then
    SelStart := Length(fPrefix);
end;

procedure TAdvCloudLookupEdit.WMCopy(var Message: TWMCopy);
var
  Allow: Boolean;
begin
  Allow := True;
  if Assigned(FOnClipboardCopy) and not FBlockCopy then
    FOnClipboardCopy(self, copy(self.Text, SelStart + 1 - Length(fPrefix), SelLength), allow);
  FBlockCopy := False;  
  if Allow then inherited;
end;

procedure TAdvCloudLookupEdit.WMCut(var Message: TWMCut);
var
  Allow: Boolean;
begin
  Allow := True;
  FBlockCopy := True;
  if Assigned(FOnClipboardCut) then
  begin
    FOnClipboardCut(self, copy(self.text, SelStart + 1 - Length(fPrefix), SelLength), allow);
  end;

  if Allow then
    inherited;

  FBlockCopy := False;

  Change;
end;


procedure TAdvCloudLookupEdit.WMPaste(var Msg: TMessage);
var
{$IFNDEF DELPHI_UNICODE}
  Data: THandle;
  content: PChar;
{$ENDIF}
  newstr, cliptxt: string;
  newss, newsl: Integer;
  allow: Boolean;

  function InsertString(s: string): string;
  var
    ss: Integer;
  begin
    Result := self.text;
    ss := SelStart - Length(fPrefix);
    if (SelLength = 0) then
    begin
      insert(s, result, ss + 1);
      newsl := 0;
      newss := ss + Length(s) + Length(fPrefix);
    end
    else
    begin
      delete(result, ss + 1, SelLength);
      insert(s, result, ss + 1);
      newsl := Length(s);
      newss := ss + Length(fPrefix);
    end;
  end;

begin
  if ReadOnly then
    Exit;

  {$IFDEF DELPHI_UNICODE}
  if ClipBoard.HasFormat(CF_TEXT) then
  begin
    Allow := True;
    cliptxt := Clipboard.AsText;
    if pos(#13,cliptxt) > 0 then
      cliptxt := copy(cliptxt,1,pos(#13,cliptxt) - 1);
    newstr := InsertString(cliptxt);
  {$ENDIF}


{$IFNDEF DELPHI_UNICODE}

  if ClipBoard.HasFormat(CF_TEXT) then
  begin
    ClipBoard.Open;
    Data := GetClipBoardData(CF_TEXT);
    try
      if Data <> 0 then
        Content := PChar(GlobalLock(Data))
      else
        Content := nil
    finally
      if Data <> 0 then
        GlobalUnlock(Data);
      ClipBoard.Close;
    end;

    if Content = nil then
      Exit;

    Allow := True;

    cliptxt := StrPas(Content);
    if pos(#13,cliptxt) > 0 then
      cliptxt := copy(cliptxt,1,pos(#13,cliptxt) - 1);
    newstr := InsertString(cliptxt);

{$ENDIF}

    if Assigned(FOnClipboardPaste) then
      FOnClipboardPaste(self, newstr, Allow);

    if not Allow then Exit;

    if MaxLength > 0 then
    begin
{$IFNDEF DELPHI_UNICODE}
      if Length(StrPas(Content)) + Length(Self.Text) - SelLength > MaxLength then
{$ENDIF}

{$IFDEF DELPHI_UNICODE}
    if Length(Clipboard.AsText) + Length(Self.Text) - SelLength > MaxLength then
{$ENDIF}
        Exit;
    end;

    Allow := true;

  Self.Text := newstr;
  SetModified(True);
  end;

  UpdateLookup;

  if TabOnFullLength then
  begin
    if (length(self.Text) = LengthLimit) and (LengthLimit > 0) then
    begin
      Windows.SetFocus(GetNextDlgTabItem(Parent.Handle,self.Handle,true));
    end;
  end;
end;

procedure TAdvCloudLookupEdit.WMPaint(var Msg: TWMPaint);
begin
  inherited;
  PaintEdit;
  if Border3D or (FFocusBorderColor <> clNone) or (FBorderColor <> clNone) or (not Enabled and DisabledBorder) then
    DrawBorder;
end;

procedure TAdvCloudLookupEdit.PaintEdit;
var
  DC: HDC;
  Oldpen: HPen;
  Loc: TRect;
  Canvas: TCanvas;
begin
  if FFlat then
  begin
    DC := GetDC(Handle);
    if FFocusBorder and (GetFocus = Handle) then
    begin
      DrawControlBorder(DC);
    end
    else
    begin
      if FFlatLineColor <> clNone then
      begin
        if Enabled then
          OldPen := SelectObject(DC, CreatePen(PS_SOLID, 1, ColorToRGB(FFlatLineColor)))
        else
          OldPen := SelectObject(DC, CreatePen(PS_SOLID, 1, ColorToRGB(clGray)));
        SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
        if FSoftBorder then
        begin

          MovetoEx(DC, Loc.Left - 4 + IndentL, Height - 1, nil);
          LineTo(DC, Width - 1, Height - 1);
          LineTo(DC, Width - 1, Loc.Top - 3);
          LineTo(DC, Loc.Left - 4 + IndentL, Loc.Top - 3);
          LineTo(DC, Loc.Left - 4 + IndentL, Height - 1);
        end
        else
        begin
          MovetoEx(DC, Loc.Left - 2 + IndentL, Height - 1, nil);
          LineTo(DC, Width - IndentR, Height - 1);
        end;

        DeleteObject(SelectObject(DC, OldPen));
      end;
    end;

    ReleaseDC(Handle, DC);
  end;

  if (FCaretPos.x <> -1) and (FCaretPos.y <> -1) then
  begin
    DC := GetDC(Handle);
    Rectangle(DC, FCaretPos.x, FCaretPos.y, FCaretPos.x + 1, FCaretPos.y - Font.Height);
    ReleaseDC(Handle, DC);
  end;

  if (Text = '') and ( (FEmptyTextFocused) or (GetFocus <> Handle) ) and (FEmptyText <> '') then
  begin
    DC := GetDC(Handle);
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := DC;
      if IsVista then
      begin
        Canvas.Brush.Color := Color;
      end
      else
        SetBkMode(Canvas.Handle, windows.TRANSPARENT);

      Canvas.Font.Assign(Font);
      Canvas.Font.Style := EmptyTextStyle;
      Canvas.Font.Color := clGray;
      Canvas.TextOut(3, 2, FEmptyText);
    finally
      Canvas.Free;
      ReleaseDC(Handle, DC);
    end;
  end;

  if (GetFocus <> Handle) and (ErrorMarkerLen > 0) then
  begin
    DC := GetDC(Handle);
    Canvas := TCanvas.Create;
    try
      Canvas.Handle := DC;
      DrawErrorLines(Canvas, ErrorMarkerPos, ErrorMarkerLen);
    finally
      Canvas.Free;
      ReleaseDC(Handle, DC);
    end;
  end;
end;

procedure TAdvCloudLookupEdit.DrawErrorLines(Canvas: TCanvas; ErrPos, ErrLen: Integer);
var
  pt1: TPoint;
  pt2: TPoint;
  l: Integer;
  o: Integer;
  ep: Integer;
  Rect: TRect;
  h: Integer;
begin
  Rect := GetClientRect;
  if ErrPos >= Length(Text) then
  begin
    ep := Length(Text);
    l := SendMessage(Handle, EM_POSFROMCHAR, ep, 0);
    pt1 := Point(LoWord(l), HiWord(l));
    pt1.X := pt1.X + 4;
  end
  else
  begin
    l := SendMessage(Handle, EM_POSFROMCHAR, ErrPos, 0);
    pt1 := Point(LoWord(l), HiWord(l));
  end;

  if ErrPos + ErrLen >= Length(Text) then
  begin
    ep := Length(Text) - 1;
    l := SendMessage(Handle, EM_POSFROMCHAR, ep, 0);
    pt2 := Point(LoWord(l), HiWord(l));
    pt2.X := pt2.X + 4;
    pt2.Y := pt1.Y;
  end
  else
  begin
    l := SendMessage(Handle, EM_POSFROMCHAR, ErrPos + ErrLen - 1, 0);
    pt2 := Point(LoWord(l), HiWord(l));
  end;

  Canvas.Pen.Color := clRed;
  Canvas.Pen.Width := 2;

  Canvas.Font.Assign(Font);
  h := Canvas.TextHeight('gh') - 1;

  l := pt1.X;
  o := 3;

  Canvas.MoveTo(Rect.Left + l, Rect.Top + pt1.Y + h + o);

  while l <= pt2.X do
  begin
    if o = 3 then o := 0 else o := 3;
    Canvas.LineTo(Rect.Left + l + 3, pt2.Y + h + o);
    Inc(l, 3);
  end;

  if o = 3 then o := 0 else o := 3;
  Canvas.LineTo(Rect.Left + l + 3, Rect.Top + pt2.Y + h + o);
end;


procedure TAdvCloudLookupEdit.WMEraseBkGnd(var Message: TWMEraseBkGnd);
var
  DC: HDC;
  i: Integer;
  p: TPoint;
begin
  if FTransparent then
  begin
    if Assigned(Parent) then
    begin
      DC := Message.DC;
      if DC <> 0 then
      begin
        i := SaveDC(DC);
        p := ClientOrigin;
        Windows.ScreenToClient(Parent.Handle, p);
        p.x := -p.x;
        p.y := -p.y;
        MoveWindowOrg(DC, p.x, p.y);
        SendMessage(Parent.Handle, WM_ERASEBKGND, DC, 0);
        SendMessage(Parent.Handle, WM_PAINT, DC, 0);
        if (Parent is TWinCtrl) then
          (Parent as TWinCtrl).PaintCtrls(DC, nil);
        RestoreDC(DC, i);
      end;
    end;
  end
  else
    inherited;
end;

procedure TAdvCloudLookupEdit.WMMouseMove(var Msg: TWMMouse);
begin
  inherited;
end;

procedure TAdvCloudLookupEdit.WMLButtonDown(var Msg: TWMMouse);
var
  uchar: Integer;
begin
  // click outside selection
  uchar := CharFromPos(point(msg.xpos, msg.ypos));

  if (SelLength <= 0) or (uchar < SelStart) or (uChar > SelStart + SelLength) or
    (GetFocus <> self.Handle) then
    inherited
  else
    if (uChar >= SelStart) and (uChar <= SelStart + SelLength) and (SelLength > 0) then
      FButtonDown := True;
end;

procedure TAdvCloudLookupEdit.WMLButtonUp(var Msg: TWMMouse);
var
  uchar: Integer;
  show: Boolean;
begin
  if FButtonDown then
  begin
    uchar := CharFromPos(point(msg.xpos, msg.ypos));
    SelStart := uChar;
    SelLength := 0;
    if Assigned(OnClick) then
      OnClick(Self);
  end;

  FButtonDown := false;

  inherited;

  if FIsUrl and (self.Handle = GetFocus) and FShowURL then
  begin
    show := True;
    if Assigned(FOnURLClick) then
      FOnURLClick(self, self.Text, show);

    if show then
      ShellExecute(0, 'open', pchar(self.Text), nil, nil, SW_NORMAL);
    inherited;
    Exit;
  end;


  if (fPrefix <> '') then
  begin
    if (SelStart < Length(fPrefix)) then
    begin
      SelStart := Length(fPrefix);
      SelLength := Length(self.Text);
    end;
  end;
  if (fSuffix <> '') then
  begin
    if (SelStart > Length(self.text)) then
    begin
      if (fPrefix <> '') then
        SelStart := Length(fPrefix) + Length(self.Text)
      else
        SelStart := Length(self.Text);
      SelLength := 0;
    end;
    if (SelStart + SelLength > Length(self.text)) then
    begin
      if (fPrefix <> '') then
        SelLength := Length(self.Text)// - SelStart;
      else
        SelLength := Length(self.Text) - SelStart;
    end;
  end;
end;

procedure TAdvCloudLookupEdit.SetPrefix(const Value: string);
var
  s: string;
begin
  s := self.Text;
  fPrefix := Value;
  inherited Text := s;
//changed for v1.8
  Text := s;
end;

procedure TAdvCloudLookupEdit.SetSuffix(const Value: string);
var
  s: string;
begin
  s := Text;
  FSuffix := Value;
  inherited Text := s;
  Text := s;
end;


function TAdvCloudLookupEdit.GetText: string;
var
  s: string;
begin
  s := inherited Text;
  if (fPrefix <> '') and (Pos(fPrefix, s) = 1) then delete(s, 1, Length(fPrefix));
  if (fSuffix <> '') then delete(s, Length(s) - Length(fSuffix) + 1, Length(fSuffix));
  Result := s;
end;

procedure TAdvCloudLookupEdit.SetText(value: string);
begin
  inherited Text := FPrefix + Value + FSuffix;

  SetModified(False);

  if FShowURL then ApplyURL(TestURL);
end;

procedure TAdvCloudLookupEdit.SetTextDirect(s: string);
begin
  inherited Text := s;
end;

function TAdvCloudLookupEdit.GetVisible: boolean;
begin
  Result := inherited Visible;
end;

procedure TAdvCloudLookupEdit.CMShowingChanged(var Message: TMessage);
begin
  inherited;
  if (FLabel <> nil) then
    FLabel.Visible := Visible;
end;

procedure TAdvCloudLookupEdit.CMTextChanged(var Message: TMessage);
begin
  inherited;
end;

procedure TAdvCloudLookupEdit.SetVisible(const Value: boolean);
begin
  inherited Visible := Value;
  if (FLabel <> nil) then
    FLabel.Visible := Value;
end;


function TAdvCloudLookupEdit.CreateLabel: TEditLabel;
begin
  Result := TEditLabel.Create(self);
  Result.Parent := Parent;
  Result.FocusControl := self;
  Result.Font.Assign(LabelFont);
  Result.OnClick := LabelClick;
  Result.OnDblClick := LabelDblClick;
  Result.ParentFont := ParentFont;
end;

function TAdvCloudLookupEdit.GetLabelCaption: string;
begin
  if FLabel <> nil then
    Result := FLabel.Caption
  else
    Result := '';
end;

function TAdvCloudLookupEdit.GetLookupVisible: boolean;
begin
  Result := FLookupList.Visible;
end;


procedure TAdvCloudLookupEdit.UpdateLabel;
begin
  FLabel.Transparent := FLabeltransparent;

  if not FParentFnt or ShowError then
  begin
    FLabel.Font.Assign(FLabelFont);
  end
  else
    FLabel.Font.Assign(Font);

  UpdateLabelPos;
end;

procedure TAdvCloudLookupEdit.UpdateLabelPos;
var
  tw: Integer;
  r: TRect;
begin
  r := Rect(0,0,1000,255);
  DrawText(FLabel.Canvas.Handle, PChar(FLabel.Caption), Length(FLabel.Caption), r, DT_HIDEPREFIX or DT_CALCRECT);
  tw := r.Right;

  case FLabelPosition of
    lpLeftTop:
      begin
        FLabel.Top := self.Top;
        FLabel.Left := self.Left - tw - FLabelMargin;
      end;
    lpLeftCenter:
      begin
        if Self.Height > FLabel.Height then
          FLabel.Top := self.Top + ((self.Height - FLabel.Height) div 2)
        else
          FLabel.Top := self.Top - ((FLabel.Height - self.Height) div 2);
        FLabel.Left := self.Left - tw - FLabelMargin;
      end;
    lpLeftBottom:
      begin
        FLabel.Top := self.Top + self.Height - FLabel.Height;
        FLabel.Left := self.Left - tw - FLabelMargin;
      end;
    lpTopLeft:
      begin
        FLabel.Top := self.Top - FLabel.height - FLabelMargin;
        FLabel.Left := self.Left;
      end;
    lpTopRight:
      begin
        FLabel.Top := self.Top - FLabel.height - FLabelMargin;
        FLabel.Left := self.Left + self.Width - FLabel.Width;
      end;
    lpTopCenter:
      begin
        FLabel.Top := self.Top - FLabel.height - FLabelMargin;
        if self.Width - FLabel.Width > 0 then
          FLabeL.Left := self.Left + ((self.Width - FLabel.Width) div 2)
        else
          FLabeL.Left := self.Left - ((FLabel.Width - self.Width) div 2)
      end;
    lpBottomLeft:
      begin
        FLabel.top := self.top + self.height + FLabelMargin;
        FLabel.left := self.left;
      end;
    lpBottomCenter:
      begin
        FLabel.top := self.top + self.height + FLabelMargin;
        if self.Width - FLabel.Width > 0 then
          FLabeL.Left := self.Left + ((self.Width - FLabel.width) div 2)
        else
          FLabeL.Left := self.Left - ((FLabel.Width - self.width) div 2)
      end;
    lpBottomRight:
      begin
        FLabel.top := self.top + self.height + FLabelMargin;
        FLabel.Left := self.Left + self.Width - FLabel.Width;
      end;
    lpLeftTopLeft:
      begin
        FLabel.top := self.top;
        FLabel.left := self.left - FLabelMargin;
      end;
    lpLeftCenterLeft:
      begin
        if Self.Height > FLabel.Height then
          FLabel.Top := self.top + ((self.height - FLabel.height) div 2)
        else
          FLabel.Top := self.Top - ((FLabel.Height - self.Height) div 2);
        FLabel.left := self.left - FLabelMargin;
      end;
    lpLeftBottomLeft:
      begin
        FLabel.top := self.top + self.height - FLabel.height;
        FLabel.left := self.left - FLabelMargin;
      end;
    lpRightTop:
      begin
        FLabel.Top := self.Top;
        FLabel.Left := self.Left + Self.Width + FLabelMargin;
      end;
    lpRightCenter:
      begin
        if Self.Height > FLabel.Height then
          FLabel.Top := self.Top + ((self.Height - FLabel.Height) div 2)
        else
          FLabel.Top := self.Top - ((FLabel.Height - self.Height) div 2);

        FLabel.Left := self.Left + Self.Width + FLabelMargin;
      end;
    lpRighBottom:
      begin
        FLabel.Top := self.Top + self.Height - FLabel.Height;
        FLabel.Left := self.Left + Self.Width + FLabelMargin;
      end;
  end;

  FLabel.Visible := Visible;
end;

procedure TAdvCloudLookupEdit.SetLabelPosition(const value: TLabelPosition);
begin
  FLabelPosition := Value;
  if FLabel <> nil then UpdateLabel;
end;

procedure TAdvCloudLookupEdit.SetLabelMargin(const value: integer);
begin
  FLabelMargin := Value;
  if FLabel <> nil then UpdateLabel;
end;

procedure TAdvCloudLookupEdit.SetLabelFont(const Value: TFont);
begin
  if not ParentFont then
    FLabelFont.Assign(Value);

  if FLabel <> nil then
    UpdateLabel;
end;

procedure TAdvCloudLookupEdit.LabelFontChange(Sender: TObject);
begin
  if FLabel <> nil then
  begin
    UpdateLabel;
    if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
      ParentFont := false;
  end;
end;

procedure TAdvCloudLookupEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);

  if (FLabel <> nil) then
  begin
    if FLabel.Parent <> nil then
      UpdateLabel;
  end;

  SetFlatRect(FFlat);

  if FFlat then
    Flat := FFlat;
end;

procedure TAdvCloudLookupEdit.SetLabelCaption(const value: string);
begin
  if FLabel = nil then
    FLabel := CreateLabel;
  FLabel.Caption := Value;
  UpdateLabel;
end;

procedure TAdvCloudLookupEdit.SetLabelTransparent(const value: boolean);
begin
  FLabelTransparent := Value;
  if FLabel <> nil then UpdateLabel;
end;

procedure TAdvCloudLookupEdit.CMMouseEnter(var Msg: TMessage);
var
  pf: TCustomForm;
begin
  inherited;

  pf := GetParentForm(self);

  if FAutoFocus and not (csDesigning in ComponentState) then
  begin
    if Assigned(pf) then
    begin
      if (GetActiveWindow = pf.Handle) then
        SetFocus;
    end
    else
      SetFocus;
  end;

    
  if not FMouseInControl and Enabled then
  begin
    FMouseInControl := True;
    if FFocusBorder then
      DrawBorder;
  end;
  if Assigned(FOnMouseEnter) then
    FOnMouseEnter(Self);
end;

procedure TAdvCloudLookupEdit.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if FMouseInControl and Enabled then
  begin
    FMouseInControl := False;
    if FFocusBorder then Invalidate;
  end;
  if Assigned(FOnMouseLeave) then
    FOnMouseLeave(Self);
end;


function ValStr(s: string): Integer;
var
  err: Integer;
begin
  val(s, result, err);
end;


function TAdvCloudLookupEdit.GetModified: boolean;
begin
  Result := fIsModified;
end;

procedure TAdvCloudLookupEdit.SetModified(const Value: boolean);
begin
  if csLoading in ComponentState then
    Exit;

  if ReadOnly then
    Exit;

  if FShowModified then
  begin
    if (value = false) then
      self.Font.Color := FFontColor
    else
      self.Font.Color := FModifiedColor;
  end;

  inherited Modified := value;
  FIsModified := value;
end;

procedure TAdvCloudLookupEdit.WMDestroy(var Msg: TMessage);
begin
  DefaultHandler(msg);
end;

function TAdvCloudLookupEdit.TestURL: Boolean;
begin
  Result := (Pos('://', self.text) > 0) or (Pos('@', self.text) > 1) or (Pos('www.', lowercase(self.Text)) = 1);
end;

function TAdvCloudLookupEdit.GetError: Boolean;
begin
  Result := FError;
end;

procedure TAdvCloudLookupEdit.ApplyErrorColor;
begin
  if FError then
  begin
    inherited Color := FErrorColor;
    Font.Color := FErrorFontColor;
  end
  else
  begin
    if GetFocus = Handle then
    begin
      if FFocusColor <> clNone then
        Color := FFocusColor
      else
        Color := FNormalColor;
      if FFocusFontColor <> clNone then
        Font.Color := FFocusFontColor;
    end
    else
    begin
      Color := FNormalColor;
      Font.Color := FFontColor;
    end;
  end;
end;

procedure TAdvCloudLookupEdit.SetError(const Value: Boolean);
begin
  if (csDesigning in ComponentState) or
    (csLoading in ComponentState) then
    Exit;

  if (Value <> FError) then
  begin
    FError := Value;

    if not ShowError then
      Exit;

    ApplyErrorColor;

  end;
end;

procedure TAdvCloudLookupEdit.Change;
var
  IsValid: Boolean;
begin
  inherited Change;

  if not (csLoading in ComponentState) then
  begin
    if FShowError then
    begin
      IsValid := DoValidate(Self.Text);
      IsError := not IsValid;
    end;
  end;
end;

{$IFDEF DELPHI_UNICODE}
procedure TAdvCloudLookupEdit.ChangeScale(M, D: Integer);
begin
  inherited;
  if not (csLoading in ComponentState) then
    FLabelFont.Size := Font.Size;
end;
{$ENDIF}

procedure TAdvCloudLookupEdit.Init;
var
  OldColor: TColor;
begin
  FNormalColor := Color;
  FFontColor := Font.Color;
  FOldBorder := BorderStyle;
  FFlat := not FFlat;
  SetFlat(not FFlat);

  if FLabel <> nil then UpdateLabel;

  if not Enabled then
  begin
    OldColor := Color;
    Color := FDisabledColor;
    FNormalColor := OldColor;
  end;
end;

procedure TAdvCloudLookupEdit.Loaded;
begin
  inherited Loaded;

  if not (csDesigning in ComponentState) then
    Init;

  Height := FLoadedHeight;
  SetBounds(Left, Top, Width, Height);

  if not LabelAlwaysEnabled and Assigned(FLabel) then
  begin
    FLabel.Enabled := Enabled;
    FLabel.AlwaysEnable := LabelAlwaysEnabled;
  end;

  if (FLabel <> nil) then
    UpdateLabel;

  if ParentFont and not ShowError and Assigned(FLabel) then
  begin
    FLabel.Font.Assign(Font);
  end;

  FParentFnt := ParentFont;

  if (FLabel <> nil) then
    UpdateLabel;
end;

procedure TAdvCloudLookupEdit.Notification(AComponent: TComponent;
  AOperation: TOperation);
begin
  if (AOperation = opRemove) then
  begin
    if (AComponent = FLookup.Provider) then
      FLookup.Provider := nil;
  end;

  inherited;
end;

procedure TAdvCloudLookupEdit.DrawBorder;
var
  DC: HDC;
begin
  if Enabled and not (FFlat or (FBorderColor <> clNone) or (FFocusBorder and FMouseInControl) or Border3D or (FFocusBorderColor <> clNone)) then
    Exit;

  DC := GetWindowDC(Handle);
  try
    DrawControlBorder(DC);
  finally
    ReleaseDC(Handle, DC);
  end;
end;

procedure TAdvCloudLookupEdit.DrawControlBorder(DC: HDC);
var
  ARect: TRect;
  BtnFaceBrush, WindowBrush: HBRUSH;
  clr: TColor;
  HasFocus: boolean;
begin
  if (csDesigning in ComponentState) then
    Exit;

  clr := clNone;
  HasFocus := GetFocus = Handle;

  if not Enabled and FIsThemed and DisabledBorder then
    clr := clSilver
  else
  begin
    if (FBorderColor <> clNone) and ((not HasFocus) or (FFocusBorderColor = clNone)) then
      clr := FBorderColor
    else
      if (FFocusBorderColor <> clNone) and HasFocus then
        clr := FFocusBorderColor;
  end;

  if clr <> clNone then
  begin
    BtnFaceBrush := CreateSolidBrush(ColorToRGB(clr));
    try
      GetWindowRect(Handle, ARect);
      OffsetRect(ARect, -ARect.Left, -ARect.Top);
      FrameRect(DC, ARect, BtnFaceBrush);
    finally
      DeleteObject(BtnFaceBrush);
    end;
    Exit;
  end;

  if not Enabled or (FocusBorder and FIsThemed) then
    Exit;

  if Is3DBorderButton then
    BtnFaceBrush := CreateSolidBrush(GetSysColor(COLOR_BTNFACE))
  else
    BtnFaceBrush := CreateSolidBrush(ColorToRGB((Parent as TWinControl).Brush.Color));

  WindowBrush := CreateSolidBrush(GetSysColor(COLOR_WINDOW));

  try
    GetWindowRect(Handle, ARect);
    OffsetRect(ARect, -ARect.Left, -ARect.Top);
    if Is3DBorderButton then
    begin
      DrawEdge(DC, ARect, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST);
      FrameRect(DC, ARect, BtnFaceBrush);
    end
    else
    begin
      FrameRect(DC, ARect, BtnFaceBrush);
      InflateRect(ARect, -1, -1);
      FrameRect(DC, ARect, BtnFaceBrush);
    end;
  finally
    DeleteObject(WindowBrush);
    DeleteObject(BtnFaceBrush);
  end;
end;

function TAdvCloudLookupEdit.Is3DBorderButton: Boolean;
begin
  if csDesigning in ComponentState then
    Result := Enabled
  else
    Result := FMouseInControl or (Screen.ActiveControl = Self);

  Result := (Result and FFocusBorder) or (Border3D);
end;

procedure TAdvCloudLookupEdit.WMNCPaint(var Message: TMessage);
begin
  inherited;
  if (FFocusBorderColor <> clNone) or (FBorderColor <> clNone) or (not Enabled and DisabledBorder) then
    DrawBorder;
end;

procedure TAdvCloudLookupEdit.SetEnabled(Value: boolean);
var
  OldValue: Boolean;
  OldColor: TColor;
begin
  if (Value = Enabled) then
    Exit;

  OldValue := Enabled;

  inherited;

  if (csLoading in ComponentState) or
    (csDesigning in ComponentState) then
    Exit;

  if (OldValue <> Value) then
  begin
    if Value then
    begin
      Color := FNormalColor;
    end
    else
    begin
      if not IsError then
        OldColor := Color
      else
        OldColor := FNormalColor;
      Color := FDisabledColor;
      FNormalColor := OldColor;
    end;

    if Value and FError then
      ApplyErrorColor;

    if Assigned(FLabel) then
      if not FLabelAlwaysEnabled then
        FLabel.Enabled := Value;
  end;

  Width := Width + 1;
  Width := Width - 1;
end;

procedure TAdvCloudLookupEdit.SetDisabledColor(const Value: TColor);
begin
  if (FDisabledColor <> Value) then
  begin
    FDisabledColor := Value;
    Invalidate;
  end;
end;

procedure TAdvCloudLookupEdit.SetDisabledBorder(const Value: boolean);
begin
  if (FDisabledBorder <> Value) then
  begin
    FDisabledBorder := Value;
    Invalidate;
  end;
end;

function TAdvCloudLookupEdit.GetColorEx: TColor;
begin
  Result := inherited Color;
end;

procedure TAdvCloudLookupEdit.SetColorEx(const Value: TColor);
begin
  inherited Color := Value;
  FNormalColor := Value;
end;

procedure TAdvCloudLookupEdit.CMParentFontChanged(var Message: TMessage);
begin
  inherited;
  if Assigned(FLabel) and not ShowError and ParentFont then
  begin
    FLabel.Font.Assign(Font);
    UpdateLabel;
  end;
end;

procedure TAdvCloudLookupEdit.CMHintShow(var Msg: TMessage);
var
  hi: PHintInfo;

begin
  if (GetTextSize > Width) and (FHintShowLargeText) then
  begin
    hi := PHintInfo(Msg.LParam);
    hi.HintStr := Text;
    hi.HintPos := ClientToScreen(Point(0, 0));
  end;
  inherited;
end;


procedure TAdvCloudLookupEdit.SetEmptyText(const Value: string);
begin
  if (FEmptyText <> Value) then
  begin
    FEmptyText := Value;
    Invalidate;
  end;
end;

procedure TAdvCloudLookupEdit.SetEmptyTextStyle(const Value: TFontStyles);
begin
  if (FEmptyTextStyle <> Value) then
  begin
    FEmptyTextStyle := Value;
    Invalidate;
  end;
end;

procedure TAdvCloudLookupEdit.CMWantSpecialKey(var Msg: TCMWantSpecialKey);
var
  IsPrev: Boolean;
  p: TWinControl;

begin
  p := Parent;
  while Assigned(p) and not (p is TCustomForm) do
    p := p.Parent;

  if not Assigned(p) then
    Exit;

  IsPrev := (p as TCustomForm).KeyPreview;

  if (Msg.CharCode = VK_ESCAPE) and FCanUndo and not IsPrev then
  begin
    if not FLookupList.Visible then
    begin
      Text := FOldString;
      SelectAll;
    end
    else
    begin
      FLookupList.Hide;
    end;

    Font.Color := FFocusFontColor;
    SetModified(False);
  end;

  if (Msg.CharCode = VK_RETURN) and not IsPrev then
  begin
    // Take care of default key handling
    if (Parent is TWinControl) then
    begin
      if (GetFocus = Parent.handle) then
      begin
        PostMessage((Parent as TWinControl).Handle, WM_KEYDOWN, VK_RETURN, 0);
        PostMessage((Parent as TWinControl).Handle, WM_KEYUP, VK_RETURN, 0);
      end;
    end;
  end;

  inherited;
end;

procedure TAdvCloudLookupEdit.SetSoftBorder(const Value: Boolean);
begin
  if FSoftBorder <> Value then
  begin
    FSoftBorder := Value;
    Invalidate;
  end;
end;

procedure TAdvCloudLookupEdit.SetLabelAlwaysEnabled(const Value: Boolean);
begin
  FLabelAlwaysEnabled := Value;
  if Assigned(FLabel) then
  begin
    if Value then
      FLabel.Enabled := True;
    FLabel.AlwaysEnable := Value;
  end;
  Invalidate;
end;


procedure TAdvCloudLookupEdit.SetBorder3D(const Value: Boolean);
begin
  if (FBorder3D <> Value) then
  begin
    FBorder3D := Value;
    Invalidate;
  end;
end;

procedure TAdvCloudLookupEdit.SetBorderColor(const Value: TColor);
begin
  if (FBorderColor <> Value) then
  begin
    FBorderColor := Value;
    if HandleAllocated then
      SendMessage(Handle, WM_NCPAINT, 0,0);
  end;
end;

procedure TAdvCloudLookupEdit.CreateWnd;
begin
  inherited;
  SetFlatRect(FFlat);
end;


procedure TAdvCloudLookupEdit.SetErrorMarkerLen(const Value: Integer);
begin
  FErrorMarkerLen := Value;
  Invalidate;
end;

procedure TAdvCloudLookupEdit.SetErrorMarkerPos(const Value: Integer);
begin
  FErrorMarkerPos := Value;
  Invalidate;
end;

procedure TAdvCloudLookupEdit.SetFocusBorder(const Value: Boolean);
begin
  if (FFocusBorder <> Value) then
  begin
    FFocusBorder := Value;
    Invalidate;
  end;
end;

function TAdvCloudLookupEdit.GetHeightEx: Integer;
begin
  Result := inherited Height;
end;

procedure TAdvCloudLookupEdit.SetHeightEx(const Value: Integer);
begin
  if (csLoading in ComponentState) then
    FLoadedHeight := Value;
  inherited Height := Value;
end;

function VarPos(su, s: string; var Res: Integer): Integer;
begin
  Res := Pos(su, s);
  Result := Res;
end;

procedure TAdvCloudLookupEdit.ListMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  DoneLookup;
end;

procedure TAdvCloudLookupEdit.CloseLookup;
begin
  SetForegroundWindow(Handle);
  SetActiveWindow(Handle);
  SetFocus;
  FLookupList.Hide;
end;

procedure TAdvCloudLookupEdit.DoneLookup;
var
  idx: Integer;
  NewValue: string;
begin
  CloseLookup;

  if (FlookupListBox.ItemIndex = -1) then
    Exit;

  idx := Integer(FLookupListBox.Items.Objects[FlookupListBox.ItemIndex]);

  if (idx >= 0) and (idx < FLookup.Values.Count) then
    NewValue := FLookup.Values.Strings[idx]
  else
    NewValue := FLookupListbox.Items[FLookupListBox.ItemIndex];

  if Assigned(FOnLookupSelect) then
    FOnLookupSelect(Self, NewValue);

  if Assigned(FOnlookupIndexSelect) then
    FOnLookupIndexSelect(Self, idx, NewValue);

  Text := NewValue;

  SelectAll;
end;

procedure TAdvCloudLookupEdit.ListKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    DoneLookup;

  if (Key = #9) and (Lookup.AcceptOnTab) then
    DoneLookup;
end;

procedure TAdvCloudLookupEdit.UpdateLookup;
var
  pt, cp: TPoint;
  i, cnt, tp: Integer;
  mw, mh, tw, vp: Integer;
  LookupText, ValStr: string;
  lx,ly: Integer;
  ismatch: boolean;

begin
  if not FLookup.Enabled then
    Exit;

  tp := 0;

  LookupText := Text;

  if (Length(LookupText) >= FLookup.NumChars) then
  begin
    if Assigned(FLookup.Provider) then
    begin
      Lookup.Values.Clear;
      FLookup.Provider.Lookup(Text, Lookup.Values);
    end;

    if Lookup.Values.Count = 0 then
      Exit;
  end;

  if (Length(LookupText) >= FLookup.NumChars) then
  begin
    pt := ClientToScreen(Point(0, 0));
    FLookupList.Text := '  ';
    FLookupList.Color := FLookup.Color;
    FLookupListbox.Color := FLookup.Color;
    FLookupListbox.Font.Name := 'Arial';
    FlookupListbox.Font.Size := 8;
    FLookupListbox.Ctl3D := False;
    FLookupListBox.HandleTab := Lookup.AcceptOnTab;

    mh := (12 * FLookup.DisplayCount) + 4;

    ly := pt.Y + Height - 6;

    i := SendMessage(Handle, EM_POSFROMCHAR, tp, 0);
    cp := Point(loword(i), hiword(i));

    lx := pt.X + 8 + cp.X;

    FLookupList.Color := clWindow;

    cnt := 0;
    FLookupListBox.Items.Clear;

    for i := 1 to FLookup.Values.Count do
    begin
       vp := Pos(AnsiUppercase(LookupText), AnsiUppercase(FLookup.Values.Strings[i - 1]));

      if FullTextSearch then
        ismatch := vp > 0
      else
        ismatch := vp = 1;

      if ismatch then
      begin
        ValStr := '';

        FLookupListbox.Items.AddObject(FLookup.Values.Strings[i - 1] + ValStr, TObject(i - 1));
        inc(cnt);
      end;
    end;

    if FLookup.Values.Count > 0 then
      FLookupListBox.ItemIndex := 0;

    if cnt < FLookup.DisplayCount then
      mh := (cnt * LOOKUPITEMHEIGHT) + 4;

    FLookupListBox.Sorted := True;

    mw := 50;
    FLookupList.Width := 0;
    FLookupList.Canvas.Font.Assign(FLookupListBox.Font);

    if cnt > 0 then
    begin
      for i := 1 to cnt do
      begin
        tw := FLookupList.Canvas.TextWidth(FLookupListBox.Items[i - 1]);

        if tw > mw then
          mw := tw;
      end;

      mw := mw + 8;

      if cnt > FLookup.DisplayCount then
        mw := mw + GetSystemMetrics(SM_CXHSCROLL);

      //if not FLookupList.Visible then
      //  FLookupList.Width := mw + 10;
    end;

    if cnt > 0 then
    begin
      FLookupList.Parent := self;
      FLookupList.Top := ly;
      FLookupList.Left := lx;
      MoveWindow(FLookupList.Handle, lx, ly, mw, mh, true);
      FLookupList.Visible := true;
      FLookupList.Top := ly;
      FLookupList.Left := lx;
      SetWindowPos(FLookupList.Handle, HWND_TOPMOST,0,0,0,0,SWP_NOSIZE or  SWP_NOMOVE or SWP_NOACTIVATE);
    end
    else
    begin
      FLookupList.Hide;
    end;
  end
  else
  begin
    FLookupList.Visible := False;
    FLookupList.Parent := nil;
  end;
end;

procedure TAdvCloudLookupEdit.LabelClick(Sender: TObject);
begin
  if Assigned(FOnLabelClick) then
    FOnLabelClick(Self);
end;

procedure TAdvCloudLookupEdit.LabelDblClick(Sender: TObject);
begin
  if Assigned(FOnLabelDblClick) then
    FOnLabelDblClick(Self);
end;

function TAdvCloudLookupEdit.DoValidate(value: string): Boolean;
var
  IsValid: Boolean;
begin
  IsValid := True;

  Result := IsValid;

  if FIsValidating then
    Exit;

  FIsValidating := True;

  ValidateEvent(value, isValid);

  FIsValidating := False;

  Result := IsValid;
end;

procedure TAdvCloudLookupEdit.ValidateEvent(Value: string; var IsValid: Boolean);
begin
  if Assigned(FOnValueValidate) then
    FOnValueValidate(Self, value, IsValid);
end;

function TAdvCloudLookupEdit.GetVersion: string;
var
  vn: Integer;
begin
  vn := GetVersionNr;
  Result := IntToStr(Hi(Hiword(vn))) + '.' + IntToStr(Lo(Hiword(vn))) + '.' + IntToStr(Hi(Loword(vn))) + '.' + IntToStr(Lo(Loword(vn)));
end;

function TAdvCloudLookupEdit.GetVersionNr: Integer;
begin
  Result := MakeLong(MakeWord(BLD_VER, REL_VER), MakeWord(MIN_VER, MAJ_VER));
end;

procedure TAdvCloudLookupEdit.SetVersion(const Value: string);
begin

end;



{ TListHintWindow }
constructor TListHintWindow.Create(AOwner: TComponent);
begin
  inherited;
end;

procedure TListHintWindow.CreateParams(var Params: TCreateParams);
const
  CS_DROPSHADOW = $00020000;

begin
  inherited CreateParams(Params);
  Params.Style := Params.Style + WS_BORDER;

  if (Win32Platform = VER_PLATFORM_WIN32_NT) and
    ((Win32MajorVersion > 5) or
    ((Win32MajorVersion = 5) and (Win32MinorVersion >= 1))) then
    Params.WindowClass.Style := Params.WindowClass.Style or CS_DROPSHADOW;

  Params.ExStyle := Params.ExStyle or WS_EX_TOPMOST;
end;


destructor TListHintWindow.Destroy;
begin
  inherited;
end;

procedure TListHintWindow.WMActivate(var Message: TMessage);
begin
  inherited;

  if integer(Message.WParam) = integer(False) then
    Hide
  else
    if FListControl.CanFocus and not (csDestroying in FListControl.ComponentState) then
      FListControl.SetFocus;
end;

procedure TListHintWindow.WMNCButtonDown(var Message: TMessage);
begin
  inherited;
end;

procedure TListHintWindow.WMNCHitTest(var Message: TWMNCHitTest);
var
  pt: TPoint;
begin
// Make the hint sizable
  pt := ScreenToClient(Point(Message.XPos, Message.YPos));

  if (pt.X > Width - 10) and (pt.Y > Height - 10) then
    message.Result := HTBOTTOMRIGHT
end;

{ TLookupSettings }

procedure TLookupSettings.Assign(Source: TPersistent);
begin
  if (Source is TLookupSettings) then
  begin
    FAcceptOnTab := (Source as TLookupSettings).AcceptOnTab;
    FColor := (Source as TLookupSettings).Color;
    FDisplayCount := (Source as TLookupSettings).DisplayCount;
    FEnabled := (Source as TLookupSettings).Enabled;
    FNumChars := (Source as TLookupSettings).NumChars;
    FValues.Assign((Source as TLookupSettings).Values);
  end;
end;

constructor TLookupSettings.Create;
begin
  inherited Create;
  FValues := TStringList.Create;
  FColor := clWindow;
  FDisplayCount := 4;
  FNumChars := 2;
  FEnabled := False;
end;

destructor TLookupSettings.Destroy;
begin
  FValues.Free;
  inherited;
end;

procedure TLookupSettings.SetNumChars(const Value: Integer);
begin
  if Value > 0 then
    FNumChars := Value
end;

procedure TLookupSettings.SetValues(const Value: TStringList);
begin
  FValues.Assign(Value);
end;

{ TListBoxTab }

procedure TListBoxTab.WMGetDlgCode(var Message: TMessage);
begin
  if FHandleTab then
    Message.Result := DLGC_WANTTAB;
end;

{ TEditLabel }

procedure TEditLabel.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  if AlwaysEnable and not Enabled then
    Enabled := true;
end;

end.
