ufunsys.~pas

一个会议签到系统

end;
{******************************************************************************
*    求某一列的合计数。        求表格的某一列的总和 WhyCol为那列  
******************************************************************************}
procedure  MySumCount(WhyCol:integer;MsFlexGridName:TMsFlexGrid;sformat:string);
var
   OI_sum:Double;
   OI_i,FZ:integer;
   tempstr:string;
begin
   OI_sum :=0;
   FZ:=MsFlexGridName.FixedRows;
with MsFlexGridName do
   begin
      for OI_i:= FZ to rows-2 do
      begin
         tempstr := TextMatrix[OI_i,WhyCol];
         Tempstr :=MyRemoveChar(',', Tempstr);
         if TempStr<>'' then
            OI_sum:=OI_sum+strToFloat(Tempstr);
      end;
      Tempstr := FormatFloat(sformat,OI_Sum);
      TextMatrix[Rows-1,WhyCol]:=Tempstr;
      OI_i:=length(tempstr)*110;
      if ColWidth[WhyCol]<OI_i then
         colWidth[WhyCol]:= OI_i;

   end;
end;
{*******************************************************************************
            去掉字符串中的指定字符  非字符串
*******************************************************************************}
function MyReMoveChar(SubStr:Char;MainStr:String):string;
var
   I,_Length:Integer;
begin
   Result:='';
   _Length:=Length(MainStr);
   for I:=1 to _Length do
     if MainStr[I]<>SubStr then
        Result:=Result+MainStr[I];
end;
{*******************************************************************************
*                                删除网格中空行
*******************************************************************************}
procedure MyRemoveEmpty(Var Grid1:TMsFlexGrid);
var
  Str1:string;
  I,K:Integer;
begin
  for I:= Grid1.Rows -2 downto 1 do begin
      Str1:='';
      for k:=0 to grid1.Cols-1  do
        Str1:=Str1+trim(Grid1.TextMatrix[i,k]);
      if Str1 = '' then   Grid1.RemoveItem(I);
  end;
end;

{*******************************************************************************
//                   得到本地计算机的名字
*******************************************************************************}
function MyGetComputerName:String;
var
  ComputerName: PChar;
  nSize: Cardinal;
begin
  nSize:= MAX_COMPUTERNAME_LENGTH + 1;
  GetMem(ComputerName, nSize);
  GetComputerName(ComputerName, nSize);
  Result := computername;
  FreeMem(computerName);
end;


{******************************************************************************
            截取以空格分隔的字符串 的前串或后串
            True,False  分别为 前串，后串
******************************************************************************}
function MyCutString(bLeftStr:boolean;MainStr:string):string;
var
   TempI:Integer;
begin
   TempI:=Pos(' ',MainStr);
   case bLeftStr of
      True:
      begin
         if TempI<>0 then  Result:=Copy(MainStr,1,TempI-1)
         else              Result := Trim(MainStr);
      end;
      False:
      begin
         if TempI<>0 then  Result:=Trim(Copy(MainStr,TempI+1,Length(MainStr)))
         else              Result := '';
      end;
   end;
end;

{..............................................................................
//           填充树 最优秀的办法  最简单的办法  最根本的办法
..............................................................................
//                     吉联 崔风  的方法填充树
..............................................................................
//      ======要填充的树的级数字段是istyle .sCode,sName 分别是编码和名称
//      ======              只填充  分类
..............................................................................
//      ======    必须清楚  istyle is null  / istyle not null 的意义
..............................................................................}
{*******************************************************************************
//                    填充树  要填充 分类与明细    Link  CuiFengFillTreeB
*******************************************************************************}
{ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
*         填充树 第一级别节点是固定的  数据库中的数据都是作为第二节点
*         所以 第一级节点必须存在
*         节点图表是固定的      
ooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo}
procedure  PCuiFengFillTreeC(TrvName:TTreeView;
                            DBTable:TDataSet;                             
                            sFieldName:String);
var
   Str,ST,sTab:string;
   I:integer;
   fFL:TextFile;
begin
  //=====获取Tab键的 一次切换位置字符串=====
  sTab:=chr(9);
  Assignfile(fFL,extractfilepath(application.ExeName)+'CuiFengTree.txt');
  Rewrite(fFL);

  if TrvName.Items.Count <= 0 then begin
     showmessage('树不能是空的');
     Exit;
  end;
  Str:=TrvName.Items[0].Text;
  Writeln(fFL,Str);

  DBTable.First;ST:=sTab;
  while not DBTable.Eof do begin
    Str:=Trim(DBTable.FieldByName(sFieldName).AsString);
    Str:=ST+Str;
    Writeln(fFL,Str);
    DBTable.Next;
  end;
  CloseFile(fFL);
  TrvName.LoadFromFile(extractfilepath(application.ExeName)+'CuiFengTree.txt');
  //节点图标
  for I:=1 to TrvName.Items.Count-1 do begin
      TrvName.Items[I].ImageIndex:=2;
      TrvName.Items[I].SelectedIndex:=2;
  end;
  TrvName.Items[0].Selected:=True;
  TrvName.Items[0].Expand(True); 
end;

procedure  PCuiFengFillTreeD(TrvName:TTreeView;
                            DBTable:TDataSet;
                            sFieldNameA,sFieldNameB:String);
var                            
   Str,ST,sTab:string;
   I:integer;
   fFL:TextFile;
   EvntTemp:TTVChangedEvent;
begin
  //=====获取Tab键的 一次切换位置字符串=====
  sTab:=chr(9);
  Assignfile(fFL,extractfilepath(application.ExeName)+'CuiFengTree.txt');
  Rewrite(fFL);

  if TrvName.Items.Count <= 0 then begin
     showmessage('树不能是空的');
     Exit;
  end;
  Str:=TrvName.Items[0].Text;
  Writeln(fFL,Str);

  DBTable.First;ST:=sTab;
  while not DBTable.Eof do begin
    Str:=Trim(DBTable.FieldByName(sFieldNameA).AsString);
    Str:=Str+'  '+Trim(DBTable.FieldByName(sFieldNameB).AsString);    
    Str:=ST+Str;
    Writeln(fFL,Str);
    DBTable.Next;
  end;
  CloseFile(fFL);
  EvntTemp:=TrvName.OnChange;
  TrvName.OnChange:=nil;
  
  TrvName.LoadFromFile(extractfilepath(application.ExeName)+'CuiFengTree.txt');
  //节点图标
  for I:=1 to TrvName.Items.Count-1 do begin
      TrvName.Items[I].ImageIndex:=2;
      TrvName.Items[I].SelectedIndex:=2;
  end;
  
  TrvName.Items[0].Selected:=True;
  TrvName.Items[0].Expand(True);  
  TrvName.OnChange:=EvntTemp; //200403017  符林 精纯的感悟 点滴的积累 内集
  EvntTemp:=nil; 
end;

{*******************************************************************************

*******************************************************************************}
procedure MyRowSelect(iRow:Integer;MsFlexGrid1:TMsFlexGrid);
var
   iTemp : Integer;
begin
   MsFlexGrid1.Redraw:=false;
   with  MsFlexGrid1  do
   begin
      if (iRow >=Rows-1)or(iRow<=0) then
         exit;
      Row := iRow;
      if  CellBackColor<>clSelect then
      begin
         for iTemp:=0 to MsFlexGrid1.Cols-1 do
         begin
            Col:=iTemp;
            CellBackColor:=$00DEDEBC;
         end;
      end
      else
      begin
         for iTemp:=0 to MsFlexGrid1.Cols-1 do
         begin
            Col:=iTemp;
            CellBackColor:=clInfoBk;
         end;
      end;
   end;
   MsFlexGrid1.Redraw:=true;
End;

{*******************************************************************************
 根据TDBDataSet控件填充数据，可以定义列的顺序对应的字段，也设置某列为空
（只要在MyFieldsList中'L_Empty'）也可以设置某列为行的序号
（只要在MyFieldslist中'L_FieldID'
          填充 With BDE Query
      L_Empty    空         ======           L_FieldID  序号
*******************************************************************************}
procedure  FillMsFlexGrid(Const MyFieldsList: Array of String;
                          MsFlexgridName:TMsFlexGrid;
                          QueryName:TDataSet);
var
   I,J,iFixedRow:integer;
   Str:string;
begin
   iFixedRow:=MsFlexgridName.FixedRows;
   MsFlexgridName.Rows:=iFixedRow;   //   fz  ++ 清空网格
   MsFlexgridName.Rows:=iFixedRow+2;
   QueryName.DisableControls;
   
   with QueryName,MsFlexgridName do begin
     	if not QueryName.Active then  QueryName.Open;
          if ReCordCount<=0 then  Exit;
          Redraw:=False;
    	  First;
          Rows:= RecordCount+iFixedRow+1;
          if  Cols<high(MyFieldsList)+1 then Cols:= High(MyFieldsList)+1;
          for  j := iFixedRow to RecordCount  do begin 
               for  i := 0 to  High(MyFieldsList)  do  begin
                 {下面这这个if 是比较高效的写法}
                 if  (MyFieldsList[i]= 'L_FieldID') or (MyFieldsList[i]= 'L_Empty') then  begin
                      if MyFieldsList[i]= 'L_FieldID' then
                         TextMatrix[j,i] := IntToStr(j-iFixedRow+1);                            
                      end  else begin
                      {效率的关键出  用变量Str替代一下 比直接赋值快}
                      Str:=FieldByName(Trim(MyFieldsList[i])).AsString;
                      TextMatrix[j,i]:=Trim(Str);
                     end;
                 end;
            	Next;
    	   end;
    	   //Close;// Del fulin 20030815
           Redraw:=True;
    	end;
        
  QueryName.EnableControls;//Add fulin 20030810
    
end;

{*******************************************************************************
      delete the  first substr in the Mainstr
*******************************************************************************}
function MyCutOutStringA(Substr,Mainstr:string):string;
var
  J,iLen1,iLen2:integer;
  S1,S2:string;
begin
  if Mainstr = '' then     begin
      MyCutOutStringA:='';
      Exit;
   end;
   J:=Pos(Substr,Mainstr);
   if J = 0 then     begin
         Result:=Mainstr;
         Exit;
   end;
   iLen1:=Length(Substr);
   iLen2:=Length(Mainstr);
   S1:=Copy(MainStr,1,j-1);
   S2:=Copy(MainStr,J+iLen1,iLen2-J-iLen1+1);
   MyCutOutStringA:=S1+S2;
end;
{*******************************************************************************
            delete all substr  in MainStr
*******************************************************************************}
function MyCutOutStringB(Substr,Mainstr:string):string;
var
 I,K:integer;
 Str:string;
begin
   str:=Mainstr;
   for i:=1 to 10000 do   begin
      k:=length(str);
      str:=MyCutOutStringA(substr,str);
      if length(str) = k then  begin
         Result:=str;
         Exit;
         end;
   end;
end;
{..............................................................................
*
..............................................................................}
function  MyStrToFloat(stemp : String) : currency;
var
   ntemp : Currency;
begin
   if sTemp = '' then
   begin
      result := 0;
      exit;
   end;
   try
      ntemp := StrToFloat(MyReMovechar(',',sTemp));
   except
      nTemp := 0;
   end;
   MyStrToFloat := nTemp;
end;
//..............................................................................
function L_RTrim(sStr:String):String;
var