Change color of text in a TStringGrid cell - delphi-xe6

Question

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;

Answer 1

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;