basecell.pas

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

    TCell(Sender).DoFetchFuncParameter( 0, para1 );
    case Integer( para1 ) of
      0:
        funcResult := IntToStr( ST.wYear ) + '年';
      1:
        funcResult := IntToStr( ST.wYear );
      - 1:
        funcResult := IntToStr( ST.wYear - 1 ) + '年';
      - 2:
        funcResult := IntToStr( ST.wYear - 1 );
    else
      funcResult := IntToStr( ST.wYear ) + '年';
    end;
  end;
  procedure SetWeek;
  var St: TSystemTime;
    Para1: OleVariant;
    a: Integer;
    S: string;
  begin
    DateTimeToSystemTime( S_CurDate, ST );
    TCell(Sender).DoFetchFuncParameter( 0, para1 );
    case Integer( para1 ) of
      0:
        begin
          a := GetWeekofYear( ST, True );
          if a < 10 then
            S := '0' + IntToStr( a )
          else
            S := IntToStr( a );
          funcResult := IntToStr( ST.wYear ) + '年' + S + '周';
        end;
      - 1:
        begin
          a := GetWeekofYear( ST, True );
          if a < 10 then
            S := '0' + IntToStr( a - 1 )
          else
            S := IntToStr( a - 1 );
          funcResult := IntToStr( ST.wYear ) + '年' + S + '周';
        end;
    end;
  end;
  procedure SetQWBSJ;
  var G: TGetDataBase;
    S1, s2, s3, s4, S5, s6, s7, s8, s9: OleVariant;
    SCol, SRow, ECol, ERow: Integer;
    Sg: TStringGrid;
    BWidth,i, j: Integer;
    m: Double;
    S: string;
    fc: olevariant;
    function IfDataGridNotDataforRow(Index:Integer):Boolean;
    var i:Integer;
    begin
      Result:=True;
      for i:=0 to G.DataGrid.ColCount-1 do
      begin
         if G.DataGrid.Cells[i,Index]<>'' then
         begin
           Result:=False;
           Break;
         end;
      end;
    end;
  begin
    G := nil;
    Sg := nil;
    try
      G := TGetDataBase.Create;
      Sg := TStringGrid.Create( nil );
      TCell(Sender).DoFetchFuncParameter( 0, S5 );
      TCell(Sender).DoFetchFuncParameter( 1, S6 );
      TCell(Sender).DoFetchFuncParameter( 2, S7 );
      TCell(Sender).DoFetchFuncParameter( 3, S8 );
      TCell(Sender).DoFetchFuncParameter( 4, S9 );

      TCell(Sender).DoFetchFuncParameter( 5, S1 );
      TCell(Sender).DoFetchFuncParameter( 6, s2 );
      TCell(Sender).DoFetchFuncParameter( 7, S3 );
      TCell(Sender).DoFetchFuncParameter( 8, S4 );

//      Cell1.DoGetRowHeight(S4,aHeight);
//      if aHeight=0 then Exit;

      SCol := s5;
      SRow := s6;
      ECol := s7;
      ERow := s8;
      G.GetFlag := S9;
      G.Username := S1;
      G.Password := G.GetPassword( S2 );
      G.DataBaseName := S3;
      G.database:=Self.DataBase1;
      G.Sql := S4;
      G.Execute;
      funcResult := '';//G.DataGrid.Cells[0, 0];
      if ( SCol <> ECol ) or ( SRow <> EROw ) then
      begin
        G.DataGrid.ColCount := ECol - SCol + 1;
        G.DataGrid.RowCount := ERow - SRow + 1;
      end;
      i := SCol + G.DataGrid.ColCount;
      if i > TCell(Sender).Cols then
        TCell(Sender).Cols := i;
      i := SRow + G.DataGrid.RowCount;
      if i > TCell(Sender).Rows then
        TCell(Sender).Rows := i;

      for i:=SCol to ECol do
        for j:=SRow to ERow do
          TCell(Sender).DoSetCellValue( i, j,0);

      for i:=SRow to ERow do
      begin
          if IfDataGridNotDataforRow(i-SRow) then
          begin
              TCell(Sender).DoSetRowHeight(i,0);
          end
          else
          begin
              TCell(Sender).DoGetRowHeight(i,BWidth);
              if BWidth<=0 then
              begin
                TCell(Sender).DoGetCellData( -1, i, fc );
                BWidth := fc;
                if BWidth = 0 then
                  TCell(Sender).DoSetRowHeight( i, 17 )
                else
                  TCell(Sender).DoSetRowHeight( i, BWidth );
              end;
          end;
      end;

      for i := 0 to G.DataGrid.ColCount - 1 do
        for j := 0 to G.DataGrid.RowCount - 1 do
        begin
          S := G.DataGrid.Cells[i, j];
          if length( S ) >= 2 then
          begin
            if S[1] = '0' then
            begin
              m := StrToFloat( Copy( S, 2, Length( S ) ) );
              TCell(Sender).DoSetCellValue( i + SCol, j + SRow, m );
            end
            else
            begin
              TCell(Sender).DoSetCellString( i + SCol, j + SRow, Copy( S, 2, Length( S ) ) );
            end;
          end;
        end;
      TCell(Sender).DoRedrawRange(SCol,SRow,ECol,ERow);
    finally
      G.Free;
      Sg.Free;
    end;
  end;
  procedure SetGetCellData;
  var
    adata, S1, s2, S3: OleVariant;
  begin
    TCell(Sender).DoFetchFuncParameter( 0, S1 );
    TCell(Sender).DoFetchFuncParameter( 1, S2 );
    TCell(Sender).DoFetchFuncParameter( 2, S3 );
    TCell(Sender).DoGetPageCellData( S1, S2, S3, adata );
    funcResult := ( adata );
  end;
  procedure SetPeriod;
  begin
    if Length(S_CurPeriod)=1 then
      funcResult := S_CurYear+'/0'+S_CurPeriod
    else
      funcResult := S_CurYear+'/'+S_CurPeriod;
  end;
  procedure SetACol;
  var
    S: OleVariant;
  begin
    TCell(Sender).DoFetchFuncParameter( 0, S );
    funcResult := S;
  end;
  procedure SetARow;
  var
    S: OleVariant;
  begin
    TCell(Sender).DoFetchFuncParameter( 0, S );
    funcResult := S;
  end;
  procedure SetConditionColor;
  var
    data2, data1,S1, s2, S3,S4,S5,S6,S7,S8,FontColor, ColorColor: OleVariant;
    aResultFlag:Boolean;
    a1,a2:Double;
    b1,b2:String;
    aHeight: Integer;
  begin
    TCell(Sender).DoFetchFuncParameter( 0, S1 ); //
    TCell(Sender).DoFetchFuncParameter( 1, S2 ); //坐标1

    TCell(Sender).DoFetchFuncParameter( 2, S3 ); //条件

    TCell(Sender).DoFetchFuncParameter( 3, S4 );
    TCell(Sender).DoFetchFuncParameter( 4, S5 ); //坐标2

    TCell(Sender).DoFetchFuncParameter( 5, S6 ); //颜色

    TCell(Sender).DoFetchFuncParameter( 6, S7 ); //当前坐标
    TCell(Sender).DoFetchFuncParameter( 7, S8 ); //当前坐标

    TCell(Sender).DoGetRowHeight(S8,aHeight);
    if aHeight=0 then Exit;

    aResultFlag:=False;
    TCell(Sender).DoGetCellData(S1,S2,Data1);
    if VarType(Data1)=varEmpty then
      Exit;
    TCell(Sender).DoGetCellData(S4,S5,Data2);
    if VarType(Data2)=varEmpty then
      Exit;
    if varType(data1)<>varOleStr then
    begin
      try
      a1:=data1;
      except
      a1:=0;
      end;
      try
      a2:=data2;
      except
      a2:=0;
      end;
      if S3='>' then
        if a1>a2 then aResultFlag:=True;
      if S3='<' then
        if a1<a2 then aResultFlag:=True;
      if S3='<=' then
        if a1<=a2 then aResultFlag:=True;
      if S3='>=' then
        if a1>=a2 then aResultFlag:=True;
      if S3='<>' then
        if a1<>a2 then aResultFlag:=True;
      if S3='=' then
        if a1=a2 then aResultFlag:=True;
    end
    else
    begin
      if Data1='' then
         b1:=' '
      else
         b1:=data1;
      if Data1='' then
         b2:=' '
      else
         b2:=data1;
      if S3='>' then
        if b1>b2 then aResultFlag:=True;
      if S3='<' then
        if b1<b2 then aResultFlag:=True;
      if S3='<=' then
        if b1<=b2 then aResultFlag:=True;
      if S3='>=' then
        if b1>=b2 then aResultFlag:=True;
      if S3='<>' then
        if b1<>b2 then aResultFlag:=True;
      if S3='=' then
        if b1=b2 then aResultFlag:=True;
    end;
    if aResultFlag then
    begin
      TCell(Sender).DoGetCellColor( S7,S8, FontColor, ColorColor );
      TCell(Sender).DoSetCellColor( S7,S8, FontColor, S6 );
      TCell(Sender).DoRedrawCell(S7,S8);
    end
    else
    begin
      //TCell(Sender).DoGetCellColor( S7,S8, FontColor, ColorColor );
      //TCell(Sender).DoSetCellColor( S7,S8, FontColor, clwhite );
      //TCell(Sender).DoRedrawCell(S7,S8);
    end;
    funcResult := '';
  end;
begin

{  TCell(Sender).DoGetCellData( -1, -1, AData );
  if AData = 'DES' then
    DesignFlag := True
  else
   DesignFlag := False;
  if Name = 'SetTempInput' then
  begin
    if DesignFlag then
      funcResult := NULL
    else
      funcResult := NULL;
  end;}
  if Name = 'Period' then
  begin
    SetPeriod;
  end;
  if (Name = 'GEDay')or (Name = 'Day')then
  begin
    SetDay;
  end;
  if (Name = 'GEMonth')or (Name = 'Month')then
  begin
    SetMonth;
  end;
  if (Name = 'GEYear')or (Name = 'Year')then
  begin
    SetYear;
  end;
  if (Name = 'GEWeek')or (Name = 'Week')then
  begin
    SetWeek;
  end;
  if Name = 'Date' then
  begin
    funcResult := DateTimeToStr( Date );
  end;
  if Name = 'Time' then
  begin
    funcResult := TimeToStr( Time );
  end;
  if Name = 'QWBSJ' then
  begin
     SetQWBSJ;
  end;
  if UpperCase( Name ) = 'GETCELLDATA' then
  begin
    SetGetCellData;
  end;
  if UpperCase( Name ) = 'TJYS' then
  begin
    SetConditionColor;
  end;
end;

procedure TBaseCellForm.Cell1SetCellData(Sender: TObject; col,
  row: Integer; var data, changed: OleVariant);
begin
    if Cell1.IsFormulaCell(col,row) then
    if uppercase( data ) = '#ERROR'  then
    begin
      changed:=True;
      data := '';
    end;
end;

procedure TBaseCellForm.ToolbarButton977Click(Sender: TObject);
begin
  Cell1.DoSetUnScrollCol(-1,-1);
  Cell1.DoSetUnScrollRow(-1,-1);
  Cell1.DoRedrawAll;
end;

procedure TBaseCellForm.ToolbarButton975Click(Sender: TObject);
//var
//	Reg:TRegistry;
begin{  Reg := nil;
  sKZTJ:='';
  try
    begin
      Reg := TRegistry.Create;
      Reg.RootKey := HKEY_LOCAL_MACHINE;
      if Reg.OpenKey( 'SoftWare\GoEasySoftWare\Report', False ) then
      begin
        try
          sKZTJ := Reg.readstring( 'CP_NO' );
        except
        end;
      end;
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
  end;}
  sSYB:=ParamStr(2);
  sCPLX:=ParamStr(1);
end;

procedure TBaseCellForm.ToolbarButton978Click(Sender: TObject);
var
	sFileName:String;
begin
  SaveDialog1.Filter:='Microsoft Excel Files (*.xls)|*.xls';
  SaveDialog1.Execute;
  sFileName:=SaveDialog1.FileName;
  Cell1.DoExportExcelFile(sFileName);
end;

procedure TBaseCellForm.ToolbarButton979Click(Sender: TObject);
var
	i,nCols:Integer;
begin
	nCols:=GetCellCols(Cell1);
  for i:=0 to nCols-1 do
    Cell1.DoSetColWidth(i, Cell1.DoGetColBestWidth(i));
  Cell1.DoRedrawAll;
end;

end.