📄 unit2.pas

📁 设备管理系统设备管理系统
💻 PAS
📖 第 1 页 / 共 2 页
字号:
上一页 12
           end;
             ADOQuery1.SQL.Clear;
             ADOQuery1.Parameters.CreateParameter('KS',ftstring,pdinput,20,combobox1.Text);
             ADOQuery1.SQL.Add('select * from jibenxinxi where 科室=:ks');
             ADOQuery1.Open;
             ADOQuery1.Locate(adoquery1.Fields[0].FieldName,bh_bt.Text,searchOptions);
             clearall;
         end;
     end;
end;

procedure TShebei_F.JG_BtKeyPress(Sender: TObject; var Key: Char);
var
  a:boolean;
begin
  a:=(key>='0')and(key<='9')or(key='.');
  if not a  then
     key:=#0;
end;

procedure TShebei_F.DBGrid1CellClick(Column: TColumn);
begin
  bh_Bt.Text:=adoquery1.Fields[0].AsString;
  MCH_Bt.Text:=adoquery1.Fields[1].AsString;
  XH_Bt.Text:=adoquery1.Fields[2].AsString;
  XLH_Bt.Text:=adoquery1.Fields[3].AsString;
  JYLB_Bt.Text:=adoquery1.Fields[4].AsString;
  ZHT_Bt.Text:=adoquery1.Fields[5].AsString;
  CLFW_Bt.Text:=adoquery1.Fields[6].AsString;
  FBL_Bt.Text:=adoquery1.Fields[7].AsString;
  CLJD_Bt.Text:=adoquery1.Fields[8].AsString;
  SCCJ_bt.Text:=adoquery1.Fields[9].AsString;
  CJDH_Bt.Text:=adoquery1.Fields[10].AsString;
  GYS_Bt.Text:=adoquery1.Fields[11].AsString;
  SJDH_Bt.Text:=adoquery1.Fields[12].AsString;
  MASKEDIT1.Text:=adoquery1.Fields[13].AsString;
  MASKEDIT2.Text:=adoquery1.Fields[14].AsString;
  combobox2.Text:=adoquery1.Fields[15].AsString;
  CFDD_Bt.Text:=adoquery1.Fields[16].AsString;
  BGR_Bt.Text:=adoquery1.Fields[17].AsString;
  JG_Bt.Text:=adoquery1.Fields[18].AsString;
  DABH_Bt.Text:=adoquery1.Fields[19].AsString;
  checkbox1.Checked:=adoquery1.Fields[20].AsBoolean;
  checkbox2.Checked:=adoquery1.Fields[21].AsBoolean;
  sopn.Text:=adoquery1.Fields[22].AsString;
  zjgcn.Text:=adoquery1.Fields[23].AsString;
  bz.Text:=adoquery1.Fields[24].AsString;
end;

procedure TShebei_F.FormCreate(Sender: TObject);


begin

   ADOquery1.Active:=true;
end;

procedure TShebei_F.ComboBox1Change(Sender: TObject);
var
  sql:string;

begin
  if combobox1.ItemIndex=0 then
     begin
       adoquery1.Close;
       adoquery1.SQL.Clear;
       adoquery1.SQL.Add('select * from jibenxinxi order by 唯一号');
       adoquery1.Open;
     end
  else
     begin
       adoquery1.Close;
       adoquery1.SQL.Clear;
       
       sql:='select * from jibenxinxi where 科室='+'"'+combobox1.Text+'" order by 唯一号';
       adoquery1.SQL.Add(sql);

       adoquery1.Prepared;
       adoquery1.Open;
       adoquery1.First;

      
     end;
end;

procedure TShebei_F.BitBtn1Click(Sender: TObject);
begin
  adoquery1.Open;
  frreport1.ShowReport;
end;

procedure TShebei_F.Button3Click(Sender: TObject);
begin
  frreport3.PrepareReport;
  frreport3.ShowPreparedReport;
end;

procedure TShebei_F.Button4Click(Sender: TObject);
var
sql:string;
begin
  adoquery1.Close;
  adoquery1.SQL.Clear;
  sql:='select * from jibenxinxi where 唯一号="'+edit1.Text+'"';
  adoquery1.SQL.Add(sql);
  adoquery1.open;
end;

procedure TShebei_F.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=cafree;
end;



procedure TShebei_F.Button5Click(Sender: TObject);
var
  sql:string;
begin
  adoquery1.Close;
  adoquery1.SQL.Clear;
  sql:='select * from jibenxinxi where 名称 like"%'+edit2.Text+'%"';
  adoquery1.SQL.Add(sql);
  adoquery1.open;
end;

procedure TShebei_F.Button2Click(Sender: TObject);
var
  flag:integer;
  
begin

  Flag:=MessageBox(handle,'当前操作会打印全部查询结果，确认吗？','打印确认',MB_yesno or MB_ICONinformation);
      if Flag=IDno then
        begin
        exit;
        end
        else
  frreport2.showreport;

end;
procedure TShebei_F.DBGrid1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState);
var
  nWidth:integer;
begin
  with dbGrid1.Canvas do
    begin
      nWidth := TextWidth(Column.Field.AsString) + 2;
      if nWidth > Column.Width then Column.Width := nWidth;
    end;

 

  with tdbgrid(sender) do
  begin
   if ((state = [gdselected]) or (state=[gdselected,gdfocused]))  then
    begin
     canvas.font.color :=clwhite;
     canvas.brush.color :=$00c08080;
    end
    else
    begin
      if datasource.dataset.recno mod 2<>0 then
        canvas.brush.color :=clwhite
      else
        canvas.brush.color :=$00cffefd;


    end;
    defaultdrawcolumncell(rect, datacol, column, state);
  end;
  dbGrid1.DefaultDrawColumnCell(Rect,DataCol,Column,State);
  with (Sender as TDBGrid).Canvas do //画 cell 的边框
  begin
    Pen.Color := $00ff0000; //定义画笔颜色(蓝色)
    MoveTo(Rect.Left, Rect.Bottom); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画蓝色的横线
    Pen.Color := $0000ff00; //定义画笔颜色(绿色)
    MoveTo(Rect.Right, Rect.Top); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画绿色的竖线
  end;


end;


procedure TShebei_F.SpeedButton1Click(Sender: TObject);
var
  f:string;
  flag:integer;
  fword,fdoc: variant;
  wdFindContinue,FindText, MatchCase, MatchWholeWord, MatchWildcards, MatchSoundsLike,
  MatchAllWordForms, Forward, Wrap, Format, ReplaceWith, Replace: OleVariant;

begin
  f:='Document/'+trim(dabh_bt.Text)+'.doc';
  if FileExists(f) then
    ShellExecute(0, nil,PChar(f),nil,nil,SW_NORMAL)
  else
    if trim(dabh_bt.Text)='' then
      showmessage('补上档案号再说！')
  else
    begin
      Flag:=MessageBox(handle,'没有找到相关的文档，要新建一个吗？','确认',MB_yesno or MB_ICONquestion);
      if flag=IDno then exit
      else
        begin
          try
            FWord := CreateOleObject('Word.Application');
            FWord.Visible := false;
          except
            ShowMessage('创建word对象失败！');
            Exit;
          end;
          try
            FDoc := FWord.Documents.open(ExtractFilePath(application.ExeName)+'/Document/temp.dot');
            FindText := '<#SNumber>';
            MatchCase := False;
            MatchWholeWord := True;
            MatchWildcards := False;
            MatchSoundsLike := False;
            MatchAllWordForms := False;
            Forward := True;
            Wrap := wdFindContinue;
            Format := False;
            ReplaceWith := dabh_bt.Text;
            Replace := True;

            FDoc.Range.Find.Execute( FindText, MatchCase, MatchWholeWord,
            MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
            Wrap, Format, ReplaceWith, Replace );
            FDoc.SaveAs(ExtractFilePath(application.ExeName) +'/Document/'+trim(dabh_bt.Text)+'.doc');
            FWord.Quit;
            FWord := Unassigned;
            ShellExecute(0, nil,PChar(f),nil,nil,SW_NORMAL);
          except
          on e: Exception do
            ShowMessage(e.Message);
          end;
        end;
    end;
end;

procedure TShebei_F.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (ssCtrl in Shift) and (key = vk_RETURN) then
      Button1.click;

end;

procedure TShebei_F.SpeedButton2Click(Sender: TObject);
var
  f:string;
  flag:integer;
  fword,fdoc: variant;
  wdFindContinue,FindText, MatchCase, MatchWholeWord, MatchWildcards, MatchSoundsLike,
  MatchAllWordForms, Forward, Wrap, Format, ReplaceWith, Replace: OleVariant;

begin
  f:='AccessoryDoc/'+trim(bh_bt.Text)+'.doc';
  if FileExists(f) then
    ShellExecute(0, nil,PChar(f),nil,nil,SW_NORMAL)
  else
    if trim(bh_bt.Text)='' then
      showmessage('请补上唯一号！')
  else
    begin
      Flag:=MessageBox(handle,'没有找到相关的文档，要新建一个吗？','确认',MB_yesno or MB_ICONquestion);
      if flag=IDno then exit
      else
        begin
          try
            FWord := CreateOleObject('Word.Application');
            FWord.Visible := false;
          except
            ShowMessage('创建word对象失败！');
            Exit;
          end;
          try
            FDoc := FWord.Documents.open(ExtractFilePath(application.ExeName)+'/AccessoryDoc/temp.dot');
            FindText := '<#SNumber>';
            MatchCase := False;
            MatchWholeWord := True;
            MatchWildcards := False;
            MatchSoundsLike := False;
            MatchAllWordForms := False;
            Forward := True;
            Wrap := wdFindContinue;
            Format := False;
            ReplaceWith := bh_bt.Text;
            Replace := True;

            FDoc.Range.Find.Execute( FindText, MatchCase, MatchWholeWord,
            MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
            Wrap, Format, ReplaceWith, Replace );
            FindText := '<#Name>';
            ReplaceWith := mch_bt.Text;
            FDoc.Range.Find.Execute( FindText, MatchCase, MatchWholeWord,
            MatchWildcards, MatchSoundsLike, MatchAllWordForms, Forward,
            Wrap, Format, ReplaceWith, Replace );
            FDoc.SaveAs(ExtractFilePath(application.ExeName) +'/AccessoryDoc/'+trim(bh_bt.Text)+'.doc');
            FWord.Quit;
            FWord := Unassigned;
            ShellExecute(0, nil,PChar(f),nil,nil,SW_NORMAL);
          except
          on e: Exception do
            ShowMessage(e.Message);
          end;
        end;
    end;
end;

end.
上一页 12
💿 文件大小 1793 K
👤 上传用户 wc7707399
📂 所属分类 Delphi控件源码
🏷️ 相关标签

#设备管理
⌨️ 快捷键说明

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