0
votes

How can I change the color of text in a TStringGrid cell depending on certain conditions?

I am using TStringGrid to display a monthly calendar view on a form and I'm populating the TStringGrid with days of the month in certain rows and columns, with days of the week as column headings. I'm also populating the TStringGrid with job work orders for certain dates that are based on entries in a database. So I'm using the DrawCell event to display the content in the TStringGrid. Certain jobs are recurring jobs and other jobs are one offs. I'd like the recurring jobs to appear in one color and the one offs in another.

Is this possible, and/or should I be using a different component to accomplish this task? I assume it's not possible to have two different text colors in the same cell.

type
  TCalendarView2 = class(TForm)
    CalViewStringGrid: TStringGrid;
    NextBtn: TButton;
    PrevBtn: TButton;
    MonthLabel1: TLabel;
    CloseBtn: TButton;
    procedure OnShow(Sender: TObject);
    procedure CalViewStringGridDrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure NextBtnClick(Sender: TObject);
    procedure PrevBtnClick(Sender: TObject);
    procedure CloseBtnClick(Sender: TObject);
  private
    { Private declarations }
FDateTime: TDateTime;
    FDay: Word;
    EndDate, StartDay: TDateTime;  // selected date so we know what month the calendar is for
     iNumDays, iDay: Integer;  // Holds the number of days for a given month
    procedure FillWithWorkOrders;
    procedure UpdateRowHeights;
  public
    { Public declarations }
     MyDate : TDateTime;
  end;

var
  CalendarView2: TCalendarView2;

implementation

{$R *.dfm}

uses POEData;

procedure TCalendarView2.OnShow(Sender: TObject);
var
  wYear, wMonth: Word;
begin
  FDateTime := Date;

  // Extract the month, day and year for the current date
  DecodeDate (FDateTime, wYear, wMonth, FDay);
  MonthLabel1.Caption := FormatSettings.LongMonthNames[wMonth] + ' ' + IntToStr(wYear);

  FillWithWorkOrders;
end;

procedure TCalendarView2.CloseBtnClick(Sender: TObject);
begin
  CalendarView2.Close;
end;

procedure TCalendarView2.CalViewStringGridDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  s, ds, sDay, WorkOrder, WorkOrders: string;
  dd, idx: integer;
  dtDate: TDateTime;
  SerType, WoNum, ETips: string;
  bIsToday: boolean;
begin
  s := CalViewStringGrid.Cells[ACol, ARow];
  Inc(Rect.Left, 2);
  Inc(Rect.Top, 2);

  if (gdFixed in State) then
  begin
    CalViewStringGrid.Canvas.Brush.Color := CalViewStringGrid.FixedColor;
    CalViewStringGrid.Canvas.Font.Color := CalViewStringGrid.Font.Color;
    CalViewStringGrid.Canvas.FillRect(Rect);
    CalViewStringGrid.Canvas.TextRect(Rect, Rect.Left, Rect.Top, s);
    Exit;
  end;

  idx := Pos(#10, s);
  if idx <> 0 then
  begin
    sDay := Copy(s, 1, idx-1);
    WorkOrders := Copy(s, idx+1, MaxInt);
  end else
  begin
    ds := s;
    WorkOrders := '';
  end;

  if sDay <> '' then
  begin
    dd := StrToIntDef(sDay, 0);
    dtDate := Date;
    bIsToday := (MonthOf(dtDate) = MonthOf(FDateTime)) and (DayOf(dtDate) = dd);
  end else begin
    bIsToday := False;
  end;

  if bIsToday then
  begin
    CalViewStringGrid.Canvas.Brush.Color := clSkyBlue;
    CalViewStringGrid.Canvas.Font.Color := clBlue;
  end;
  begin
    CalViewStringGrid.Canvas.Brush.Color := CalViewStringGrid.Color;
    CalViewStringGrid.Canvas.Font.Color := CalViewStringGrid.Font.Color;
  end;
  CalViewStringGrid.Canvas.FillRect(Rect);
  CalViewStringGrid.Canvas.TextRect(Rect, Rect.Left, Rect.Top, sDay);

  if (WorkOrders = '') then Exit;

  Inc(Rect.Top, CalViewStringGrid.Canvas.TextHeight(sDay) + 2);
  repeat
    idx := Pos(#10, WorkOrders);
    if idx <> 0 then
    begin
      WorkOrder := Copy(WorkOrders, 1, idx-1);
      WorkOrders := Copy(WorkOrders, idx+1, MaxInt);
    end else
    begin
      WorkOrder := WorkOrders;
      WorkOrders := '';
    end;

    s := WorkOrder;
    idx := Pos('-', s);
    ETips := Copy(s, 1, idx-1);
    s := Copy(s, idx+1, MaxInt);
    idx := Pos('-', s);
    SerType := Copy(s, 1, idx-1);
    s := Copy(s, idx+1, MaxInt);
    WoNum := s;

   if bIsToday then
    begin
      CalViewStringGrid.Canvas.Brush.Color := clSkyBlue;
      //CalViewStringGrid.Font.Color := clBlue;
    end
    else if SerType = 'R' then
    begin
      CalViewStringGrid.Canvas.Font.Color := clRed;
    end
    else if SerType = 'P' then
    begin
      CalViewStringGrid.Canvas.Font.Color := clBlue;
    end
    else if SerType = 'S' then
    begin
      CalViewStringGrid.Canvas.Font.Color := clGreen;
    end
    else if SerType = 'N' then
    begin
      CalViewStringGrid.Canvas.Font.Color := clBlack;
    end;
    begin
      CalViewStringGrid.Canvas.Font.Color := CalViewStringGrid.Font.Color;
    end;
    CalViewStringGrid.Canvas.TextRect(Rect, Rect.Left, Rect.Top, WorkOrder);
    Inc(Rect.Top, CalViewStringGrid.Canvas.TextHeight(WorkOrder) + 2);
  until WorkOrders = '';
  // CalViewStringGrid.Canvas.Font.Color := clBlack;
end;

procedure TCalendarView2.FillWithWorkOrders;
const
  days: array[0..6] of String = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
var
  X, Y, i, DateSW, RotType, PurType, SheType, SW, iNumDays: Integer;
  dtTime, StartDay, EndDate: TDateTime;
  SerType, WoNum, CoName, SCity, ETips, s: string;
  wDay: Word;
  WorkOrders: array[1..31] of String;
begin
  RotType := 0;
  PurType := 0;
  SheType := 0;
  SW := 0;

  // This section displays the abbreviated day of the week in each cell in the first row,
  // and clears out cell info just in case any data was left over from before
  for i := 0 to 6 do
  begin
    CalViewStringGrid.Cells[i, 0] := days[i];
    CalViewStringGrid.Cells[i, 1] := '';
    CalViewStringGrid.Cells[i, 2] := '';
    CalViewStringGrid.Cells[i, 3] := '';
    CalViewStringGrid.Cells[i, 4] := '';
    CalViewStringGrid.Cells[i, 5] := '';
    CalViewStringGrid.Cells[i, 6] := '';
  end;

  // Gets the number of days for the current month
  iNumDays := DaysInMonth(FDateTime);

  // The next two lines initialize the variables the first time through
  if DateSW = 0 then
  begin
    StartDay := FDateTime - FDay;
    EndDate := EndOfTheMonth(FDateTime);
  end;
  DateSW := 1;

  //Generate and open the ToBeSchedGrid Query
  POE_Data.ToBeSchedGrid.Close;
  POE_Data.ToBeSchedGrid.Sql.Clear;
  POE_Data.ToBeSchedGrid.Sql.Add('SELECT DISTINCT D.WorkOrder, D.CustID, D.OpID, D.EnteredDate, D.EnteredTime, D.EstServiceDate, D.Status, D.EstBoxes, D.Truck, D.EstTips, D.ServiceDesc, D.Zone, D1.CompanyName, D1.Contact, D1.SContact1, D1.SPhone1, D1.SCity');
  POE_Data.ToBeSchedGrid.Sql.Add('FROM ":Shred:WorkOrdersIn.DB" D, ":Shred:Customer.DB" D1');
  POE_Data.ToBeSchedGrid.Sql.Add('WHERE (D.EstServiceDate > "' + DateToStr(StartDay) + '")');
  POE_Data.ToBeSchedGrid.Sql.Add('AND (D.EstServiceDate <= "' + DateToStr(EndDate) + '")');
  POE_Data.ToBeSchedGrid.Sql.Add('AND (D1.CustID = D.CustID)');
  POE_Data.ToBeSchedGrid.Sql.Add('AND (D.Status <> "Cancelled")');
  POE_Data.ToBeSchedGrid.Sql.Add('ORDER BY D.EstServiceDate');
  // Save this Query to a text file for debugging purposes
  POE_Data.ToBeSchedGrid.Sql.SaveToFile('c:\PolarQBE\WorkOrdersIn.txt');
  POE_Data.ToBeSchedGrid.Open;

  // populate each day's Work Orders
  While NOT POE_Data.ToBeSchedGrid.EOF do
  begin
    dtTime := POE_Data.ToBeSchedGridEstServiceDate.AsDateTime;
    SerType := POE_Data.ToBeSchedGridServiceDesc.AsString;
    WoNum := POE_Data.ToBeSchedGridWorkOrder.AsString;
    SCity := POE_Data.ToBeSchedGridSCity.AsString;
    ETips := POE_Data.ToBeSchedGridEstTips.AsString;
    if ETips = '' then ETips := '0';
    CoName := POE_Data.ToBeSchedGridCompanyName.AsString;

    if SerType = 'Route' then
      Inc(RotType);
    if SerType = 'Purge' then
      Inc(PurType);
    if SerType = 'Shred Event' then
      Inc(SheType);

    //wDay := DayOfTheMonth(FDateTime);
    wDay := DayOfTheMonth(dtTime);
    //WorkOrders[wDay] := WorkOrders[wDay] + ETips + '-' + Copy(CoName,1,11) + '-' + Copy(SCity,1,8) + '-' + Copy(SerType,1,1) + '-' + WoNum + #10;
    WorkOrders[wDay] := WorkOrders[wDay] + ETips + '-' + Copy(SerType,1,1) + '-' + WoNum + #10;

    POE_Data.ToBeSchedGrid.Next;
  end;

  // Initialize the Row and Column counters
  Y := 1;
  X := DayOfWeek(StartOfTheMonth(FDateTime)- 1);
  if X > 6 then X := (X div 6) - 1;

  for i := 1 to iNumDays do
  begin
    s := IntToStr(i);
    if WorkOrders[i] <> '' then begin
      s := s + #10 + WorkOrders[i];
    end;
    CalViewStringGrid.Cells[X, Y] := s;
    // increment the column counter
    Inc(X);
    // if the column counter is greater than 6 reset back to 0.
    if X > 6 then
    begin
      X := 0;
      Inc(Y);
    end;
  end;

  UpdateRowHeights;
end;

procedure TCalendarView2.UpdateRowHeights;
var
  X, Y, TxtHeight: Integer;
  MaxHeight: Integer;
  R: TRect;
begin
  // This next line seems to really control the height of the rows
  CalViewStringGrid.Canvas.Font.Size := 8;
  for Y := CalViewStringGrid.FixedRows to CalViewStringGrid.RowCount - 1 do
  begin
    MaxHeight := CalViewStringGrid.DefaultRowHeight - 4;
    for X := CalViewStringGrid.FixedCols to CalViewStringGrid.ColCount - 1 do
    begin
      R := Rect(0, 0, CalViewStringGrid.ColWidths[X] - 4, 0);
      TxtHeight := DrawText(CalViewStringGrid.Canvas.Handle,
        PChar(CalViewStringGrid.Cells[X, Y]), -1, R, DT_WORDBREAK or DT_CALCRECT);
      if TxtHeight > MaxHeight then
        MaxHeight := TxtHeight;
    end;
    // 11/18/2015 - was = AGrid.RowHeights[Y] := MaxHeight + 4;
    CalViewStringGrid.RowHeights[Y] := MaxHeight + 1;
  end;
end;
1

1 Answers

0
votes

Yes, it is possible to use multiple colors in a single cell. Since you are already using the TStringGrid.OnDrawCell event to draw the cells yourself, simply extend your drawing logic to include per-job text colors. All you have to do is assign the TStringGrid.Canvas.Font.Color property before drawing a job's text onto the TStringGrid.Canvas. You just need to expose a way for your OnDrawCell handler to know when a given job is recurring or not, so it can assign the appropriate color before drawing that job's text.

Update: Try something more like this instead:

type
  TCalViewForm = class(TForm)
    CalViewStringGrid: TStringGrid;
    procedure OnShow(Sender: TObject);
    procedure CalViewStringGridDrawCell(Sender: TObject; ACol,
  private
    FDateTime: TDateTime;
    FDay: Word;
    procedure FillWithWorkOrders;
    procedure UpdateRowHeights;
  end;

...

procedure TCalViewForm.OnShow(Sender: TObject);
var
  wYear, wMonth: Word;
begin
  FDateTime := Date;

  // Extract the month, day and year for the current date
  DecodeDate (FDateTime, wYear, wMonth, FDay);
  MonthLabel.Caption := FormatSettings.LongMonthNames[wMonth] + ' ' + IntToStr(wYear);

  FillWithWorkOrders;
end;

procedure TCalViewForm.FillWithWorkOrders;
const
  days: array[0..6] = ('Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat');
var
  X, Y, i, DateSW: Integer;
  dtTime: TDateTime;
  SerType, WoNum, CoName, SCity, ETips, s: string;
  wDay: Word;
  WorkOrders: array[1..31] of String;
begin
  RotType := 0;
  PurType := 0;
  SheType := 0;
  SW := 0;

  // This section displays the abbreviated day of the week in each cell in the first row,
  // and clears out cell info just in case any data was left over from before
  for i := 0 to 6 do
  begin
    CalViewStringGrid.Cells[i, 0] := days[i];
    CalViewStringGrid.Cells[i, 1] := '';
    CalViewStringGrid.Cells[i, 2] := '';
    CalViewStringGrid.Cells[i, 3] := '';
    CalViewStringGrid.Cells[i, 4] := '';
    CalViewStringGrid.Cells[i, 5] := '';
    CalViewStringGrid.Cells[i, 6] := '';
  end;

  // Gets the number of days for the current month
  iNumDays := DaysInMonth(FDateTime);

  // The next two lines initialize the variables the first time through
  if DateSW = 0 then
  begin
    StartDay := FDateTime - FDay;
    EndDate := EndOfTheMonth(FDateTime);
  end;
  DateSW := 1;

  //Generate and open the ToBeSchedGrid Query
  POE_Data.ToBeSchedGrid.Close;
  POE_Data.ToBeSchedGrid.Sql.Clear;
  POE_Data.ToBeSchedGrid.Sql.Add('SELECT DISTINCT D.WorkOrder, D.CustID, D.OpID, D.EnteredDate, D.EnteredTime, D.EstServiceDate, D.Status, D.EstBoxes, D.Truck, D.EstTips, D.ServiceDesc, D.Zone, D1.CompanyName, D1.Contact, D1.SContact1, D1.SPhone1, D1.SCity');
  POE_Data.ToBeSchedGrid.Sql.Add('FROM ":Shred:WorkOrdersIn.DB" D, ":Shred:Customer.DB" D1');
  POE_Data.ToBeSchedGrid.Sql.Add('WHERE (D.EstServiceDate > "' + DateToStr(StartDay) + '")');
  POE_Data.ToBeSchedGrid.Sql.Add('AND (D.EstServiceDate <= "' + DateToStr(EndDate) + '")');
  POE_Data.ToBeSchedGrid.Sql.Add('AND (D1.CustID = D.CustID)');
  POE_Data.ToBeSchedGrid.Sql.Add('AND (D.Status <> "Cancelled")');
  POE_Data.ToBeSchedGrid.Sql.Add('ORDER BY D.EstServiceDate');
  // Save this Query to a text file for debugging purposes
  POE_Data.ToBeSchedGrid.Sql.SaveToFile('c:\PolarQBE\WorkOrdersIn.txt');
  POE_Data.ToBeSchedGrid.Open;

  // populate each day's Work Orders
  While NOT POE_Data.ToBeSchedGrid.EOF do
  begin
    dtTime := POE_Data.ToBeSchedGridEstServiceDate.AsDateTime;
    SerType := POE_Data.ToBeSchedGridServiceDesc.AsString;
    WoNum := POE_Data.ToBeSchedGridWorkOrder.AsString;
    SCity := POE_Data.ToBeSchedGridSCity.AsString;
    ETips := POE_Data.ToBeSchedGridEstTips.AsString;
    if ETips = '' then ETips := '0';
    CoName := POE_Data.ToBeSchedGridCompanyName.AsString;

    if SerType = 'Route' then
      Inc(RotType);
    if SerType = 'Purge' then
      Inc(PurType);
    if SerType = 'Shred Event' then
      Inc(SheType);

    wDay := DayOfTheMonth(dtTime);
    //WorkOrders[wDay] := WorkOrders[wDay] + ETips + '-' + Copy(CoName,1,11) + '-' + Copy(SCity,1,8) + '-' + Copy(SerType,1,1) + '-' + WoNum + #10;
    WorkOrders[wDay] := WorkOrders[wDay] + ETips + '-' + Copy(SerType,1,1) + '-' + WoNum + #10;

    POE_Data.ToBeSchedGrid.Next;
  end;

  // Initialize the Row and Column counters
  Y := 1;
  X := DayOfWeek(StartOfTheMonth(FDateTime)- 1);
  if X > 6 then X := (X div 6) - 1;

  for i := 1 to iNumDays do
  begin
    s := IntToStr(i);
    if WorkOrders[i] <> '' then begin
      s := s + #10 + WorkOrders[i];
    end;
    CalViewStringGrid.Cells[X, Y] := s;
    // increment the column counter
    Inc(X);
    // if the column counter is greater than 6 reset back to 0.
    if X > 6 then
    begin
      X := 0;
      Inc(Y);
    end;
  end;

  UpdateRowHeights;
end;

procedure TCalViewForm.CalViewStringGridDrawCell(Sender: TObject; ACol,
  ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  s, sDay, WorkOrder, WorkOrders: string;
  dd, idx: integer;
  dtDate: TDateTime;
  SerType, WoNum, ETips: string;
  bIsToday: boolean;
begin
  s := CalViewStringGrid.Cells[ACol, ARow];
  Inc(Rect.Left, 2);
  Inc(Rect.Top, 2);

  if (gdFixed in State) then
  begin
    CalViewStringGrid.Canvas.Brush.Color := CalViewStringGrid.FixedColor;
    CalViewStringGrid.Canvas.Font.Color := CalViewStringGrid.Font.Color;
    CalViewStringGrid.Canvas.FillRect(Rect);
    CalViewStringGrid.Canvas.TextRect(Rect, Rect.Left, Rect.Top, s);
    Exit;
  end;

  idx := Pos(#10, s);
  if idx <> 0 then
  begin
    sDay := Copy(s, 1, idx-1);
    WorkOrders := Copy(s, idx+1, MaxInt);
  end else
  begin
    sDay := s;
    WorkOrders := '';
  end;

  if sDay <> '' then
  begin
    dd := StrToIntDef(sDay, 0);
    dtDate := Date;
    bIsToday := (MonthOf(dtDate) = MonthOf(FDateTime)) and (DayOf(dtDate) = dd);
  end else begin
    bIsToday := False;
  end;

  if bIsToday then
  begin
    CalViewStringGrid.Canvas.Brush.Color := clSkyBlue;
    CalViewStringGrid.Canvas.Font.Color := clBlue;
  end
  begin
    CalViewStringGrid.Canvas.Brush.Color := CalViewStringGrid.Color;
    CalViewStringGrid.Canvas.Font.Color := CalViewStringGrid.Font.Color;
  end;
  CalViewStringGrid.Canvas.FillRect(Rect);
  CalViewStringGrid.Canvas.TextRect(Rect, Rect.Left, Rect.Top, sDay);

  if (WorkOrders = '') then Exit;

  Inc(Rect.Top, CalViewStringGrid.Canvas.TextHeight(sDay) + 2);
  repeat
    idx := Pos(#10, WorkOrders);
    if idx <> 0 then
    begin
      WorkOrder := Copy(WorkOrders, 1, idx-1);
      WorkOrders := Copy(WorkOrders, idx+1, MaxInt);
    end else
    begin
      WorkOrder := WorkOrders;
      WorkOrders := '';
    end;

    s := WorkOrder;
    idx := Pos('-', s);
    ETips := Copy(s, 1, idx-1);
    s := Copy(s, idx+1, MaxInt);
    idx := Pos('-', s);
    SerType := Copy(s, 1, idx-1);
    s := Copy(s, idx+1, MaxInt);
    WoNum := s;

    if SerType = 'R' then
    begin
      CalViewStringGrid.Canvas.Font.Color := clRed;
    end
    else if SerType = 'P' then
    begin
      CalViewStringGrid.Canvas.Font.Color := clBlue;
    end
    else if SerType = 'S' then
    begin
      CalViewStringGrid.Canvas.Font.Color := clGreen;
    end
    else if bIsToday then
    begin
      CalViewStringGrid.Canvas.Font.Color := clBlue;
    end
    begin
      CalViewStringGrid.Canvas.Font.Color := CalViewStringGrid.Font.Color;
    end;

    CalViewStringGrid.Canvas.TextRect(Rect, Rect.Left, Rect.Top, WorkOrder);
    Inc(Rect.Top, CalViewStringGrid.Canvas.TextHeight(WorkOrder) + 2);
  until WorkOrders = '';
end;

procedure TCalViewForm.UpdateRowHeights;
var
  X, Y, TxtHeight: Integer;
  MaxHeight: Integer;
  R: TRect;
begin
  // This next line seems to really control the height of the rows
  CalViewStringGrid.Canvas.Font.Size := 9;
  for Y := CalViewStringGrid.FixedRows to CalViewStringGrid.RowCount - 1 do
  begin
    MaxHeight := CalViewStringGrid.DefaultRowHeight - 4;
    for X := CalViewStringGrid.FixedCols to CalViewStringGrid.ColCount - 1 do
    begin
      R := Rect(0, 0, CalViewStringGrid.ColWidths[X] - 4, 0);
      TxtHeight := DrawText(CalViewStringGrid.Canvas.Handle,
        PChar(CalViewStringGrid.Cells[X, Y]), -1, R, DT_WORDBREAK or DT_CALCRECT);
      if TxtHeight > MaxHeight then
        MaxHeight := TxtHeight;
    end;
    // 11/18/2015 - was = AGrid.RowHeights[Y] := MaxHeight + 4;
    CalViewStringGrid.RowHeights[Y] := MaxHeight + 1;
  end;
end;