mylib.pas

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

//{$D-,L-}
unit mylib;
interface
uses
  Windows, Messages, SysUtils, ADODB, Dialogs, StdCtrls, ComCtrls, ExtCtrls;
{ }

function getpy1(S: string): string; //获取汉字拼音
function GetPY2(hzchar: string): char;
function pass(pstr: string): string; //字符加密器
function intdata(d: double): double; //四舍五入
function isdate(s: string): boolean; //检测字符串是否是日期
function getyear(d: Tdatetime): integer; //获取日期中的年份
function getyeardf(d: Tdatetime; e: Tdatetime): integer; //获取两个日期的相差年份
function GetBuildInfo: string; //获取版本号
function is4year(s: string): boolean; //检测是否是4位年份
function ComboBoxIsEmpty(combox1: TCombobox; errmsg: string): boolean;
function EditIsEmpty(ed1: TEdit; errmsg: string): boolean;
function EditIsYear(ed1: TEdit): boolean; //edit中输入的是否为合法4位年份的日期
procedure pyxm(ed1, ed2, ed3: TlabeledEdit; qry1, qry2: TADOquery; combox: Tcombobox);
//下面的过程把combobox内容添加到数据表并增加combobox项
procedure addnewdata(queryq: TADOQuery; tbname, fd1: string; Combox: Tcombobox);
//ED1内容添加到数据表
procedure AddData(queryq: TADOQuery; tbname, fd1: string; ed1: Tedit);
//ED1内容及拼音添加到数据表
procedure AddDataPy(queryq: TADOQuery; tbname, fd1, fd1py: string; ed1: Tedit);
procedure addcombox(ADOqry1: TADOQUERY; fd1, tbl: string; Combox: Tcombobox);
procedure open1AdoQuery(ADOqry1: TADOquery; fd1, tbl: string);
procedure openAdoQuery(ADOqry1: TADOquery; sqltxt: string);
procedure ExecAdoQuery(ADOqry1: TADOquery; sqltxt: string);
procedure DelMsgADOQuery(Handle: thandle; ADOqry1: TADOquery); //ADOQUERY删除选中的一条记录

implementation

procedure DelMsgADOQuery(Handle: Thandle; ADOqry1: TADOquery);
var
  sMsgCaption, sMsgText: string;
  iMsgType, iUserResp: integer;
begin
  sMsgCaption := '警告！';
  sMsgText := '你真的要删除选中资料吗？';
  iMsgType := MB_OKCANCEL + MB_ICONWARNING + MB_DEFBUTTON2;
  iUserResp := MessageBox(Handle, '你真的要删除选中资料吗？', '警告！',
    MB_OKCANCEL + MB_ICONWARNING + MB_DEFBUTTON2);
  case iUserResp of
    IDOK:
      begin
        ADOQry1.Delete;
      end;
    IDCANCEL:
      begin
      end;
  end;
end;

//**********************************************************************
//日期检测处理,Edit组件输入是否为有效日期，日期的年份是否为4位
//ed1:被检测TlabeledEdit类型组件
//**********************************************************************

function EditIsYear(ed1: TEdit): boolean;
begin
  result := true;
  if isdate(ed1.text) = false then
  begin
    MessageDlg('日期输入不正确！', mtWarning, [mbOk], 0);
    ed1.SetFocus;
    result := false;
    exit;
  end;
  if is4year(ed1.Text) = false then
  begin
    MessageDlg('年份必须输入4位！格式为XXXX-XX-XX(年—月—日）！', mtWarning, [mbOk], 0);
    ed1.SetFocus;
    result := false;
  end;
end;


//**********************************************************************
//消息显示框，用于检测Edit输入为空白的错误
//ed1:被检测TlabeledEdit类型组件
//errmsg:String 错误提示信息
//**********************************************************************

function EditIsempty(ed1: TEdit; errmsg: string): boolean;
begin
  result := true;
  if trim(ed1.text) = '' then
  begin
    MessageDlg(errmsg, mtWarning, [mbOk], 0);
    ed1.SetFocus;
    result := false;
  end;
end;
//**********************************************************************
//消息显示框，用于检测combox输入为空白的错误
//errmsg:String 错误提示信息
//**********************************************************************

function ComboBoxIsEmpty(combox1: TCombobox; errmsg: string): boolean;
begin
  result := true;
  if trim(combox1.text) = '' then
  begin
    MessageDlg(errmsg, mtWarning, [mbOk], 0);
    combox1.SetFocus;
    result := false;
  end;
end;

//**********************************************************************
//通用打开查询2, 用于查找一个字段排序
//参数说明：adoqry1—TADOQuery组件,fd1,tbl-字段名，数据表名称字符串
//2002-08-21
//**********************************************************************

procedure open1AdoQuery(ADOqry1: TADOquery; fd1, tbl: string);
var s: string;
begin
  s := 'select ' + fd1 + ' from ' + tbl + ' group by ' + fd1 + ' order by ' + fd1;
  with ADOqry1 do
  begin
    close;
    SQL.clear;
    SQL.add(s);
    open;
  end;
end;

//**********************************************************************
//通用ADO查询,根据用户输入SQL检索数据
//参数说明：adoqry1—TADOQuery组件,sqltxt-SQL语句
//**********************************************************************

procedure openAdoQuery(ADOqry1: TADOquery; sqltxt: string);
begin
  with ADOqry1 do
  begin
    close;
    SQL.clear;
    SQL.add(sqltxt);
    open;
  end;
end;

//**********************************************************************
//通用ADO执行查询,根据用户输入SQL检索数据
//参数说明：adoqry1—TADOQuery组件,sqltxt-EXECSQL语句
//**********************************************************************

procedure ExecAdoQuery(ADOqry1: TADOquery; sqltxt: string);
begin
  with ADOqry1 do
  begin
    close;
    SQL.clear;
    SQL.add(sqltxt);
    EXECSQL;
  end;
end;
//**********************************************************************
//下面是向combobox添加数据库内容列表的通用过程
//参数说明：ADOqry1—TADOQUERY组件,
//fd1,tbl—要添加的字段名称,数据表名称；Combox:要添加的combobox组件
//**********************************************************************

procedure addcombox(ADOqry1: TADOQUERY; fd1, tbl: string; Combox: Tcombobox);
var
  i, j: integer;
begin
  combox.Clear;
  open1AdoQuery(ADOqry1, fd1, tbl);
  j := ADOqry1.RecordCount;
  if j > 0 then
  begin
    for i := 1 to j do
    begin
      Combox.items.add(ADOqry1.FieldValues[fd1]);
      ADOqry1.Next;
    end;
  end;
end;

//**********************************************************************
//下面是追加当前edit及拼音到数据表中，如果不存在则添加
//参数说明：QUERYQ—TADOQuery组件名称,tbname—数据表名称，
//fd1—要添加的字段名称；fd1py:fd1的拼音代码，ed1:TEdit组件
//**********************************************************************

procedure AddDataPy(queryq: TADOQuery; tbname, fd1, fd1py: string; ed1: Tedit);
var
  s1, sqltxt, fpy: string;
begin
  if trim(ed1.Text) = '' then exit;
  s1 := trim(ed1.Text);
  fpy := getpy1(s1);
  sqltxt := 'select * from ' + tbname + ' where ' + fd1 + '=''' + s1 + '''';
  with Queryq do
  begin
    Close;
    sql.clear;
    sql.Add(sqltxt);
    open;
  end;
  if queryq.RecordCount > 0 then exit;
  if queryq.RecordCount = 0 then
    sqltxt := 'insert into ' + tbname + '(' + fd1 + ',' + fd1py + ')' + '  values(''' + s1 + '''';
  sqltxt := sqltxt + ',''' + fpy + ''')';
  with Queryq do
  begin
    Close;
    sql.clear;
    sql.Add(sqltxt);
    execsql;
  end;
end;

//**********************************************************************
//下面是追加当前edit到数据表中，如果不存在则添加
//参数说明：QUERYQ—TADOQuery组件名称,tbname—数据表名称，
//fd1—要添加的字段名称；ed1:TEdit组件
//**********************************************************************

procedure AddData(queryq: TADOQuery; tbname, fd1: string; ed1: Tedit);
var
  s1, sqltxt: string;
begin
  if trim(ed1.Text) = '' then exit;
  s1 := trim(ed1.Text);