selectgoodsfrm.~pas

来自「医药连锁经营管理系统源码」· ~PAS 代码 · 共 606 行 · 第 1/2 页

            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;
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFrmSelectGoods.Xml');
end;

procedure TFmSelectGoods.FormShow(Sender: TObject);
begin
  inherited;
  SetGridEhColor(dbgSelectGoods);
  ptBkPanel.Color := TitlePanelColor ;
  ptCaption.FillColor := ptBkPanel.Color;
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);
  if self.Visible then 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 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;
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.edGoodsIDKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Shift=[ssCtrl])then
  begin
    if (key=13) then
      ActQuery.Execute
    else if Key=VK_NEXT then
      dbgSelectGoods.SetFocus
    else if Key=VK_PRIOR then
      edSearchValue.SetFocus;
  end;
end;

procedure TFmSelectGoods.edSearchValueKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key=VK_UP)or(Key=VK_DOWN) then begin
    PostMessage(dbgSelectGoods.Handle,WM_KEYDOWN,Key,0);
    Key :=0;
  end
  else if Shift=[ssCtrl] then
  begin
    if Key=VK_NEXT then
      edGoodsID.SetFocus
    else if Key=VK_PRIOR then
      dbgSelectGoods.SetFocus;
  end
  else if key=13 then
    ActSelected.Execute;
end;

procedure TFmSelectGoods.dbgSelectGoodsKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if Shift=[ssCtrl] then
  begin
    if Key=VK_NEXT then
      edSearchValue.SetFocus
    else if Key=VK_PRIOR then
      edGoodsID.SetFocus;
    if not dbgSelectGoods.Focused then
      Key := 0;
  end
  else if key=13 then begin
    Key := 0;
    ActSelected.Execute;
  end;
end;

procedure TFmSelectGoods.BtnPopMenuClick(Sender: TObject);
var tp:TPoint;
begin
	tp.x:=BtnPopMenu.left;
	tp.y:=BtnPopMenu.Top+BtnPopMenu.Height+1;
	tp:=ClientToScreen(tp);
	TopPopmenu.Popup(tp.x,tp.Y);
end;

procedure TFmSelectGoods.ActFieldsLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgSelectGoods], '浏览药品');
end;

procedure TFmSelectGoods.ActDataExportExecute(Sender: TObject);
begin
	ExportData([cdsSelectGoods], '浏览药品', '');
end;

procedure TFmSelectGoods.cdsSelectGoodsAfterOpen(DataSet: TDataSet);
begin
  if cdsFieldProperty.Active then
    SetFieldProperty(CdsFieldProPerty,cdsSelectGoods, 'Goodses');
end;

procedure TFmSelectGoods.rbUnit1Click(Sender: TObject);
begin
  if Visible and edSearchValue.Enabled 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.