pub_program.pas

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

            if ((Sender as TForm).Components[i] is TPANEL) then
            begin
               panel := TPANEL((Sender as TForm).Components[I]);
               panel.caption := '';
               if panel.Enabled = false then
                  colorpn_wy(panel, $00ECF0F2);
            end
         else
            if ((Sender as TForm).Components[i] is TRadioGroup) then
            TRadioGroup((Sender as TForm).Components[I]).ItemIndex := 0
         else
            if ((Sender as TForm).Components[i] is TAdvStringGrid) then
            begin
               with (TAdvStringGrid((Sender as TForm).Components[i])) do
                  begin
                     clearnormalcells;
                     for j := colcount to colcount + 10 do
                        clearnormalcols(j, rowcount - 1);
                     rowcount := 2;
                     if (not enabled) and m_bsg then
                        Color := $00E9ECED
                     else
                        Color := clwhite;
                  end;
            end
         else
            if ((Sender as TForm).Components[i] is TStringGrid) then
            begin
               with (TStringGrid((Sender as TForm).Components[i])) do
                  begin
                     rowcount := 2;
                     for j := 0 to colcount + 6 do
                        begin
                           cells[j, 1] := '';
                        end;
                     if (not enabled) and m_bsg then
                        Color := $00E9ECED
                     else
                        Color := clwhite;
                  end;
            end;
      end;
end;

function noedit_sg(sg_jl: Tstringgrid; bzl: integer = 0): boolean;
var
   i: Integer;
   s: string;
begin
   result := true;
   bzl := iif(bzl = 0, sg_jl.colcount, bzl);
   with sg_jl do
      for i := 1 to rowcount - 1 do
         begin
            s := getstr(cells[bzl, i], 'normal');
            if s <> 'normal' then
               begin
                  result := false;
                  exit;
               end;
         end;
end;

function Check_pn(pn_room: TPanel): boolean;
var
   i: Integer;
   s: string;
begin
   result := false;
   for i := 0 to pn_room.controlCount - 1 do
      begin
         if ((pn_room.controls[I]).enabled = true) then
            begin
               if (pn_room.controls[i] is TEdit) and ((pn_room.controls[i] as TEdit).Enabled) and ((pn_room.controls[i] as TEdit).visible) then
                  s := s + onlycharin(TEdit(pn_room.controls[I]).Text)
               else
                  if (pn_room.controls[i] is TComBoBox) and ((pn_room.controls[i] as TComBoBox).Enabled) and ((pn_room.controls[i] as TComBoBox).visible) then
                  s := s + onlycharin(TComboBox(pn_room.controls[I]).Text)
               else
                  if (pn_room.controls[i] is TFlatEdit) and ((pn_room.controls[i] as TFlatEdit).Enabled) and ((pn_room.controls[i] as TFlatEdit).visible) then
                  s := s + onlycharin(TFlatEdit(pn_room.controls[I]).Text)
               else
                  if (pn_room.controls[i] is TFlatComBoBox) and ((pn_room.controls[i] as TFlatComBoBox).Enabled) and ((pn_room.controls[i] as TFlatComBoBox).visible) then
                  s := s + onlycharin(TFlatComBoBox(pn_room.controls[I]).Text)
               else
                  if (pn_room.controls[i] is TMemo) and ((pn_room.controls[i] as TMemo).Enabled) and ((pn_room.controls[i] as TMemo).visible) then
                  s := s + onlycharin(TMemo(pn_room.controls[I]).Text);
               if length(s) > 0 then
                  begin
                     result := true;
                     break;
                  end;
            end;
      end;
end;

function sg_locate_wy(sg_jl: TAdvStringGrid; bzl: integer = 0): integer;
var
   i, m_col, m_icom, m_firstcol, m_result: integer;
   s, m_comp, m_logic, m_cont, m_old, m_str: string;
begin
   tran_str := 'item_count:' + inttostr(sg_jl.colcount - 1) + '*';
   with sg_jl do
      for i := 0 to colcount - 1 do
         tran_str := tran_str + 'col' + inttostr(i) + ':' + trim(cells[i, 0]) + '*';
   F_WEB_LOCATE := tF_WEB_LOCATE.create(Application);
   F_WEB_LOCATE.showmodal;
   m_icom := 0;
   bzl := iif(bzl = 0, sg_jl.colcount * 3 + 10, bzl);
   result := -1;
   if g_bsel then
      begin
         m_str := tran_str;
         with sg_jl do
            for i := 1 to rowcount - 1 do
               cells[bzl, i] := '2';

         with sg_jl do
            while pos(')*', m_str) > 0 do
               begin
                  s := getpartstr(m_str, ')*');
                  m_logic := analy_str('(logic', s);
                  m_str := getpartstr(m_str, ')*', '', false);
                  m_col := strtoint(analy_str('col', s));
                  m_comp := analy_str('comp', s);
                  m_cont := analy_str('cont', s);
                  if copy(m_cont, 1, 1) = '#' then
                     begin
                        m_comp := '#';
                        m_cont := trim(copy(m_cont, 2, length(m_cont)));
                     end;
                  if m_logic = 'fir' then
                     m_firstcol := m_col;
                  if m_comp = '=' then
                     m_icom := 0
                  else
                     if (m_comp = '#') or (m_comp = '^') then
                     m_icom := 6;
                  for i := 1 to rowcount - 1 do
                     begin
                        m_old := cells[bzl, i];
                        if (m_logic = 'fir') then
                           result := m_col;
                        if (m_logic = 'fir') or ((m_logic = 'and') and (m_old = '1')) or ((m_logic = 'or') and (m_old <> '1')) then
                           case m_icom of
                              0: cells[bzl, i] := iif(getstr(cells[m_col, i]) = m_cont, '1', '2');
                              //1: cells[bzl, i] := iif(getstr(cells[m_col, i]) > m_cont, '1', '2');
                              //2: cells[bzl, i] := iif(getstr(cells[m_col, i]) >= m_cont, '1', '2');
                              //3: cells[bzl, i] := iif(getstr(cells[m_col, i]) < m_cont, '1', '2');
                              //4: cells[bzl, i] := iif(getstr(cells[m_col, i]) <= m_cont, '1', '2');
                              //5: cells[bzl, i] := iif(getstr(cells[m_col, i]) <> m_cont, '1', '2');
                              6:
                                 begin
                                    if (m_comp = '#') then
                                       cells[bzl, i] := iif(pos(m_cont, getstr(cells[m_col, i])) >= 1, '1', '2') //如查询条件只为一个汉字, 则只取第一位
                                    else
                                       cells[bzl, i] := iif(pos(m_cont, getstr(cells[m_col, i])) = 1, '1', '2'); //否则只要有, 应取；
                                 end;
                           end;
                     end;
                  result := 0;
                  for i := 1 to rowcount - 1 do
                     if cells[bzl, i] = '1' then
                        begin
                           result := 1;
                           break;
                        end;
               end;
         sg_jl.Repaint;
      end;
end;

procedure colorpn_wy(Sender: Tpanel; m_color: integer; m_ball: boolean = false);
var
   i, j: Integer;
begin
   j := m_color;
   for i := 0 to Sender.controlCount - 1 do
      begin
         if (Sender.controls[I]).enabled or m_ball then
            begin
               if (Sender.controls[i] is TEdit) then
                  TEdit(Sender.controls[I]).color := j
               else
                  if (Sender.controls[i] is TComBoBox) then
                  TComboBox(Sender.controls[I]).color := j
               else
                  if (Sender.controls[i] is TFlatEdit) then
                  TFlatEdit(Sender.controls[I]).ColorFlat := j
               else
                  if (Sender.controls[i] is TFlatComBoBox) then
                  TFlatComboBox(Sender.controls[I]).color := j
               else
                  if (Sender.controls[i] is TRadioGroup) then
                  TRadioGroup(Sender.controls[I]).color := j
               else
                  if (Sender.controls[i] is TStringGrid) then
                  TStringGrid(Sender.controls[I]).color := j
               else
                  if (Sender.controls[i] is TMemo) then
                  TMemo(Sender.controls[I]).color := j;
            end;
      end;
end;

procedure colorpn_font_wy(Sender: Tpanel; m_color: integer);
var
   i, j: Integer;
begin
   j := m_color;
   for i := 0 to Sender.controlCount - 1 do
      begin
         if ((Sender.controls[I]).enabled = true) then
            begin
               if (Sender.controls[i] is TLabel) then
                  TLabel(Sender.controls[I]).Font.color := j
               else
                  if (Sender.controls[i] is TEdit) then
                  TEdit(Sender.controls[I]).Font.color := j
               else
                  if (Sender.controls[i] is TComBoBox) then
                  TComboBox(Sender.controls[I]).Font.color := j
               else
                  if (Sender.controls[i] is TFlatEdit) then
                  TFlatEdit(Sender.controls[I]).Font.Color := j
               else
                  if (Sender.controls[i] is TFlatComBoBox) then
                  TFlatComboBox(Sender.controls[I]).Font.Color := j
               else
                  if (Sender.controls[i] is TMemo) then
                  TMemo(Sender.controls[I]).Font.Color := j;
            end;
      end;
end;

function InputBox_wy(s_cap: string = '输入框'; s_hint: string = '输入值'; s_def: string = ''; def_ret: string = ''; input_type: integer = 0): string;
begin
   result := def_ret;
   g_diff := input_type;
   tran_str := 'caption:' + s_cap + '*hint:' + s_hint + '*default:' + s_def + '*';
   F_WEB_INPUT := TF_WEB_INPUT.Create(Application);
   F_WEB_INPUT.ShowModal;
   if g_bsel then
      result := tran_str;
end;

procedure enablepn_wy(Sender: Tpanel; m_bFlag: bool; m_ball: boolean = false);
var
   i: Integer;
begin
   for i := 0 to Sender.controlCount - 1 do
      if (not (Sender.controls[i] is TLabel)) and ((Sender.controls[i].tag < 888) or m_ball) then
         (Sender.controls[I]).enabled := m_bflag;
end;

procedure visiblepn_wy(Sender: Tpanel; m_bFlag: bool);
var
   i: Integer;
begin
   for i := 0 to Sender.controlCount - 1 do
      (Sender.controls[I]).visible := m_bflag;
end;

function iif(flag: boolean; A_ret: string; B_ret: string): string; overload;
begin
   result := B_ret;
   if flag then
      result := A_ret;
end;

function iif(flag: boolean; A_ret: boolean; B_ret: boolean): boolean; overload;
begin
   result := B_ret;
   if flag then
      result := A_ret;
end;

function iif(flag: boolean; A_ret: tdatetime; B_ret: tdatetime): tdatetime; overload;
begin
   result := B_ret;
   if flag then
      result := A_ret;
end;

function iif(flag: boolean; A_ret: integer; B_ret: integer): integer; overload;
begin
   result := B_ret;
   if flag then
      result := A_ret;
end;

function ReplaceChr(s, m_src, m_des: string): string;
var
   i, j: integer;
begin
   s := trim(s);
   result := '';
   j := length(s);
   if j > 0 then
      for i := 1 to j do
         if s[i] = m_src then
            result := result + m_des
         else
            result := result + s[i];
end;

function ReplaceStr(s: string; Src: string; Des: string): string;
var
   i, j: integer;
begin
   i := length(src);
   j := pos(src, s);
   if j = 0 then
      result := s
   else
      result := trim(copy(s, 1, j - 1) + des + copy(s, i + j, length(s)));
end;

function Check_sg(sg_jl: Tstringgrid; arow: integer = 1; specrow: boolean = false): boolean;
var
   i: Integer;
   s: string;
begin
   result := false;
   s := '';
   if (not specrow) and (sg_jl.row > 0) then
      arow := sg_jl.row; //如非指定行,则为当前行
   with sg_jl do
      for i := 0 to colCount - 1 do
         s := s + trim(cells[i, arow]);
   if length(trim(s)) > 0 then
      result := true;
end;

procedure ClearPn_wy(Sender: Tpanel; m_bAll: bool; m_bsg: bool = false);
var
   i, j, k: Integer;
   part: boolean;
begin
   for i := 0 to Sender.controlCount - 1 do
      begin
         j := (Sender.controls[I]).tag;
         part := false;
         if (j = 0) or (j = 711) then
            part := true;
         if m_bsg or (((Sender.controls[I]).enabled = true) and (part or m_bAll)) then
            begin
               if (Sender.controls[i] is TEdit) then
                  TEdit(Sender.controls[I]).text := ''
               else
                  if (Sender.controls[i] is TFlatEdit) then
                  begin
                     TFlatEdit(Sender.controls[I]).text := '';
                     if TFlatEdit(Sender.controls[I]).Height < 20 then
                        TFlatEdit(Sender.controls[I]).Height := 20;
                  end
               else
                  if (Sender.controls[i] is TComBoBox) then
                  begin
                     TComboBox(Sender.controls[I]).itemindex := -1;
                     TComboBox(Sender.controls[I]).Text := '';
                  end
               else
                  if (Sender.controls[i] is TFlatComBoBox) then
                  begin
                     TFlatComBoBox(Sender.controls[I]).itemindex := -1;
                     TFlatComBoBox(Sender.controls[I]).Text := '';
                  end
               else
                  if (Sender.controls[i] is TCheckBox) then
                  TCheckBox(Sender.controls[I]).checked := false
               else
                  if (Sender.controls[i] is TMemo) then
                  TMemo(Sender.controls[I]).clear
               else
                  if (Sender.controls[i] is TStringGrid) then
                  with TStringGrid(Sender.controls[I]) do
                     begin
                        rowcount := 2;
                        for k := 0 to colcount + 10 do
                           cells[k, 1] := '';
                     end
               else
                  if (Sender.controls[i] is TRadioGroup) then
                  TRadioGroup(Sender.controls[I]).ItemIndex := 0;
            end;
      end;
end;

procedure title_sg_wy(sg: tadvstringgrid; title: string; m_bSpace: boolean = true); //此函数仅用於为 STRING GRID 第一行命名标题
var
   i, len, posi, s_len, j, k: integer;
   til: string;
begin
   i := 0;
   len := length(title);
   j := 0;
   for i := 0 to len do
      if title[i] = '*' then
         inc(j);
   j := j div 2;
   i := 0;

   with sg do
      begin
         clear;
         colcount := j + 5; //;