ge_publicfunction.pas

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

unit GE_PublicFunction;
interface
uses Windows, Classes, Controls, StdCtrls, SysUtils, Forms,
  CELLLib_TLB, Dialogs, CheckLst,extctrls,Messages;

    //定义全局变量
type
  TRegProc      = function : HResult; stdcall;

const
  ISSERVER = 0; //编译GE_RunMain时判断如果是 client端收集部分不显示
var Pubpath: string;
  OpenStyle: Integer; //打开窗口中先显示哪一页
  CurDate: TDateTime; //当前时间
  RunDate: TDateTime; //运行报表时的当前日期
  CurUnit: string; //当前单位
  CurUser: string; // 当前用户
  FromFirstDay: Boolean; //是否是从第一天算起始周
  UserCellFormula: Boolean; //是否调用cell自己的公式向导 Cell1InputFormula()中调用
  AcMasterEdit, UnitMasterEdit: string; //单位和财务主管的名称
  SavePath: string; //导出表的缺省路径
  S_ZTH: string; //帐套号
  CurYear: string; //当前财年
  CurPeriod: string; //当前财月
  RunYear, RunPeriod: string; //运行报表时的财年财月
  HDA: Integer;
  BOUID: Integer;
  ISORACLE: Integer; //=0为oracle数据库
  DataBaseType:String;
function PosEx( SubStr, Fullstr: string; Index: Integer ): Integer;

function GetPathFromExeName( ExeName: string ): string;
function Transfer( GetNum: integer ): string;
function UnTranSfer( CellsName: string ): TPoint;
function FindCellNoteName( ACell: TCell; AName: string ): TPoint;
function IsNumber( const Ident: string; Flag: Integer ): Boolean;
function GetStrFromCellNote( AType: Integer; CellNote: string ): string;
    //获得文件名的扩展名
function GetExtName( FileName: string; var NormalName, Extname: string ): Boolean;

    //获得关键字从cell表中
procedure GetKeyFromCell( Cell: TCell; var Str: TStrings );

    //在结果表中获得关键字
function GetResultKeyFromCell( Cell: TCell; UnitFlag: Boolean ): string;

    //通过对当前表达式的分析获得表达式中引用的相对偏移之后的表达式
function GetFormulaForRelative( Cell: TCell; Str: string; FromCol, FromRow, RelativeCol, RelativeRow: Integer ): string;

    //将定义的数据区返回坐标
function GetRectFromCell( CellStr: string ): TRect;

    //获得完整周的周数
function GetWeekofYear( SysDate: TSystemTime; AFromFirstDay: Boolean ): integer;

    //按照升序或降序排列
procedure SetSort( Cell1: TCell; Scol, SRow, ECol, ERow: Integer; UpFlag: Boolean );

    //写读自定义格式报表
procedure WriteCellToStream( Cell: TCell; M: TMemoryStream );
procedure ReadCellToStream( Cell: TCell; M: TMemoryStream );

    //启动时判断
function StartSemaphore( S: string ): Boolean;

function SetStrFromCellNote( AType: Integer; CellNote: string; AData: string ): string;

function IsCharForAZ( const Ident: string ): Boolean;

function GetXIANGMU( Cell: TCell; Index: Integer ): string;

function FormatStrFor0(S:String;ALength:Integer):String;

    //获得全局变量从命令行参数中
procedure GetPublicvar( Str: array of string );
function GetSubCount( SubStr, Fullstr: string ): Integer;

type TBookStruct = object
    PAGENO: string; //报表编码
    PAGENAME: string; //名称
    AABSTRACT: string; //摘要信息
    TOPIC: string; //主题信息
    SHEETNO: Integer; //表套编号
    ISTEMPLATE: Boolean; //是否为模板文件
    CREATEDATE: TDateTime; //建立日期 当前机器时间
    UPDATEBY: string; //最后更新者
    Timekey, UnitKey: string; //关键字 =#04 表示没有关键字
    IsDesign: string; //是否为设计表 T 为真
  end;

const
  WM_EXE_WORK = WM_USER + 908;

  C_CELLNAME = 0;
  C_CHECKFIRST = 1;
  C_CHECKNEXT = 2;
  C_CHECKREPORT = 3;
  C_CHECKRELEASE = 4;
  C_GATHER = 5; //当前点参加汇总
  C_TempInput = 6;
  C_DC = 7; //项目点的借贷方向

  C_TIMEKEY = 8;
  C_UNITKEY = 9;
  C_RUNYEAR = 10; //结果表中存放这些运行数据
  C_RUNPERIOD = 11;
  C_RUNDATE = 12;
  C_LISTBOX = 13;//下啦列表框的数据库连接说明

  C_DBNAME = 14;//对应数据库 的名称
  C_DBLIST = 15;// 对应数据库 导出公式

  //状态行 位置
  Status_Modi = 0;
  Status_TimeKey = 1;
  Status_UnitKey = 2;
  Status_Check = 3;
  Status_ReadOnly = 4; //是否为只读状态
  Status_TempInput = 5; //当前点是临时输入点
  Status_Sum = 6; //当前点是取汇总点
  Status_balance = 7; //当前点有审核公式

implementation


function GetPathFromExeName( ExeName: string ): string;
var S, S1: string;
begin
  S := Exename;
  while ( Pos( '\', S ) > 0 ) do
  begin
    S1 := S1 + Copy( S, 1, Pos( '\', S ) );
    S := Copy( S, Pos( '\', S ) + 1, Length( S ) );
  end;
  Result := S1;
end;

function UnTranSfer( CellsName: string ): TPoint;
const
  KeyAr = ['a'..'z', 'A'..'Z'];
var
  S: string;
  N: Integer;
begin
  try
    S := UpperCase( CellsName );
    Result.X := -1;
    Result.Y := -1;
    if length( CellsName ) = 2 then
    begin
      N := Ord( S[1] ) - $40;
      Result.X := N;
      Result.Y := StrToInt( S[2] );
    end;

    if ( length( CellsName ) > 2 ) then
    begin
      if S[2] in KeyAr then
      begin
        N := ( Ord( S[1] ) - $40 ) * 26;
        N := N + Ord( S[2] ) - $40;

        Result.X := N;
        Result.Y := StrToInt( Copy( S, 3, Length( S ) ) );
      end
      else
      begin
        N := Ord( S[1] ) - $40;
        Result.X := N;
        Result.Y := StrToInt( Copy( S, 2, Length( S ) ) );
      end;
    end;
    if Result.x > 256 then
      Result.x := -1;
  except
    Result.X := -1;
    Result.Y := -1;
  end;
end;

function Transfer( GetNum: integer ): string;
var
  Divisor: integer;
  Remainder: integer;
  FirstName, lastName: char;
begin
  if GetNum > 0 then
  begin
    Divisor := GetNum div 26;
    Remainder := GetNum mod 26;
    if Remainder = 0 then
    begin
      Divisor := Divisor - 1;
      Remainder := 26;
    end;
    if divisor = 0 then
      Result := chr( Remainder + 64 )
    else
    begin
      FirstName := chr( Divisor + 64 );
      LastName := chr( Remainder + 64 );
      Result := FirstName + LastName;
    end;
  end
  else
    Result := '?';
end;

function FindCellNoteName( ACell: TCell; AName: string ): TPoint;
var i, j: Integer;
  S: string;
begin
  Result.X := -2;
  Result.y := -2;
  for i := 0 to ACell.Cols do
    for j := 0 to ACell.Rows do
    begin
      S := ACell.DoGetCellNote( i, j );
      if S = '' then Continue;
      s := Copy( S, 1, Pos( #05, S ) - 1 );
      if S = AName then
      begin
        Result.X := i + 1;
        Result.y := j + 1;
        Exit;
      end;
    end;
end;

function GetExtName( FileName: string; var NormalName, Extname: string ): Boolean;
var S, S1: string;
begin
  s := FileName;
  S1 := '';
  if pos( '.', S ) > 0 then
  begin
    while pos( '.', S ) > 0 do
    begin
      S1 := S1 + Copy( S, 1, pos( '.', S ) );
      Delete( S, 1, pos( '.', S ) );
    end;
    NormalName := S1;
    ExtName := S;
  end;
  Result := ExtName = '';

end;

function IsCharForAZ( const Ident: string ): Boolean;
const
  A = ['A'..'Z'];
var s: string;
var i: Integer;
begin
  S := Uppercase( Ident );
  Result := True;
  for I := 1 to Length( S ) do
    if ( not ( S[I] in A ) ) then
      Result := False;
end;

function IsNumber( const Ident: string; Flag: Integer ): Boolean;
const
  A = ['0'..'9'];
  AlphaNumeric = ['0'..'9', '.'];
  Al = ['+', '-'];
  Alpha = Al + AlphaNumeric;
var
  I, j: Integer;
begin
  Result := False;
  if Ident = '' then
    Exit;
  if Flag = 1 then //判断是否为整数
  begin
    for I := 1 to Length( Ident ) do
      if ( not ( Ident[I] in A ) ) then
        Exit;
    Result := True;
  end
  else
  begin
    if ( Length( Ident ) = 0 ) or not ( Ident[1] in Alpha ) then
      Exit;
    if ( Ident[1] in Al ) and ( Length( Ident ) = 1 ) then Exit;
    for I := 2 to Length( Ident ) do
      if ( not ( Ident[I] in AlphaNumeric ) ) then
        Exit;
    j := 0;
    for I := 1 to Length( Ident ) do
      if Ident[I] = '.' then
        j := j + 1;
    if j >= 2 then exit;
    Result := True;
  end;
end;

function PosEx( SubStr, Fullstr: string; Index: Integer ): Integer;
var S: string;
  i, findflag, j, n, F: Integer;
begin
  S := FullStr;
  Result := 0;
  findflag := 0;
  j := 2;
  n := 0;
  for i := 1 to Length( Fullstr ) do
  begin
    if Fullstr[i] = SubStr[1] then //找到符合第一个字符
    begin
      findFlag := 1;
      F := i;
    end;
    if FindFlag = 1 then
    begin
      if j > Length( SubStr ) then
      begin
        n := n + 1;
        if n = index then
        begin
          Result := F;
          Exit;
        end
        else //不符合Index 继续找
        begin
          FindFlag := 0;
          j := 2;
          Continue;
        end;
      end;
      if Fullstr[i] <> SubStr[j] then
      begin //找到的不对
        FindFlag := 0;
        j := 2;
        Continue;
      end;
      j := j + 1;
    end;
  end;
end;

function GetSubCount( SubStr, Fullstr: string ): Integer;
var S: string;
  i, findflag, j, n, F: Integer;
begin
  S := FullStr;
  Result := 0;
  findflag := 0;
  j := 2;
  n := 0;
  for i := 1 to Length( Fullstr ) do
  begin
    if Fullstr[i] = SubStr[1] then //找到符合第一个字符
    begin
      findFlag := 1;
      F := i;
    end;
    if FindFlag = 1 then
    begin
      if j > Length( SubStr ) then
      begin
        n := n + 1;
      end;
      if Fullstr[i] <> SubStr[j] then
      begin //找到的不对
        FindFlag := 0;
        j := 2;
        Continue;
      end;
      j := j + 1;
    end;
  end;
  Result := n;
end;

function SetStrFromCellNote( AType: Integer; CellNote: string; AData: string ): string;
var
  i, j, Index1, Index2: Integer;
begin
  j := 0;
  Result := '';
  case ATYpe of
    C_CELLNAME:
      begin
        if CellNote = '' then
          Result := Adata + #05
        else
          Result := Adata + #05 + Copy( CellNote, pos( #05, CellNote ) + 1, Length( CellNote ) );
      end;
    C_CHECKFIRST:
      begin
        if CellNote = '' then
          Result := #05 + #05 + Adata + #05
        else
        begin
          for i := 2 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 2 );
          Index2 := PosEx( #05, CellNote, 3 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_CHECKNEXT:
      begin
        if CellNote = '' then
          Result := #05 + #05 + #05 + Adata + #05
        else
        begin
          for i := 3 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 3 );
          Index2 := PosEx( #05, CellNote, 4 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_CHECKREPORT:
      begin
        if CellNote = '' then
          Result := #05 + #05 + #05 + #05 + Adata + #05
        else
        begin
          for i := 4 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 4 );
          Index2 := PosEx( #05, CellNote, 5 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_CHECKRELEASE:
      begin
        if CellNote = '' then
          Result := #05 + #05 + #05 + #05 + #05 + Adata + #05
        else
        begin
          for i := 5 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 5 );
          Index2 := PosEx( #05, CellNote, 6 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_GATHER:
      begin
        if CellNote = '' then
          Result := #05 + #05 + #05 + #05 + #05 + #05 + Adata + #05
        else
        begin
          for i := 6 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 6 );
          Index2 := PosEx( #05, CellNote, 7 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_TempInput:
      begin
        if CellNote = '' then
          Result := #05 + #05 + #05 + #05 + #05 + #05 + #05 + Adata + #05
        else
        begin
          for i := 7 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 7 );
          Index2 := PosEx( #05, CellNote, 8 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_DC:
      begin
        if CellNote = '' then
          Result := #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + Adata + #05
        else
        begin
          for i := 8 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 8 );
          Index2 := PosEx( #05, CellNote, 9 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_RUNYEAR:
      begin
        if CellNote = '' then
          Result := #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + Adata + #05
        else
        begin
          for i := 9 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 9 );
          Index2 := PosEx( #05, CellNote, 10 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_RUNPERIOD:
      begin
        if CellNote = '' then
          Result := #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + #05 + Adata + #05
        else
        begin
          for i := 10 downto GetSubCount( #05, CellNote ) do
            CellNote := CellNote + #05;
          Index1 := PosEx( #05, CellNote, 10 );
          Index2 := PosEx( #05, CellNote, 11 );
          Result := Copy( CellNote, 1, Index1 ) + AData + #05 + Copy( CellNote, Index2 + 1, Length( CellNote ) );
        end;
      end;
    C_RUNDATE:
      begin
        if CellNote = '' then