I am doing a project for school. I have written code to populate two string grids in a calendar style. The second string grid (StringGrid2) shows the month after the first (StringGrid1). This is all done in the following upDateCalendar() procedure that receives an integer iMonthChange to indicate if the user wants to view one month forward (iMonthchange := 1) or one month back (iMonthChange := -1).
Here is the populating procedure:
procedure TStudentDashboard.upDateCalendar(iMonthChange: integer);
var
iNumDaysinMonth, iWeekCount: integer;
tNewMonthStart, tTempMonth: TDateTime;
tYear, tMonth, tDay: Word;
I, ARow: integer;
begin
// date inputs
tFirstStudyDate := dtpicker.Date;
updateCheckBoxes;
iStudySessionDuration :=
strToInt((cmbStudySessionLength.Items[cmbStudySessionLength.ItemIndex][1] +
cmbStudySessionLength.Items[cmbStudySessionLength.ItemIndex][2]));
tLastStudyDate := arrCourses[iCourseArrayPointer].lastStudyDate
(tFirstStudyDate, iStudySessionDuration, arrWeekDaysSelected);
bDrawPastTestDate := false;
// populate fixed row
for I := 0 to StringGrid1.RowCount - 1 do
StringGrid1.Rows[I].Clear;
StringGrid1.Cells[0, 0] := 'Mon';
StringGrid1.Cells[1, 0] := 'Tue';
StringGrid1.Cells[2, 0] := 'Wed';
StringGrid1.Cells[3, 0] := 'Thu';
StringGrid1.Cells[4, 0] := 'Fri';
StringGrid1.Cells[5, 0] := 'Sat';
StringGrid1.Cells[6, 0] := 'Sun';
// increment month
tNewMonthStart := IncMonth(tCurrentShowMonthStart, iMonthChange);
iWeekCount := 1;
tTempMonth := tNewMonthStart;
for I := 1 to DaysInMonth(tNewMonthStart) do
begin
tTempMonth := IncDay(tNewMonthStart, I - 1);
if (arrCourses[iCourseArrayPointer].getTestDate <> 'click here to book') or
(bBookingTest = true) then
begin
if (arrCourses[iCourseArrayPointer].getTestDate <> 'click here to book') then
begin
tTestDate := strToDate(arrCourses[iCourseArrayPointer].getTestDate);
end
else
begin
tTestDate := dtpckerTestDate.Date;
end;
if tTempMonth = tTestDate then
begin
StringGrid1.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
iCalendarATestDateXVal := DayOfTheWeek(tTempMonth) - 1;
iCalendarATestDateYVal := iWeekCount;
bDrawPastTestDate := true;
end
else
begin
StringGrid1.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
end;
if (tTempMonth < StrToDate(arrCourses[iCourseArrayPointer].getTestDate))
and (I = DaysInMonth(tNewMonthStart)) then
begin
bDrawPastTestDate := true;
iCalendarATestDateXVal := 6;
iCalendarATestDateYVal := 6;
end;
if (tTempMonth > StrToDate(arrCourses[iCourseArrayPointer].getTestDate))
and (I = 1) then
begin
bDrawPastTestDate := true;
iCalendarATestDateXVal := 0;
iCalendarATestDateYVal := 0;
end;
end
else
begin
StringGrid1.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
bDrawPastTestDate := false;
end;
if (tTempMonth < tLastStudyDate) and (I = DaysInMonth(tNewMonthStart)) then
begin
StringGrid1.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
// set at last cell because date to stop colouring is on next stringgrid/month
iCalendarALastStudyDateXVal := 6;
iCalendarALastStudyDateYVal := 6;
end;
if (tTempMonth > tLastStudyDate) and (I = 1) then
begin
StringGrid1.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
// set at last cell because date to stop colouring is on previous month
iCalendarALastStudyDateXVal := 0;
iCalendarALastStudyDateYVal := 0;
end;
if tTempMonth = tLastStudyDate then
begin
StringGrid1.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
iCalendarALastStudyDateXVal := DayOfTheWeek(tTempMonth) - 1;
iCalendarALastStudyDateYVal := iWeekCount;
end;
if (tTempMonth < tFirstStudyDate) and (I = DaysInMonth(tNewMonthStart)) then
begin
StringGrid1.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
// set at last cell because date to stop colouring is on next stringgrid/month
iCalendarAFirstStudyDateXVal := 6;
iCalendarAFirstStudyDateYVal := 6;
end;
if (tTempMonth > tFirstStudyDate) and (I = 1) then
begin
StringGrid1.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
// set at last cell because date to stop colouring is on previous month
iCalendarAFirstStudyDateXVal := 0;
iCalendarAFirstStudyDateYVal := 0;
end;
if tTempMonth = tLastStudyDate then
begin
StringGrid1.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
// set date x and y values to be highlighted
iCalendarAFirstStudyDateXVal := DayOfTheWeek(tTempMonth) - 1;
iCalendarAFirstStudyDateYVal := iWeekCount;
end;
if DayOfTheWeek(tTempMonth) = 7 then
begin
Inc(iWeekCount);
end;
end;
// iMonth1LastXVal := DayOfWeek(IncDay(tNewMonthStart,
// (DaysInMonth(tNewMonthStart) - 1) - 1)) - 1;
// iMonth1LastYVal := iWeekCount;
tCurrentShowMonthStart := tNewMonthStart;
lblMonth1.Caption := LongMonthNames[MonthOf(tCurrentShowMonthStart)];
lblMonth2.Caption := LongMonthNames
[MonthOf(IncMonth(tCurrentShowMonthStart))];
lblYear1.Caption := IntToStr(YearOf(tCurrentShowMonthStart));
lblYear2.Caption := IntToStr(YearOf(IncMonth(tCurrentShowMonthStart)));
// populate fixed row
for I := 0 to StringGrid2.ColCount - 1 do
StringGrid2.Cols[I].Clear;
with StringGrid2 do
begin
Cells[0, 0] := 'Mon';
Cells[1, 0] := 'Tue';
Cells[2, 0] := 'Wed';
Cells[3, 0] := 'Thu';
Cells[4, 0] := 'Fri';
Cells[5, 0] := 'Sat';
Cells[6, 0] := 'Sun';
end;
// increment to month after first stringgrid
tNewMonthStart := IncMonth(tCurrentShowMonthStart, 1);
iWeekCount := 1;
tTempMonth := tNewMonthStart;
for I := 1 to DaysInMonth(tNewMonthStart) do
begin
tTempMonth := IncDay(tNewMonthStart, I - 1);
if arrCourses[iCourseArrayPointer].getTestDate <> 'click here to book' then
begin
if tTempMonth = strToDate(arrCourses[iCourseArrayPointer].getTestDate) then
begin
// save x and y values if test date is on this stringgrid
StringGrid2.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
iCalendarBTestDateXVal := DayOfTheWeek(tTempMonth) - 1;
iCalendarBTestDateYVal := iWeekCount;
bDrawPastTestDate := true;
end
else
begin
// otherwise just populate
StringGrid2.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
end;
if (tTempMonth < StrToDate(arrCourses[iCourseArrayPointer].getTestDate))
and (I = DaysInMonth(tNewMonthStart)) then
begin
// set x and y values to last cell because date to be highlightted is in next month
StringGrid2.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
bDrawPastTestDate := true;
iCalendarBTestDateXVal := 6;
iCalendarBTestDateYVal := 6;
end;
if (tTempMonth > StrToDate(arrCourses[iCourseArrayPointer].getTestDate))
and (I = 1) then
begin
// set x and y values to first because date to be highlightted is in prior month/stringgrid
StringGrid2.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
bDrawPastTestDate := true;
iCalendarBTestDateXVal := 0;
iCalendarBTestDateYVal := 0;
end;
end
else
begin
StringGrid2.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
// otherwise just populate
bDrawPastTestDate := false;
end;
if (tTempMonth < tLastStudyDate) and (I = DaysInMonth(tNewMonthStart)) then
begin
StringGrid2.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
// set x and y values to last cell because last cell to be higlighted is in next month
iCalendarBLastStudyDateXVal := 6;
iCalendarBLastStudyDateYVal := 6;
end;
if (tTempMonth > tLastStudyDate) and (I = 1) then
begin
StringGrid2.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
// set x and y values to last cell because last cell to be higlighted is in prior month/stringgrid
iCalendarBLastStudyDateXVal := 0;
iCalendarBLastStudyDateYVal := 0;
end;
if tTempMonth = tLastStudyDate then
begin
StringGrid2.Cells[DayOfTheWeek(tTempMonth) - 1, iWeekCount] :=
IntToStr(DayOfTheMonth(tTempMonth));
// set x and y values to current cell
iCalendarBLastStudyDateXVal := DayOfTheWeek(tTempMonth) - 1;
iCalendarBLastStudyDateYVal := iWeekCount;
end;
if DayOfTheWeek(tTempMonth) = 7 then
begin
Inc(iWeekCount);
end;
end;
// iMonth2LastXVal := DayOfWeek(IncDay(tNewMonthStart,
// (DaysInMonth(tNewMonthStart) - 1) - 1)) - 1;
// iMonth2LastYVal := iWeekCount;
StringGrid1.refresh;
StringGrid2.refresh;
// ShowMessage(IntToStr(iCal2LastStudyDateXVal));
// ShowMessage(IntToStr(iCal2LastStudyDateYVal));
end;
The next procedure is the OnDrawCell procedure that runs every time something on a string grid changes. It is basically identical for StringGrid1 as StringGrid2, except that wherever a variable is iCalendarB... it would be iCalendarA... for StringGrid1DrawCell().
Read the comments for further explanation on how the cell colouring works. But basically, it uses the x and y values saved by the upDateCalendar() procedure to determine which cells should be highlighted. See the image below for the result.
My issue is that somewhere the OnDrawCell is constantly being called, or something is causing the StringGrids to continuously update.
procedure TStudentDashboard.StringGrid2DrawCell(Sender: TObject;
ACol, ARow: integer; Rect: TRect; State: TGridDrawState);
begin
StringGrid2.Selection := TGridRect(Rect);
// if the cell is not empty or fixed
if (StringGrid2.Cells[ACol, ARow] <> '') and (ARow > 0) then
begin
// if the weekday of the cell corresponds with checkboxes
if (arrWeekDaysSelected[ACol] = true) then
begin
// if the cell has these x and y values make it yellow
if (ACol = iCalendarBLastStudyDateXVal) and
(ARow = iCalendarBLastStudyDateYVal) then
begin
StringGrid2.Canvas.Brush.Color := $008BECFA; // yellow
StringGrid2.Canvas.Font.Name := 'Roboto Lt';
StringGrid2.Canvas.FillRect(Rect);
StringGrid2.Canvas.TextOut(Rect.Left + 3, Rect.Top + 3,
StringGrid2.Cells[ACol, ARow]);
// StringGrid2.Cells[ACol, ARow] := Copy(StringGrid2.Cells[ACol, ARow],1,StringGrid2.Cells[ACol, ARow].Length-1);
end
// only colour the following if the cell has x and y values smaller than i...LastStudyDate..X/Yval
else if (ARow < iCalendarBLastStudyDateYVal) or
((ACol < iCalendarBLastStudyDateXVal) and
(ARow = iCalendarBLastStudyDateYVal)) then
begin
// if the cell has x and y values larger than i...TestDate..X/Yval make red
if (bDrawPastTestDate = true) and
(((ARow >= iCalendarBTestDateYVal) and (ACol > iCalendarBTestDateXVal)
) or (ARow > iCalendarBTestDateYVal)) then
begin
StringGrid2.Canvas.Brush.Color := $00A49FF9; // red
StringGrid2.Canvas.Font.Name := 'Roboto Lt';
StringGrid2.Canvas.FillRect(Rect);
StringGrid2.Canvas.TextOut(Rect.Left + 3, Rect.Top + 3,
StringGrid2.Cells[ACol, ARow]);
end
// otherwise make it green
else
begin
StringGrid2.Canvas.Brush.Color := $00A4F99F; // green
StringGrid2.Canvas.Font.Name := 'Roboto Lt';
StringGrid2.Canvas.FillRect(Rect);
StringGrid2.Canvas.TextOut(Rect.Left + 3, Rect.Top + 3,
StringGrid2.Cells[ACol, ARow]);
end;
end
// otherwise make white
else
begin
StringGrid2.Canvas.Brush.Color := $00F1FFFB;
StringGrid2.Canvas.Font.Name := 'Roboto Lt';
StringGrid2.Canvas.FillRect(Rect);
StringGrid2.Canvas.TextOut(Rect.Left + 3, Rect.Top + 3,
StringGrid2.Cells[ACol, ARow]);
end;
end
// if cell is the test date make blue
else if (ACol = iCalendarBTestDateXVal) and (ARow = iCalendarBTestDateYVal)
then
begin
StringGrid2.Canvas.Brush.Color := $00F9A49F; // blue
StringGrid2.Canvas.Font.Name := 'Roboto Lt';
StringGrid2.Canvas.FillRect(Rect);
StringGrid2.Canvas.TextOut(Rect.Left + 3, Rect.Top + 3,
StringGrid2.Cells[ACol, ARow]);
// StringGrid2.Cells[ACol, ARow] := copy(StringGrid2.Cells[ACol, ARow],1,StringGrid2.Cells[ACol, ARow].Length-1);
bDrawPastTestDate := true;
end
//otherwise make white
else
begin
StringGrid2.Canvas.Brush.Color := $00F1FFFB;
StringGrid2.Canvas.Font.Name := 'Roboto Lt';
StringGrid2.Canvas.FillRect(Rect);
StringGrid2.Canvas.TextOut(Rect.Left + 3, Rect.Top + 3,
StringGrid2.Cells[ACol, ARow]);
end;
end
else if gdFixed in State then
begin
end
//otherwise make white
else if gdSelected in State then
begin
StringGrid2.Canvas.Brush.Color := $00F1FFFB;
StringGrid2.Canvas.Font.Name := 'Roboto Lt';
StringGrid2.Canvas.FillRect(Rect);
StringGrid2.Canvas.TextOut(Rect.Left + 3, Rect.Top + 3,
StringGrid2.Cells[ACol, ARow]);
end
//otherwise make white
else
begin
StringGrid2.Canvas.Brush.Color := $00F1FFFB;
StringGrid2.Canvas.Font.Name := 'Roboto Lt';
StringGrid2.Canvas.FillRect(Rect);
StringGrid2.Canvas.TextOut(Rect.Left + 3, Rect.Top + 3,
StringGrid2.Cells[ACol, ARow]);
end;
end;
My goal is to stop the redraw loop and flickering. The flickering I can easily remove using DoubleBuffered := true, however the event still runs continuously keeping other controls from updated (for example, the CheckBoxes work, but you don't see the tick). I assume that's because of the loop?
