.#selectgoodsfrm.pas.1.17

来自「群星医药系统源码」· 17 代码 · 共 414 行

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, Mask, RzEdit, DB, DBClient,
  ckDBClient, xBaseFrm, MConnect, SConnect, RzRadChk, RzLstBox, RzChkLst,
  IMainFrm, ModuleAction, DBCtrls, RzDBNav;

type
  TFmSelectGoods = class(TxBaseForm)
    dbgSelectGoods: TxDBGridEh;
    RzPanel1: TRzPanel;
    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;
    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);
  private
    IFmMain: IMainForm;
    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;

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

{$R *.dfm}

{选择药品
DataSet:要选择药品的源数据表
vGIDField:源数据表中的药品代码字段
vUnitField:源数据表中的药品单位字段(该参数可以为nil)
bSetAllValues：是否设置其它值(在下面的c_Fields常量数组中定义，如：药品名称、规格等)
bAppend:是否为追加模式或修改模式，只有在追加模式才能多行选定
bMultiSlt:是否允许多行选定
}
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);
    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(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;
      cdsSelectGoods.Filtered := false;
      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 begin
        edGoodsID.Text := str;
//        edSearchValue.Text := str;
//        edSearchValue.SetFocus;
      end;
    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
  IFmMain := (Application.MainForm as IMainForm);
  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.cdsSelectGoodsBeforeGetRecords(Sender: TObject;
  var OwnerData: OleVariant);
var val: Variant;
begin
  val := OwnerData;
  OwnerData := VarArrayCreate([0,2], varVariant);
  OwnerData[0] := val;
  OwnerData[1] := swGoods;
  OwnerData[2] := LastGoodsRecNo;
end;

procedure TFmSelectGoods.ActExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TFmSelectGoods.ActQueryExecute(Sender: TObject);
const
  cStr1 = ' and (GoodsID like ''%s'' or Pym like ''%s'' or BarCode Like ''%s'' or BarCode2 like ''%s'')';
  cStr2 = ' and (Name like ''%s'' or EName like ''%s'' or Alias like ''%s'') ';
var str: String;
    sTableNames: string;
begin
  str := edGoodsID.Text;
  swGoods := '';
  if str<>'' then
    swGoods := swGoods+Format(cStr1, [str, str, str, str]);
  str := edGoodsName.Text;
  if str<>'' then
    swGoods := swGoods+Format(cStr2, [str, str, str]);
  str := edSpecs.Text;
  if str<>'' then
    swGoods := swGoods+' and Specs like '''+str+'''';
  if swGoods<>'' then
    Delete(swGoods, 1, 4);
  cdsSelectGoods.Close;
  LastGoodsID := '';
  ActMore.Enabled := true;
  ActMore.Execute;

  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFrmSelectGoods.Xml');
  sTableNames := 'Goodses';
  if cdsFieldProperty.Active then
    SetFieldProperty(CdsFieldProPerty,cdsSelectGoods,sTableNames);
  edSearchValue.SetFocus;
end;

procedure TFmSelectGoods.ActMoreExecute(Sender: TObject);
var i: Integer;
begin
{  if LastGoodsID='' then
    cdsSelectGoods.Close
  else
    str := str+' AND WorkRecNo>'+IntToStr(LastRecNo);
  i := edGetRecCount.IntValue;
}
  i := GetTickCount;
  with cdsSelectGoods do begin
    PacketRecords := IFmMain.IFmMainEx.GetLocSetting^.PacketRecs;
    if Active then begin
      iLastRecCount := GetNextPacket;
      Inc(LastGoodsRecNo, iLastRecCount);
    end else begin
      LastGoodsRecNo := 0;
      Open;
      iLastRecCount := RecordCount;
      LastGoodsRecNo := iLastRecCount;
    end;
    ActMore.Enabled := iLastRecCount=PacketRecords;
  end;
  i := GetTickCount-i;
  Caption := '选择商品(本次耗时：'+IntToStr(i)+'毫秒)';
end;

procedure TFmSelectGoods.ActClearAllBoxExecute(Sender: TObject);
begin
  edGoodsID.Text := '';
  edGoodsName.Text := '';
  edSpecs.Text := '';
  cmMainKind.Text := '';
  edPdcAddr.Text := '';
  edMaker.Text := '';
  edProvNo.Text := '';
  edBerthNo.Text := '';
  edRemark.Text := '';
end;

procedure TFmSelectGoods.ActSelectedExecute(Sender: TObject);
begin
  if (not cdsSelectGoods.Active) or cdsSelectGoods.IsEmpty or
     (CanMultiSelect and (dbgSelectGoods.SelectedRows.Count=0)) then
  begin
    Application.MessageBox('请先选择药品！', '警告', MB_ICONINFORMATION);
    Exit;
  end;
  ModalResult := mrOK;
end;

function TFmSelectGoods.GetMultiSelect: Boolean;
begin
  Result := dgMultiSelect in dbgSelectGoods.Options;
end;

procedure TFmSelectGoods.SetMultiSelect(const Value: Boolean);
begin
  if Value then
    dbgSelectGoods.Options := dbgSelectGoods.Options+[dgMultiSelect]
  else
    dbgSelectGoods.Options := dbgSelectGoods.Options-[dgMultiSelect];
  dbgSelectGoods.SelectedRows.Clear;
end;

procedure TFmSelectGoods.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caHide;
end;

procedure TFmSelectGoods.dbgSelectGoodsDblClick(Sender: TObject);
begin
  if not cdsSelectGoods.IsEmpty then
    ActSelected.Execute;
end;

procedure TFmSelectGoods.ActViewPriceExecute(Sender: TObject);
var sGoodsID, sName, sSpecs, sPdcAddr, sMaker: String;
begin
  if cdsSelectGoods.IsEmpty then Exit;
  sGoodsID:= cdsSelectGoods.fieldByName('GoodsID').AsString;
//  sUnit   := cdsSelectGoods.fieldByName('Unit').AsString;
  sName   := cdsSelectGoods.fieldByName('Name').AsString;
  sSpecs  := cdsSelectGoods.fieldByName('Specs').AsString;
  sPdcAddr:= cdsSelectGoods.fieldByName('PdcAddr').AsString;
  sMaker  := cdsSelectGoods.fieldByName('Maker').AsString;
  ViewGoodsPrice(sGoodsID, '');
end;

procedure TFmSelectGoods.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=27 then close;
  if (key=13)and(ssCtrl in Shift)and(not edSearchValue.Focused) then
    ActQuery.Execute;
end;

procedure TFmSelectGoods.edSearchValueChange(Sender: TObject);
const
  MatchFields: array[0..6] of string=('GoodsID','Pym','BarCode','BarCode2','name','EName','Alias');
var
  i: integer;
begin
  i := 0;
  if not cdsSelectGoods.Active then exit;
  try
    if edSearchValue.Text = '' then exit;
    while (i<7)and(not cdsSelectGoods.Locate(MatchFields[i],edSearchValue.Text,[loPartialKey,loCaseInsensitive])) do
      inc(i);
  except
  end;
end;

procedure TFmSelectGoods.edSearchValueKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key=VK_UP)or(Key=VK_DOWN) then
    PostMessage(dbgSelectGoods.Handle,WM_KEYDOWN,Key,0);
  if key=13 then ActSelectedExecute(nil);
end;

procedure TFmSelectGoods.dbgSelectGoodsKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if key=13 then edSearchValue.SetFocus;
end;

initialization
  RegisterClass(TFmSelectGoods);
  if not Assigned(FmSelectGoods) then begin
    if Application.MainForm.ClassName<>'TAppBuilder' then
      FmSelectGoods := TFmSelectGoods.Create(Application.MainForm);
  end;

finalization
  if Assigned(FmSelectGoods) then
    FreeAndNil(FmSelectGoods);
  UnRegisterClass(TFmSelectGoods);

end.