main.pas

医院X光片资料管理系统—全部源码 这是源码。去年做的一个小软件。因为这是给一家医院做的

unit MAIN;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
  ActnList, ToolWin, ImgList, shellapi, ADOConEd, inifiles, registry,
  XPMenu;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    cxtj: TMenuItem;
    cxtj2: TMenuItem;
    cxtj3: TMenuItem;
    back0: TMenuItem;
    tool: TMenuItem;
    N1: TMenuItem;
    cxtj5: TMenuItem;
    backup1: TMenuItem;
    tool1: TMenuItem;
    cxtj4: TMenuItem;
    StatusBar: TStatusBar;
    ToolBar2: TToolBar;
    tool2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    view0: TMenuItem;
    view1: TMenuItem;
    N5: TMenuItem;
    help0: TMenuItem;
    help1: TMenuItem;
    help2: TMenuItem;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    N2: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    XPMenu1: TXPMenu;
    procedure FileExit1Execute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure backup1Click(Sender: TObject);
    procedure tool1Click(Sender: TObject);
    procedure tool2Click(Sender: TObject);
    procedure view1Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure help1Click(Sender: TObject);
    procedure help2Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    SL: TStringList;
  end;

var
  MainForm: TMainForm;
  FileName: string; //ADO打开dbsetup.ini文件使用
  username: string;

implementation
{$R *.dfm}
uses input, qry, tj, fix, dmwh, repairdb, changepass, usergl, login, mylib, dm,
  About;
//*****************************************************
//模块编号：01
//目的： 打开MDI子窗体，如果已经打开或最小化则恢复，否则创建子窗体
//定位于主窗体的左上角，以普通方式打开（原来大小）
//编写日期：20002.03.01
//*****************************************************

procedure OpenForm(FormClass: TFormClass; var fm; AOwner: TComponent);
var
  i: integer;
  Child: TForm;
begin
  for i := 0 to Screen.FormCount - 1 do
    if Screen.Forms[i].ClassType = FormClass then
    begin
      Child := Screen.Forms[i];
      if Child.WindowState = wsMinimized then
        ShowWindow(Child.handle, SW_SHOWNORMAL)
      else
        ShowWindow(Child.handle, SW_SHOWNA);
      if (not Child.Visible) then Child.Visible := True;
      Child.BringToFront;
      Child.Setfocus;
      TForm(fm) := Child;
      exit;
    end;
  Child := TForm(FormClass.NewInstance);
  TForm(fm) := Child;
  Child.Create(AOwner);
//  child.WindowState := wsNormal;
  if (child.Name = 'qryfm') then
  begin
    child.Left := 0;
    child.top := 0;
  end;
  if (child.Name = 'tjfm') then
  begin
    child.Left := 0;
    child.top := 0;
  end;
  if (child.Name = 'dmwhfm') then
  begin
    child.Left := 0;
    child.top := 0;
  end;
  if (child.Name = 'fixfm') then
  begin
    child.Left := 0;
    child.top := 0;
  end;

  if (child.Name = 'login') then
  begin
    child.Position := poScreenCenter
  end
  else
  begin
//    child.Left := 0;
//    child.top := 0;
//  child.Position:=poMainFormCenter;
  end;

end;

procedure TMainForm.FileExit1Execute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.FormShow(Sender: TObject);
var
  TheReg: TRegistry;
  KeyName, user: string;
begin

//设定日期显示格式
  DateSeparator := '-';
  ShortDateFormat := 'yyyy-mm-dd';
  StatusBar.Panels[2].Text := datetostr(date);

//  panel1.Caption := '今天是：' + datetostr(date);
//读取注册信息-------------
//  TheReg := TRegistry.Create;
//  TheReg.RootKey := HKEY_LOCAL_MACHINE;
//  keyName := 'SOFTWARE\jnsqws';
//  if TheReg.OpenKey(keyName, True) then
//  begin
//    user := '【用户名称】：' + TheReg.readString('user') + '社区卫生服务中心(站)';
////    StatusBar.Panels[0].Width := length(user) * 6 + 10;
////    StatusBar.Panels[0].Text := user;
//    TheReg.CloseKey;
//  end;
//  Thereg.Free;
//-------
//loginfm.ShowModal;
end;
//压缩整理

procedure TMainForm.backup1Click(Sender: TObject);
begin
  OpenForm(Trepair, repair, self);
end;

procedure TMainForm.tool1Click(Sender: TObject);
begin
  Winexec('CALC.EXE', sw_Normal);
end;

procedure TMainForm.tool2Click(Sender: TObject);
begin
  Winexec('Notepad.exe', sw_Normal);
end;
//工具栏是否屏蔽

procedure TMainForm.view1Click(Sender: TObject);
begin
  view1.Checked := not view1.Checked;
  if view1.Checked then ToolBar2.Visible := True else ToolBar2.Visible := False;
end;
//状态条是否屏蔽

procedure TMainForm.N5Click(Sender: TObject);
begin
  N5.Checked := not N5.Checked;
  if N5.Checked then StatusBar.Visible := True else StatusBar.Visible := False;
end;

procedure TMainForm.help1Click(Sender: TObject);
var fpath: string;
begin
  fpath := ExtractFilePath(ParamStr(0)) + 'help.chm';
  ShellExecute(handle, nil, pchar(fpath), nil, nil, sw_shownormal);
end;

procedure TMainForm.help2Click(Sender: TObject);
begin
  aboutbox.showmodal;
end;

procedure TMainForm.N4Click(Sender: TObject);
var
  filehandle: integer;
  con: string;
begin
//检查所有子窗口是否关闭
{  with Mainform do
  begin
    if MDIChildCount > 0 then
    begin
      showmessage('请将所有录入、查询窗口关闭！');
      exit;
    end;
  end;
  if MessageDlg('此功能一般情况下不要使用，若操作错误将导致系统不能使用！你真的要使用此功能吗？',
    mtConfirmation, [mbYes, mbNo], 0) = mrNo then exit;
//如果不存在dbsetup.ini文件则创建
  fileName := ExtractFilePath(ParamStr(0)) + 'dbsetup.ini';
  if not FileExists(FileName) then
  begin
    filehandle := filecreate(filename);
    fileclose(filehandle);
  end;
//保存数据库设置到dbsetup.ini并试图连接
  SL := TStringList.Create;
  DMform.ADOConnection1.Connected := false;
  EditConnectionString(DMform.ADOConnection1);
  SL.Text := DMform.ADOConnection1.ConnectionString;
  SL.SaveToFile(Filename);
  Con := SL.Text;
  sl.free;
  try
    DMform.ADOConnection1.Connected := false;
    DMform.ADOConnection1.ConnectionString := Con;
    DMform.ADOConnection1.Connected := true;
    DMfrm3.ADOConnection1.Connected := false;
    DMfrm3.ADOConnection1.ConnectionString := Con;
    DMfrm3.ADOConnection1.Connected := true;
    DMqryfm.ADOConnection1.Connected := false;
    DMqryfm.ADOConnection1.ConnectionString := Con;
    DMqryfm.ADOConnection1.Connected := true;
    showmessage('数据库配置成功，请退出重新运行本系统！');
    exit;
  except
    showmessage('数据库初始化错误，无法找到数据库' + #13 + Con);
  end;}
end;

procedure TMainForm.SpeedButton2Click(Sender: TObject);
begin
  OpenForm(Ttjfm, tjfm, self);
end;

procedure TMainForm.SpeedButton3Click(Sender: TObject);
begin
//  OpenForm(Tfuzhu, fuzhu, self);
end;

procedure TMainForm.SpeedButton4Click(Sender: TObject);
begin
  OpenForm(Tinputfm, inputfm, self);
end;

procedure TMainForm.SpeedButton5Click(Sender: TObject);
begin
  OpenForm(Tfixfm, fixfm, self);
end;

procedure TMainForm.N7Click(Sender: TObject);
begin
  OpenForm(Tdmwhfm, dmwhfm, self);

end;

procedure TMainForm.N8Click(Sender: TObject);
begin
  OpenForm(Tchangepassfm, changepassfm, self);
end;

procedure TMainForm.N10Click(Sender: TObject);
begin
  OpenForm(Tuserglfm, userglfm, self);
end;

procedure TMainForm.FormActivate(Sender: TObject);
begin
  if mainform.Tag = 0 then loginfm.ShowModal;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
var s1, s2, s3, sqltxt: string;
begin
  s1 := datetimetostr(now());
  s2 := inttostr(mainform.Tag);
  sqltxt := 'update rz set jtime=''' + s1 + '''';
  sqltxt := sqltxt + 'where id=' + s2;
  if s2 <> '0' then
    execadoquery(dmfm.ADOQuery1, sqltxt);
end;

procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
  OpenForm(Tqryfm, qryfm, self);
end;

end.