pub_program.pas

以前写的一个利用P2P 技术的一个通讯的例子。里面用到了 DBISAM 、INDY 控件。

         rowcount := 2;
         Fixedrows := 1;
         while (len > 0) do
            begin
               posi := pos('*', title);
               til := copy(title, 1, posi - 1);
               len := len - posi;
               title := copy(title, posi + 1, len);
               posi := pos('*', title);
               s_len := strtoint(copy(title, 1, posi - 1));
               ColWidths[i] := floor(s_len * 6.5);
               len := len - posi;
               title := copy(title, posi + 1, len);
               if m_bspace then
                  begin
                     j := (s_len - length(til)) div 2;
                     for k := 1 to j do
                        til := ' ' + til;
                  end;
               cells[i, 0] := til;
               inc(i);
            end;
         ColCount := i;
         for i := 0 to colcount + 2 do
            cells[i, 1] := '';
      end;
end;

procedure title_dbsg_wy(sg: tDBAdvStringgrid; title: string); //此函数仅用於为 STRING GRID 第一行命名标题
var
   i, len, posi, s_len: integer;
   til: string;
begin
   i := 0;
   len := length(title);
   with sg do
      begin
         clear;
         colcount := 100;
         rowcount := 2;
         Fixedrows := 1;
         while (len > 0) do
            begin
               posi := pos('*', title);
               til := copy(title, 1, posi - 1);
               len := len - posi;
               title := copy(title, posi + 1, len);
               posi := pos('*', title);
               s_len := strtoint(copy(title, 1, posi - 1));
               ColWidths[i] := floor(s_len * 6.5);
               len := len - posi;
               title := copy(title, posi + 1, len);
               Fields.Items[i].Title := til;
               inc(i);
            end;
         ColCount := i;
         for i := 0 to colcount + 2 do
            cells[i, 1] := '';
      end;
end;

procedure clear_sg_wy(sg: TAdvStringGrid); //此函数仅用於清空 STRING GRID 中的数据, 不能用於数据修改
var
   i, j, k: integer;
begin
   j := sg.ColCount * 2; //因为从 colcount 至 colcount + 10 常有其他不可见的保留数据
   with sg do
      begin
         clearNormalcells;
         for i := 1 to RowCount - 1 do
            for k := 0 to j do
               cells[k, i] := '';
         RowCount := 2;
      end;
end;

function chk_eng(m_src: string): boolean;
var
   i: integer;
begin
   result := false;
   m_src := trim(m_src);
   for i := 1 to length(m_src) do
      case m_src[i] of
         chr(8), chr(32)..chr(57), chr(65)..chr(90), chr(97)..chr(122):
            result := true;
         else
            begin
               result := false;
               break;
            end;
      end;
end;

procedure str_grid_wy(sg: tstringgrid; var arow: integer); //此函数仅用於清空 STRING GRID 中的数据, 能用於数据修改
var
   i: integer;
begin
   with sg do
      begin
         i := rowcount - 1;
         if check_sg(sg, i, true) then
            rowcount := rowcount + 1;
         arow := rowcount - 1;
      end;
end;

function Only_Space(Input: string; var m_bEng: boolean; var m_sIdx: string; var m_sEng: string): string;
var
   i: integer;
   s: string;
begin
   input := getstr(input, '');
   result := input;
   m_beng := false;
   s := '';
   m_sidx := '';
   m_sEng := '';
   if input = '' then
      exit;

   for i := 1 to length(input) do //先去除多馀空格;
      if (input[i] <> ' ') or ((input[i] = ' ') and (input[i + 1] <> ' ')) then
         s := s + input[i];

   for i := 1 to length(s) do
      case s[i] of
         chr(8), chr(32)..chr(57), chr(65)..chr(90), chr(97)..chr(122):
            m_bEng := true;
         else
            begin
               m_bEng := false;
               break;
            end;
      end;

   if m_beng then
      begin
         m_sidx := s[1];
         for i := 1 to length(s) - 1 do //先去除多馀空格;
            if (s[i] = ' ') and (s[i + 1] <> ' ') then
               m_sidx := m_sidx + s[i + 1];
         s := uppercase_wy(s);
         m_sidx := uppercase_wy(m_sidx);
         m_sEng := uppercase_wy(s);
      end
   else
      begin
         s := onlycharin(s);
         m_sidx := makespellcode(s, 0, 4);
         m_sEng := makespellcode(s, 1, 30);
      end;
   result := s;
end;

function IsHz(Source: string): Bool;
begin
   result := ((Word(Source[1]) shl 8 + Word(Source[2])) >= $B0A1) and
      ((Word(Source[1]) shl 8 + Word(Source[2])) <= $D7F9)
end;

function UpperCase_WY(Input: string): string;
var
   i: integer;
   s: string;
begin
   input := getstr(input, '');
   result := input;
   s := '';
   if input = '' then
      exit;

   for i := 1 to length(input) do //先去除多馀空格;
      if (input[i] <> ' ') or ((input[i] = ' ') and (input[i + 1] <> ' ')) then
         s := s + input[i];

   for i := 1 to length(s) do
      case ord(s[i]) of
         97..122:
            s[i] := chr(ord(s[i]) - 32);
      end;

   result := s;
end;

function XxToDx(const hjnum: real): string;
var
   Vstr, zzz, cc, cc1, Presult: string;
   xxbb: array[1..12] of string;
   uppna: array[0..9] of string;
   iCount, iZero, vPoint, vdtlno: integer;
begin
   //*设置大写中文数字和相应单位数组*//
   xxbb[1] := '亿';
   xxbb[2] := '仟';
   xxbb[3] := '佰';
   xxbb[4] := '拾';
   xxbb[5] := '万';
   xxbb[6] := '仟';
   xxbb[7] := '佰';
   xxbb[8] := '拾';
   xxbb[9] := '元';
   xxbb[10] := '.';
   xxbb[11] := '角';
   xxbb[12] := '分';
   uppna[0] := '零';
   uppna[1] := '壹';
   uppna[2] := '贰';
   uppna[3] := '叁';
   uppna[4] := '肆';
   uppna[5] := '伍';
   uppna[6] := '陆';
   uppna[7] := '柒';
   uppna[8] := '捌';
   uppna[9] := '玖';
   Str(hjnum: 12: 2, Vstr);
   cc := '';
   cc1 := '';
   zzz := '';
   result := '';
   presult := '';
   iZero := 0;
   vPoint := 0;
   for iCount := 1 to 10 do
      begin
         cc := Vstr[iCount];
         if cc <> ' ' then
            begin
               zzz := xxbb[iCount];
               if cc = '0' then
                  begin
                     if iZero < 1 then //*对“零”进行判断*//
                        cc := '零'
                     else
                        cc := '';
                     if iCount = 5 then //*对万位“零”的处理*//
                        if copy(result, length(result) - 1, 2) = '零' then
                           result := copy(result, 1, length(result) - 2) + xxbb[iCount]
                              + '零'
                        else
                           result := result + xxbb[iCount];
                     cc1 := cc;
                     zzz := '';
                     iZero := iZero + 1;
                  end
               else
                  begin
                     if cc = '.' then
                        begin
                           cc := '';
                           if (cc1 = '') or (cc1 = '零') then
                              begin
                                 Presult := copy(result, 1, Length(result) - 2);
                                 result := Presult;
                                 iZero := 15;
                              end;
                           if iZero >= 1 then
                              zzz := xxbb[9]
                           else
                              zzz := '';
                           vPoint := 1;
                        end
                     else
                        begin
                           iZero := 0;
                           cc := uppna[StrToInt(cc)];
                        end
                  end;
               result := result + (cc + zzz)
            end;
      end;
   if Vstr[11] = '0' then //*对小数点後两位进行处理*//
      begin
         if Vstr[12] <> '0' then
            begin
               cc := '零';
               result := result + cc;
               cc := uppna[StrToInt(Vstr[12])];
               result := result + (uppna[0] + cc + xxbb[12]);
            end
      end
   else
      begin
         if iZero = 15 then
            begin
               cc := '零';
               result := result + cc;
            end;
         cc := uppna[StrToInt(Vstr[11])];
         result := result + (cc + xxbb[11]);
         if Vstr[12] <> '0' then
            begin
               cc := uppna[StrToInt(Vstr[12])];
               result := result + (cc + xxbb[12]);
            end;
      end;
   result := result + '正';
end;

function OnlyCharIn(Input: string): string;
var
   trans, s: string;
   i, len: integer;
begin
   s := '';
   i := 1;
   len := length(Input);
   while i <= len do
      begin
         trans := copy(Input, i, 1);
         if trans <> '' then
            s := trim(s) + trim(trans);
         inc(i);
      end;
   result := trim(s);
end;

function Only_dat(Key: char): char;
type
   TNumChar = set of char;
var
   numchar: TNumChar;
begin
   numchar := ['-', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', ':', ' ', #8]; //#8为 BackSpace
   if (key in numchar) = false then
      key := #0; //#0为NULL;
   result := Key;
end;

function Only_tim(Key: char): char;
type
   TNumChar = set of char;
var
   numchar: TNumChar;
begin
   numchar := ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', ':', #8]; //#8为 BackSpace
   if (key in numchar) = false then
      key := #0; //#0为NULL;
   result := Key;
end;

function Only_Num(Key: char): char; //此函数仅用於输入各类流水号
type
   TNumChar = set of char;
var
   numchar: TNumChar;
begin
   numchar := ['0', '1', '2', '3', '4', '5', '6', '7', '8', '9', #8]; //#8为 BackSpace
   if (key in numchar) = false then
      key := #0; //#0为NULL;
   result := Key;
end;

function Only_mon(Key: char): char; //此函数可用於输入浮点数
type
   TNumChar = set of char;
var
   numchar: TNumChar;
begin
   numchar := ['.', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', #8]; //#8为 BackSpace
   if (key in numchar) = false then
      key := #0; //#0为NULL;
   result := Key;
end;

function Only_chr(Key: char): char; //此函数可用於输入浮点数
begin
   case key of
      chr(8), chr(32), chr(65)..chr(90), chr(97)..chr(122): result := key;
      else
         result := #0;
   end;
end;

function Only_ansi(Key: char): char; //此函数可用於输入浮点数
begin
   case key of
      chr(8), chr(32), chr(48)..chr(57), chr(65)..chr(90), chr(97)..chr(122): result := key;
      else
         result := #0;
   end;
end;

function trans_money_wy(s: real): string;
var
   orignal: string;
   pot, s_len, i, j, k: integer;
   money, mon, h: string;
begin
   k := 0;
   if s < 0 then
      begin
         k := 1;
         s := abs(s);
      end;
   j := 0;
   orignal := formatcurr('0.00', s);
   s_len := length(orignal);
   money := '';
   mon := '';

   for i := s_len downto 1 do
      begin
         inc(j);
         h := copy(orignal, i, 1);
         if h = '.' th