f_commfun.pas

用Delphi 开发的一个 户籍管理系统

    sql_copy.Next();
    if pb <> nil then
      pb.Position := pb.Position + 1;
  end;
  sql_copy.EnableControls;

  //拷贝到剪贴板
  Clipboard().SetTextBuf(PChar(tmp));

  mymd := Tsuimessagedialog.Create(fm_main);
  mymd.Text := '已经复制到剪贴板，你可以在Excel中粘贴此内容';
  mymd.IconType := suiinformation;
  mymd.UIStyle := winxp;
  mymd.Position := pomainformcenter;
  mymd.Caption := '提示';
  mymd.ButtonCount := 1;
  mymd.Button1Caption := '确定';
  mymd.ShowModal;
  mymd.Destroy;
  if pb <> nil then
    pb.Position := 0;
end;

procedure CopyToClipboard3(tv: TcxGridDBbandedTableView; pb: TProgressBar =
  nil);
var
  tmp: AnsiString;
  sp_i, i, k: integer;
  sql_copy: TDataSet;
  mymd: Tsuimessagedialog;
begin
  sql_copy := tv.DataController.DataSource.DataSet;
  if not sql_copy.Active or (sql_copy.RecordCount < 1) then
    exit;

  //读取列标题
  sp_i := tv.ColumnCount;
  for i := 0 to sp_i - 1 do
  begin
    if i = 0 then
      tmp := tmp + tv.Columns[i].Caption
    else
      tmp := tmp + chr(VK_TAB) + tv.Columns[i].Caption;
  end;
  tmp := tmp + chr(VK_RETURN);

  //定位到第一条记录
  sql_copy.DisableControls;
  sql_copy.First();

  //开始读取记录
  if pb <> nil then
  begin
    pb.Max := sql_copy.RecordCount;
    pb.Position := 0;
  end;
  for k := 0 to sql_copy.RecordCount - 1 do
  begin
    //读取各字段
    for i := 0 to sp_i - 1 do
    begin
      if i = 0 then
        tmp := tmp +
          Trim(sql_copy.FieldByName(tv.Columns[i].DataBinding.FieldName).AsString)
      else
        tmp := tmp + chr(VK_TAB) +
          Trim(sql_copy.FieldByName(tv.Columns[i].DataBinding.FieldName).AsString);
    end;
    tmp := tmp + chr(VK_RETURN);
    sql_copy.Next();
    if pb <> nil then
      pb.Position := pb.Position + 1;
  end;
  sql_copy.EnableControls;

  //拷贝到剪贴板
  Clipboard().SetTextBuf(PChar(tmp));

  mymd := Tsuimessagedialog.Create(fm_main);
  mymd.Text := '已经复制到剪贴板，你可以在Excel中粘贴此内容';
  mymd.IconType := suiinformation;
  mymd.UIStyle := winxp;
  mymd.Position := pomainformcenter;
  mymd.Caption := '提示';
  mymd.ButtonCount := 1;
  mymd.Button1Caption := '确定';
  mymd.ShowModal;
  mymd.Destroy;
  if pb <> nil then
    pb.Position := 0;
end;

procedure ShowOk(m: AnsiString);
var
  mymd: Tsuimessagedialog;
begin
  mymd := Tsuimessagedialog.Create(fm_main);
  mymd.Text := m;
  mymd.IconType := suiinformation;
  mymd.UIStyle := winxp;
  mymd.Position := pomainformcenter;
  mymd.Caption := '提示';
  mymd.ButtonCount := 1;
  mymd.Button1Caption := '确定';
  mymd.ShowModal;
  mymd.Destroy;
end;

procedure ShowError(m: AnsiString);
var
  mymd: Tsuimessagedialog;
begin
  mymd := Tsuimessagedialog.Create(fm_main);
  mymd.Text := m;
  mymd.IconType := suistop;
  mymd.UIStyle := winxp;
  mymd.Position := pomainformcenter;
  mymd.Caption := '出错了';
  mymd.ButtonCount := 1;
  mymd.Button1Caption := '确定';
  mymd.ShowModal;
  mymd.Destroy;
end;

procedure SetNext(var Key: Char; h: hwnd);
begin
  if Key = #13 then { 判断是按执行键}
  begin
    Key := #0;
    sendmessage(h, WM_NEXTDLGCTL, 0, 0); {移动到下一个控件}
  end;
end;

function GetPYIndexChar(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 := 'V';
  end;
end;

function GetPYString(HzStr: string): string;
var
  i: integer;
  PY: string;
  s: string;
begin
  s := '';
  i := 1;
  while i <= Length(HzStr) do
  begin
    PY := Copy(HzStr, i, 1);
    if PY >= chr(128) then
    begin
      Inc(i);
      PY := PY + Copy(HzStr, i, 1);
      s := s + GetPYIndexChar(PY);
    end
    else
      s := s + PY;
    Inc(i);
  end;
  result := s;
end;

function MoneyToStr(Money: string): string;
const
  BigNumber = '零壹贰叁肆伍陆柒捌玖';
  BigUnit = '万仟佰拾亿仟佰拾万仟佰拾元';
  {共可表示13为金额}
var
  nLeft, nRigth, lTemp, rTemp, BigNumber1, BigUnit1, AllStr: string;
  i: integer;
  UnderZero: boolean;
begin
  {取整数和小数部分}
  if Copy(Money, 1, 1) = '-' then
  begin
    UnderZero := true;
    Money := Copy(Money, 2, Length(Money) - 1);
  end
  else
    UnderZero := false;
  Money := FormatCurr('0.00', StrToFloat(Money));
  nLeft := Copy(Money, 1, Pos('.', Money) - 1);
  nRigth := Copy(Money, Pos('.', Money) + 1, 2); {转换整数部分}
  for i := 1 to Length(nLeft) do
  begin
    BigNumber1 := Copy(BigNumber, strtoint(nLeft[i]) * 2 + 1, 2);
    BigUnit1 := Copy(BigUnit, (Trunc(Length(BigUnit) / 2) - Length(nLeft) + i -
      1) * 2 + 1, 2);
    if (BigNumber1 = '零') and ((Copy(lTemp, Length(lTemp) - 1, 2)) = '零') then
      lTemp := Copy(lTemp, 1, Length(lTemp) - 2);
    if (BigNumber1 = '零') and ((BigUnit1 = '亿') or (BigUnit1 = '万') or
      (BigUnit1 = '元')) then
    begin
      BigNumber1 := BigUnit1;
      if BigUnit1 <> '元' then
        BigUnit1 := '零'
      else
        BigUnit1 := '';
    end;
    if (BigNumber1 = '零') and (BigUnit1 <> '亿') and (BigUnit1 <> '万') and
      (BigUnit1 <> '元') then
      BigUnit1 := '';
    lTemp := lTemp + BigNumber1 + BigUnit1;
  end;
  if Pos('亿万', lTemp) <> 0 then
    Delete(lTemp, Pos('亿万', lTemp) + 2, 2);
  {转换小数部分}
  if strtoint(nRigth[1]) <> 0 then
    rTemp := Copy(BigNumber, strtoint(nRigth[1]) * 2 + 1, 2) + '角';
  if strtoint(nRigth[2]) <> 0 then
  begin
    if strtoint(nRigth[1]) = 0 then
      rTemp := '零';
    rTemp := rTemp + Copy(BigNumber, strtoint(nRigth[2]) * 2 + 1, 2) + '分';
  end;
  if UnderZero then
    AllStr := '负' + lTemp + rTemp + '整'
  else
    AllStr := lTemp + rTemp + '整';
  if AllStr = '元整' then
    result := '零元整'
  else
    result := AllStr;
end;

function GetIp: string;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of Char;
  i: integer;
  GInitData: TWSADATA;
begin
  WSAStartup($101, GInitData);
  result := '';
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(Buffer);
  if phe = nil then
    exit;
  pptr := PaPInAddr(phe^.h_addr_list);
  i := 0;
  while pptr^[i] <> nil do
  begin
    result := StrPas(inet_ntoa(pptr^[i]^));
    Inc(i);
  end;
  WSACleanup;
end;

function GetMac(LanaNum: integer): string;
var
  NCB: TNCB;
  AdpStat: TAdpStat;
  RetCode: WORD;
begin
  FillChar(NCB, SizeOf(NCB), 0);
  FillChar(AdpStat, SizeOf(AdpStat), 0);
  NCB.Command := NCB_ADPSTAT;
  NCB.Buf := @AdpStat;
  NCB.Length := SizeOf(AdpStat);
  FillChar(NCB.CallName, SizeOf(TNBName), $20);
  NCB.CallName[0] := Byte('*');
  NCB.Lana_Num := LanaNum;
  RetCode := NetBiosCmd(NCB);
  if RetCode = NRC_GOODRET then
  begin
    result := Format('%2.2x:%2.2x:%2.2x:%2.2x:%2.2x:%2.2x',
      [AdpStat.ID[0],
      AdpStat.ID[1],
        AdpStat.ID[2],
        AdpStat.ID[3],
        AdpStat.ID[4],
        AdpStat.ID[5]
        ]);
  end
  else
  begin
    result := '??:??:??:??:??:??';
  end;
end;

function password(pwd: string): string;
begin
  password := MD5Print(MD5String(pwd));
end;

function GetGuid(): TGuid;
begin
  Createguid(result);
end;

function GetMonth(num: integer): AnsiString;
begin
  case num of
    1: result := '一月份';
    2: result := '二月份';
    3: result := '三月份';
    4: result := '四月份';
    5: result := '五月份';
    6: result := '六月份';
    7: result := '七月份';
    8: result := '八月份';
    9: result := '九月份';
    10: result := '十月份';
    11: result := '十一月份';
    12: result := '十二月份';
  else
    result := '';
  end;
end;

end.