Merge branch 'FixGoogleAPICalendarDemo' into 'main'

Google Calendar API Demo

See merge request freepascal.org/lazarus/lazarus!218

components/googleapis/demo/calendar/calendardemo.lpi

@@ -1,16 +1,16 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="12"/>
     <PathDelim Value="\"/>
     <General>
       <Flags>
         <SaveOnlyProjectUnits Value="True"/>
         <SaveJumpHistory Value="False"/>
         <SaveFoldState Value="False"/>
+        <CompatibilityMode Value="True"/>
       </Flags>
       <SessionStorage Value="InProjectDir"/>
-      <MainUnit Value="0"/>
       <Title Value="calendardemo"/>
       <ResourceType Value="res"/>
       <UseXPManifest Value="True"/>
@@ -18,9 +18,6 @@
     <i18n>
       <EnableI18N LFM="False"/>
     </i18n>
-    <VersionInfo>
-      <StringTable ProductVersion=""/>
-    </VersionInfo>
     <BuildModes Count="2">
       <Item1 Name="Default" Default="True"/>
       <Item2 Name="Debug">
@@ -50,13 +47,12 @@
     </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
     </PublishOptions>
     <RunParams>
-      <local>
-        <FormatVersion Value="1"/>
-      </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default"/>
+      </Modes>
     </RunParams>
     <RequiredPackages Count="3">
       <Item1>
@@ -95,7 +91,7 @@
     </Target>
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="C:\Documents and Settings\Ludo\Mes documents\Borland Studio Projects\ODBCHTTP\synapse\source\libsvn;.."/>
+      <OtherUnitFiles Value="C:\Documents and Settings\Ludo\Mes documents\Borland Studio Projects\ODBCHTTP\synapse\source\libsvn\;.."/>
       <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>
     <CodeGeneration>

components/googleapis/demo/calendar/frmmain.lfm

@@ -2,13 +2,13 @@ object MainForm: TMainForm
   Left = 456
   Height = 388
   Top = 191
-  Width = 666
+  Width = 1240
   Caption = 'Calendar Demo'
   ClientHeight = 388
-  ClientWidth = 666
+  ClientWidth = 1240
   OnCreate = FormCreate
   OnDestroy = FormDestroy
-  LCLVersion = '1.5'
+  LCLVersion = '2.2.4.0'
   object BFetchCalendars: TButton
     Left = 8
     Height = 25
@@ -22,11 +22,11 @@ object MainForm: TMainForm
     Left = 0
     Height = 80
     Top = 308
-    Width = 666
+    Width = 1240
     Align = alBottom
     Caption = 'Please provide Google API access code'
     ClientHeight = 52
-    ClientWidth = 662
+    ClientWidth = 1236
     TabOrder = 1
     Visible = False
     object LEAccess: TLabel
@@ -38,7 +38,7 @@ object MainForm: TMainForm
       ParentColor = False
     end
     object BSetAccess: TButton
-      Left = 490
+      Left = 1064
       Height = 25
       Top = 9
       Width = 75
@@ -48,7 +48,7 @@ object MainForm: TMainForm
       TabOrder = 0
     end
     object BCancel: TButton
-      Left = 570
+      Left = 1144
       Height = 25
       Top = 8
       Width = 75
@@ -61,13 +61,13 @@ object MainForm: TMainForm
       Left = 112
       Height = 18
       Top = 8
-      Width = 362
+      Width = 936
       Anchors = [akTop, akLeft, akRight]
       TabOrder = 2
     end
   end
   object BFetchEvents: TButton
-    Left = 548
+    Left = 1122
     Height = 25
     Top = 8
     Width = 96
@@ -87,18 +87,6 @@ object MainForm: TMainForm
     OnSelectionChange = LBCalendarsSelectionChange
     ScrollWidth = 308
     TabOrder = 3
-    TopIndex = -1
-  end
-  object LBEvents: TListBox
-    Left = 328
-    Height = 249
-    Top = 40
-    Width = 324
-    Anchors = [akTop, akLeft, akRight, akBottom]
-    ItemHeight = 0
-    ScrollWidth = 320
-    TabOrder = 4
-    TopIndex = -1
   end
   object LEvents: TLabel
     Left = 328
@@ -110,4 +98,39 @@ object MainForm: TMainForm
     Caption = 'Events for calendar : <select a calendar>'
     ParentColor = False
   end
+  object SGEvents: TStringGrid
+    Left = 326
+    Height = 248
+    Top = 40
+    Width = 892
+    Anchors = [akTop, akLeft, akBottom]
+    FixedCols = 0
+    RowCount = 1
+    TabOrder = 4
+    ColWidths = (
+      64
+      108
+      108
+      493
+      112
+    )
+    Cells = (
+      5
+      0
+      0
+      'ID'
+      1
+      0
+      'Start Date/Time'
+      2
+      0
+      'End Date/Time'
+      3
+      0
+      'Description'
+      4
+      0
+      'TimeStamp'
+    )
+  end
 end

components/googleapis/demo/calendar/frmmain.pp

@@ -14,7 +14,8 @@ interface
 
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  synautil, IniFiles, googlebase, googleservice, googleclient, googlecalendar;
+  Grids, synautil, IniFiles, googlebase, googleservice, googleclient,
+  googlecalendar, opensslsockets;
 
 type
 
@@ -31,7 +32,7 @@ type
     LEvents: TLabel;
     LEAccess: TLabel;
     LBCalendars: TListBox;
-    LBEvents: TListBox;
+    SGEvents: TStringGrid;
     procedure BCancelClick(Sender: TObject);
     procedure BFetchEventsClick(Sender: TObject);
     procedure BSetAccessClick(Sender: TObject);
@@ -122,7 +123,7 @@ begin
   else
     begin
     LEvents.Caption:='Events for calendar : <select a calendar>';
-    LBEvents.Items.Clear;
+    SGEvents.RowCount:=1;
     FCurrentCalendar:=Nil;
     end;
 
@@ -235,31 +236,68 @@ var
   Entry: TEvent;
   EN : String;
   i:integer;
+  pageToken: String;
+  SD, ED, TS: String; //Startdate, Enddate, Timestamp
+
+  function prepareDate(EVDate: TEventDateTime):String;
+  begin
+     if EVDate.date<>0 then
+       prepareDate:=DateToStr(EVDate.date)
+     else if EVDate.dateTime<>0 then
+       prepareDate:=DateTimeToStr(EVDate.datetime)
+     else
+       prepareDate:='(unspecified)';
+  end;
+
+  function prepareTS(EVDate: TEventDateTime):String;
+  begin
+     if EVDate.date<>0 then
+       prepareTS:=Format('%.*d',[12,TimeStampToMSecs(DateTimeToTimeStamp(EVDate.date)) div 1000])
+     else if EVDate.dateTime<>0 then
+       prepareTS:=Format('%.*d',[12,TimeStampToMSecs(DateTimeToTimeStamp(EVDate.dateTime)) div 1000])
+     else
+       prepareTS:='(unspecified)';
+  end;
+
 
 begin
   if LBCalendars.ItemIndex<0 then
-    Exit;
-  LBEvents.Items.Clear;
+     Exit;
+  BFetchEvents.Enabled:=False;
+  MainForm.Cursor:=crHourGlass;
+
+  SGEvents.RowCount:=1;
   FreeAndNil(Events);
-  Events:=FCalendarAPI.EventsResource.list(FCurrentCalendar.id,'');
   SaveRefreshToken;
   I:=0;
-  if assigned(Events) then
-    for Entry in Events.items do
-      begin
-      Inc(i);
-      EN:=Entry.Summary;
-      if EN='' then
-        EN:=Entry.id+' ('+Entry.description+')';
-      if Assigned(Entry.Start) then
-        if Entry.start.date<>0 then
-          EN:=DateToStr(Entry.start.date)+' : '+EN
-        else if Entry.start.dateTime<>0 then
-          EN:=DateTimeToStr(Entry.start.datetime)+' : '+EN
-        else
-          EN:='(unspecified time) '+EN;
-      LBEvents.Items.AddObject(IntToStr(i)+': '+EN,Entry);
+  pageToken := '';
+  repeat
+     SD:='(unspecified)';
+     ED:='(unspecified)';
+     TS:='(unspecified)';
+     Events:=FCalendarAPI.EventsResource.list(FCurrentCalendar.id,'pageToken='+pageToken);
+     if assigned(Events) then begin
+       pageToken:=Events.nextPageToken;
+       for Entry in Events.items do
+        begin
+        Inc(i);
+        if Assigned(Entry.start) then begin
+          SD:=prepareDate(Entry.start);
+          TS:=prepareTS(Entry.start);
+        end;
+
+        if Assigned(Entry._end) then
+          ED:=prepareDate(Entry._end);
+
+
+        SGEvents.InsertRowWithValues(SGEvents.RowCount,[IntToStr(i),SD,ED,Entry.Summary,TS]);
       end;
+      Application.ProcessMessages;
+    end;
+  until (not assigned(Events)) or (pageToken='');
+  SGEvents.SortColRow(True,4);
+  MainForm.Cursor:=crDefault;
+  BFetchEvents.Enabled:=True;
 end;
 
 Procedure TMainForm.DoUserConsent(Const AURL: String; Out AAuthCode: String);