unit VpImportPreview_ICalEvent; {$mode objfpc}{$H+} interface uses LCLVersion, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, VpData, VpBaseDS, VpImportPreview, VpICal, Grids, StdCtrls, Spin; type { TVpImportPreviewICalEventForm } TVpImportPreviewICalEventForm = class(TVpImportPreviewForm) lblOpenEndDuration: TLabel; rbOpenEndDuration30mins: TRadioButton; rbOpenEndDuration1Hr: TRadioButton; rbOpenEndDuration2Hrs: TRadioButton; rbOpenEndDuration4Hrs: TRadioButton; procedure btnExecuteClick(Sender: TObject); procedure FormActivate(Sender: TObject); procedure GridGetEditText(Sender: TObject; {%H-}ACol, {%H-}ARow: Integer; var Value: string); procedure GridSetEditText(Sender: TObject; {%H-}ACol, {%H-}ARow: Integer; const Value: string); private FActivated: Boolean; FCalendar: TVpICalendar; FDefaultCategory: String; FTimeFormat: String; function GetEventText(AEvent: TVpICalEvent): String; procedure SetCalendar(const AValue: TVpICalendar); {$IF LCL_FullVersion >= 3000000} private FCanCloseTaskDialog: Boolean; procedure OpenEndEventsDialog; procedure OpenendEventsDialogButtonClicked(Sender: TObject; AModalResult: TModalResult; var ACanClose: Boolean); procedure OpenEndEventsDialogRadioButtonClicked(Sender: TObject); {$ENDIF} protected function GetCellText(ACol, ARow: Integer): String; override; procedure PrepareItems; override; public constructor Create(AOwner: TComponent); override; procedure CheckItem(ARow: Integer; AChecked: Boolean); override; function IsChecked(ARow: Integer): Boolean; override; property Calendar: TVpICalendar read FCalendar write SetCalendar; property DefaultCategory: String read FDefaultCategory write FDefaultCategory; end; var VpImportPreviewICalEventForm: TVpImportPreviewICalEventForm; implementation {$R *.lfm} uses VpSR, VpConst; constructor TVPImportPreviewICalEventForm.Create(AOwner: TComponent); begin inherited; Grid.OnGetEditText := @GridGetEditText; Grid.OnSetEditText := @GridSetEditText; Caption := RSImportICalEvent; lblOpenEndDuration.Caption := RSOpenEndEventsDurationLbl; rbOpenEndDuration30mins.Caption := RS30Minutes; rbOpenEndDuration1Hr.Caption := RS1Hour; rbOpenEndDuration2Hrs.Caption := RS2Hours; rbOpenEndDuration4Hrs.Caption := RS4Hours; FTimeFormat := 'c'; // short date + long time format end; procedure TVpImportPreviewICalEventForm.CheckItem(ARow: Integer; AChecked: Boolean); var item: TVpICalEntry; begin if ARow < Grid.FixedRows then exit; item := TVpICalEntry(FItems[ARow - Grid.FixedRows]); if item <> nil then begin item.Checked := AChecked; inherited; end; end; function TVpImportPreviewICalEventForm.GetCellText(ACol, ARow: Integer): String; var event: TVpICalEvent; begin Result := ''; if (ARow >= Grid.FixedRows) then begin event := TVpICalEvent(FItems[ARow - Grid.FixedRows]); if event <> nil then case ACol of 1: Result := GetEventText(event); 2: Result := Grid.Columns[2].PickList[event.PickedCategory]; end; end; end; function TVpImportPreviewICalEventForm.GetEventText(AEvent: TVpICalEvent): String; var startTime, endTime: TDateTime; sStartTime, sEndTime: String; nDays: Integer; advTime: Integer; advTimeUnits: TVpAlarmAdvType; dingPath: String; s: String; cat: String; begin startTime := AEvent.StartTime[false]; endTime := AEvent.EndTime[false]; sStartTime := FormatDateTime(FTimeFormat, startTime); if endTime = NO_DATE then sEndTime := '' else sEndTime := FormatDateTime(FTimeFormat, endTime - OneSecond); if AEvent.IsAllDayEvent then begin if endTime = NO_DATE then nDays := 1 else nDays := round(endTime - startTime); if nDays in [0, 1] then Result := Format('%s (%s)', [sStartTime, RSAllDay]) else Result := Format('%s - %s (%s)', [sStartTime, sEndTime, RSAllDay]); Result := Result + ' (all day)'; end else Result := RSStartTimeLbl + ' ' + sStartTime + LineEnding + RSEndTimeLbl + ' ' + sEndTime; Result := Result + LineEnding + RSDescriptionLbl + ' ' + AEvent.Summary; // Categories if Assigned(Datastore) then begin cat := AEvent.Categories.CommaText; if cat = '' then cat := RSNoneStr; Result := Result + LineEnding + RSCategoryLbl + ' ' + cat; end; // Recurrence if AEvent.RecurrenceFrequency <> '' then begin s := ''; case Uppercase(AEvent.RecurrenceFrequency) of 'YEARLY': if AEvent.RecurrenceInterval in [0, 1] then s := Format(RSYearlyOn, [FormatDateTime('dd/mm',startTime)]) else s := Format(RSEveryYearsOn, [AEvent.RecurrenceInterval, FormatDateTime('dd/mm', startTime)]); 'MONTHLY': if AEvent.RecurrenceInterval in [0, 1] then s := Format(RSMonthlyOn, [FormatDateTime('d', startTime)]) else s := Format(RSEveryMonthsOn, [AEvent.RecurrenceInterval, FormatDateTime('d', startTime)]); 'WEEKLY': if AEvent.RecurrenceInterval in [0, 1] then s := Format(RSWeeklyOn, [FormatDateTime('dddd',startTime)]) else s := Format(RSEveryWeeksOn, [AEvent.RecurrenceInterval, FormatDateTime('ddd', startTime)]); 'DAILY': if AEvent.RecurrenceInterval in [0, 1] then s := RSDaily else s := Format(RSEveryDays, [AEvent.RecurrenceInterval]); end; if s <> '' then Result := Result + LineEnding + RSRepeat + ' ' + s; end; // Alarm if AEvent.Alarm <> nil then begin TVpEvent.GetAlarmParams(AEvent.Alarm.Trigger, advTime, advTimeUnits); dingPath := AEvent.Alarm.AudioSrc; if advTime <> 1 then begin case advTimeUnits of atMinutes: s := Format(RSXMinutes, [advTime]); atHours: s := Format(RSXHours, [advTime]); atDays: s := Format(RSXDays, [advTime]); end; s := Format(RSAlarmIn, [s]); end else case advTimeUnits of atMinutes: s := Format(RSAlarmIn, [RS1Minute]); atHours: s := Format(RSAlarmIn, [RS1Hour]); atDays: s := Format(RSAlarmIn, [RS1Day]); end; Result := Result + LineEnding + s; if FileExists(dingPath) then Result := Format('%s, %s: %s', [Result, RSSound, dingPath]); end else Result := Result + LineEnding + RSNoAlarm; end; procedure TVpImportPreviewICalEventForm.GridGetEditText(Sender: TObject; ACol, ARow: Integer; var Value: string); var event: TVpICalEvent; begin event := TVpICalEvent(FItems[Grid.Row - Grid.FixedRows]); if event <> nil then Value := Grid.Columns[2].PickList[event.PickedCategory]; end; procedure TVpImportPreviewICalEventForm.btnExecuteClick(Sender: TObject); begin if FCalendar.ContainsOpenEndEvents then begin {$IF LCL_FullVersion >= 3000000} OpenEndEventsDialog; {$ELSE} if not (rbOpenEndDuration30mins.Checked or rbOpenEndDuration1Hr.Checked or rbOpenEndDuration2Hrs.Checked or rbOpenEndDuration4Hrs.Checked) then begin MessageDlg(RSDurationForOpenEndEvents, mtInformation, [mbOK], 0); ModalResult := mrNone; exit; end; if rbOpenEndDuration30mins.Checked then FCalendar.FixOpenEndEvents(0.5/24) else if rbOpenEndDuration1Hr.Checked then FCalendar.FixOpenEndEvents(1.0/24) else if rbOpenEndDuration2Hrs.Checked then FCalendar.FixOpenEndEvents(2.0/24) else if rbOpenEndDuration4Hrs.Checked then FCalendar.FixOpenEndEvents(4.0/24); {$IFEND} end; end; procedure TVpImportPreviewICalEventForm.FormActivate(Sender: TObject); var x1: Integer = 0; x2: Integer; begin if not FActivated then begin FActivated := true; {$IF LCL_FullVersion < 3000000} // This part is only seen without Taskdialog x1 := rbOpenEndDuration4Hrs.Left + rbOpenEndDuration4Hrs.Width; {$IFEND} x2 := ClientWidth - btnExecute.Left + btnExecute.BorderSpacing.Left; Constraints.MinWidth := x1 + x2; if Width < Constraints.MinWidth then Width := 0; end; end; procedure TVpImportPreviewICalEventForm.GridSetEditText(Sender: TObject; ACol, ARow: Integer; const Value: string); var event: TVpICalEvent; begin event := TVpICalEvent(FItems[Grid.Row - Grid.FixedRows]); if event <> nil then event.PickedCategory := Grid.Columns[2].PickList.IndexOf(Value);; end; function TVpImportPreviewICalEventForm.IsChecked(ARow: Integer): Boolean; var item: TVpICalEntry; begin Result := false; if ARow < Grid.FixedRows then exit; item := TVpICalEntry(FItems[ARow - Grid.FixedRows]); if (item <> nil) then Result := item.Checked; end; {$IF LCL_FullVersion >= 3000000} procedure TVpImportPreviewICalEventForm.OpenendEventsDialog; const DURATIONS: array[0..3] of Double = (0.5/24, 1.0/24, 2.0/24, 4.0/24); var dlg: TTaskDialog; begin dlg := TTaskDialog.Create(nil); try dlg.Caption := RSImportICalendarEvents; dlg.Title := RSOpenEndEvents; dlg.Text := RSDurationForOpenEndEvents; dlg.RadioButtons.Add.Caption := RSHalfAnHour; dlg.RadioButtons.Add.Caption := RSOneHour; dlg.RadioButtons.Add.Caption := RSTwoHours; dlg.RadioButtons.Add.Caption := RSFourHours; dlg.OnButtonClicked := @OpenEndEventsDialogButtonClicked; dlg.OnRadioButtonClicked := @OpenEndEventsDialogRadioButtonClicked; dlg.Flags := dlg.Flags + [tfNoDefaultRadioButton]; dlg.Execute; if dlg.ModalResult = mrOK then FCalendar.FixOpenEndEvents(DURATIONS[dlg.RadioButton.Index]); finally dlg.Free; end; end; procedure TVpImportPreviewICalEventForm.OpenendEventsDialogButtonClicked( Sender: TObject; AModalResult: TModalResult; var ACanClose: Boolean); var i: Integer; begin if AModalResult = mrCancel then exit; with TTaskDialog(Sender) do ACanClose := FCanCloseTaskDialog; if not ACanClose then MessageDlg(RSNoEventDurationSelected, mtError, [mbOK], 0); end; procedure TVpImportPreviewICalEventForm.OpenEndEventsDialogRadioButtonClicked(Sender: TObject); begin FCanCloseTaskDialog := true; end; {$ENDIF} procedure TVpImportPreviewICalEventForm.PrepareItems; var i: Integer; L: TStrings; event: TVpICalEvent; cat: String; begin Grid.Columns[1].Title.Caption := RSEventItems; Grid.Columns[2].Title.Caption := RSAssignedCategory; // Populate picklist in column 2 L := TStringList.Create; try for i := 0 to 9 do L.Add(Datastore.CategoryColorMap.GetName(i)); Grid.Columns[2].PickList.Assign(L); finally L.Free; end; FItems.Clear; if (FCalendar <> nil) and (Datastore <> nil) then begin for i := 0 to FCalendar.Count-1 do if (FCalendar.Entry[i] is TVpICalEvent) then begin // Add ical event event := TVpIcalEvent(FCalendar.Entry[i]); FItems.Add(event); // Select best category in picklist column cat := Datastore.FindBestEventCategory(event.Categories); if cat = '' then cat := FDefaultCategory; if cat <> '' then event.PickedCategory := Grid.Columns[2].PickList.IndexOf(cat) else event.PickedCategory := 0; end; {$IF LCL_FullVersion < 3000000} lblOpenEndDuration.Visible := FCalendar.ContainsOpenEndEvents; rbOpenEndDuration30mins.Visible := lblOpenEndDuration.Visible; rbOpenEndDuration1Hr.Visible := lblOpenEndDuration.Visible; rbOpenEndDuration2Hrs.Visible := lblOpenEndDuration.Visible; rbOpenEndDuration4Hrs.Visible := lblOpenEndDuration.Visible; {$IFEND} end; inherited; end; procedure TVpImportPreviewICalEventForm.SetCalendar(const AValue: TVpICalendar); begin if AValue <> FCalendar then begin FCalendar := AValue; PrepareItems; end; end; end.