firstdealcorpfrm.pas

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

unit FirstDealCorpFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ChainGSPBaseFrm, DB, DBClient, MConnect, ckDBClient, Menus,
  ActnList, ModuleAction, TB2Dock, ImgList, ExtCtrls, Buttons, RzButton,
  TB2Item, TB2Toolbar, ComCtrls, RzDTP, RzDBDTP, RzDBBnEd, StdCtrls, Mask,
  RzEdit, RzDBEdit, DbFuncs, DBCtrls;

type
  TFmFirstDealCorp = class(TFmChainGSPBase)
    cdsMainBillNo: TStringField;
    cdsMainDepartID: TIntegerField;
    cdsMainDepartName: TStringField;
    cdsMainFDate: TDateTimeField;
    cdsMainCorpName: TStringField;
    cdsMainCorpAddr: TStringField;
    cdsMainLegalPerson: TStringField;
    cdsMainLinkman: TStringField;
    cdsMainPhone: TStringField;
    cdsMainFax: TStringField;
    cdsMainClass: TStringField;
    cdsMainFinancing: TStringField;
    cdsMainProperty: TStringField;
    cdsMainLicence: TStringField;
    cdsMainOperationPermit: TStringField;
    cdsMainManufactureLicence: TStringField;
    cdsMainOperationRange: TStringField;
    cdsMainQualityWarrant: TStringField;
    cdsMainAfterService: TStringField;
    cdsMainApplyReason: TStringField;
    cdsMainDeptNotion: TStringField;
    cdsMainDeptResult: TStringField;
    cdsMainDeptPrincipal: TStringField;
    cdsMainDeptPrincipalName: TStringField;
    cdsMainQCNotion: TStringField;
    cdsMainQCResult: TStringField;
    cdsMainQCPrincipal: TStringField;
    cdsMainQCPrincipalName: TStringField;
    cdsMainManagerNotion: TStringField;
    cdsMainManagerResult: TStringField;
    cdsMainManagerPrincipal: TStringField;
    cdsMainManagerName: TStringField;
    cdsMainAudit: TBooleanField;
    cdsMainApprove: TBooleanField;
    cdsMainApprovalDate: TDateTimeField;
    cdsMainApprover: TStringField;
    cdsMainCreater: TStringField;
    cdsMainApproverName: TStringField;
    cdsMainCreaterName: TStringField;
    cdsMainCreatTime: TDateTimeField;
    cdsMainMender: TStringField;
    cdsMainMenderName: TStringField;
    cdsMainUpdateTime: TDateTimeField;
    cdsMainGrup: TIntegerField;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Bevel1: TBevel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    Label34: TLabel;
    Bevel2: TBevel;
    Label35: TLabel;
    Label36: TLabel;
    edBillNo: TRzDBEdit;
    edDepart: TRzDBButtonEdit;
    RzDBDateTimePicker1: TRzDBDateTimePicker;
    RzDBEdit3: TRzDBEdit;
    RzDBEdit4: TRzDBEdit;
    RzDBEdit5: TRzDBEdit;
    RzDBEdit6: TRzDBEdit;
    RzDBEdit7: TRzDBEdit;
    RzDBEdit9: TRzDBEdit;
    RzDBEdit10: TRzDBEdit;
    RzDBEdit11: TRzDBEdit;
    RzDBEdit12: TRzDBEdit;
    RzDBEdit13: TRzDBEdit;
    RzDBEdit14: TRzDBEdit;
    RzDBEdit15: TRzDBEdit;
    RzDBEdit16: TRzDBEdit;
    RzDBEdit18: TRzDBEdit;
    RzDBEdit19: TRzDBEdit;
    RzDBEdit32: TRzDBEdit;
    RzDBEdit33: TRzDBEdit;
    RzDBEdit34: TRzDBEdit;
    ActShowAudited: TModlAction;
    N1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure edDepartButtonClick(Sender: TObject);
    procedure cdsMainNewRecord(DataSet: TDataSet);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActShowAuditedExecute(Sender: TObject);
    procedure ActInsertExecute(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure cdsMainAfterOpen(DataSet: TDataSet);
    procedure cdsMainAfterScroll(DataSet: TDataSet);
    procedure cdsMainAfterRefresh(DataSet: TDataSet);
  private
    { Private declarations }
    procedure SetBillNoFontColor;
  public
    { Public declarations }
  end;

const
  sFieldProPerty='select * from SysFieldProperty ' +
                 'where TableName = ''Gsp_FirstDealCorpInfo''';
var
  FmFirstDealCorp: TFmFirstDealCorp;

implementation
uses  ShowProgress, xBaseFrm, SelectDepartFrm;

{$R *.dfm}

procedure TFmFirstDealCorp.FormCreate(Sender: TObject);
begin
  inherited;
  RecState := rsDoNothing; //只显示未审核也未审批的记录
  svrMain := IFmMain.GetConnection(Handle,'','SvrChainGSP.CoChainGSP');
  cdsMain.RemoteServer := svrMain;
  cdsMain.ProviderName := 'dspFirstDealCorp';
end;

procedure TFmFirstDealCorp.FormShow(Sender: TObject);
begin
  inherited;
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmFirstDealCorp.Xml');
  SetFieldProperty(CdsFieldProPerty, cdsMain, 'Gsp_FirstDealCorpInfo');
  SetGressHint('读取历史记录...');
  FreeGressForm;
  cdsMain.Params[0].AsInteger := Integer(RecState);
  cdsMain.Open;
end;

procedure TFmFirstDealCorp.edDepartButtonClick(Sender: TObject);
var
  iDepartID: integer;
  sDepartNo,sDepartName: string;
begin
  if EditMode=0 then exit;
  iDepartID := cdsMainDepartID.Value;
  if SelectDepart(iDepartID,sDepartNo,sDepartName) then
  begin
    cdsMainDepartName.Value := sDepartName;
    cdsMainDepartID.Value := iDepartID;
  end;
end;

procedure TFmFirstDealCorp.cdsMainNewRecord(DataSet: TDataSet);
begin
  inherited;
  cdsMainBillNo.Value := GetBillNo('Gsp_FirstDealCorpInfo');
  cdsMainFDate.Value := Date;
end;

procedure TFmFirstDealCorp.ActAuditExecute(Sender: TObject);
begin
  inherited;
  CheckAudit(cdsMainAudit.Value);
  if MessageBox(Handle,'即将审核首营企业记录。审核之后将不能再修改数据。'#13'要继续吗？','警告',MB_ICONEXCLAMATION or MB_YESNO or MB_DEFBUTTON2)=IDNO then
    exit;
  EditMode := 1;
  cdsMain.Edit;
  cdsMainAudit.Value := true;
  ActSave.Execute;
  ActRefresh.Execute;
end;

procedure TFmFirstDealCorp.ActShowAuditedExecute(Sender: TObject);
begin
  CheckEditMode;
  if RecState = rsDoNothing then
    RecState := rsDoNothingAndAudited
  else
    RecState := rsDoNothing;
  ActShowAudited.Checked := (RecState = rsDoNothingAndAudited);
  with cdsMain do
  begin
    Params[0].AsInteger := Integer(RecState);
    if Active then Refresh else Open;
  end;
end;

procedure TFmFirstDealCorp.ActUpdateExecute(Sender: TObject);
begin
  CheckAudit(cdsMainAudit.Value);
  inherited;
end;

procedure TFmFirstDealCorp.ActDeleteExecute(Sender: TObject);
begin
  CheckEditMode;
  CheckAudit(cdsMainAudit.Value);
  inherited;
end;

procedure TFmFirstDealCorp.SetBillNoFontColor;
var
  c: TColor;
begin
  c := clWindowText;
  if cdsMainAudit.Value then
    c := clMaroon;
  if cdsMainApprove.Value then
    c := clRed;
  edBillNo.Font.Color := c;
end;

procedure TFmFirstDealCorp.cdsMainAfterOpen(DataSet: TDataSet);
begin
  inherited;
  SetBillNoFontColor;
end;

procedure TFmFirstDealCorp.cdsMainAfterScroll(DataSet: TDataSet);
begin
  inherited;
  SetBillNoFontColor;
end;

procedure TFmFirstDealCorp.cdsMainAfterRefresh(DataSet: TDataSet);
begin
  inherited;
  SetBillNoFontColor;
end;

procedure TFmFirstDealCorp.ActInsertExecute(Sender: TObject);
begin
  inherited;
  edDepart.SetFocus;
end;

initialization
  RegisterClass(TFmFirstDealCorp);

finalization
  UnRegisterClass(TFmFirstDealCorp);

end.