wwdbcomb.pas

胜天进销存源码,国产优秀的进销存

unit Wwdbcomb;
{$R-}
{
//
// Components : TwwDBCustomCombo, TwwDBComboDlg
//
// Copyright (c) 1996, 1997, 1998 by Woll2Woll Software
//
// 7/23/97 - Enable edit so later call to edit will not revert text to
//           original value
// 7/30/97 - Set modified to True since clearing
//
// 9/24/97 - Call SetItemIndex instead of setting FItemIndex in SelectValue methods
//
// 9/25/97 - KeyDown method - Don't search or auto-dropdown if alt key is pressed
//
//
// 9/26/97 - Prevents going into edit mode if closeup method does not have
//           any entry selected.
//
// 11/18/97 - AllowClearKey when not dropped down did not set modified flag.
//            As a result, the clearing was not saved.  This problem is now fixed.
//
// 1/16/98  - Numpad digits not handled in KeyDown method.
//
// 3/24/98 - Added Value property which is hidden stored value
// 4/8/98 - Update FItemIndex in DataChange event
// 4/29/98 - skip code if shift key pressed
// 10/12/98 - Don't restore ShowHint if it was never dropped down
// 11/15/98 - Calling closeup immediately would cause problems from hook
// 2/24/99 - Fix for ItemIndex being incorrect at time of OnCloseUp
// 3/31/99 - Improved support for ShowMatchText and AllowClearKey
// 4/2/99 - Support calculated field edits
// 4/18/99 - Only execute 4/2/99 code change for calculated fields
// 6/29/99 - ShowMatchText cursor pos should be where typing
// 8/17/00 - Add history list
// 8/17/00 - Only ignore key if csDropDownList
// 9/5/00 - Fire onkeydown event
// 10/11/2000-PYW-Prevents backspace from working on string lengths > 32
// 10/20/2000- Update listbox's itemindex property when value set.
// 11/28/2000 - PYW - Check based on actual work area.
// 12/17/00 RSW - Fix problem where handle gets created when destroying
// 10/4/01 RSW - In applylist, update flag for dirtylistbox.  This prevents the
//               problem where the itemindex from being cleared
// 10/4/01 - GetComboValue was returning displaytext when using mapped values
//           if the displayvalue was not found.  This was an incompatibility
//           with InfOpower 2000.
//10/29/01 - Handle the case when abort is called.
//11/05/2001 - Allow overriding of Listbox Color and Font.
//11/05/2001 - Not taking into account maplist when owner draw.
// 11/29/01 - Don't paste into control with csDropDownList
// 12/12/2001-Don't clear result if this is for TwoColumnDisplay
// 2/19/02 - Case insensitive when maplist is true
// 2/22/2002 - Don't do otherwise to delay listbox creation until necessary
// 9/18/02 - Don't call addhistory event if already in list
}
interface
{$i wwIfDef.pas}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, Mask, Wwdbedit, Wwdotdot,
  db, menus, wwdatsrc, wwtypes, grids, wwframe, wwhistorylist;


type

  TwwDBCustomComboBox = class;
  TwwDBComboBox = class;
  TwwComboCloseUpEvent = procedure(Sender: TwwDBComboBox; Select: boolean) of object;
  TwwAddHistoryItemEvent = procedure(Sender: TwwDBCustomComboBox; Value : String; var Accept : Boolean) of object;

  TwwPopupListbox = class(TCustomListbox)
  private
    FSearchText: String;
    FSearchTickCount: Longint;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
//    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure KeyPress(var Key: Char); override;
    procedure DrawItem(Index: Integer; Rect: TRect;
      State: TOwnerDrawState); override;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
  public
    constructor Create(AOwner: TComponent); Override;
    property Sorted;  // Allows inherited TwwDBComboBox control to access Sorted property
  end;

  TwwDBCustomComboBox = class(TwwDBCustomCombo)
  private
    FMapList: boolean;
    FItems: TStrings;
    FDropDownCount: integer;
    FItemHeight: integer;
    FListbox: TwwPopupListBox;
    FListVisible: Boolean;
    FNoKeysEnteredYet: boolean;
    FAllowClearKey: boolean;
    FItemIndex: integer;
    FStyle: TComboBoxStyle;
    FCanvas: TCanvas;
    FDropDownWidth: integer;
    FAutoDropDown: boolean;
    FShowMatchText: boolean;
    FHistoryList: TwwHistoryList;

    FOnDropDown: TNotifyEvent;
    FOnCloseUp: TwwComboCloseUpEvent;
    FOnDrawItem: TDrawItemEvent;
    FOnMeasureItem: TMeasureItemEvent;
    FOnAddHistoryItem: TwwAddHistoryItemEvent;

    InAutoDropDown: boolean;
    LastShowHint: boolean;
    PreDropDownText: string;
    DoSelChange: boolean;
    DirtyListBox: boolean;

    FDisableDropDownList: boolean;
    FColumn1Width: integer;
    FTwoColumnDisplay: boolean;

    function GetComboText: string;
    procedure SetComboText(const Value: string);
    procedure SetItemList(Value: TStrings);
    Function GetSorted: boolean;
    procedure SetSorted(val: Boolean);
    Function GetItemIndex: integer;
    procedure ListMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    {$ifndef wwDelphi4Up}
    procedure WndProc(var Message: TMessage); override;
    {$endif}
    procedure WMPaste(var Message: TMessage); message WM_PASTE;
    Function GetCanvas: TCanvas;
    Procedure SetStyle(val: TComboBoxStyle);
    Function GetValue: string;
    procedure SetDroppedDown(val: boolean);
  protected
    Procedure SetValue(Value: string); virtual;
    Function IndexOf(Value: string; StartIndex: integer = 0): integer; virtual;
    procedure Loaded; override;
    Function OwnerDraw: boolean; override;
    Function GetStoredText: string; override;
    procedure CloseUp(Accept: Boolean); override;
    Function IsDroppedDown: boolean; override;
    Function Editable: boolean; override;
    Function MouseEditable: boolean; override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    function CreateListBox: TwwPopupListBox; virtual;
    procedure ListBoxNeeded;
    procedure DoSelectAll;
    Procedure ShowText(ACanvas: TCanvas;
          ARect: TRect; indentLeft, indentTop: integer; AText: string; transparent: boolean = false); override;
    procedure SetListBoxItemIndex(val: integer);
    {$ifdef wwDelphi4Up}
    procedure WndProc(var Message: TMessage); override;
    {$endif}
    procedure ProcessSearchKey(
      Key: char;
      NewItemIndex: integer;
      OldItemIndex: integer;
      FSearchText: string;
      MatchTextFromList: string);

    procedure DataChange(Sender: TObject); virtual;
    procedure SetItemIndex(val: integer); virtual;
    function CalcItemHeight: integer; virtual;

  public
    procedure WMCut(var Message: TMessage); message WM_CUT;
    procedure WMClear(var Message: TMessage); message WM_CLEAR;
    procedure CMCancelMode(var Message: TCMCancelMode); message CM_CancelMode;
    procedure WMKillFocus(var Message: TWMKillFocus); message WM_KillFocus;
    procedure CNKeyDown(var Message: TWMKeyDown); message CN_KEYDOWN; {handle tab}
    procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
    procedure CMExit(var Message: TCMExit); message CM_EXIT;

  public
    property Listbox: TwwPopupListBox read FListbox;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure ListBoxItemsNeeded;
    procedure DeleteItem(Value: string; DeleteFromHistory: boolean = False); virtual;
    procedure AddItem(Value: string; AddToHistory: boolean = False); virtual;
    procedure ClearHistory; virtual;

    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    Function GetFieldMapText(StoreValue: string; var res: string): boolean; override; { Map Value to Display Value }
    Function GetComboValue(DisplayText: string): string; virtual;
    Function GetComboDisplay(Value: string): string; virtual;
    procedure ApplyList; virtual;
    procedure DropDown; override;

{    property Text;}
    property Canvas : TCanvas read GetCanvas;
    property DroppedDown: boolean read IsDroppedDown write SetDroppedDown;
    property Value: string read GetValue write SetValue;

  public
    property ShowButton;  { Publish before Style property for SetStyle code }
    property Style : TComboboxStyle read FStyle write SetStyle; {Must be published before Items}
    property MapList: boolean read FMapList write FMapList; { publish before Items }

    property AllowClearKey : boolean read FAllowClearKey write FAllowClearKey;
    property AutoDropDown : boolean read FAutoDropDown write FAutoDropDown default False;
    property EditAlignment;
    property ShowMatchText: boolean read FShowMatchText write FShowMatchText default False;
    property ButtonStyle default cbsDownArrow;
    property DropDownCount : integer read FDropDownCount write FDropDownCount;
    property DropDownWidth: Integer read FDropDownWidth write FDropDownWidth default 0;
    property DisableDropDownList: boolean read FDisableDropDownList write FDisableDropDownList default False;
    property TwoColumnDisplay: boolean read FTwoColumnDisplay write FTwoColumnDisplay default False;
    property Column1Width: integer read FColumn1Width write FColumn1Width default 0;

    property HistoryList: TwwHistoryList read FHistoryList write FHistoryList;
    property ItemHeight : integer read FItemHeight write FItemHeight;
    property Items : TStrings read FItems write SetItemList;
    property ItemIndex: integer read GetItemIndex write SetItemIndex default -1;
    property Sorted : boolean read GetSorted write SetSorted;

    property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
    property OnCloseUp: TwwComboCloseUpEvent read FOnCloseUp write FOnCloseUp;
    property OnDrawItem : TDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
    property OnAddHistoryItem: TwwAddHistoryItemEvent read FOnAddHistoryItem write FOnAddHistoryItem;
  protected
    procedure Reset; override;
  end;

  TwwDBComboBox = class(TwwDBCustomComboBox)
  published
    property Controller;
    property BevelEdges;
    property BevelInner;
    property BevelKind default bkNone;
    property BevelOuter;

    
    property DisableThemes;
    {$ifdef wwDelphi4Up}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property ParentBiDiMode;
    {$endif}

    property ShowButton;  { Publish before Style property for SetStyle code }
    property Style;
    property MapList;

    property AllowClearKey;
    property AutoDropDown;
    property ShowMatchText;
    property AutoFillDate;
    property AutoSelect;
    property AutoSize;
    property BorderStyle;
    property ButtonStyle default cbsDownArrow;
    property CharCase;
    property Color;
    property Column1Width;
    property Ctl3D;
    property DataField;
    property DataSource;
    property DisableDropDownList;
    property DragMode;
    property DragCursor;
    property DropDownCount;
    property DropDownWidth;
    property Enabled;
    property Font;
    property ButtonEffects;
    property Frame;
    property ButtonWidth;
    property ButtonGlyph;
    property HistoryList;

    {$ifdef wwDelphi3Up}
    property ImeMode;
    property ImeName;
    {$endif}
    property ItemHeight;
    property Items;
    property ItemIndex;
    property LimitEditRect;
    property MaxLength;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property Picture;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property Sorted;
    property TabOrder;
    property TabStop;
    property UnboundDataType;
    property UsePictureMask;
    property Visible;
    property UnboundAlignment;
    property TwoColumnDisplay;

    property OnAddHistoryItem;
    property OnChange;
    property OnCheckValue;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDropDown;
    property OnCloseUp;
    property OnDrawItem;
    property OnMeasureItem;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
  end;

procedure Register;

implementation

uses wwstr, wwcommon;

{ The following hook proc is a workaround for a delphi 4 bug
  where it no longer sends a CM_CANCELMODE message when the end-user
  clicks away from the dropped down list }
{$ifdef wwDelphi4up}
var wwHook: HHOOK;

function wwHookProc(nCode: Integer; wParam: Integer; lParam: Integer): LResult; stdcall;
var r1, r2: TRect;
begin
  result := CallNextHookEx(wwHook, nCode, wParam, lParam);
  with PMouseHookStruct(lParam)^ do
  begin
    if (wParam = WM_LBUTTONDOWN) or (wParam = WM_NCLBUTTONDOWN) then
    begin
      if (Screen.ActiveControl <> nil) and (Screen.ActiveControl is TwwDBCustomComboBox) then
        with (Screen.ActiveControl as TwwDBCustomComboBox) do
      begin
        { Auto-closeup if clicked outside of drop-down area }
        if DroppedDown then begin
           GetWindowRect(FListBox.Handle, r1);
           GetWindowRect(Handle, r2);
           if (not PtInRect(r1, pt)) and (not PtInRect(r2, pt)) then
             { 11/15/98 - Calling closeup immediately would cause problems
              if user's OnCloseUp aborted }
             PostMessage(Handle, CM_CANCELMODE, 0, 0);
//           CloseUp(True);
        end
      end;
    end;
  end;
end;
{$endif}

procedure TwwDBCustomComboBox.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    wm_KeyDown, wm_SysKeyDown, wm_Char:
      with TWMKey(Message) do
      begin
         { 4/29/98 - skip code if shift key pressed }
//         if not (ssShift in KeyDataToShiftState(KeyData)) then
         begin
             if not (isDroppedDown and
               (CharCode in [VK_LEFT, VK_RIGHT, VK_HOME, VK_END]) and
               (Message.Msg=wm_KeyDown)) then begin

               // 3/13/03 - give chance for KeyDown to fire
               if (Message.Msg = wm_keydown) and (charcode=vk_f4) then
               begin
                  inherited WndProc(Message);
                  if (Message.Msg = wm_keydown) and (charcode=vk_f4) then
                     HandleDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
                  exit;
               end;

               if (charcode<>vk_f4) then
                  HandleDropDownKeys(CharCode, KeyDataToShiftState(KeyData));
               if (CharCode <> 0) and FListVisible then
               begin
                 with TMessage(Message) do
                    SendMessage(FListBox.Handle, Msg, WParam, LParam);
               end