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

📄 mainform.pas

📁 病历管理系统
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    procedure wwDBNavigator2ButtonClick(Sender: TObject);
    procedure RvCustomConnection1Restore(Connection: TRvCustomConnection);
    procedure RvCustomConnection1First(Connection: TRvCustomConnection);
    procedure RvCustomConnection1Next(Connection: TRvCustomConnection);
    procedure RvCustomConnection1EOF(Connection: TRvCustomConnection;
      var Eof: Boolean);
    procedure pc1Enter(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fmMain: TfmMain;
  myDS:TStringList;
  myDSPTR:integer;

implementation

{$R *.DFM}

procedure TfmMain.grdMainCalcTitleImage(Sender: TObject; Field: TField;
  var TitleImageAttributes: TwwTitleImageAttributes);
begin
  if (Field.FieldName='temp1') then
  begin
    TitleImageAttributes.ImageIndex:=2;
  end;
end;

procedure TfmMain.tblBingLiCalcFields(DataSet: TDataSet);
begin
  with dataset do
  begin
    fieldbyname('Addr').asstring:=fieldbyname('ZhuZhi').asstring+ ' ' + fieldbyname('YouZhengMa').asstring;
    fieldbyname('Natr').asstring:=fieldbyname('GuoJi').asstring + ' ' +fieldbyname('ChuShengDi').asstring;
  end;
end;

procedure TfmMain.tblXiMuCalcFields(DataSet: TDataSet);
begin
  with dataset do
  begin
    fieldbyname('ChuZhen').asstring:=fieldbyname('MenZhenZhenDuan').asstring+ ';' + fieldbyname('LinChuangChuZhen').asstring;
    fieldbyname('ShiJian').asstring:=fieldbyname('RuYuanSJ').asstring + ';' +fieldbyname('ChuYuanSj').asstring;
    fieldbyname('YiSheng').asstring:=fieldbyname('MenZhenYiSheng').asstring + ';' +fieldbyname('ZhuYuanYiSheng').asstring+ ';' +fieldbyname('ZhuZhiYiSheng').asstring;
  end;
end;

procedure TfmMain.ld1InitDialog(Dialog: TwwLocateDlg);
begin
  Dialog.Height:=Dialog.Height-(Dialog.FirstButton.Top-Dialog.FieldsGroup.Top)+5;
  Dialog.FirstButton.Top:=Dialog.FieldsGroup.Top+5;
  Dialog.NextButton.Top:=Dialog.FirstButton.Top;
  Dialog.CanCelBtn.Top:=Dialog.FirstButton.Top;
  Dialog.FirstButton.Caption:='找第一个';
  Dialog.NextButton.Caption:='找下一个';
  Dialog.CancelBtn.Caption:='退出';
  Dialog.FieldsGroup.Visible:=False;
  Dialog.SearchTypeGroup.Caption:='查找形式';
  Dialog.CaseSensitiveCheckBox.Caption:='大小写敏感';
  Dialog.ExactMatchBtn.Caption:='完全匹配';
  Dialog.PartialMatchStartBtn.Caption:='从头起部分匹配';
  Dialog.PartialMatchAnyBtn.Caption:='任意部位部分匹配';
  Dialog.FieldValueGroup.Caption:='查找值';
end;

procedure TfmMain.tblBingLiAfterInsert(DataSet: TDataSet);
begin
//  DataSet.FieldValues['YouZhengMa']:=0;   //若是在数据库中定义有默认值(整型默认为0),需在此赋值,否则会出现完整性错
//  DataSet.FieldValues['NianLing']:=0;
  DataSet.FieldValues['HunKuang']:=false;
  DataSet.FieldValues['GuoJi']:='中国';
  DataSet.Post;
  tblXiMu.Insert;
end;

procedure TfmMain.tblBingLiBeforeDelete(DataSet: TDataSet);
begin
  //if Application.MessageBox('该患者的所有信息将被删掉,你确定吗?', '确认删除', MB_YESNO)=IDNO then abort;
  qry1.SQL.Text:='Delete From XiMu Where ID=' + DataSet.FieldByName('ID').AsString;
  qry1.ExecSQL;
end;

procedure TfmMain.tblXiMuAfterInsert(DataSet: TDataSet);
var
  i:integer;
begin
  With DataSet do
  begin
//    FieldValues['ZhuYuanHao']:=0; //若是在数据库中定义有默认值(整型默认为0),需在此赋值,否则会出现完整性错
    FieldValues['No']:=0;
    Prior;
    i:=FieldByName('No').AsInteger;
    Next;
    Edit;
    FieldValues['No']:=i+1;
    Post;
  end;
end;

procedure TfmMain.wwDBNavigator2Button1Click(Sender: TObject);
begin
  qry1.SQL.Text:='select * from bingli,ximu '+
      'where bingli.id=ximu.id and bingli.id='+
      tblBingli.FieldByName('ID').AsString+ ' and ximu.no='+
      tblXimu.FieldByName('No').AsString;
  qry1.Open;
  rvp1.SelectReport('ChuYuanXiaoJie',true);
  rvp1.SetParam('zhuyuantianshu',inttostr(DaysBetween(qry1.FieldByName('ChuYuanSJ').AsDateTime,qry1.FieldByName('RuYuanSJ').AsDateTime)));
  rvp1.Execute;
  qry1.Close;
end;

procedure TfmMain.wwDBNavigator2ButtonClick(Sender: TObject);
begin
  qry1.SQL.Text:='select * from bingli,ximu '+
      'where bingli.id=ximu.id and bingli.id='+
      tblBingli.FieldByName('ID').AsString+ ' and ximu.no='+
      tblXimu.FieldByName('No').AsString;
  qry1.Open;
  rvp1.SelectReport('ZhuYuanBingAn',true);
  rvp1.SetParam('hunkuang',ifthen(qry1.FieldByName('hunkuang').AsBoolean,'已婚','未婚'));
  rvp1.Execute;
  qry1.Close;
end;

procedure TfmMain.RvCustomConnection1Open(Connection: TRvCustomConnection);
  function SplitSTR(srcS:String;addLF:boolean=true): String;
  const
    maxbyteperline=76;
  var
    lfp,firstp:integer;
  begin
    firstp:=1;
    result:=srcS;
    repeat
      lfp:=posex(#13#10,result+#13#10,firstp);
      while lfp-firstp>maxbyteperline do
      begin
        inc(firstp,maxbyteperline);
        if ByteType(result,firstp-1)=mbLeadByte then inc(firstp);
        Insert(#13#10' ',result,firstp);       // 由于RAVE中若字符串的汉字前只有单字节空格时,汉字会显示成问号,需在单独的行前加一单字节可打印字符或双字节字符(这里加双字节空格)
        inc(firstp,2);
        inc(lfp,4);
      end;
      if (lfp>0) and (lfp<length(result)) then Insert(' ',result,lfp+2); //为每个原有的换行后加双字节空格
      firstp:=lfp+2;
    until lfp=0;
    if addLF then Result:=Result+#13#10;
  end;
  Function JoinSTR():String;
  begin
    result:=
       SplitSTR('问诊:'+qry1.FieldByName('wenzhen').AsString)
      +SplitSTR('主诉:'+qry1.FieldByName('zhusu').AsString)
      +SplitSTR('现病史:'+qry1.FieldByName('xianbingshi').AsString)
      +SplitSTR('既往史:'+qry1.FieldByName('jiwangshi').AsString)
      +SplitSTR('个人史:'+qry1.FieldByName('gerenshi').AsString)
      +ifthen(qry1.FieldByName('xingbie').AsString='女',SplitSTR('月经史:'+qry1.FieldByName('yuejingshi').AsString))
      +SplitSTR('婚育史:'+qry1.FieldByName('hunyushi').AsString)
      +SplitSTR('过敏史:'+qry1.FieldByName('guominshi').AsString)
      +SplitSTR('家庭史:'+qry1.FieldByName('jiazushi').AsString,false);
  end;
  procedure InitDS();
  const
    linesperpage=29;
    fixlinesonfirstpage=6;
  var
    i:integer;
  begin
    myDS:=TStringlist.Create;
    myDS.Text:=JoinSTR;
    for i:=1 to (linesperpage-(myDS.Count+fixlinesonfirstpage) mod linesperpage) do
      myDS.Add('');
  end;
begin
  InitDS;
end;

procedure TfmMain.RvCustomConnection1GetCols(
  Connection: TRvCustomConnection);
begin
  RvCustomConnection1.WriteField('OneCol',dtString,76,'OneCol','');
end;

procedure TfmMain.RvCustomConnection1GetRow(
  Connection: TRvCustomConnection);
begin
  Connection.WriteStrData('',myDS.Strings[myDSPTR]);
end;

procedure TfmMain.RvCustomConnection1Restore(
  Connection: TRvCustomConnection);
begin
  myDS.Free;
end;

procedure TfmMain.RvCustomConnection1First(
  Connection: TRvCustomConnection);
begin
  myDSPTR:=0;
end;

procedure TfmMain.RvCustomConnection1Next(Connection: TRvCustomConnection);
begin
  if myDSPTR<myDS.Count then Inc(myDSPTR);
end;

procedure TfmMain.RvCustomConnection1EOF(Connection: TRvCustomConnection;
  var Eof: Boolean);
begin
  Eof:=not(myDSPTR<myDS.Count);
end;

procedure TfmMain.pc1Enter(Sender: TObject);
begin
  if rgYueJingShi.Opened and (tblBingLi.FieldByName('xingbie').AsString='男') then rgJiWangShi.Open;;
  rgYueJingShi.Visible:=tblBingLi.FieldByName('xingbie').AsString='女';
end;

end.

⌨️ 快捷键说明

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