.#selectgoodsfrm.pas.1.23

来自「群星医药系统源码」· 23 代码 · 共 487 行 · 第 1/2 页

unit SelectGoodsFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, RzPanel, Grids, DBGrids, DBGridEh, DbUtilsEh, 
  EhLibCDS, xEhLibCtl, ImgList, ActnList, RzButton, RzCmboBx, RzChkLst, RzEdit,
  DB, DBClient, DBCtrls, Mask, RzDBNav, MConnect, SConnect, RzRadChk, RzLstBox,
  TFlatSpeedButtonUnit, RzStatus, TFlatPanelUnit, Menus,
  xBaseFrm, ModuleAction, IMainFrm, ckDBClient, ceGlobal, uDataTypes;

type
  TFmSelectGoods = class(TxBaseForm)
    dbgSelectGoods: TxDBGridEh;
    RzPanel1: TRzGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    edGoodsID: TRzEdit;
    edGoodsName: TRzEdit;
    edSpecs: TRzEdit;
    cmMainKind: TRzComboBox;
    edPdcAddr: TRzEdit;
    edMaker: TRzEdit;
    edProvNo: TRzEdit;
    edBerthNo: TRzEdit;
    edRemark: TRzEdit;
    RzBitBtn1: TRzBitBtn;
    cdsSelectGoods: TckClientDataSet;
    DsSelectGoods: TDataSource;
    SocketConnection1: TSocketConnection;
    RzBitBtn4: TRzBitBtn;
    ImageList1: TImageList;
    ActionList1: TActionList;
    ActQuery: TAction;
    ActExit: TAction;
    ActRefersh: TAction;
    ActMore: TAction;
    RzPanel2: TRzPanel;
    Label10: TLabel;
    edSearchValue: TRzEdit;
    RzBitBtn3: TRzBitBtn;
    btnOK: TRzBitBtn;
    rbUnit1: TRzRadioButton;
    rbUnit2: TRzRadioButton;
    ActSelected: TAction;
    ActClearAllBox: TAction;
    RzPanel3: TRzPanel;
    RzDBNavigator1: TRzDBNavigator;
    RzBitBtn5: TRzBitBtn;
    ActViewPrice: TModlAction;
    ModlAction2: TModlAction;
    TopPopMenu: TPopupMenu;
    SetFields1: TMenuItem;
    refresh1: TMenuItem;
    ptBkPanel: TFlatPanel;
    ptCaption: TRzMarqueeStatus;
    FlatPanel2: TPanel;
    BtnWhatIs: TFlatSpeedButton;
    BtnHelp: TFlatSpeedButton;
    FlatPanel3: TPanel;
    BtnPopMenu: TFlatSpeedButton;
    procedure FormCreate(Sender: TObject);
    procedure ActMoreExecute(Sender: TObject);
    procedure cdsSelectGoodsBeforeGetRecords(Sender: TObject;
      var OwnerData: OleVariant);
    procedure ActExitExecute(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
    procedure ActSelectedExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure dbgSelectGoodsDblClick(Sender: TObject);
    procedure ActClearAllBoxExecute(Sender: TObject);
    procedure ActViewPriceExecute(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edSearchValueChange(Sender: TObject);
    procedure edSearchValueKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure dbgSelectGoodsKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure edGoodsIDKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BtnPopMenuClick(Sender: TObject);
    procedure ActFieldsLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
  private
    IFmMain: IMainForm;
    LocSetting: PLocSetting;
    SvrGoodses: TDispatchConnection;
    swGoods, LastGoodsID: String;
    LastGoodsRecNo, iLastRecCount: Integer;
    CdsFieldProperty :TckClientDataSet;
    function GetMultiSelect: Boolean;
    procedure SetMultiSelect(const Value: Boolean);
  public
    property CanMultiSelect: Boolean read GetMultiSelect write SetMultiSelect;
  end;

var
  FmSelectGoods: TFmSelectGoods;

Function SelectGoodsID(var sGoodsID:String; bMultiSlt: Boolean): Boolean;

Function SelectGoods(DataSet: TDataSet; vGIDField, vUnitField: TField;
  bSetAllValues, bAppend, bMultiSlt: Boolean; iPriceMode: Integer=-1): Boolean;

implementation

uses ViewGoodsPriceFrm, DBFuncs, DataExportFrm, FieldsLayoutFrm;

Const
  sFieldProPerty='Select * From SysFieldProperty Where TableName=''Goodses''';

{$R *.dfm}

Function SelectGoodsID(var sGoodsID:String; bMultiSlt: Boolean): Boolean;
var n, j: Integer;
    sRetGoodsIDs : String;
begin
  Result := False;
  with FmSelectGoods do begin
    CanMultiSelect := bMultiSlt;
    edGoodsID.Text := sGoodsID;
    If Not(cdsSelectGoods.Active) Then ActQueryExecute(NIl);
    if sGoodsID<>'' then
      CdsSelectGoods.Locate('GoodsID',sGoodsID,[]);
    if ShowModal=mrOk then begin
      if bMultiSlt then begin
        j := dbgSelectGoods.SelectedRows.Count;
      end else
        j:= 1;
      for n:= 0 to j-1 do begin
        if bMultiSlt then
          cdsSelectGoods.Bookmark := dbgSelectGoods.SelectedRows[n];
          sRetGoodsIDs := sRetGoodsIDs+','+Trim(CdsSelectGoods.FieldByName('GoodsID').AsString);
      end;
      Delete(sRetGoodsIDs,1,1);
      sGoodsID := sRetGoodsIDs;
      Result := True ;
    end;//end if
  end;//end with
end;

{选择药品
DataSet:要选择药品的源数据表
vGIDField:源数据表中的药品代码字段
vUnitField:源数据表中的药品单位字段(该参数可以为nil)
bSetAllValues：是否设置其它值(在下面的c_Fields常量数组中定义，如：药品名称、规格等)
bAppend:是否为追加模式或修改模式，只有在追加模式才能多行选定
bMultiSlt:是否允许多行选定
}
Function SelectGoods(DataSet: TDataSet; vGIDField, vUnitField: TField;
  bSetAllValues, bAppend, bMultiSlt: Boolean; iPriceMode: Integer): Boolean;
const
  c_Fields1: Array[0..9] of String = ('BarCode', 'GoodsName', 'Name','Alias', 'Specs', 'BaseBerthNo', 'PdcAddr', 'Maker', 'PassNo', 'PackSpecs');
  c_Fields2: Array[0..9] of String = ('BarCode', 'Name',      'Name','Alias', 'Specs', 'BaseBerthNo', 'PdcAddr', 'Maker', 'PassNo', 'PackSpecs');
var vField1, vField2: TField;
    str: String;
    n, j, i, k: Integer;
begin
  Result := false;
  if vGIDField=nil then Exit;
  if not bAppend then
    bMultiSlt := false;
  with FmSelectGoods do begin
    CanMultiSelect := bMultiSlt;
    if (not bAppend)and(not vGIDField.IsNull) then begin
      str := vGIDField.AsString;
      if cdsSelectGoods.Active and cdsSelectGoods.Locate('GoodsID', str, []) then begin
        rbUnit2.Checked := (vUnitField<>nil)and(cdsSelectGoods.FieldByName('Unit2').AsString=vUnitField.AsString);
        if edGoodsID.Text=str then edGoodsID.Text := '';
      end else
        edGoodsID.Text := str;
    end;

    if ShowModal=mrOk then begin
      if bMultiSlt then begin
        j := dbgSelectGoods.SelectedRows.Count;
      end else
        j:= 1;
      for n:= 0 to j-1 do begin
        if bMultiSlt then
          cdsSelectGoods.Bookmark := dbgSelectGoods.SelectedRows[n];
        if bAppend then begin
          if DataSet.State<>dsInsert then
            DataSet.Append;
        end else begin
          if not (DataSet.State in dsEditModes) then
            DataSet.Edit;
        end;
        if vUnitField<>nil then begin
          if rbUnit2.Checked and not cdsSelectGoods.FieldByName('Unit2').IsNull then
            str := 'Unit2'
          else
            str := 'Unit1';
          vUnitField.AsString := cdsSelectGoods.FieldByName(str).AsString;
        end;
        vGIDField.AsString := cdsSelectGoods.FieldByName('GoodsID').AsString;
        if bSetAllValues then begin
          k := Length(c_Fields1);
          for i:=0 to k-1 do begin
            vField1 := DataSet.FindField(c_Fields1[i]);
            if vField1=nil then Continue;
            vField2 := cdsSelectGoods.FindField(c_Fields2[i]);
            if vField2=nil then Continue;
            vField1.Value := vField2.Value;
          end;
        end;
        if bMultiSlt then
          DataSet.Post;
      end;
      Result := true;
    end;//end if
  end;//end with
end;

procedure TFmSelectGoods.FormCreate(Sender: TObject);
begin
  inherited;
  IFmMain := (Application.MainForm as IMainForm);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SvrGoodses := IFmMain.GetConnection(Handle, '', 'CKGoodsBase.DmGoodses');
  cdsSelectGoods.RemoteServer := SvrGoodses;
  if SvrGoodses is TDCOMConnection then
    Caption := Caption+' -- '+TDCOMConnection(SvrGoodses).ComputerName
  else
    Caption := Caption+' -- '+TSocketConnection(SvrGoodses).Host+TSocketConnection(SvrGoodses).Address;

  CdsFieldProperty := TckClientDataSet.Create(Self);
  CdsFieldProPerty.ProviderName:='DspPublic';
  CdsFieldProPerty.RemoteServer:=SvrGoodses;
end;

procedure TFmSelectGoods.FormShow(Sender: TObject);
begin
  inherited;