dxbarextdbitems.pas

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

{*******************************************************************}
{                                                                   }
{       Developer Express Visual Component Library                  }
{       ExpressBars extended DB items                               }
{                                                                   }
{       Copyright (c) 1998-2008 Developer Express Inc.              }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{   The entire contents of this file is protected by U.S. and       }
{   International Copyright Laws. Unauthorized reproduction,        }
{   reverse-engineering, and distribution of all or any portion of  }
{   the code contained in this file is strictly prohibited and may  }
{   result in severe civil and criminal penalties and will be       }
{   prosecuted to the maximum extent possible under the law.        }
{                                                                   }
{   RESTRICTIONS                                                    }
{                                                                   }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES           }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE    }
{   SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS   }
{   LICENSED TO DISTRIBUTE THE EXPRESSBARS AND ALL ACCOMPANYING VCL }
{   CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY.                 }
{                                                                   }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED      }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE        }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE       }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT  }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                      }
{                                                                   }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}

unit dxBarExtDBItems;

{$I cxVer.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Db, StdCtrls, Forms,
  dxCommon, dxBar;

type
  TdxBarLookupCombo = class;
  TdxBarPopupLookupControl = class;

  TdxBarLookupLink = class(TDataLink)
  private
    FBarLookupCombo: TdxBarLookupCombo;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
    procedure LayoutChanged; override;
  end;

  TdxBarLookupCombo = class(TCustomdxBarCombo)
  private
    FAllowResizing: Boolean;
    FCurKeyValue: Variant;
    FListLink: TdxBarLookupLink;
    FPopupList: TdxBarPopupLookupControl;
    FKeyFieldName: string;
    FListFieldName: string;
    FListFieldIndex: Integer;
    FKeyField: TField;
    FListField: TField;
    FListFields: TList;
    FKeyValue: Variant;
    FSetValue: Boolean;
    FListActive: Boolean;
    FColor: TColor;
    FImmediateDropDown : Boolean;
    FPopupWidth: Integer;

    FRowCount: Integer;

    FListVisible: Boolean;
    FFindSelection: Boolean;
    FFindStr: string;
    FInFindSelection: Boolean;

    FLocateEdit: TEdit;
    FLocateList: TdxBarPopupLookupControl;

    FOnKeyValueChange: TNotifyEvent;

    FForm: TForm;
    ButtonOk, ButtonCancel: TButton;

    function GetListSource: TDataSource;
    procedure SetKeyFieldName(const Value: string);
    procedure SetKeyValue(const Value: Variant);
    procedure SetListFieldIndex(Value: Integer);
    procedure SetListFieldName(const Value: string);
    procedure SetListSource(Value: TDataSource);
    procedure SetRowCount(Value: Integer);

    function GetEditHandle : Integer;
    function GetEditText : String;
    procedure SetEditText(AText : String);
    procedure DoKeyPress(Sender: TObject; var Key: Char);
    procedure DoKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

    procedure FormSize(Sender: TObject);
  protected
    procedure CloseUp; override;
    procedure DoEnter; override;
    procedure DropDown(X, Y: Integer); override;
    function GetDropDownWindow: HWND; override;
    function CheckKeyForDropDownWindow(Key: Word; Shift: TShiftState): Boolean; override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;

    procedure UpdateListFields;
    procedure ListLinkDataChanged;
    procedure KeyValueChanged;
    function LocateKey: Boolean;
    procedure ResetFindStr;

    property EditText: string read GetEditText write SetEditText;
    property ListFields: TList read FListFields;
    property ListLink: TdxBarLookupLink read FListLink;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DoClick; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    property KeyValue: Variant read FKeyValue write SetKeyValue;
  published
    property AllowResizing: Boolean read FAllowResizing write FAllowResizing default True;
    property Color: TColor read FColor write FColor default clWindow;
    property ImmediateDropDown: Boolean read FImmediateDropDown write FImmediateDropDown default False;
    property KeyField: string read FKeyFieldName write SetKeyFieldName;
    property ListField: string read FListFieldName write SetListFieldName;
    property ListFieldIndex: Integer read FListFieldIndex write SetListFieldIndex default 0;
    property ListSource: TDataSource read GetListSource write SetListSource;
    property RowCount: Integer read FRowCount write SetRowCount;
    property Text stored False;
    property PopupWidth: Integer read FPopupWidth write FPopupWidth default 0;

    property OnKeyValueChange: TNotifyEvent read FOnKeyValueChange write FOnKeyValueChange;
  end;

  TdxBarLookupComboControl = class(TCustomdxBarComboControl)
  protected
    procedure SetFocused(Value: Boolean); override;
    procedure WndProc(var Message: TMessage); override;
  end;

  TdxBarPopupLookupLink = class(TDataLink)
  private
    FBarPopupLookup: TdxBarPopupLookupControl;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
    procedure LayoutChanged; override;
    procedure DataSetScrolled(Distance: Integer); override;
  end;

  TdxBarPopupLookupControl = class(TCustomControl)
  private
    FListLink: TdxBarPopupLookupLink;
    FListFieldName: string;
    FListFieldIndex: Integer;
    FListField: TField;
    FListFields: TList;
    FListActive : Boolean;

    FRecordIndex: Integer;
    FRecordCount: Integer;
    FRowCount: Integer;
    FTracking: Boolean;
    FTimerActive: Boolean;
    FMousePos: Integer;
    FSelectedItem: string;

    FHScrollWidth : Integer;
    FVScrollWidth : Integer;
    FCloseBtnDown : Boolean;
    FCloseBtnPaint : Boolean;
    FComboTop : Integer;

    FCombo: TdxBarLookupCombo;
    FCorner: TdxCorner;
    FCloseButtonRect, FGripRect: TRect;
    FCloseButtonIsTracking: Boolean;
    FMouseAboveCloseButton: Boolean;

    function GetListSource: TDataSource;
    function GetPainter: TdxBarPainter;
    procedure SetListFieldName(const Value: string);
    procedure SetListSource(Value: TDataSource);

    procedure SelectCurrent;
    procedure SelectItemAt(X, Y: Integer);
    procedure SetRowCount(Value: Integer);
    procedure StopTimer;
    procedure StopTracking;
    procedure TimerScroll;
    procedure UpdateScrollBar;

    procedure WMCancelMode(var Message: TMessage); message WM_CANCELMODE;
    procedure WMCaptureChanged(var Message: TMessage); message WM_CAPTURECHANGED;
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
    procedure WMGetMinMaxInfo(var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCHitTest(var Message: TWMNCHITTEST); message WM_NCHITTEST;
    procedure WMNCLButtonDown(var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMTimer(var Message: TMessage); message WM_TIMER;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
    procedure WMWindowPosChanging(var Message : TWMWINDOWPOSCHANGING); message WM_WINDOWPOSCHANGING;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DblClick; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure ListLinkDataChanged;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure Paint; override;

    function GetTextHeight: Integer;
    procedure UpdateListFields;

    property ListField: string read FListFieldName write SetListFieldName;
    property ListFieldIndex: Integer read FListFieldIndex write FListFieldIndex default 0;
    property ListFields: TList read FListFields;
    property ListLink: TdxBarPopupLookupLink read FListLink;
    property ListSource: TDataSource read GetListSource write SetListSource;
    property Painter: TdxBarPainter read GetPainter; 
  public
    IsPopup: Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    property ComboTop: Integer read FComboTop write FComboTop;
    property RowCount: Integer read FRowCount write SetRowCount stored False;
    property SelectedItem: string read FSelectedItem;
  end;

implementation

{$R dxBarExtDBItems.res}

uses
  {$IFDEF DELPHI6}Variants,{$ENDIF} dxBarCommon, cxClasses, dxBarStrs;

function VarEquals(const V1, V2: Variant): Boolean;
begin
  Result := False;
  try
    Result := V1 = V2;
  except
  end;
end;

{ TdxBarLookupLink }

procedure TdxBarLookupLink.ActiveChanged;
begin
  if FBarLookupCombo <> nil then FBarLookupCombo.UpdateListFields;
end;

procedure TdxBarLookupLink.DataSetChanged;
begin
  if FBarLookupCombo <> nil then FBarLookupCombo.ListLinkDataChanged;
end;

procedure TdxBarLookupLink.LayoutChanged;
begin
  if FBarLookupCombo <> nil then FBarLookupCombo.UpdateListFields;
end;

{ TdxBarLookupCombo }

constructor TdxBarLookupCombo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Glyph.LoadFromResourceName(HInstance, 'DXBARLOOKUPCOMBO');

  FAllowResizing := True;
  FListLink := TdxBarLookupLink.Create;
  FListLink.FBarLookupCombo := Self;
  FListFields := TList.Create;
  FKeyValue := Null;
  FRowCount := 7;
  FPopupList := TdxBarPopupLookupControl.Create(nil);
  FColor := clWindow;
  with FPopupList do
  begin
    FCombo := Self;
  end;
end;

destructor TdxBarLookupCombo.Destroy;
begin
  FPopupList.Free;
  FListFields.Free;
  FListLink.FBarLookupCombo := nil;
  FListLink.Free;

  inherited Destroy;
end;

procedure TdxBarLookupCombo.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if (FListLink <> nil) and (AComponent = ListSource) then ListSource := nil;
end;

procedure TdxBarLookupCombo.CloseUp;
begin
  if GetCapture = FPopupList.Handle then ReleaseCapture;

  RowCount := FPopupList.RowCount;
  FPopupWidth := FPopupList.Width;
  FListVisible := False;
  ResetFindStr;
  if FKeyField = nil then
    FCurKeyValue := Null
  else
    FCurKeyValue := FKeyField.Value;

  inherited;

  FPopupList.ListSource := nil;
  FPopupList.Parent := nil;
end;

procedure TdxBarLookupCombo.DoEnter;
begin
  ResetFindStr;
  inherited;
end;

procedure TdxBarLookupCombo.DropDown(X, Y: Integer);
var
  AControlWidth: Integer;
  R: TRect;
  W: Integer;
begin
  FSetValue := False;

  with FPopupList do
  begin
    IsPopup := True;
    Parent := CurItemLink.Control.Parent;
    GetWindowRect(TdxBarLookupComboControl(CurItemLink.Control).Handle, R);
    ComboTop := R.Top + (R.Bottom - R.Top) div 2;
    InternalInitDropDownWindow(FPopupList);
    if Self.Color <> clWindow then
      Color := Self.Color;

    if Self.ListField <> '' then
      ListField := Self.ListField
    else
      ListField := Self.KeyField;
    ListFieldIndex := Self.ListFieldIndex;
    RowCount := Self.RowCount;
    ListSource := Self.ListSource;
    if FListLink.Active then
      FRecordCount := FListLink.RecordCount;
    if not FInFindSelection and not VarIsNull(FCurKeyValue) and FListLink.Active then
      FListLink.DataSet.Locate(FKeyFieldName, FCurKeyValue, []);
  end;

  with CurItemLink.ItemRect do
    W := Right - Left - TdxBarLookupComboControl(CurItemLink.Control).GetCaptionAreaWidth;
  if W > FPopupWidth then
    AControlWidth := W
  else
    AControlWidth := FPopupWidth;

  SetWindowPos(FPopupList.Handle, 0, 0, 0, AControlWidth, FPopupList.Height,
    SWP_NOZORDER or SWP_NOMOVE or SWP_NOACTIVATE);
  FListVisible := True;

  inherited DropDown(X, Y);
end;

procedure TdxBarLookupCombo.DoClick;
var
  W, H, D, I, J: Integer;
begin
  inherited DoClick;
  if Assigned(OnClick) or ReadOnly then
    Exit;

  FForm := TForm.Create(nil);
  with FForm do
  begin
    if FAllowResizing then
      BorderIcons := []
    else
      BorderStyle := bsDialog;
    Caption := cxGetResourceString(@dxSBAR_LOOKUPDIALOGCAPTION);
    Font := BarManager.Font;
    Position := poScreenCenter;

    FLocateEdit := TEdit.Create(FForm);
    with FLocateEdit do
    begin
      Parent := FForm;
      OnKeyPress := DoKeyPress;
      OnKeyDown := DoKeyDown;
    end;
    FLocateList := TdxBarPopupLookupControl.Create(FForm);
    with FLocateList do
    begin
      FCombo := Self;
      IsPopup := False;
      Parent := FForm;
      Color := clWindow;
      if Self.ListField <> '' then
        ListField := Self.ListField
      else
        ListField := Self.KeyField;
      ListFieldIndex := Self.ListFieldIndex;
      ListSource := Self.ListSource;

      Height := 2 * 2 + Self.RowCount * GetTextHeight;
      if Self.FPopupWidth = 0 then
        Width := FLocateEdit.Width
      else
        Width := Self.FPopupWidth;
    end;
    ButtonOk := TButton.Create(FForm);
    with ButtonOk do
    begin
      Caption := cxGetResourceString(@dxSBAR_LOOKUPDIALOGOK);
      Default := True;
      ModalResult := mrOk;
      Parent := FForm;
    end;
    ButtonCancel := TButton.Create(FForm);
    with ButtonCancel do
    begin
      Caption := cxGetResourceString(@dxSBAR_LOOKUPDIALOGCANCEL);
      Cancel := True;
      ModalResult := mrCancel;
      Parent := FForm;
    end;

    H := MulDiv(FLocateEdit.Height, 43, 42);
    W := MulDiv(H, 13, 4);
    D := FLocateEdit.Height div 4;

    FLocateEdit.SetBounds(D, D, FLocateList.Width, FLocateEdit.Height);
    with FLocateList do
    begin
      Left := D;
      Top := FLocateEdit.BoundsRect.Bottom + D;
    end;
    ButtonOk.SetBounds(FLocateList.BoundsRect.Right + D, D, W, H);
    ButtonCancel.SetBounds(ButtonOk.Left, ButtonOk.BoundsRect.Bottom + D, W, H);
    I := D + FLocateList.Width + D + W + D;
    J := D + FLocateEdit.Height + D + FLocateList.Height + D;
    if J < 3 * D + 2 * H then J := 3 * D + 2 * H;
    while (ClientWidth <> I) or (ClientHeight <> J) do
    begin
      ClientWidth := I;
      ClientHeight := J;
    end;

    OnResize := FormSize;
    FLocateEdit.Text := Text;