Внешний вид сайта:

Создание многоцветоного StringGrid

Стандартный компонент Delphi TStringGrid имеет один цвет для всех ячеек. Как же создать многоцветный StringGrid?

Реализация:

TBWStringGrid=class(TStringGrid) 
  private 
  protected 
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; 
      AState: TGridDrawState); override; 
  public 
    { только содержит некоторые данные для ячейки } 
    CellColor:array of array of TColor; 
    CellFontColor:Array of array of TColor; 
    CellData:array of array of REAL; 
    procedure RebuildDynColorArray; // net gut !!!! 
    procedure ResizeGrid(ColCount:Integer;RowCount:Integer;
        ClearAllFields:Boolean=TRUE); 
    procedure ResetGridCellData; 
    procedure ResetGrid; 
    procedure UnselectAll; 
  published 
  end; 

function InvertColor(Color:TColor):TColor; 

{ TBWStringGrid } 

//>Created at 05-Jul-2002 (14:12:19 ) by benjamin wittfoth 
procedure TBWStringGrid.DrawCell(ACol, ARow: Integer; 
    ARect: TRect; AState: TGridDrawState); 
begin 
  inherited; 
  if CellColor[ACol,ARow]=clBlack then EXIT; 
  With Canvas Do Begin 
    if (gdSelected in AState) then begin  
    // wenn selektiert -> INVERTIEREN 
       Font.Color:=InvertColor(CellFontColor[ACol,ARow]); 
       Brush.Color := InvertColor(CellColor[ACol,ARow]); 
    end 
     else begin // Ansonsten nicht ! 
       Brush.Color := CellColor[ACol,ARow]; 
       Font.Color:= CellFontColor[ACol,ARow]; 
     end; 
    Brush.Style := bsSolid; 
    FillRect( ARect ); 
    TextRect( ARect, ARect.left+2, ARect.top+2, Cells[ ACol, ARow ] ); 
  End; 
end; 

//>Created at 05-Jul-2002 (14:56:33 ) by benjamin wittfoth 
procedure TBWStringGrid.RebuildDynColorArray; 
begin 
  SetLength(CellColor,ColCount,RowCount); 
  SetLength(CEllFontColor,ColCount,RowCount); 
  SetLength(CellData,ColCount,RowCount); 
end; 

//>Created at 10-Jul-2002 (08:11:25 ) by benjamin wittfoth 
procedure TBWStringGrid.ResizeGrid(ColCount:Integer;
    RowCount:Integer;ClearAllFields:Boolean=TRUE); 
begin 
  Self.RowCount:=RowCount; 
  Self.ColCount:=ColCount; 
  RebuildDynColorArray; 
  if ClearAllFields then 
    ResetGrid; 
end; 

//>Created at 10-Jul-2002 (08:11:29 ) by benjamin wittfoth 
procedure TBWStringGrid.ResetGridCellData; 
var X,Y:Integer; 
begin 
  for Y:=0 to RowCount-1 do 
    for X:=0 to ColCount-1 do 
      CellData[X,Y]:=0; 
end; 
//>Created at 09-Jul-2002 (16:54:43 ) by benjamin wittfoth 
procedure TBWStringGrid.ResetGrid; 
var X,Y:Integer; 
begin 
  for Y:=0 to RowCount-1 do begin 
    for X:=0 to ColCount-1 do begin 
      CellData[X,Y]:=0; 
      CellColor[X,Y]:=clWhite; 
      CellFontColor[X,Y]:=clBlack; 
      Cells[X,Y]:=''; 
    end; 
  end; 
end; 


//>Created at 09-Jul-2002 (11:08:35 ) by benjamin wittfoth 
procedure TBWStringGrid.UnselectAll; 
var ARect:TGridRect; 
begin 
  ARect.Left:=0;ARect.Top:=0;ARect.Right:=0;ARect.Bottom:=0; 
  Selection:=ARect; 
end; 


function InvertColor(Color:TColor):TColor; 
begin 
  case Color of 
    clAqua      : RESULT:=clTeal; 
    clBlack     : RESULT:=clWhite; 
    clBlue      : RESULT:=clMaroon; 
    clDkGray    : RESULT:=clFuchsia; 
    clFuchsia   : RESULT:=clDkGray; 
//    clGray      : RESULT:=clPurple; 
    clGreen     : RESULT:=clRed; 
    clLime      : RESULT:=clSilver;//clYellow; 
    clLtGray    : RESULT:=clLime      ; 
    clMaroon    : RESULT:=clOlive;    //clBlue; 
    clNavy      : RESULT:=clNavy; 
    clOlive     : RESULT:=clMaroon;//clNavy; 
    clPurple    : RESULT:=clGray; 
    clRed       : RESULT:=clYellow;//clGreen; 
//    clSilver    : RESULT:=clLtGray; 
    clTeal      : RESULT:=clAqua; 
    clWhite     : RESULT:=clBlack; 
    clYellow    : RESULT:=clRed;//clLime; 
  end; 
end; 

Комментарии

Нет комментариев. Ваш будет первым!