更改 TStringGrid 单元格中文本的颜色
Change color of text in a TStringGrid cell
如何根据特定条件更改 TStringGrid 单元格中文本的颜色?
我正在使用 TStringGrid 在窗体上显示月度日历视图,并在 TStringGrid 中填充某些行和列中的月份日期,并将星期几作为列标题。我还使用基于数据库条目的某些日期的作业工单填充 TStringGrid。所以我使用 DrawCell 事件来显示 TStringGrid 中的内容。某些工作是重复性工作,而其他工作是一次性的。我希望重复性工作以一种颜色显示,而另一种颜色显示。
这可能吗,and/or 我应该使用不同的组件来完成这项任务吗?我假设在同一个单元格中不可能有两种不同的文本颜色。
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;
是的,可以在一个单元格中使用多种颜色。由于您已经在使用 TStringGrid.OnDrawCell
事件自己绘制单元格,因此只需扩展您的绘制逻辑以包含每个作业的文本颜色。您所要做的就是在将作业文本绘制到 TStringGrid.Canvas
之前分配 TStringGrid.Canvas.Font.Color
属性。您只需要为您的 OnDrawCell
处理程序公开一种方法,使其知道给定作业何时重复出现,以便它可以在绘制该作业的文本之前分配适当的颜色。
更新:试试更像这样的东西:
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;
如何根据特定条件更改 TStringGrid 单元格中文本的颜色?
我正在使用 TStringGrid 在窗体上显示月度日历视图,并在 TStringGrid 中填充某些行和列中的月份日期,并将星期几作为列标题。我还使用基于数据库条目的某些日期的作业工单填充 TStringGrid。所以我使用 DrawCell 事件来显示 TStringGrid 中的内容。某些工作是重复性工作,而其他工作是一次性的。我希望重复性工作以一种颜色显示,而另一种颜色显示。
这可能吗,and/or 我应该使用不同的组件来完成这项任务吗?我假设在同一个单元格中不可能有两种不同的文本颜色。
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;
是的,可以在一个单元格中使用多种颜色。由于您已经在使用 TStringGrid.OnDrawCell
事件自己绘制单元格,因此只需扩展您的绘制逻辑以包含每个作业的文本颜色。您所要做的就是在将作业文本绘制到 TStringGrid.Canvas
之前分配 TStringGrid.Canvas.Font.Color
属性。您只需要为您的 OnDrawCell
处理程序公开一种方法,使其知道给定作业何时重复出现,以便它可以在绘制该作业的文本之前分配适当的颜色。
更新:试试更像这样的东西:
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;