examadvice.~pas

来自「某疗养院动脉硬化管理系统」· ~PAS 代码 · 共 163 行

unit ExamAdvice;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RecordForm, cxStyles, cxCustomData, cxGraphics, cxFilter,
  cxData, cxDataStorage, cxEdit, DB, cxDBData, ADODB, DBCtrls, cxGridLevel,
  cxClasses, cxControls, cxGridCustomView, cxGridCustomTableView,
  cxGridTableView, cxGridDBTableView, cxGrid, ExtCtrls, StdCtrls, Buttons;

type
  TFrmExamAdvice = class(TFrmRecord)
    Panel3: TPanel;
    GroupBox1: TGroupBox;
    Memo: TMemo;
    BtnNew: TBitBtn;
    BtnDel: TBitBtn;
    BtnEdit: TBitBtn;
    BtnSave: TBitBtn;
    BtnClose: TBitBtn;
    cxGrid1DBTableView1ID: TcxGridDBColumn;
    cxGrid1DBTableView1Advice: TcxGridDBColumn;
    Label1: TLabel;
    EdtID: TEdit;
    procedure BtnCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BtnNewClick(Sender: TObject);
    procedure BtnDelClick(Sender: TObject);
    procedure BtnEditClick(Sender: TObject);
    procedure BtnSaveClick(Sender: TObject);
  private
    Flag:integer;
    //显示数据
    procedure ShowData;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmExamAdvice: TFrmExamAdvice;

implementation

uses DataModule, PubFunction;

{$R *.dfm}

procedure TFrmExamAdvice.BtnCloseClick(Sender: TObject);
begin
  inherited;
  close;
end;

procedure TFrmExamAdvice.FormCreate(Sender: TObject);
begin
  inherited;
  ShowRecord(ADQ,'*','ExamAdvice','ID');
end;

procedure TFrmExamAdvice.ShowData;
begin
  EdtID.Text:=ADQ.FieldByName('ID').AsString;
  Memo.Lines.Text:=ADQ.FieldByName('Advice').AsString;
end;

procedure TFrmExamAdvice.FormShow(Sender: TObject);
begin
  inherited;
  SetBtnStatus(BtnNew,BtnDel,BtnEdit,BtnSave,'Ini');
end;

procedure TFrmExamAdvice.BtnNewClick(Sender: TObject);
begin
  inherited;
  Flag:=0;
  EdtID.Text:=GenID('ID','ExamAdvice','A');
  Memo.SetFocus;
  SetBtnStatus(BtnNew,BtnDel,BtnEdit,BtnSave,'New');
end;

procedure TFrmExamAdvice.BtnDelClick(Sender: TObject);
begin
  inherited;
  if ADQ.IsEmpty then
    exit;
  if Application.MessageBox('确定要删除这条记录？','提示',mb_yesno+mb_iconquestion)=idyes then
    ADQ.Delete;
end;

procedure TFrmExamAdvice.BtnEditClick(Sender: TObject);
begin
  inherited;
  if ADQ.IsEmpty then
    exit;
  Flag:=1;
  ShowData;
  SetBtnStatus(BtnNew,BtnDel,BtnEdit,BtnSave,'Edit');
end;

procedure TFrmExamAdvice.BtnSaveClick(Sender: TObject);
begin
  inherited;
  if Trim(Memo.Lines.Text)='' then
  begin
    application.MessageBox('请输入指导意见！','提示',mb_ok+mb_iconinformation);
    Memo.SetFocus;
    exit;
  end;
  DM.ADOCn.BeginTrans;
  if Flag=0 then
    begin
      try
        with ADQ do
        begin
          sql.Clear;
          sql.Add('INSERT INTO ExamAdvice(ID,Advice) VALUES (:v1,:v2)');
          Parameters.ParamByName('v1').Value :=Trim(EdtID.Text);
          Parameters.ParamByName('v2').Value :=Trim(Memo.Lines.Text);
          ExecSql;
        end;
        DM.ADOCn.CommitTrans;
        ShowRecord(ADQ,'*','ExamAdvice','ID');
        SetBtnStatus(BtnNew,BtnDel,BtnEdit,BtnSave,'Ini');
        Memo.Lines.Clear;
      except
        on e:Exception do
        begin
          DM.ADOCn.RollbackTrans;
          Application.MessageBox('保存失败！','警告',mb_ok+mb_iconwarning);
          WriteLog('指导意见保存失败'+e.Message);
          ShowRecord(ADQ,'*','ExamAdvice','ID');
        end;
      end;
    end
  else
    begin
      try
        with ADQ do
        begin
          sql.Clear;
          sql.Add('UPDATE ExamAdvice Set Advice=:v1 WHERE ID=:v2');
          Parameters.ParamByName('v1').Value :=Trim(Memo.Lines.Text);
          Parameters.ParamByName('v2').Value :=Trim(EdtID.Text);
          ExecSql;
        end;
        DM.ADOCn.CommitTrans;
        ShowRecord(ADQ,'*','ExamAdvice','ID');
        SetBtnStatus(BtnNew,BtnDel,BtnEdit,BtnSave,'Ini');
        Memo.Lines.Clear;
      except
        DM.ADOCn.RollbackTrans;
        raise;
        application.MessageBox('保存失败！','警告',mb_ok+mb_iconwarning);
        ShowRecord(ADQ,'*','ExamAdvice','ID');
      end;
    end;
end;

end.