How to Show images in ListView depends on the date - delphi

I'm Using Delphi Sydney 10.4 FMX, I have a ListView connected to a Database with liveBinding, ImageList that has 3 images.
In the ListView, I Have 3 Fields: Image, Expiry, Domain.
The Expiry and Domain are filled from the Database, but the image I want to show depends on the date, example :
Expiry = date of today or before today: I want to show imageindex 0
Expiry = from Tomorrow until 30 days from Today: I want to show imageindex 1
Expiry = 31 Days Later from today: I want to show imageindex 2
procedure TForm1.DomainsListViewUpdateObjects(const Sender: TObject;
const AItem: TListViewItem);
begin
var DT : TDateTime;
DT := Now;
if DomainsListView.Items[DomainsListView.ItemIndex].Data['expiry'].AsString < datetostr(DT+30) then
DomainsListView.Items[DomainsListView.ItemIndex].Data['image'] := 1
else if DomainsListView.Items[DomainsListView.ItemIndex].Data['expiry'].AsString < DateToStr(DT) then
DomainsListView.Items[DomainsListView.ItemIndex].Data['image'] := 0
else if DomainsListView.Items[DomainsListView.ItemIndex].Data['expiry'].AsString > DateToStr(DT+31) then
DomainsListView.Items[DomainsListView.ItemIndex].Data['image'] := 2
end;
I used this code, but does not works correctly

You are comparing String values, which doesn't work to compare dates. You should be comparing TDateTime values instead, as well as paying more attention to the order of your comparisons.
Try something more like this instead:
uses
..., System.SysUtils, System.DateUtils;
procedure TForm1.DomainsListViewUpdateObjects(const Sender: TObject;
const AItem: TListViewItem);
begin
var Item: TListViewItem := DomainsListView.Items[DomainsListView.ItemIndex]; // or: DomainsListView.Selected
var dtToday: TDateTime := System.DateUtils.Today;
var dtExpiry: TDateTime := System.SysUtils.StrToDate(Item.Data['expiry'].AsString);
if dtExpiry <= dtToday then
Item.Data['image'] := 0
else if dtExpiry < (dtToday+31) then
Item.Data['image'] := 1
else
Item.Data['image'] := 2;
end;

Related

Is there a way to call a StringGrid OnCellDraw during runtime

I have a program that tracks the days during the year which are booked. In order to display this I have a StringGrid which I use Colors to display the days booked. The days booked are stored in ar2Booking which is a 2D array which contains the days and months respectively.
procedure TfrmClient.stgYearPlan1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
k, iMonth, iDay : Integer;
begin
for k := 1 to 31 do
stgYearPlan1.Cells[k,0] := IntToStr(k);
for k := 1 to 12 do
stgYearPlan1.Cells[0,k] := ShortMonthNames[k];
for iDay := 1 to 31 do
for iMonth := 1 to 12 do
begin
if ar2Booking[iDay,iMonth] = 'Y' then
begin
if (ACol = iDay) and (ARow = iMonth) then
begin
stgYearPlan1.Canvas.Brush.Color := clBlack;
stgYearPlan1.Canvas.FillRect(Rect);
stgYearPlan1.Canvas.TextOut(Rect.Left,Rect.Top,stgYearPlan1.Cells[ACol, ARow]);
end;
end;
if ar2Booking[iDay,iMonth] = 'D' then
begin
if (ACol = iDay) and (ARow = iMonth) then
begin
stgYearPlan1.Canvas.Brush.Color := clSilver;
stgYearPlan1.Canvas.FillRect(Rect);
stgYearPlan1.Canvas.TextOut(Rect.Left+2,Rect.Top+2,stgYearPlan1.Cells[ACol, ARow]);
end;
end;
end;
end;
I then want to click a button during runtime which allows a user to book a date. I would then like the date they select to reflect in the StringGrid. If I update the array how would I be able to run the OnCellDraw again in order to reflect the new booked dates?
Thanks
Generally you would invalidate part of the control causing it to be redrawn with the next windows paint message. The methods of a TStringGrid to do this are protected so you need to use a cracker class to access them.
// -- add to the type section
type
TStringGridCracker = class(TStringGrid);
procedure TForm1.Button1Click(Sender: TObject);
begin
TStringGridCracker(StringGrid1).InvalidateCell(1,2);
end;
I discovered after a friend showed me, the StringGrid.Redraw procedure accomplishes what I need. Thanks everyone

How to get the year when bolding month days in a TMonthCalendar?

I have a log that use the Calendar and I want to bold the days that have recorded info. I have them in an 3D array TDiaryLog = array[1900..2399] of array[1..12] of array[1..31] of POneDay;. But in the OnGetMonthInfo, when I must build the list with the bold days, it gives me only the Month, and not the Year. How should I know for what month I must pass the day if I don't have the year ? When December is displayed as the current month in the Calendar, there are a few days shown from the January next year !
procedure TMainForm.CalendarGetMonthInfo(Sender: TObject; Month: Cardinal;
var MonthBoldInfo: Cardinal);
begin
end;
I made a new component where I intercepted the MCN_GETDAYSTATE message and I extracted the year too from the message info... It was there all the time, but Delphi decided that year is not useful.
TOnGetMonthInfoExEvent = procedure(Sender: TObject; Year, Month: Word;
var MonthBoldInfo: LongWord) of object;
TNewMonthCalendar = class(TMonthCalendar)
private
FOnGetMonthInfoEx: TOnGetMonthInfoExEvent;
procedure CNNotify(var Msg: TWMNotifyMC); message CN_NOTIFY;
published
property OnGetMonthInfoEx: TOnGetMonthInfoExEvent read FOnGetMonthInfoEx write FOnGetMonthInfoEx;
end;
procedure TNewMonthCalendar.CNNotify(var Msg: TWMNotifyMC);
var
I: Integer;
Month, Year: Word;
DS: PNMDayState;
CurState: PMonthDayState;
begin
if (Msg.NMHdr.code = MCN_GETDAYSTATE) and Assigned(FOnGetMonthInfoEx) then begin
DS:= Msg.NMDayState;
FillChar(DS.prgDayState^, DS.cDayState * SizeOf(TMonthDayState), 0);
CurState:= DS.prgDayState;
for I:= 0 to DS.cDayState - 1 do begin
Year:= DS.stStart.wYear;
Month:= DS.stStart.wMonth + I;
if Month > 12 then begin Inc(Year); Dec(Month, 12); end;
FOnGetMonthInfoEx(Self, Year, Month, CurState^);
Inc(CurState);
end;
end
else inherited;
end;
BONUS
And, as a bonus, you need this to update the changes you made to the bold info of the current month view... because it doesn't work with Invalidate.
procedure TNewMonthCalendar.RefreshDayState;
var N: Cardinal;
Range: array[0..1] of TSystemTime;
Year, Month: Word;
States: array of TMonthDayState;
I: Integer;
begin
if not Assigned(FOnGetMonthInfoEx) then Exit;
N:= SendMessage(Handle, MCM_GETMONTHRANGE, GMR_DAYSTATE, LPARAM(#Range));
Year:= Range[0].wYear;
Month:= Range[0].wMonth;
SetLength(States, N);
FillChar(States[0], N * SizeOf(TMonthDayState), 0);
for I:= 0 to N-1 do begin
FOnGetMonthInfoEx(Self, Year, Month, States[I]);
Inc(Month);
if Month > 12 then
begin Dec(Month, 12); Inc(Year); end;
end;
SendMessage(Handle, MCM_SETDAYSTATE, N, LPARAM(#States[0]));
end;

delphi get hour&minutes difference in specific format

Was playing with dateutils and did some experimenting.
procedure TForm1.Button1Click(Sender: TObject);
var
fromDate, toDate : TDateTime;
begin
fromDate := cxDateEdit1.Date ;
toDate := cxDateEdit2.Date ;
Label1.Caption := 'Hour difference '+IntToStr(HoursBetween(toDate, fromDate))+' hours';
Label2.Caption := 'Minute difference '+IntToStr(MinutesBetween(toDate, fromDate))+' minutes';
end;
How can I get a time difference result in a label caption like hh/mm (example 01:05) ???
A TDateTime is intended to be used with absolute dates and times. Instead you might consider TTimeSpan from the System.TimeSpan unit.
uses
System.TimeSpan;
....
var
d1, d2: TDateTime;
Span: TTimeSpan;
str: string;
....
d1 := ...;
d2 := ...;
Span := TTimeSpan.Subtract(d2, d1);
str := Format('%.2d:%.2d', [Span.Hours, Span.Minutes]));
This assumes that the span is less than a day. But then the format of your output seems to build in that very assumption.
Whether or not this is really any better than simply subtracting two date time values I am not so sure.
SysUtils.FormatDateTime has many useful TDateTime to string conversions:
Label3.Caption := 'Time difference [hh:mm] '+FormatDateTime('hh:nn',toDate-fromDate);
As an alternative, use the result from MinutesBetween:
var
minutes: Integer;
...
minutes := MinutesBetween(toDate,FromDate);
Label3.Caption :=
'Time difference [hh:mm] '+Format('%.2d:%.2d',[minutes div 60,minutes mod 60]);

Free Pascal use for loop to determine visibility of component based on status of Date Component

My form contains some components whose naming follows a simple convention...
date1, date2, date3, date4, date5
check1, check2, check3, check4, check5
I need to be able to determine the visibility of the checkboxes based on the contents of the date fields, i.e. if a date is returned then the checkbox should be visible.
I'm trying to do this with the following code and everything compiles, but I'm failing to target the components, presumably because its trying to alter the variable rather than the component. Am I going about this in completely the wrong way?
var
dateVar : variant;
checkVar : variant;
x : integer;
// Set visibility of checkboxes and docs
x := 0;
dateVar := 'area.Date' + IntToStr(x);
checkVar := 'area.Check' + IntToStr(x);
for x:=1 to 5 do
begin
if dateVar > '00:00:00' then // Does FPC support the != or not equal to context?
checkVar.Visibility := False
else
checkVar.Visibility := True;
end;
You can iterate over the components via FindComponent. In the example below Self as the Form is given as Owner.
Procedure SetChecks(AOwner:TComponent);
var
x:Integer;
begin
for x:=1 to 5 do
TCheckBox(AOwner.FindComponent('check' + IntToStr(x))).Visible :=
TDateEdit(AOwner.FindComponent('date' + IntToStr(x))).Date <>StrToDateTime('00:00:00');
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetChecks(Self);
end;

Delphi - What object (multidimensional array, etc) will work?

I have a need to keep the top ten values in sorted order. My data structure is:
TMyRecord = record
Number: Integer;
Value: Float;
end
I will be calculating a bunch of float values. I need to keep the top 10 float values. Each value has an associated number. I want to add "sets"... If my float Value is higher than one of the top 10, it should add itself to the list, and then the "old" number 10, now 11, gets discarded. I should be able to access the list in (float value) sorted order...
It is almost like a TStringList, which maintains sorted order....
Is there anything like this already built into Delphi 2010?
You can use a combination of the generic list Generics.Collections.TList<TMyRecord> and insertion sort.
Your data structure is like this
TMyRecord = record
Number: Integer;
Value: Float;
end;
var
Top10: TList<TMyRecord>;
You'll need to use Generics.Collections to get the generic list.
Instantiate it like this:
Top10 := TList<TMyRecord>.Create;
Use this function to add to the list:
procedure Add(const Item: TMyRecord);
var
i: Integer;
begin
for i := 0 to Top10.Count-1 do
if Item.Value>Top10[i].Value then
begin
Top10.Insert(i, Item);
Top10.Count := Min(10, Top10.Count);
exit;
end;
if Top10.Count<10 then
Top10.Add(Item);
end;
This is a simple implementation of insertion sort. The key to making this algorithm work is to make sure the list is always ordered.
David's answer is great, but I think as you progress through the data, you'll fill the list pretty fast, and the odds of having a value greater than what's already in the list probably decreases over time.
So, for performance, I think you could add this line before the for loop to quickly discard values that don't make it into the top 10:
if (Item.Value <= Top10[Top10.Count - 1].Value) and (Top10.Count = 10) then
Exit;
If the floats are always going to be above a certain threshold, it might make sense to initialize the array with 10 place-holding records with values below the threshold just so you could change the first line to this:
if (Item.Value <= Top10[9].Value) then
Exit;
And improve the method to this:
procedure Add(const Item: TMyRecord);
var
i: Integer;
begin
// Throw it out if it's not bigger than our smallest top10
if (Item.Value <= Top10[9].Value) then
Exit;
// Start at the bottom, since it's more likely
for i := 9 downto 1 do
if Item.Value <= Top10[i - 1].Value then
begin
// We found our spot
Top10.Insert(i, Item);
// We're always setting it to 10 now
Top10.Count := 10;
// We're done
Exit;
end;
// Welcome, leader!
Top10.Insert(0, Item);
// We're always setting it to 10 now
Top10.Count := 10;
end;
Since you are working with a fixed number of items, you could use a plain TMyRecord array, eg:
type
TMyRecord = record
Number: Integer;
Value: Float;
end;
const
MaxRecordsInTopTen = 10;
var
TopTen: array[0..MaxRecordsInTopTen-1] of TMyRecord;
NumRecordsInTopTen: Integer = 0;
procedure CheckValueForTopTen(Value: Float; Number: Integer);
var
I, J, NumToMove: Integer;
begin
// see if the new Value is higher than an value already in the list
for I := 0 to (NumRecordsInTopTen-1) do
begin
if Value > TopTen[I].Value then
begin
// new Value is higher then this value, insert before
// it, moving the following values down a slot, and
// discarding the last value if the list is full
if NumRecordsInTopTen < MaxRecordsInTopTen then
NumToMove := NumRecordsInTopTen - I
else
NumToMove := MaxRecordsInTopTen - I - 1;
for J := 1 to NumToMove do
Move(TopTen[NumRecordsInTopTen-J], TopTen[NumRecordsInTopTen-J-1], SizeOf(TMyRecord));
// insert the new value now
TopTen[I].Number := Number;
TopTen[I].Value := Value;
NumRecordsInTopTen := Min(NumRecordsInTopTen+1, MaxRecordsInTopTen);
// all done
Exit;
end;
end;
// new value is lower then existing values,
// insert at the end of the list if room
if NumRecordsInTopTen < MaxRecordsInTopTen then
begin
TopTen[NumRecordsInTopTen].Number := Number;
TopTen[NumRecordsInTopTen].Value := Value;
Inc(NumRecordsInTopTen);
end;
end;
I wouldn't bother with anything other than straight Object Pascal.
{$APPTYPE CONSOLE}
program test2; uses sysutils, windows;
const
MAX_VALUE = $7FFF;
RANDNUMCOUNT = 1000;
var
topten: array[1..10] of Longint;
i, j: integer;
Value: Longint;
begin
randomize;
FillChar(topten, Sizeof(topten), 0);
for i := 1 to RANDNUMCOUNT do
begin
Value := Random(MAX_VALUE);
j := 1;
while j <= 10 do
begin
if Value > topten[j] then
begin
Move(topten[j], topten[j+1], SizeOf(Longint) * (10-j));
topten[j] := Value;
break;
end;
inc(j);
end;
end;
writeln('Top ten numbers generated were: ');
for j := 1 to 10 do
writeln(j:2, ': ', topten[j]);
readln;
end.

Resources