check_unit.pas

药品进销管理程序,内有SQL附加的数据库.....详情看里面的,运行就OK

unit Check_Unit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, Grids, DBGrids, Buttons,
  DB, ADODB, RpRender, RpRenderCanvas, RpRenderPreview, RpCon, RpConDS,
  RpDefine, RpRave, RpBase, RpSystem;

type
  TfrmCheck = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    lblCheckID: TLabel;
    cmbxCheckMan: TComboBox;
    CheckDatetime: TDateTimePicker;
    edtRemark: TMemo;
    lblCheckStatus: TLabel;
    DBGrid1: TDBGrid;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    cmbxType: TComboBox;
    cmbxMedicineID: TComboBox;
    ValidityDatetime: TDateTimePicker;
    edtAmount: TEdit;
    btnAuditing: TBitBtn;
    btnPrint: TBitBtn;
    btnSave: TBitBtn;
    btnDel: TBitBtn;
    btnAdd: TBitBtn;
    btnFind: TBitBtn;
    dsrqryCountingBody: TDataSource;
    qryCountingHeader: TADOQuery;
    qryCountingBody: TADOQuery;
    qryMedicine: TADOQuery;
    qryUser: TADOQuery;
    qryPrint: TADOQuery;
    RvProject1: TRvProject;
    RvDataSetConnection1: TRvDataSetConnection;
    RvSystem1: TRvSystem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnAddClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure cmbxCheckManExit(Sender: TObject);
    procedure cmbxMedicineIDExit(Sender: TObject);
    procedure btnFindClick(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumn);
    procedure btnDelClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnAuditingClick(Sender: TObject);
    procedure btnPrintClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmCheck: TfrmCheck;

implementation

uses Common_Unit, LeechdomMain_Unit;

{$R *.dfm}

procedure TfrmCheck.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  frmCheck := nil;
end;

procedure TfrmCheck.btnAddClick(Sender: TObject);
var
  InsertHeaderStr, MaxID: string;
begin
  qryCountingBody.Close;
  cmbxCheckMan.Text := '';
  lblCheckStatus.Caption := '未审核';
  cmbxMedicineID.Text := '';
  edtAmount.Text := '';
  edtRemark.Text := '';
  MaxID := 'Exec proc_Check @Flag=''SelectMaxID''' ;
  OpenDataSQL(frmLeechdomMain.qryMaxID, MaxID);
  if frmLeechdomMain.qryMaxID.FieldByName('MaxID').AsString = '' then
    lblCheckID.Caption := 'CH' + FormatDatetime('yyyymm',Date) + '0001'
  else
    lblCheckID.Caption := 'CH' + frmLeechdomMain.qryMaxID.FieldByName('MaxID').AsString;
end;

procedure TfrmCheck.FormShow(Sender: TObject);
var
  SelectStrMed, CheckMan, sID, sName: string;
begin
  SelectStrMed := 'Select * From Medicine';
  cmbxMedicineID.Items.Clear;
  OpenDataSQL(qryMedicine, SelectStrMed);
  with qryMedicine do
  begin
    while not Eof do
    begin
      sID := FieldByName('MedicineID').AsString;
      sName := FieldByName('MedName').AsString;
      cmbxMedicineID.Items.Add(sID + '.' + sName);
      Next;
    end;
  end;

  CheckMan := 'Select * From [User]';
  cmbxCheckMan.Items.Clear;
  OpenDataSQL(qryUser, CheckMan);
  with qryUser do
  begin
    while not Eof do
    begin
      sID := FieldByName('LoginID').AsString;
      cmbxCheckMan.Items.Add(sID + '.' + sName);
      Next;
    end;
  end;
end;

procedure TfrmCheck.cmbxCheckManExit(Sender: TObject);
begin
  cmbxCheckMan.Text := Copy(cmbxCheckMan.Text,1,Pos('.',cmbxCheckMan.Text)-1);
end;

procedure TfrmCheck.cmbxMedicineIDExit(Sender: TObject);
begin
  cmbxMedicineID.Text := Copy(cmbxMedicineID.Text,1,Pos('.',cmbxMedicineID.Text)-1);
end;

procedure TfrmCheck.btnFindClick(Sender: TObject);
var
  SelectAll, FindID: string;
  FindBool: Boolean;
begin
  try
    FindID := lblCheckID.Caption;
    FindBool := InputQuery('查询', '输入查询的编号', FindID);
    if FindBool then
    begin
      SelectAll := 'Exec proc_Check @Flag=''SelectCheck'''
                  +',@CheckID=' + Quotedstr(FindID);
      OpenDataSQL(qryCountingHeader, SelectAll);
      OpenDataSQL(qryCountingBody, SelectAll);
      lblCheckID.Caption := qryCountingHeader.FieldByName('CheckID').AsString;
      cmbxCheckMan.Text := qryCountingHeader.FieldByName('AuditingPeople').AsString;
      edtRemark.Text := qryCountingHeader.FieldByName('Remark').AsString;
      CheckDatetime.Date := StrToDate(qryCountingHeader.FieldByName('CheckDatetime').AsString);
      lblCheckStatus.Caption := qryCountingHeader.FieldByName('Auditing').AsString;
    end;
  except
    Application.MessageBox('查询错误,请核实后重新查询!','错误',16);
    lblCheckID.Caption := '自动生成';
  end;
end;

procedure TfrmCheck.DBGrid1CellClick(Column: TColumn);
begin
  if DBGrid1.DataSource.DataSet.IsEmpty then
    Exit;
  if qryCountingBody.Active then
  begin
    cmbxType.Text := DBGrid1.DataSource.DataSet.FieldByName('MedType').AsString;
    cmbxMedicineID.Text := DBGrid1.DataSource.DataSet.FieldByName('MedicineID').AsString;
    edtAmount.Text := DBGrid1.DataSource.DataSet.FieldByName('CheckAmount').AsString;
    ValidityDatetime.Date := DBGrid1.DataSource.DataSet.FieldByName('ValidityDatetime').AsDateTime;
  end;
end;

procedure TfrmCheck.btnDelClick(Sender: TObject);
var
  DelBodyStr,DelHeadStr,SelectAll , SelectBody: string;
begin
  if lblCheckStatus.Caption = '已审核' then
  begin
    Application.MessageBox('已审核不能修改!','提示',16);
    Exit;
  end;
  if DBGrid1.DataSource.DataSet.IsEmpty then
    Exit;
  if Application.MessageBox('确定要删除此条信息吗?','提示',68) = IDYes then
  begin
    DelBodyStr := 'Exec proc_Check @Flag=''DelCheck'''
            + ',@CheckID=' + Quotedstr(lblCheckID.Caption)
            + ',@MedicineID=' + Quotedstr(cmbxMedicineID.Text)
            + ',@ValidityDatetime=' + Quotedstr(DateToStr(ValidityDatetime.Date));
    DelHeadStr := 'Exec proc_Check @Flag=''DelHeader'''
                + ',@CheckID = ' + QuotedStr(lblCheckID.Caption);
    ExecSQL(qryCountingBody,DelBodyStr);
    if FindSQL('Select * From CheckBody where CheckID=' + QuotedStr(lblCheckID.Caption)) = False then
      ExecSQL(qryCountingHeader,DelHeadStr);
    SelectAll := 'Exec proc_Check @Flag=''SelectCheck'''
                +',@CheckID=' + Quotedstr(lblCheckID.Caption);
    OpenDataSQL(qryCountingHeader, SelectAll);
    Application.MessageBox('明细删除成功!','提示',64);
  end;
end;

procedure TfrmCheck.btnSaveClick(Sender: TObject);
var
  InsertHeader, InsertBody, SelectBody: string;
begin
  try
    if lblCheckStatus.Caption = '已审核' then
    begin
      Application.MessageBox('已审核不能再保存数据!','提示',16);
      Exit;
    end;
    if (cmbxType.Text = '') or (cmbxMedicineID.Text = '') or (edtAmount.Text = '')then
    begin
      Application.MessageBox('明细数据不能为空!','错误',16);
      cmbxMedicineID.SetFocus;
      Exit;
    end;
    if lblCheckID.Caption = '自动生成' then
    begin
      Application.MessageBox('主项数据没有单号,请添加!','错误',16);
      Exit;
    end;

    InsertHeader := 'Exec proc_Check @Flag=''InsertCheck'''
                 + ',@CheckID=' + Quotedstr(lblCheckID.Caption)
                 + ',@CheckDatetime=' + Quotedstr(DateToStr(CheckDatetime.Date))
                 + ',@CheckMan=' + Quotedstr(cmbxCheckMan.Text)
                 + ',@AuditingPeople=' + Quotedstr(LoginID)
                 + ',@Remark=' + Quotedstr(edtRemark.Text);

    InsertBody := 'Exec proc_Check @Flag=''InsertBody'''
                + ',@CheckID=' + Quotedstr(lblCheckID.Caption)
                + ',@MedType=' + Quotedstr(cmbxType.Text)
                + ',@ValidityDatetime=' + Quotedstr(DateToStr(ValidityDatetime.Date))
                + ',@MedicineID=' + Quotedstr(cmbxMedicineID.Text)
                + ',@CheckAmount=' + edtAmount.Text;

    SelectBody := 'Exec proc_Check @Flag=''SelectCheck'''
                 +',@CheckID='+ QUotedstr(lblCheckID.Caption);
    ExecSQL(qryCountingHeader,InsertHeader);
    ExecSQL(qryCountingBody,InsertBody);
    OpenDataSQL(qryCountingBody, SelectBody);
  except
    Application.MessageBox('保存数据错误,请查实!','错误',16);
  end;
end;

procedure TfrmCheck.btnAuditingClick(Sender: TObject);
var
  Auditing, Update: string;
begin
  if lblCheckStatus.Caption = '已审核' then
  begin
    Application.MessageBox('不能重复审核!','提示',16);
    Exit;
  end;
  if DBGrid1.DataSource.DataSet.IsEmpty then
    Exit;
  if Application.MessageBox('确定要审核此单吗?','提示',68) = IDNo then
    Exit;
  Auditing := 'Exec proc_Check @Flag=''UpdateCheck'''
             +',@CheckID=' + Quotedstr(lblCheckID.Caption);
  ExecSQL(qryCountingHeader,Auditing);
  Update := 'Exec proc_Storage @Flag=''UpdateCheck'''
            + ',@CheckID=' + Quotedstr(lblCheckID.Caption);
  ExecSQL(qryCountingHeader,Update);
  Application.MessageBox('审核成功!','提示',64);
  lblCheckStatus.Caption := '已审核';
end;

procedure TfrmCheck.btnPrintClick(Sender: TObject);
var
  PrintSQL: string;
begin
  PrintSQL := 'Select A.*,B.*, C.MedName From CheckHeader A'
            + ' left Join CheckBody B on A.CheckID=B.CheckID'
            + ' Left Join Medicine C on B.MedicineID=C.MedicineID'
            + ' where A.CheckID =' + QuotedStr(lblCheckID.Caption);
  if lblCheckID.Caption = '自动生成' then Exit;
  OpenDataSQL(qryPrint, PrintSQL);
  RvProject1.ProjectFile :='.\CheckReport.rav';
  RvProject1.Execute;
end;

end.