selectgoodsfrm.~pas

来自「群星医药系统源码」· ~PAS 代码 · 共 606 行 · 第 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);
    procedure cdsSelectGoodsAfterOpen(DataSet: TDataSet);
    procedure rbUnit1Click(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(var FieldNames: String; var Values: string;
  GetAll: boolean=false): boolean; overload;
Function SelectGoods(DataSet: TDataSet; vGIDField, vUnitField: TField;
  bSetAllValues, bAppend, bMultiSlt: Boolean; iPriceMode: Integer=-1): Boolean; overload;

{取得药品属性并回传到一个数组
  参数：
    FieldNames  要取值的字段名
    RetValues   返回值
    GetAll      返回所有字段及其值
}

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;

Function SelectGoods(var FieldNames: String; var Values: string;
GetAll: boolean): boolean;
var i,Len1,Len2: Integer;
    Field: TField;
    A,B: TStrings;
begin
  Result := False;
  A := TStringList.Create;
  B := TStringList.Create;
  try
    A.Text := FieldNames;
    B.Text := Values;
    with FmSelectGoods do
    begin
      CanMultiSelect := false;
      //看是否传入了药品代码，如果是，则定位到该药品
      for i := 0 to B.Count -1 do
      begin
        if i > A.Count -1 then break;
        if LowerCase(A.Strings[i])='goodsid' then
          edGoodsID.Text := B.Strings[i];
          break;
      end;

      If Not(cdsSelectGoods.Active) Then ActQueryExecute(NIl);
      if ShowModal=mrOk then
      begin
        if GetAll then
        begin
          A.Clear;
          for i:=0 to cdsSelectGoods.FieldCount-1 do
            A.Add(cdsSelectGoods.Fields[i].FieldName);
        end;
        B.Clear;
        //将各字段的值对号入座，以便在调用过程中正确处理
        for i:=0 to A.Count -1 do
        begin
          Field := cdsSelectGoods.FindField(A.Strings[i]);
          if Field=nil then
            B.Add('')
          else
            B.Add(Field.AsString);
        end;
        FieldNames := A.Text;
        Values := B.Text;
        Result := True ;
      end;
    end;
  finally
    A.Free;
    B.Free;
  end;
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');
  cWhereStr = '(GoodsID like ''%s'' or BarCode Like ''%s'' or BarCode2 like ''%s'' or Pym like ''%s%%'' or Name like ''%s%%'' or EName like ''%s%%'' or Alias like ''%s%%'' )';
  cNotFindGoods = '找不到匹配的药品资料，是否激活查询对话框来查找更多记录？';
var vField1, vField2: TField;
    sGoodsID, str: String;
    n, j, i, k: Integer;
    bUnit2, bSelected: Boolean;
begin
  Result := false;
  bSelected := false;
  if vGIDField=nil then Exit;
  if not bAppend then
    bMultiSlt := false;
  with FmSelectGoods do begin
    CanMultiSelect := bMultiSlt;
    sGoodsID := vGIDField.AsString;
//    str := Vartostr(vGIDField.NewValue)+#13+Vartostr(vGIDField.CurValue)+#13+Vartostr(vGIDField.OldValue);
//    ShowMessage(sGoodsID+#13+str);
    if sGoodsID<>'' then
    begin
      bUnit2 := sGoodsID[1]='-';
      if bUnit2 then
        Delete(sGoodsID, 1, 1);
      if cdsSelectGoods.Active and cdsSelectGoods.Locate('GoodsID', sGoodsID, []) then
      begin
        if not bUnit2 then
          bUnit2 := (vUnitField<>nil)and(cdsSelectGoods.FieldByName('Unit2').AsString=vUnitField.AsString);
        if edGoodsID.Text=sGoodsID then edGoodsID.Text := '';
        //bSelected := cdsSelectGoods.RecordCount=1;这里不能这样，否则当用户在表格上按'...'按钮时不能弹出对话框
      end else
      begin//如果定位不到，则重新查询
        swGoods := Format(cWhereStr, [sGoodsID, sGoodsID, sGoodsID, sGoodsID, sGoodsID, sGoodsID, sGoodsID]);
        cdsSelectGoods.Close;
        LastGoodsID := '';
        ActMore.Enabled := true;
        ActMore.Execute;
        i := cdsSelectGoods.RecordCount;
        if i=0 then
        begin
          if (Application.MessageBox(cNotFindGoods, '消息', MB_ICONQUESTION+MB_YESNO)=IDNO) then
            Exit
          else
            edGoodsID.Text := sGoodsID;
        end else
          bSelected := i=1;
      end;
    end;

    rbUnit1.Checked := not bUnit2;
    rbUnit2.Checked := bUnit2;
    if not bSelected then
      bSelected := ShowModal=mrOk;
    if bSelected then begin
      if bMultiSlt then
      begin
        j := dbgSelectGoods.SelectedRows.Count;
        if j=0 then
        begin
          j := 1;
          dbgSelectGoods.SelectedRows.CurrentRowSelected := true;
        end;
      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