(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTDBLookupMenu;

interface
{$R AHMDBLookupmenu.Res}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Mask, AHMTLookupEdit,DB,DBCtrls,DBTables,AHMStdClass,AHMStandardConst;

type
  TAHMDBLookupMenu = class(TAHMCustomLookupEdit)
  private
    FAboutStr : TAHMAboutSControlStr;
    FItems: TStrings;
    FItemIndex: Integer;
    FOnChange: TNotifyEvent;
    FNonSelected : String;
    FItemChecked: Boolean;
    FDirectInput: Boolean;
    FAlwaysEnable: Boolean;
    FAlignment: TAlignment;
    FDataLink: TFieldDataLink;
    FCanvas: TControlCanvas;
    FFocused: Boolean;
    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetFocused(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMEnter(var Message: TMessage); message CM_ENTER;
    procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
    procedure WMCut(var Message: TWMCut); message WM_CUT;
    procedure SetDirectInput(Value: Boolean);
    procedure SetNonSelected(Value:String);
    procedure SetItems(Items: TStrings);
    procedure SetItemIndex(Value : Integer);
    procedure WMCommand(var Message: TMessage); message WM_COMMAND;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
  protected
    procedure OnLookupPress(Sender : TObject);
    procedure Change; override;
    function EditCanModify: Boolean; override;
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
    procedure Reset; override;
    property AlwaysEnable: Boolean read FAlwaysEnable write FAlwaysEnable default False;
  public
    constructor Create(AOwner: TComponent); override;
    destructor destroy; override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure KeyPress(var Key: Char); override;
    procedure SelectAll;
    property Field: TField read GetField;
  published
    property About : TAHMAboutSControlStr read FAboutStr write FAboutStr;  
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property ReadonlyClickable: Boolean read fDirectInput write SetDirectInput default False;
    property NonSelected : String Read FNonSelected Write SetNonSelected;
    property Items: TStrings read FItems write SetItems;
    property ItemChecked: Boolean read FItemChecked write FItemChecked;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property ItemIndex: Integer read FItemIndex write SetItemIndex;
    property EditButton1;
    Property Enabled;
    property Alignment;
    property EditMask;
    property MaxLength;
    property Text;
    property AutoSize;
    property CharCase;
    property PasswordChar;
    property ReadOnly;
    property Font;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

implementation

constructor TAHMDBLookupMenu.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  EditButton1.Glyph.LoadFromResourceName(HInstance,'AHMDBLookupMenu');
  EditButton1.NumGlyphs:=2;
  FNonSelected:=ahmrcstdnonselected;
  FItems := TStringList.Create;
  ItemIndex := -1;
  ControlStyle:=ControlStyle + [csReplicatable];
  AutoSize:=False;
  FDirectInput:=false;
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnEditingChange := EditingChange;
  FDataLink.OnUpdateData := UpdateData;
  OnButton1Click:=OnLookupPress;
  EditButton2.Visible:=False;
end;

destructor TAHMDBLookupMenu.Destroy;
begin
  FDataLink.Free;
  FDataLink := nil;
  FCanvas.Free;
  FItems.Free;
  Inherited destroy;
end;

procedure TAHMDBLookupMenu.WMChar(var Message: TWMChar);
begin
  if Message.CharCode = VK_SPACE Then PostMessage(Handle,WM_LBUTTONDOWN,0,0) else inherited;
end;

procedure TAHMDBLookupMenu.SetItems(Items: TStrings);
begin
  FItems.Assign(Items);
  SetItemIndex(FItemIndex);
end;

procedure TAHMDBLookupMenu.SetNonSelected(Value : String);
begin
  FNonSelected:=Value;
  SetItemIndex(FItemIndex);
end;

procedure TAHMDBLookupMenu.WMCommand(var Message: TMessage);
begin
  if FFocused and EditCanModify then
  begin
    FItemIndex := Message.wParam;
    Self.text:=FItems[FitemIndex];
    if Assigned(FOnChange) Then FOnChange(Self);
  end;
end;

procedure TAHMDBLookupMenu.SetItemIndex(Value : Integer);
begin
  if FFocused and EditCanModify then
  if (Value>-2) and (Value<FItems.Count-1) then
  begin
    FItemIndex:=Value;
    if Value=-1 then Self.Text:=FNonSelected else Self.text:=FItems[FitemIndex];
    If Assigned(FOnChange) then FOnChange(self);
  end;
end;

procedure TAHMDBLookupMenu.OnLookupPress(Sender : TObject);
var pc,pd: TPoint;
    hMyMenu: Hmenu;
    i: Integer;
    CCaption: array[0..255] of Char;
begin
  if FFocused and EditCanModify then
  If Fitems.Count >=1 then
  begin
    hMyMenu := CreatePopupMenu;
    For i := 1 to FItems.Count Do
      if FItems[i-1] = '-' then
        appendmenu(HMyMenu,MF_MENUBREAK,i-1,nil)
      else
      begin
        StrPCopy(CCaption,FItems[i-1]);
        if (FItemChecked) and (ItemIndex = i-1) then
          AppendMenu(HMyMenu,MF_STRING or MF_CHECKED,i-1,CCaption)
        else
          AppendMenu(HMyMenu,MF_STRING,i-1,CCaption);
      end;
    pc.x := left;
    pc.y := top + Height;
    With (Owner as TForm) do pd := ClientToScreen(pc);
    TrackPopupMenu(HMyMenu,TPM_LEFTALIGN,pd.x,pd.y,0,Handle,nil);
    DestroyMenu(HMyMenu);
    PostMessage(Handle,WM_LBUTTONUP,0,0);
  end;
end;

procedure TAHMDBLookupMenu.Notification(AComponent: TComponent;Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation=opRemove) and (FDataLink<>nil) and (AComponent=DataSource) then DataSource:=nil;
end;

procedure TAHMDBLookupMenu.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (Key in [#32..#255]) and (FDataLink.Field <> nil) and not FDataLink.Field.IsValidChar(Key) then
  begin
    MessageBeep(0);
    Key := #0;
  end;
  case Key of
    ^H, ^V, ^X, #32..#255 : FDataLink.Edit;
    #27 :
    begin
      FDataLink.Reset;
      SelectAll;
      Key := #0;
    end;
  end;
end;

function TAHMDBLookupMenu.EditCanModify: Boolean;
begin
  Result := FDataLink.Edit;
end;

procedure TAHMDBLookupMenu.Reset;
begin
  FDataLink.Reset;
  SelectAll;
end;

procedure TAHMDBLookupMenu.SetFocused(Value: Boolean);
begin
  if FFocused <> Value then
  begin
    FFocused := Value;
    if value then Windows.Setfocus(Handle);
    FDataLink.Reset;
  end;
end;

procedure TAHMDBLookupMenu.Change;
begin
  FDataLink.Modified;
  inherited Change;
end;

function TAHMDBLookupMenu.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TAHMDBLookupMenu.SetDataSource(Value: TDataSource);
begin
  FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TAHMDBLookupMenu.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TAHMDBLookupMenu.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TAHMDBLookupMenu.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TAHMDBLookupMenu.DataChange(Sender: TObject);
begin
  Seteditrect;
  if FDataLink.Field <> nil then
  begin
    if FAlignment <> FDataLink.Field.Alignment then
    begin
      EditText := '';
      FAlignment := FDataLink.Field.Alignment;
    end;
    EditMask := FDataLink.Field.EditMask;
    if FDataLink.Field.DataType = ftString then
      MaxLength := FDataLink.Field.Size else
      MaxLength := 0;
    if FFocused and FDataLink.CanModify then
      Text := FDataLink.Field.Text
    else
      EditText := FDataLink.Field.DisplayText;
  end else
  begin
    FAlignment := taLeftJustify;
    EditMask := '';
    MaxLength := 0;
    EditText:='';
  end;
end;

procedure TAHMDBLookupMenu.EditingChange(Sender: TObject);
begin
  inherited Readonly := not FDataLink.Editing;
end;

procedure TAHMDBLookupMenu.UpdateData(Sender: TObject);
begin
  ValidateEdit;
  FDataLink.Field.Text := Text;
end;

procedure TAHMDBLookupMenu.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SelectAll;
    SetFocus;
    raise;
  end;
  SetFocused(False);
  CheckCursor;
  DoExit;
end;

procedure TAHMDBLookupMenu.CMGetDataLink(var Message: TMessage);
begin
  Message.Result := Integer(FDataLink);
end;

procedure TAHMDBLookupMenu.CreateParams(var Params: TCreateParams);
const
  Alignments: array[TAlignment] of Longint = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;

procedure TAHMDBLookupMenu.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
end;


procedure TAHMDBLookupMenu.CMEnter(var Message: TMessage);
begin
  if AutoSelect and not (csLButtonDown in ControlState) then SelectAll;
  SetFocused(True);
  inherited;
end;

procedure TAHMDBLookupMenu.SelectAll;
begin
  if fDirectInput then inherited SelectAll;
end;

procedure TAHMDBLookupMenu.SetDirectInput(Value: Boolean);
begin
  FDirectInput := Value;
end;

procedure TAHMDBLookupMenu.WMPaste(var Message: TWMPaste);
begin
  if not FDirectInput or Readonly then Exit;
  FDataLink.Edit;
  inherited;
end;

procedure TAHMDBLookupMenu.WMCut(var Message: TWMCut);
begin
  if not FDirectInput or Readonly then Exit;
  FDataLink.Edit;
  inherited;
end;


end.
