u_filmrecord.~pas

对于医院的影像室的资料进行管理,主要方便查阅,特别是对于病人的照片的病前后比较对于病情的发展很有价值

unit U_filmrecord;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB, ComCtrls, Buttons, ExtCtrls;

type
  TF_filmrecord = class(TForm)
    qFilmRecord: TADOQuery;
    qFilmRecordfilm_id: TAutoIncField;
    qFilmRecordfilmnumber: TWideStringField;
    qFilmRecorddate: TDateTimeField;
    qFilmRecordname: TWideStringField;
    qFilmRecordsex: TWideStringField;
    qFilmRecordage: TWideStringField;
    qFilmRecordadress: TWideStringField;
    qFilmRecordtel: TWideStringField;
    qFilmRecorddiagnose: TWideStringField;
    qFilmRecordfilmstage: TWideStringField;
    qFilmRecordfilminfer: TWideStringField;
    qFilmRecordcasehis: TWideStringField;
    qFilmRecordfilm: TMemoField;
    qFilmRecordbeiyong: TWideStringField;
    GroupBox1: TGroupBox;
    Label9: TLabel;
    casehis: TMemo;
    Label10: TLabel;
    filminfer: TMemo;
    Label11: TLabel;
    diagnose: TMemo;
    GroupBox2: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label12: TLabel;
    filmNumber: TEdit;
    name: TEdit;
    age: TEdit;
    tel: TEdit;
    address: TEdit;
    filmStage: TComboBox;
    sex: TComboBox;
    date: TDateTimePicker;
    beizhu: TEdit;
    button3: TBitBtn;
    Panel1: TPanel;
    button1: TBitBtn;
    button2: TBitBtn;
    Button4: TBitBtn;
    BitBtn1: TBitBtn;
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure BitBtn1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
   function getFilmRec(filmNo:string):boolean;
   function initialFilmRec:boolean;
   procedure initAllCbx;
   function CheckbeforePost:boolean;
  end;

var
  F_filmrecord: TF_filmrecord;
  bIns:boolean;
  CurrFilmNumber:string;
  procedure updFilmRecData(filmNo:string);
  procedure insFilmRecData;


implementation

uses u_main, U_modal, U_datamodule, U_jibingleixing, u_setParams;

{$R *.dfm}

  procedure updFilmRecData(filmNo:string);
  begin
  if (F_filmrecord=nil) or not assigned(F_filmrecord) then application.createform(TF_filmrecord,F_filmrecord);
  CurrFilmNumber:=filmNo;
  bIns:=false;
  if  F_filmrecord.getFilmRec(filmNo) then
  begin
  if not F_filmrecord.active then
  F_filmrecord.ShowModal
  end
  else
  if   messagebox(application.handle,'没有发现该号的信息，你希望添加新纪录马?','新增数据提示',mb_yesno+mb_defbutton1)=idYES then
  begin
  insFilmRecData;
  end;
  end;
  
  procedure insFilmRecData;
  begin
  if (F_filmrecord=nil) or not assigned(F_filmrecord) then application.createform(TF_filmrecord,F_filmrecord);
  CurrFilmNumber:='0';
  F_filmrecord.initialFilmRec;
  if not F_filmrecord.active then
  F_filmrecord.ShowModal;
  end;

procedure TF_filmrecord.Button1Click(Sender: TObject);
begin
if not CheckbeforePost then exit;

if not qFilmRecord.Active then
qFilmRecord.Open;
if bIns then
qFilmRecord.Append
else
begin
qFilmRecord.Filter:='filmnumber='+CurrFilmNumber;
qFilmRecord.edit;
end;
//判断filmstage是否存在，不存在，添加
if filmnumber.Text='' then
showmessage('影像号为空不能保存!')
else
begin
if name.Text='' then
showmessage('姓名为空不能保存!')
else
begin
qFilmRecord.FieldByName('filmnumber').AsString:=filmnumber.text;
qFilmRecord.FieldByName('date').AsString:=formatdatetime('yyyy-mm-dd',date.date);
qFilmRecord.FieldByName('filmstage').AsString:=filmstage.text;
qFilmRecord.FieldByName('name').AsString:=name.text;
qFilmRecord.FieldByName('sex').AsString:=sex.text;
qFilmRecord.FieldByName('age').AsString:=age.text;
qFilmRecord.FieldByName('beiyong').AsString:=beizhu.text;
qFilmRecord.FieldByName('tel').AsString:=tel.text;
qFilmRecord.FieldByName('adress').AsString:=address.text;
qFilmRecord.FieldByName('casehis').AsString:=casehis.text;
qFilmRecord.FieldByName('filminfer').AsString:=filminfer.text;
qFilmRecord.FieldByName('diagnose').AsString:=diagnose.text;
qFilmRecord.Post;
showmessage('记录已添加成功,您可以继续添加照片记录!');
initialFilmRec;
end;
end;

end;

function TF_filmrecord.CheckbeforePost: boolean;
begin
result:=true;

end;

function TF_filmrecord.getFilmRec(filmNo: string): boolean;
var sSql,sRtn:string;
begin
sSQL:='select count(filmnumber) from  filmrecord  where filmnumber='+quotedstr(filmNo);
sRtn:=getdatabySql(sSql);

if sRtn>'0' then
//quoted(str:string)为字符两边加引号
begin
sSQL:='select * from  filmrecord  where filmnumber='+quotedstr(filmNo);
qFilmRecord.close;
qFilmRecord.sql.text:=sSql;
qFilmRecord.open;
filmnumber.text:=qFilmRecord.FieldByName('filmnumber').AsString;
date.date:=qFilmRecord.FieldByName('date').Asdatetime;
filmstage.text:=qFilmRecord.FieldByName('filmstage').AsString;
name.text:=qFilmRecord.FieldByName('name').AsString;
beizhu.text:=qFilmRecord.FieldByName('beiyong').AsString;
sex.text:=qFilmRecord.FieldByName('sex').AsString;
age.text:=qFilmRecord.FieldByName('age').AsString;
tel.text:=qFilmRecord.FieldByName('tel').AsString;
address.text:=qFilmRecord.FieldByName('adress').AsString;
casehis.text:=qFilmRecord.FieldByName('casehis').AsString;
filminfer.text:=qFilmRecord.FieldByName('filminfer').AsString;
diagnose.text:=qFilmRecord.FieldByName('diagnose').AsString;
end;

end;

procedure TF_filmrecord.initAllCbx;
begin
sex.Clear;
sex.Items.Add('男');
sex.Items.Add('女');
filmstage.Clear;
dm.qSearch.close;
dm.qSearch.SQL.Text:='select * from filmstage';
dm.qSearch.open;
while not dm.qSearch.eof do
//dataset.eof判断数据是否在记录集最后
begin
filmstage.items.Add( dm.qSearch.fieldbyname('filmstage').asstring);
dm.qSearch.Next;
end;
dm.qSearch.close;

end;

function TF_filmrecord.initialFilmRec: boolean;
begin
bIns:=true;
filmnumber.text:='';
date.date:=now;
filmstage.text:='甲级';
name.text:='';
beizhu.Text:='';
sex.text:='男';
age.text:='';
tel.text:='';
address.text:='';
casehis.text:='';
filminfer.text:='';
diagnose.text:='';
end;

procedure TF_filmrecord.Button3Click(Sender: TObject);
begin
updFilmRecData(filmNumber.text);
end;

procedure TF_filmrecord.Button2Click(Sender: TObject);
begin
Close;
end;

procedure TF_filmrecord.FormCreate(Sender: TObject);
begin
initAllCbx;
end;

procedure TF_filmrecord.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
if messagebox(handle,'你确定退出该窗口吗?','[窗口关闭]确认信息',mb_iconwarning+mb_yesno+mb_defbutton2)<>idYes then
begin
Action:=canone;
exit;
end;
qfilmrecord.Close;
end;

procedure TF_filmrecord.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
case Key of
    VK_RETURN:
      begin
        Key := Word(#0);
        Perform(WM_NEXTDLGCTL, 0, 0)
      end;
    vk_escape:close;
end;      
end;

procedure TF_filmrecord.BitBtn1Click(Sender: TObject);
begin
F_jibingleixing.showmodal;
end;

procedure TF_filmrecord.Button4Click(Sender: TObject);
begin
if not assigned(frmSetParams) then
application.CreateForm(TfrmSetParams,frmSetParams);
frmSetParams.ShowModal;
end;

procedure TF_filmrecord.FormShow(Sender: TObject);
begin
setImeName(self,currImeName);
end;

end.