tntlookupcomboboxex.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

unit TntLookupComboBoxEx;

interface

{$INCLUDE TntCompilers.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, DBCtrls, DBGrids, TntDBGrids, TntDBCtrls, DB, TntStdCtrls, TntSysUtils,
  TntDB, TntClasses, TntDbCtrlsEx, TntVer;

type
  TSetupDataSourceEvent = procedure(Sender: TObject;
    const Text: WideString) of object;
  TCloseUpEvent = procedure(Sender: TObject;
    Accepted: Boolean) of object;

  TTntCustomDynLookupComboBox = class(TTntCustomComboBox)
  private
    FAbout: TAboutInfo;
    FOnSetupDataSource: TSetupDataSourceEvent;
    FLeavingPopup: Boolean;
    FOnCloseUp: TCloseUpEvent;
    FForm: TForm;
    FFormWindowProc: TWndMethod;
    FGrid: TTntDBGrid;
    FShowing, FCancelFlag: Boolean;
    FListSource: TDataSource;
    FListField: string;
    FListIndex: Integer;
    FJustLeftGrid: Boolean;
    FGridWidth: Integer;
    procedure ClearColumns;
    procedure FormWindowProcHook(var Message: TMessage);
    procedure SetGridWidth(const Value: Integer);
  protected
    procedure DropDown; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure GridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y:
      Integer);
    procedure LeavePopup(Sender: TObject); virtual;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  protected
    property ListSource: TDataSource read FListSource write FListSource;
    property ListField: string read FListField write FListField;
    property ListIndex: Integer read FListIndex write FListIndex;
    property OnSetupDataSource: TSetupDataSourceEvent
      read FOnSetupDataSource write FOnSetupDataSource;
    property OnCloseUp: TCloseUpEvent read FOnCloseUp write FOnCloseUp;
    property CancelFlag: Boolean read FCancelFlag write FCancelFlag;
  published
    property About: TAboutInfo read FAbout write FAbout stored False;
    property Style; {Must be published before Items}
    property GridWidth: Integer read FGridWidth write SetGridWidth default -1;
    property Color;
    property Ctl3D;
    property DragMode;
    property DragCursor;
    property DropDownCount;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDrag;
  end;

  TTntDynLookupComboBox = class(TTntCustomDynLookupComboBox)
  published
    property ListSource;
    property ListField;
    property ListIndex;
    property OnSetupDataSource;
    property OnCloseUp;

    property Style;
    property Color;
    property Ctl3D;
    property DragMode;
    property DragCursor;
    property DropDownCount;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDrag;
  end;

  TTntDBDynLookupComboBox = class(TTntCustomDynLookupComboBox)
  private
    FDataLink: TFieldDataLink;
    FPaintControl: TTntPaintControl;
    procedure DataChange(Sender: TObject);
    procedure EditingChange(Sender: TObject);
    function GetComboText: WideString;
    function GetDataField: string;
    function GetDataSource: TDataSource;
    function GetField: TField;
    procedure SetComboText(const Value: WideString);
    procedure SetDataField(const Value: string);
    procedure SetDataSource(Value: TDataSource);
    procedure SetItems(Value: TTntStrings); reintroduce;
    procedure SetReadOnly(Value: Boolean);
    procedure UpdateData(Sender: TObject);
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;
    procedure CMGetDataLink(var Message: TMessage); message CM_GETDATALINK;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  protected
    procedure Change; override;
    procedure Click; override;
    procedure CreateWnd; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure SetStyle(Value: TComboboxStyle); override;
    procedure DropDown; override;
    function GetReadOnly: Boolean;
    procedure LeavePopup(Sender: TObject); override;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function ExecuteAction(Action: TBasicAction): Boolean; override;
    function UpdateAction(Action: TBasicAction): Boolean; override;
    function UseRightToLeftAlignment: Boolean; override;
    property Field: TField read GetField;
    property Text;
  published
    property ListSource;
    property ListField;
    property ListIndex;
    property OnSetupDataSource;
    property OnCloseUp;

    property Style; {Must be published before Items}
    property Anchors;
    property BiDiMode;
    property Color;
    property Constraints;
    property Ctl3D;
    property DataField: string read GetDataField write SetDataField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property Items write SetItems stored False;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDock;
    property OnStartDrag;
  end;

type
  TTntCustomValueComboBox = class(TTntCustomComboBox)
  private
    FAbout: TAboutInfo;
    FValues: TTntStrings;
    function GetValue: WideString;
    procedure SetValue(const Value: WideString);
    procedure SetValues(const Value: TTntStrings);
  protected
    procedure SetStyle(Value: TComboBoxStyle); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Clear; override;
    property Value: WideString read GetValue write SetValue;
    property Values: TTntStrings read FValues write SetValues;
  published
    property About: TAboutInfo read FAbout write FAbout stored False;
  end;

  TTntValueComboBox = class(TTntCustomValueComboBox)
  published
    property Style; {Must be published before Items}
    property Anchors;
    property BiDiMode;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property DropDownCount;
    property Enabled;
    property Font;
    property ImeMode;
    property ImeName;
    property ItemHeight;
    property MaxLength;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;
    property OnChange;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnDropDown;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnStartDock;
    property OnStartDrag;
    property Items; { Must be published after OnMeasureItem }
    property Values;
  end;

procedure LoadValueComboBox(C: TTntCustomValueComboBox; DataSet: TDataSet;
  const FieldName, FieldValueName: string);

implementation

uses
  DBConsts{$IFDEF DELPHI_6_UP}, VDbConsts{$ENDIF},
  TntDbEx, TntDBCtrls2;

procedure TTntCustomDynLookupComboBox.ClearColumns;
begin
  FGrid.Columns.Clear;
end;

constructor TTntCustomDynLookupComboBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if not (csDesigning in ComponentState) then
  begin
    FForm := TForm.Create(Self);
    FForm.ParentFont := True;
    FForm.BorderStyle := Forms.bsNone;
    FForm.AutoScroll := FALSE;
    FForm.Color := Color;
    FForm.Visible := False;
    FFormWindowProc := FForm.WindowProc;
    FForm.WindowProc := FormWindowProcHook;
    FGrid := TTntDBGrid.Create(Self);
    with FGrid do
    begin
      Align := alClient;
      Parent := FForm;
      ParentFont := True;
      OnKeyDown := GridKeyDown;
      OnDblClick := LeavePopup;
      //OnExit := DeactivateForm;
      Ctl3D := False;
      Options := [dgColLines, dgRowSelect];
      ClearColumns;
    end;
  end
  else
    FGrid := nil;
  FGridWidth := -1;
  FOnSetupDataSource := nil;
  FOnCloseUp := nil;
  FShowing := False;

  FListSource := nil;
  FListField := '';
  FListIndex := 0;
  FCancelFlag := False;
end;

destructor TTntCustomDynLookupComboBox.Destroy;
begin
  inherited Destroy;
end;

procedure TTntCustomDynLookupComboBox.FormWindowProcHook(var Message: TMessage);
var
  F: TCustomForm;
begin
  case (Message.Msg) of
    WM_MOUSEACTIVATE:
      begin
        Message.Result := MA_NOACTIVATE;
        SetWindowPos(FForm.Handle, HWND_TOP, 0, 0, 0, 0, SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);

        if (GetActiveWindow <> FForm.Handle) then
          SetActiveWindow(Parent.Handle);

        exit;
      end;
    WM_ACTIVATE:
      begin
        if ((Parent.Handle = GetActiveWindow) <> Boolean(TWMActivate(Message).Active)) then
          SendMessage(Parent.Handle, WM_NCACTIVATE, TWMActivate(Message).Active, 0);

        if (TWMActivate(Message).Active = WA_INACTIVE) then
        begin
          F := GetParentForm(Self); // Combobox's form
          if Assigned(F) and (TWMActivate(Message).ActiveWindow = F.Handle) then
          begin
            FJustLeftGrid := True;
            if not FLeavingPopup then
              FCancelFlag := True;
          end;
          LeavePopup(nil);
        end;
      end;

  end; // case

  FFormWindowProc(Message);
end;

procedure TTntCustomDynLookupComboBox.CMTextChanged(var Message: TMessage);
begin
  inherited;
  if FForm <> nil then
  begin
    FForm.Visible := False;
  end;
end;

procedure TTntCustomDynLookupComboBox.DropDown;
var
  FieldPos, FieldLength: Integer;
  CurrentField: string;
  F: TCustomForm;
  aPoint: TPoint;
begin
  F := GetParentForm(Self);
  if Assigned(F) and (F.ActiveControl = FGrid) then
    SetFocus;

  if FJustLeftGrid then
  begin
    FJustLeftGrid := False;
    Exit;
  end;
  //inherited;
  aPoint := Point(Left, Top + Height);
  aPoint := Parent.ClientToScreen(aPoint);
  if FGridWidth = -1 then
    FForm.Width := Self.Width
  else
    FForm.Width := FGridWidth;
  if (aPoint.x + FForm.Width < Screen.Width) then
    FForm.Left := aPoint.x
  else
    FForm.Left := aPoint.x + Width - FForm.Width;

  if (aPoint.y + FForm.Height > Screen.Height) then
    FForm.Top := aPoint.y - Height - FForm.Height
  else
    FForm.Top := aPoint.y;

  FForm.Height := Self.DropDownCount * (Self.Height - 2);
  with FGrid do
  begin