wwidlg.pas

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

unit wwidlg;
{
//
// Components : TwwLookupDialog, TwwSearchDialog, TwwCustomLookupDialog
//
// Copyright (c) 1995-2001 by Woll2Woll Software
//
// 9/19/97 - If show match text then have control update text in Activate method
//
// 11/4/97 - UseTFields=False did not update field order correctly (Fixed)
//
// 11/10/97 - AdjustcolumnstoIndex modifed to support virtual data sets
//
// 2/23/98 - Support client-datasets and publish OrderChange event.
// 4/30/98 - ColWidths is rounded to character boundary so expand grid by
//           difference
// 8/24/98 - With ClientDataSet, should check if field is nil
// 10/8/98 - KeyCombo fix to display hint and honor accelerator key
// 12/18/98 - Clear keycombo datasource if its not visible
// 12/9/99 - Put if clause first so that error is not generated if searchtable is unassigned
}

interface
{$i wwIfDef.pas}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Grids, DBTables, DB, StdCtrls,
  Buttons, Wwkeycb, Wwdbgrid,
  Wwtable, Wwdblook, {DsgnIntf, }wwCommon, wwstr, Wwdbigrd, Wwdatsrc,
  ExtCtrls, wwDialog;

type
  TwwLookupDlg = class;

  TwwDBLookupDlgOption =(opShowOKCancel, opShowSearchBy, opGroupControls,
                         opFixFirstColumn, opShowStatusBar, opDisableReorderColumns);
  TwwDBLookupDlgOptions = Set of TwwDBLookupDlgOption;

  TwwUserButtonEvent = procedure(Sender: TObject; LookupTable: TDataSet) of object;
  TwwOnInitDialogEvent = procedure(Dialog : TwwLookupDlg) of object;
  TwwSyncDataSetsEvent = procedure(Sender: TObject; MoveDataSet, BaseDataSet : TDataSet) of object;

  TwwLookupDlg = class(TForm)
    SearchCharacterLabel: TLabel;
    SortByLabel: TLabel;
    wwDBGrid1: TwwDBGrid;
    wwIncrementalSearch1: TwwIncrementalSearch;
    DataSource1: TwwDataSource;
    StatusHeader: THeader;
    UserButtonPanel: TPanel;
    UserButton1: TButton;
    UserButton2: TButton;
    procedure wwKeyCombo1Change(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure wwKeyCombo1Enter(Sender: TObject);

    procedure wwDBGrid1DblClick(Sender: TObject);
    procedure DataSource1DataChange(Sender: TObject; Field: TField);
//    procedure wwKeyCombo1KeyDown(Sender: TObject; var Key: Word;
//      Shift: TShiftState);
    procedure UserButton1Click(Sender: TObject);
    procedure UserButton2Click(Sender: TObject);
    procedure wwDBGrid1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    {$ifdef win32}
    procedure wwDBGrid1ColumnMoved(Sender: TObject; FromIndex,
      ToIndex: Integer);
    {$else}
    procedure wwDBGrid1ColumnMoved(Sender: TObject; FromIndex,
      ToIndex: Longint);
    {$endif}

  private
    InShow: boolean;
    FUserButton1Click: TwwUserButtonEvent;
    FUserButton2Click: TwwUserButtonEvent;
    FOnInitDialog: TwwOnInitDialogEvent;
    FOnCloseDialog: TwwOnInitDialogEvent;
    FOnSortChange: TNotifyEvent;
    FSearchText: string;
    FShowingChanged: boolean;
    OrigLeft: integer;
    CallingComponent: TComponent;

    initialized: boolean;
    PictureMaskFromField: boolean;
    procedure AdjustColumnsToIndex;
    procedure ResizeControls(padOnly: boolean);
    procedure ApplyIntl;
    procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure UpdateSearchField;

  protected
    procedure WriteStatusInfo;
    procedure DoShow; override;
    procedure Activate; override;

  public
    OKBtn: TButton;
    CancelBtn: TButton;

    MaxWidth, MaxHeight: integer;
    Options: TwwDBLookupDlgOptions;
    ClickedMemoField: boolean;
    ThisDataSet: TDataSet;
    wwKeyCombo1: TwwKeyCombo;

    constructor Create(AOwner: TComponent); override;
    procedure KeyComboChange;

  end;

  TwwCustomLookupDialog = class(TwwCustomDialog)
  private
    FUserButton1Click: TwwUserButtonEvent;
    FUserButton2Click: TwwUserButtonEvent;
    FOnInitDialog: TwwOnInitDialogEvent;
    FOnSyncDataSets: TwwSyncDataSetsEvent;
    FOnCloseDialog: TwwOnInitDialogEvent;
    FOnSortChange: TNotifyEvent;
    FUserButton1Caption: string;
    FUserButton2Caption: string;
    FUseTFields: boolean;
    FPictureMaskFromField: boolean;
    FControlType: TStrings;
    FControlInfoInDataset: boolean;
    FPictureMasks: TStrings;
    FPictureMaskFromDataSet: boolean;
    FOnPerformCustomSearch: TwwPerformSearchEvent;
    procedure SetPictureMasks(val: TStrings);
    procedure SetControlType(val: TStrings);

  protected
    FMaxWidth: integer;  { maximum width of dialog }
    FMaxHeight: integer;
    FGridTitleAlignment: TAlignment;
    FSelected : TStrings;
    FLookupTable: TDataSet;
    FSyncTable: TDataSet;
    FOptions: TwwDBLookupDlgOptions;
    FGridOptions: TwwDBGridOptions;
    FGridColor: TColor;
    FCaption: String;
    FCharCase: TEditCharCase;

    function GetSelectedFields: TStrings;
    procedure SetSelectedFields(sel : TStrings);

    procedure SetLookupTable(sel : TDataSet);
    procedure SetWWLookupTable(sel : TDataSet);
    procedure SetSyncTable(sel : TDataSet);
    function GetSyncTable: TDataSet;
    function GetLookupTable: TDataSet;
    function GetWWLookupTable: TDataSet;
    procedure SetOptions(sel: TwwDBLookupDlgOptions);
    procedure SetGridOptions(sel: TwwDBGridOptions);
    procedure Notification(AComponent: TComponent;
               Operation: TOperation); override;
    Procedure DoSyncDataSets(tempLookupTable, FSyncTable : TDataSet); virtual;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    Function Execute: boolean; override;

    function GetPrimaryDataSet: TDataSet; override;
    property SearchTable: TDataSet read getSyncTable write SetSyncTable;
    property Selected : TStrings read getSelectedFields write setSelectedFields;
    property GridColor: TColor read FGridColor write FGridColor;
    property Options: TwwDBLookupDlgOptions read FOptions write SetOptions
      default [opShowOKCancel, opShowSearchBy];
    property GridOptions: TwwDBGridOptions read FGridOptions write SetGridOptions
      default [dgEditing, dgTitles, dgIndicator, dgColumnResize, dgColLines,
      dgRowLines, dgTabs, dgConfirmDelete];
    property Caption : String read FCaption write FCaption;
    property MaxWidth : integer read FMaxWidth write FMaxWidth;
    property MaxHeight : integer read FMaxHeight write FMaxHeight;
    property CharCase: TEditCharCase read FCharCase write FCharCase;
    property GridTitleAlignment: TAlignment read FGridTitleAlignment write FGridTitleAlignment;
    property OnUserButton1Click: TwwUserButtonEvent read FUserButton1Click write FUserButton1Click;
    property OnUserButton2Click: TwwUserButtonEvent read FUserButton2Click write FUserButton2Click;
    property OnSyncDataSets: TwwSyncDataSetsEvent read FOnSyncDataSets write FOnSyncDataSets;
    property OnPerformCustomSearch: TwwPerformSearchEvent read FOnPerformCustomSearch write FOnPerformCustomSearch;
    property UserButton1Caption: string read FUserButton1Caption write FUserButton1Caption;
    property UserButton2Caption: string read FUserButton2Caption write FUserButton2Caption;
    property OnInitDialog: TwwOnInitDialogEvent read FOnInitDialog write FOnInitDialog;
    property OnCloseDialog: TwwOnInitDialogEvent read FOnCloseDialog write FOnCloseDialog;
    property OnSortChange: TNotifyEvent read FOnSortChange write FOnSortChange;
    property UseTFields: boolean read FUseTFields write FUseTFields default True;
    property PictureMaskFromField: boolean read FPictureMaskFromField write FPictureMaskFromField default False;
    property ControlType : TStrings read FControlType write SetControlType;
    property ControlInfoInDataset: boolean
           read FControlInfoInDataset write FControlInfoInDataSet default True;
    property PictureMaskFromDataset: boolean
            read FPictureMaskFromDataset write FPictureMaskFromDataSet default True;
    property PictureMasks: TStrings read FPictureMasks write SetPictureMasks;
end;

TwwLookupDialog = class(TwwCustomLookupDialog)
  public
    Function Execute: boolean; override;
    function GetPrimaryDataSet: TDataSet; override;
  published
    property Selected;
    property GridTitleAlignment;
    property GridColor;
    property Options;
    property GridOptions;
    property LookupTable: TDataSet read getLookupTable write SetLookupTable;
    property Caption;
    property MaxWidth;
    property MaxHeight;
    property CharCase;
    property PictureMaskFromField;
    property UseTFields;
    property UserButton1Caption;
    property UserButton2Caption;
    property OnUserButton1Click;
    property OnUserButton2Click;
    property OnInitDialog;
    property OnCloseDialog;
    property OnSortChange;
    property OnPerformCustomSearch;
    property ControlType;
    property ControlInfoInDataset;
    property PictureMaskFromDataset;
    property PictureMasks;
end;

TwwSearchDialog = class(TwwCustomLookupDialog)
  public
    function GetPrimaryDataSet: TDataSet; override;
  published
   property Selected;
   property GridTitleAlignment;
   property GridColor;
   property Options;
   property GridOptions;
   property SearchTable;
   property ShadowSearchTable: TDataSet read GetWWLookupTable write SetWWLookupTable;
   property PictureMaskFromField;
   property Caption;
   property MaxWidth;
   property MaxHeight;
   property CharCase;
   property UseTFields;
   property UserButton1Caption;
   property UserButton2Caption;
   property OnUserButton1Click;
   property OnUserButton2Click;
   property OnSyncDataSets;
   property OnInitDialog;
   property OnCloseDialog;
   property OnSortChange;
   property OnPerformCustomSearch;
   property ControlType;
   property ControlInfoInDataset;
   property PictureMaskFromDataset;
   property PictureMasks;
end;

Function ExecuteWWLookupDlg(
   AParentForm: TForm;
   AComponent: TComponent;
   ASelected: TStrings;
   ADataSet: TDataSet;
   AOptions: TwwDBLookupDlgOptions;
   AGridOptions: TwwDBGridOptions;
   AGridColor: TColor;
   AGridTitleAlignment: TAlignment;
   ACaption: String;
   AMaxWidth, AMaxHeight: integer;
   ACharCase: TEditCharCase;
   AUserButton1Caption, AUserButton2Caption: string;
   AUserButton1Click, AUserButton2Click: TwwUserButtonEvent;
   AOnInitDialog: TwwOnInitDialogEvent;
   AOnCloseDialog: TwwOnInitDialogEvent;
   AOnSortChange: TNotifyEvent;
   ASearchText: string;
   AUseTFields: boolean;
   APictureMaskFromField: boolean): boolean;

procedure Register;

implementation

uses wwmemo, wwintl, typinfo, wwdbdlg,
{$ifdef win32}
bde;
{$else}
dbiprocs, dbierrs, dbitypes;
{$endif}

{$R *.DFM}

type
  TwwTempKeyCombo=class(TwwKeyCombo)
    private
      LookupDlg: TwwLookupDlg;
    protected
      procedure Change; override;
      procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    public
      constructor Create(AOwner: TComponent); override;
  end;

procedure TwwTempKeyCombo.KeyDown(var Key: Word; Shift: TShiftState);
begin
   if (not (ssAlt in shift)) and (key=vk_down) and (not DroppedDown) then begin
      setFocus;
      DroppedDown:= True
   end
end;

procedure TwwTempKeyCombo.change;
begin
   inherited Change;
   LookupDlg.KeyComboChange;
end;

procedure TwwLookupDlg.KeyComboChange;
begin
   wwKeyCombo1Change(self);
end;

constructor TwwTempKeyCombo.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  LookupDlg:= AOwner as TwwLookupDlg;
end;

constructor TwwLookupDlg.Create(AOwner: Tcomponent);
begin
   inherited Create(AOwner);
   initialized:= False;

   MaxWidth:= 0;
   MaxHeight:= 360;

   OkBtn:= TButton(wwCreateCommonButton(Self, bkOK));
   OKBtn.TabOrder := 4;
   OKBtn.Default:= True;
   OKBtn.Top:= 600;
   OKBtn.visible:= True;
   CancelBtn:= TButton(wwCreateCommonButton(Self, bkCancel));
   CancelBtn.TabOrder := 5;
   CancelBtn.Top:= 600;
   CancelBtn.visible:= True;
   wwKeyCombo1:= TwwTempKeyCombo.create(self);
   wwKeyCombo1.parent:= self;
   wwKeyCombo1.visible:= false;
   wwKeyCombo1.datasource:= Datasource1;
   wwKeyCombo1.ShowHint:= True; { 10/8/98 }
   SortByLabel.FocusControl:= wwKeyCombo1; { 10/8/98 }
end;

constructor TwwCustomLookupDialog.Create(AOwner: TComponent);
begin
   inherited create(AOwner);

   FSelected:= TStringList.create;  { Must be a TStringList type }
   FLookupTable:= Nil;
   FSyncTable:= Nil;

   FGridOptions := [dgTitles, dgIndicator, dgColumnResize, dgRowSelect,
    dgColLines, dgRowLines, dgTabs, dgAlwaysShowSelection, dgConfirmDelete,
    dgPerfectRowFit];
   FOptions:= [opShowOKCancel, opShowSearchBy];
   FGridColor:= clWhite;
   FGridTitleAlignment:= taLeftJustify;
   if self is TwwLookupDialog then FCaption:= 'Lookup'
   else FCaption:= 'Search';
   FMaxHeight:= 209;
   FUseTFields:= True;

   FControlType:= TStringList.create;
   FControlInfoInDataset:= True;
   FPictureMasks:= TStringList.create;
   FPictureMaskFromDataSet:= True;

end;

destructor TwwCustomLookupDialog.Destroy;
begin
   FSelected.Free;
   FSelected := Nil;
   FControlType.Free;
   FPictureMasks.Free;
   inherited Destroy;
end;

function TwwCustomLookupDialog.GetPrimaryDataSet: TDataSet;
begin
  raise EInvalidOperation.Create('Derived classes of "TwwCustomLookupDialog" must implement function "GetPrimaryDataSet"');
end;

procedure ReadFromTableComponent(ListHandle: TStrings; dataSet: TDataSet);
var i: integer;
begin
    ListHandle.clear;
    with dataSet do begin
       if not Active then begin
          MessageDlg('DataSet for this component must be active.', mtInformation, [mbok], 0);
          exit;
       end;

       for i:= 0 to fieldCount-1 do begin
         if (fields[i].visible) then begin
             ListHandle.add(fields[i].fieldName + #9 +
                      inttostr(fields[i].displayWidth) + #9 +
                      fields[i].displayLabel + #9 + 'F');
          end;
       end
   end;
end;

Function ExecuteWWLookupDlg(
   AParentForm: TForm;
   AComponent: TComponent;
   ASelected: TStrings;
   ADataSet: TDataSet;
   AOptions: TwwDBLookupDlgOptions;
   AGridOptions: TwwDBGridOptions;
   AGridColor: TColor;
   AGridTitleAlignment: TAlignment;
   ACaption: String;
   AMaxWidth, AMaxHeight: integer;
   ACharCase: TEditCharCase;
   AUserButton1Caption, AUserButton2Caption: string;
   AUserButton1Click, AUserButton2Click: TwwUserButtonEvent;
   AOnInitDialog: TwwOnInitDialogEvent;
   AOnCloseDialog: TwwOnInitDialogEvent;
   AOnSortChange: TNotifyEvent;
   ASearchText: string;
   AUseTFields: boolean;
   APictureMaskFromField: boolean): boolean;
var TempResult: boolean;
    TempControl: TComponent;
    tempPictureMasks, tempControlType: TStrings;
begin
   TempResult:= False;

   with TwwLookupDlg.create(Application) do
   try
      Caption:= ACaption;

      if (AParentForm<>Nil) and (AParentForm.FormStyle=fsStayOnTop) then
         FormStyle:= fsStayOnTop;