mylib.pas

PB源代码 非常实用的

  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 + ')' + '  values(''' + s1 + ''')';
  with Queryq do
  begin
    Close;
    sql.clear;
    sql.Add(sqltxt);
    execsql;
  end;
end;


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

procedure addnewdata(queryq: TADOQuery; tbname, fd1: string; Combox: Tcombobox);
var
  s1, sqltxt: string;
begin
  if trim(combox.Text) = '' then exit;
  s1 := trim(combox.Text);
  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 + ')' + '  values(''' + s1 + ''')';
  with Queryq do
  begin
    Close;
    sql.clear;
    sql.Add(sqltxt);
    execsql;
  end;
  combox.Items.Add(trim(combox.text));
end;
//**********************************************************************
//拼音查找姓名代码
//ed1:拼音输入文本框；ed2:显示家庭成员编号；ed3:显示家庭成员姓名，
//qry1,qry2:TADOquery:查询拼音对应的所有人员，如果只有一人则查询其基本情况
//Combox:combobox组件，若只有一人，则自动定位到下一个输入焦点combobox组件
//**********************************************************************

procedure pyxm(ed1, ed2, ed3: TlabeledEdit; qry1, qry2: TADOquery; combox: Tcombobox);
var
  s: string;
  sqltxt: string;
begin
  s := ed1.text + '%';
  with qry1 do
  begin
    close;
    SQL.clear;
    SQL.add('select * from bb');
    Sql.add(' where b27 like :xt');
    parameters.ParamByname('xt').value := s;
    open;
  end;
  if qry1.RecordCount = 1 then
  begin
    ed2.Text := qry1.FieldValues['b2'];
    ed3.Text := qry1.FieldValues['b3'];
    sqltxt := 'select * from bb where b2=:xt';
    qry2.Close;
    qry2.sql.clear;
    qry2.sql.Add(sqltxt);
    qry2.Parameters.ParamByname('xt').value := ed2.text;
    qry2.open;
    combox.setfocus;
//    combox.DroppedDown :=true;
  end;
end;


//获取日期中的年份

function getyear(d: Tdatetime): integer;
var yy, mm, dd: word;
begin
  DecodeDate(d, yy, mm, dd);
  result := yy;
end;
//获取两个日期之间的年份差值

function getyeardf(d: Tdatetime; e: Tdatetime): integer;
begin
  result := getyear(d - e) - 1900
end;


//判断字符串是否是有效日期类型

function isdate(s: string): boolean;
begin
  result := false;
  try
    strtodate(s);
    result := true;
  except
    on econverterror do
      result := false;
  end;
end;

//检测是否是4位年份

function is4year(s: string): boolean;
begin
  result := false;
  if length(s) < 4 then exit;
  try
    strtoint(copy(s, 1, 4));
    result := true;
  except
    on EConvertError do
      result := false;
  end;
end;
//四舍五入

function intdata(d: double): double;
begin
  result := int(d * 100 + 0.5) / 100;
end;
//字符加密

function pass(pstr: string): string;

var str, str1: string;
  i, j: integer;
begin
  str := pstr;
  for i := 1 to length(str) do begin
//进行第一次变换
    j := (i * i * i mod (i + 20)) + (i * i mod (i + 10)) + i * 2 + 1;
    str1 := str1 + chr(ord(str[i]) + j); //第二次变换
    j := (i * i * i mod (i + 10)) + (i * i mod (i + 20)) + i * 2 + 1;
    str1 := str1 + chr(ord(str[i]) + j); end;
  pass := str1;
end;


//获取汉字拼音

function GetPY2(hzchar: string): char;
begin
  case WORD(hzchar[1]) shl 8 + WORD(hzchar[2]) of
    $B0A1..$B0C4: result := 'a';
    $B0C5..$B2C0: result := 'b';
    $B2C1..$B4ED: result := 'c';
    $B4EE..$B6E9: result := 'd';
    $B6EA..$B7A1: result := 'e';
    $B7A2..$B8C0: result := 'f';
    $B8C1..$B9FD: result := 'g';
    $B9FE..$BBF6: result := 'h';
    $BBF7..$BFA5: result := 'j';
    $BFA6..$C0AB: result := 'k';
    $C0AC..$C2E7: result := 'l';
    $C2E8..$C4C2: result := 'm';
    $C4C3..$C5B5: result := 'n';
    $C5B6..$C5BD: result := 'o';
    $C5BE..$C6D9: result := 'p';
    $C6DA..$C8BA: result := 'q';
    $C8BB..$C8F5: result := 'r';
    $C8F6..$CBF9: result := 's';
    $CBFA..$CDD9: result := 't';
    $CDDA..$CEF3: result := 'w';
    $CEF4..$D1B8: result := 'x';
    $D1B9..$D4D0: result := 'y';
    $D4D1..$D7F9: result := 'z';
  else
    result := char(0);
  end;
end;

function GetBuildInfo: string;
var
  VerInfoSize: DWORD;
  VerInfo: Pointer;
  VerValueSize: DWORD;
  VerValue: PVSFixedFileInfo;
  Dummy: DWORD;
  V1, V2, V3, V4: Word;
begin
  VerInfoSize := GetFileVersionInfoSize(PChar(ParamStr(0)), Dummy);
  if VerInfoSize = 0 then begin
    Dummy := GetLastError;
    Result := '0.0.0.0';
  end; {if}
  GetMem(VerInfo, VerInfoSize);
  GetFileVersionInfo(PChar(ParamStr(0)), 0, VerInfoSize, VerInfo);
  VerQueryValue(VerInfo, '\', Pointer(VerValue), VerValueSize);
  with VerValue^ do begin
    V1 := dwFileVersionMS shr 16;
    V2 := dwFileVersionMS and $FFFF;
    V3 := dwFileVersionLS shr 16;
    V4 := dwFileVersionLS and $FFFF;
  end;
  Result := IntToStr(V1) + '.'
    + IntToStr(V2) + '.'
    + IntToStr(V3) + '.'
    + IntToStr(V4);
  FreeMem(VerInfo, VerInfoSize);
end;



function getpy1(S: string): string;
var
  cstr, hz, py, py1: string;
  hstr: array[1..23] of string;
  i, j, k: integer;
const zm: array[1..23] of char = 'abcdefghjklmnopqrstwxyz';