ge_publicfunction.pas

相关的销售服务管理行业的一个软件

          Result := #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + Adata + #05
        else
        begin
          for i := 11 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 11 );
          Index2 := PosEx( #05, CellNote, 12 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_LISTBOX:
      begin
        if CellNote = '' then
          Result := #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 +Adata + #05
        else
        begin
          for i := 12 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 12 );
          Index2 := PosEx( #05, CellNote, 13 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_DBNAME:
      begin
        if CellNote = '' then
          Result := #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 +Adata + #05
        else
        begin
          for i := 13 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 13 );
          Index2 := PosEx( #05, CellNote, 14 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_DBLIST:
      begin
        if CellNote = '' then
          Result := #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 +Adata + #05
        else
        begin
          for i := 14 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 14 );
          Index2 := PosEx( #05, CellNote, 15 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
  end;
end;

function GetStrFromCellNote( AType: Integer; CellNote: string ): string;
var S: string;
  i, j: Integer;
begin
  j := 0;
  S := '';
  case ATYpe of
    C_CELLNAME:
      begin
        for i := 1 to Length( CellNote ) do
          if CellNote[i] <> #05 then
            S := S + CellNote[i]
          else
            break;
      end;
    C_TIMEKEY:
      begin
        i := PosEx( #05, CellNote, 0 );
        j := PosEx( #05, CellNote, 1 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_UNITKEY:
      begin
        i := PosEx( #05, CellNote, 1 );
        j := PosEx( #05, CellNote, 2 );
        if j=0 then j:=Length(CellNote)+1;
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_CHECKFIRST:
      begin
        i := PosEx( #05, CellNote, 2 );
        j := PosEx( #05, CellNote, 3 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_CHECKNEXT:
      begin
        i := PosEx( #05, CellNote, 3 );
        j := PosEx( #05, CellNote, 4 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_CHECKREPORT:
      begin
        i := PosEx( #05, CellNote, 4 );
        j := PosEx( #05, CellNote, 5 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_CHECKRELEASE:
      begin
        i := PosEx( #05, CellNote, 5 );
        j := PosEx( #05, CellNote, 6 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_GATHER:
      begin
        i := PosEx( #05, CellNote, 6 );
        j := PosEx( #05, CellNote, 7 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_TempInput:
      begin
        i := PosEx( #05, CellNote, 7 );
        j := PosEx( #05, CellNote, 8 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_DC: //项目名称的借贷方向
      begin
        i := PosEx( #05, CellNote, 8 );
        j := PosEx( #05, CellNote, 9 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_RUNYEAR:
      begin
        i := PosEx( #05, CellNote, 9 );
        j := PosEx( #05, CellNote, 10 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_RUNPERIOD:
      begin
        i := PosEx( #05, CellNote, 10 );
        j := PosEx( #05, CellNote, 11 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_RUNDATE:
      begin
        i := PosEx( #05, CellNote, 11 );
        j := PosEx( #05, CellNote, 12 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_LISTBOX:
      begin
        i := PosEx( #05, CellNote, 12 );
        j := PosEx( #05, CellNote, 13 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_DBNAME:
      begin
        i := PosEx( #05, CellNote, 13 );
        j := PosEx( #05, CellNote, 14 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
    C_DBLIST:
      begin
        i := PosEx( #05, CellNote, 14 );
        j := PosEx( #05, CellNote, 15 );
        S := Copy( CellNote, i + 1, j - i - 1 );
      end;
  end;
  Result := S;
end;
//获得关键字从cell表中

procedure GetKeyFromCell( Cell: TCell; var Str: TStrings );
var CellNote, S: string;
begin
  CellNote := Cell.DoGetCellNote( -1, -1 );
  S := copy( CellNote, 1, Pos( #05, CellNote ) - 1 );
  CellNote := copy( CellNote, Pos( #05, CellNote ) + 1, Length( CellNote ) );
  Str.Add( S );
  S := copy( CellNote, 1, Pos( #05, CellNote ) - 1 );
  CellNote := copy( CellNote, Pos( #05, CellNote ) + 1, Length( CellNote ) );
  Str.Add( S );
  S := copy( CellNote, 1, Pos( #05, CellNote ) - 1 );
  CellNote := copy( CellNote, Pos( #05, CellNote ) + 1, Length( CellNote ) );
  Str.Add( S );
  S := copy( CellNote, 1, Pos( #05, CellNote ) - 1 );
  CellNote := copy( CellNote, Pos( #05, CellNote ) + 1, Length( CellNote ) );
  Str.Add( S );
end;

//通过对当前表达式的分析获得表达式中引用的相对偏移之后的表达式

function GetFormulaForRelative( Cell: TCell; Str: string; FromCol, FromRow, RelativeCol, RelativeRow: Integer ): string;
const
  A = ['a'..'z', 'A'..'Z'];
  B = ['0'..'9', '.'];
  F = ['_'];
  C = A + B;
  D = ['"', ''''];
  E = ['[', ']'];
var
  T, T1: string;
  HaveFondFlag, i: Integer;
  function SetValue( S: string ): string;
  var P: TPoint;
  begin
    try
      P := UnTransfer( S );
      if ( P.x = -1 ) or ( P.y = -1 ) then
        abort;
      Result := Transfer( P.x + RelativeCol ) + IntToStr( P.y + RelativeRow );
    except
      P := FindCellNoteName( Cell, S );
      if P.X = -2 then
        Result := S
      else
        Result := Transfer( P.x + RelativeCol ) + IntToStr( P.y + RelativeRow );
    end;
  end;
begin
  T := '';
  HaveFondFlag := 0;
  for i := 1 to Length( Str ) do
  begin
    if HaveFondFlag = 1 then
    begin
      if ( ( Str[i] in C ) {or ( Str [ i ] >= #$A0 ) } ) then
      begin
        T := T + Str[i];
        if i = Length( Str ) then
        begin
          T1 := T1 + SetValue( T );
        end;
        continue;
      end
      else
      begin
        T1 := T1 + SetValue( T );
        T := '';
        HaveFondFlag := 0;
      end; //本子串结束
    end;
    if HaveFondFlag = 2 then
    begin
      if Str[i] in D then
      begin
        T := T + Str[i];
        T1 := T1 + T;
        T := '';
        HaveFondFlag := 0;
      end
      else
      begin
        T := T + Str[i];
        if i = Length( Str ) then
        begin
          raise Exception.Create( '引号没有结束' );
        end;
      end;
      continue;
    end;
    if ( Str[i] = #13 ) or ( Str[i] = #10 ) then
      Continue; //滤掉回车换行
    if ( HaveFondFlag = 0 ) and ( Str[i] in D ) then
    begin
      HaveFondFlag := 2;
      T := T + Str[i];
      continue;
    end;
    if ( HaveFondFlag = 0 ) and ( ( Str[i] in A ) {or ( Str [ i ] >= #$A0 ) } ) then
    begin
      HaveFondFlag := 1;
      T := T + Str[i];
      Continue;
    end;
    T1 := T1 + Str[i];
  end;
  Result := T1;
end;

function GetRectFromCell( CellStr: string ): TRect;
var S1, S2: string;
begin
  if Pos( ':', CellStr ) > 0 then
  begin
    S1 := Copy( CellStr, 1, Pos( ':', CellStr ) - 1 );
    S2 := Copy( CellStr, Pos( ':', CellStr ) + 1, Length( CellStr ) );
    Result.Left := UnTranSfer( S1 ).X;
    Result.Top := UnTranSfer( S1 ).y;
    Result.Right := UnTranSfer( S2 ).X;
    Result.Bottom := UnTranSfer( S2 ).y;
    if Result.Right = -1 then Result.Right := -2;
    if Result.Bottom = -1 then Result.Bottom := -2;
  end
  else
  begin
    Result.Left := UnTranSfer( CellStr ).X;
    Result.Top := UnTranSfer( CellStr ).y;
    Result.Right := -1;
    Result.Bottom := -1;
  end;

end;

function GetResultKeyFromCell( Cell: TCell; UnitFlag: Boolean ): string;
begin
  Result := Cell.DoGetCellNote( -1, -1 );
  if UnitFlag then
    Result := copy( Result, Pos( #05, Result ) + 1, Length( Result ) )
  else
    Result := copy( Result, 1, Pos( #05, Result ) - 1 );
end;

function GetWeekofYear( SysDate: TSystemTime; AFromFirstDay: Boolean ): integer;
var
  Date, RDate: TDate;
begin
  Date := EnCodeDate( SysDate.wYear, SysDate.wMonth, SysDate.wDay );
  if AFromFirstDay then
    RDate := EnCodeDate( SysDate.wYear, 1, 1 )
  else
  begin
    RDate := EnCodeDate( SysDate.wYear, 1, 1 );
    if dayofweek( RDate ) = 1 then
      RDate := EnCodeDate( SysDate.wYear, 1, 1 )
    else
      RDate := EnCodeDate( SysDate.wYear, 1, 7 - dayofweek( RDate ) + 2 );
  end;
  result := ( round( Date ) - round( RDate ) + dayofweek( RDate ) ) div 7 + 1;
end;

procedure SetSort( Cell1: TCell; Scol, SRow, ECol, ERow: Integer; UpFlag: Boolean );
var Cell: TCell;
  i, j: Integer;
  O: OleVariant;
begin
  Cell := TCell.Create( nil );
  Cell.Cols := ECol - SCol + 1;
  Cell.Rows := ERow - SRow + 1;
  for i := 0 to Cell.Cols - 1 do
    for j := 0 to Cell.Rows - 1 do
    begin
      Cell1.DoGetCellData( SCol + i, SRow + j, O );
      Cell.DoSetCellData( i, j, O );
    end;
  for i := 0 to Cell.Cols - 1 do
  begin
    Cell.DoSetSortCol( i, True );
  end;
  Cell.DoSortByCol( UpFlag, 0 );
  for i := 0 to Cell.Cols - 1 do
    for j := 0 to Cell.Rows - 1 do
    begin
      Cell.DoGetCellData( i, j, O );
      Cell1.DoSetCellData( SCol + i, SRow + j, O );
    end;
  Cell.Free;
end;

procedure WriteCellToStream( Cell: TCell; M: TMemoryStream );
var Str: TStrings;
  AData: OleVariant;
  S: string;
  writer: Twriter;
  M1: TMemoryStream;
begin
  Writer := nil;
  M1 := nil;
  try
    M1 := TMemoryStream.Create;
    writer := TWriter.Create( M, 1024 );
    Writer.WriteString( 'GoEasy Copyright.' );
    Cell.DoGetCellData( -1, -1, Adata );
    S := AData;
    Writer.WriteString( Adata ); //表类型
    Writer.WriteString( Cell.Hint ); //表编号
    if S = 'DES' then
    begin
      Str := TStringList.Create;
      GetKeyFromCell( Cell, Str );
      Writer.WriteBoolean( Str[0] <> #04 ); //是否有时间关键字
      Writer.WriteString( Str[1] ); //时间关键字
      Writer.WriteBoolean( Str[2] <> #04 ); //是否有单位关键字
      Writer.WriteString( Str[3] ); //单位关键字
      Str.Free;
    end
    else if S = 'RUN' then
    begin
      Writer.WriteString( GetResultKeyFromCell( cell, False ) ); //时间关键字
      Writer.WriteString( GetResultKeyFromCell( cell, True ) ); //单位关键字
    end;
    Cell.DosaveFile( 'c:\Temp.xxx' );
    M1.LoadFromFile( 'c:\Temp.xxx' );
    Writer.WriteInteger( M1.Size );
    writer.FlushBuffer;
    M.CopyFrom( M1, M1.Size );
  finally
    Writer.Free;
    M1.Free;
  end;
end;

procedure ReadCellToStream( Cell: TCell; M: TMemoryStream );
var
  AData: OleVariant;
  S, S1: string;
  Reader: TReader;
  M1: TMemoryStream;
  i: Integer;
begin
  Reader := nil;
  M1 := nil;
  try
    Reader := TReader.Create( M, 1024 );
    M1 := TMemoryStream.Create;
    if Reader.ReadString <> 'GoEasy Copyright.' then
      raise Exception.Create( '不是GoEasy报表格式' );
    S := Reader.ReadString; //表类型
    Adata := s;
    Cell.DoSetCellData( -1, -1, Adata );
    if cell.Hint = '' then
      Cell.Hint := Reader.ReadString
    else
      Reader.ReadString; //读出报表编号

    if S = 'DES' then
    begin
       //read timekey
      S1 := '';
      if not Reader.ReadBoolean then
      begin
        S1 := #04#05#05;
        Reader.ReadString;
      end
      else
      begin
        S1 := #05 + Reader.ReadString + #05;
      end;
       //read Unitkey
      if not Reader.ReadBoolean then
      begin
        S1 := S1 + #04#05#05;
        Reader.ReadString;
      end
      else
      begin
        S1 := S1 + #05 + Reader.ReadString + #05;
      end;
    end
    else if S = 'RUN' then
    begin //时间关键字//单位关键字
      S1 := Reader.ReadString + #05 + Reader.ReadString;
    end;
    i := Reader.readInteger;
    M.Position := Reader.Position;
    M1.CopyFrom( M, i );
    M1.savetoFile( 'c:\Temp.xxx' );
    Cell.DoOpenFile( 'c:\Temp.xxx' );
  finally
    Reader.Free;
    M1.Free;
  end;
end;

function StartSemaphore( S: string ): Boolean;
var
  aHandle: THANDLE;
//  TheSemaphore: THANDLE;
  p: array[0..79] of Char;
begin
  Result := True;
  StrPCopy( P, S );
  aHandle := FindWindow( Pchar( 'TApplication' ), P );
  if ( aHandle <> 0 ) then
  begin // 已经启动过应用程序 激活先前实例!
    SetForegroundWindow( aHandle );
    SetActiveWindow( aHandle );
    if IsIconic( aHandle ) then
      ShowWindow( aHandle, SW_RESTORE );
    Result := False;
  end;
end;

function GetXIANGMU( Cell: TCell; Index: Integer ): string;
var SCol1, SRow1, ECol1, ERow1: Integer;
  adata: Olevariant;
begin
  Cell.DoGetJoinRange( 0, Index, SCol1, SRow1, ECol1, ERow1 );
  Cell.DoGetCellData( 0, SRow1, Adata );
  Result := AData;
end;

procedure GetPublicvar( Str: array of string );
begin
  CurUser := Str[1];
  CurDate := StrToInt( Str[2] );
//  GERPTDM.APassword := Str[3];
  BOUID := StrToInt( Str[4] );
  HDA := StrToInt( Str[5] );
  S_ZTH := Str[6];
      //MyParamStr [ 7 ]; not use
  CurYear := Str[8];
  CurPeriod := Str[9];
end;

function FormatStrFor0(S:String;ALength:Integer):String;
var i,l:Integer;
begin
  Result:=S;
  l:=Length(S);
  for i:=0 to ALength- l-1 do
    Result:='0'+Result;
end;


end.