⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 examadvice.~pas

📁 某疗养院动脉硬化管理系统
💻 ~PAS
字号:
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.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -