Blog
All Blog Posts | Next Post | Previous PostA single-source TV-guide for 6 operating systems
Wednesday, April 6, 2016
Introduction
With the first release of our brand new TMS FNC UI Pack we are venturing into a new way of designing and creating components. A way that allows developers to easily switch between 3 frameworks (FMX, VCL and LCL). As the TMS FNC UI Pack targets these three frameworks it automatically comes with support for a multitude of operating systems. As we wanted to take "easily switching between 3 frameworks" to the test we have created a TV-guide application that uses the planner component, parses JSON retrieved with our TMS Cloud Components and made it running on 6! major operating systems: Windows 10, Mac OS X Yosemite, iOS 9.0, Android Lollipop, Ubuntu and Raspbian.
Click image for more screenshots.
Cross-platform, cross-framework code
Creating our business logic
After installing the TMS FNC UI Pack the TTMSFNCPlanner component is available on FMX, VCL and LCL and we are ready to start developing applications. Now, to start using it, it would be wise to think a few moments on how to write an application that is running on multiple frameworks, multiple operating systems. If we want to start with VCL and want to move to FMX in a couple of months, it would not be very resource and time friendly to write an application that does not use the power of FNC. Therefore we want to create a single source universal business logic unit that will be used in three different projects, one for every framework. To create a single source unit and use it in different projects, which is compatible with FMX, VCL and LCL we need to add a conditional define to our project to identify each framework, if only because unit names for FNC components must be different (requirement in the Delphi IDE hosting both FMX & VCL).To initialize the planner and retrieving data from our service, we start by adding a TTVGuideLogic class that is instantiated in each separate project main form unit and contains the business logic for the app.
TTVGuideLogic = class private FPlanner: TTMSFNCPlanner; FChannels: TTVChannels; FAccess: TCloudAccess; public destructor Destroy; override; function GetJSONArray(URL: string; AID: String = ''): TJSONArray; function FindChannelByName(AName: String): TTVChannel; procedure InitPlanner(APlanner: TTMSFNCPlanner); procedure InitChannels; procedure UpdateResources(AChannel: TTVChannel; AResource: Integer); end;
uses {$IFDEF VCL} Classes, SysUtils, VCL.TMSFNCPlanner, VCL.TMSFNCCustomControl, VCL.TMSFNCPlannerBase, VCL.TMSFNCPlannerData, CloudBase, Generics.Collections, JSON, VCL.TMSFNCGraphics, VCL.TMSFNCUtils, DateUtils; {$ENDIF} {$IFDEF FMX} Classes, SysUtils, FMX.TMSFNCPlanner, FMX.TMSFNCCustomControl, FMX.TMSFNCPlannerBase, FMX.TMSFNCPlannerData, FMX.TMSCloudBase, Generics.Collections, JSON, FMX.TMSFNCGraphics, FMX.TMSFNCUtils, DateUtils; {$ENDIF} {$IFDEF LCL} Classes, SysUtils, LCLTMSCloudBase, LCLTMSFNCPlanner, LCLTMSFNCPlannerBase, LCLTMSFNCPlannerData, LCLTMSFNCGraphics, LCLTMSFNCUTils, DateUtils, fgl, fpjson, jsonparser; {$ENDIF}
Initializing the planner
The initialization code for the planner look & feel is added to the InitPlanner method, which is called after creating an instance of the TTVGuideLogic class in your project. When comparing this to our unit section, you will notice it doesn't require any conditional defines in order to succesfully compile. With the TMS FNC UI Pack we have added a few helper units to set the font size, set the color and have also created our own fill and stroke classes that are used in every FNC component.procedure TTVGuideLogic.InitPlanner(APlanner: TTMSFNCPlanner); var I: Integer; begin FPlanner := APlanner; FPlanner.BeginUpdate; FPlanner.Items.Clear; FPlanner.Positions.Count := 6; FPlanner.OrientationMode := pomHorizontal; FPlanner.DefaultItem.TitleColor := gcSlategray; FPlanner.DefaultItem.TitleFontColor := gcWhite; FPlanner.DefaultItem.Color := gcWhitesmoke; FPlanner.DefaultItem.ActiveColor := gcSlateGray; FPlanner.Interaction.ReadOnly := True; FPlanner.Resources.Clear; for I := 0 to FPlanner.Positions.Count - 1 do FPlanner.Resources.Add; FPlanner.ItemsAppearance.Stroke.Color := gcWhite; FPlanner.ItemsAppearance.Stroke.Kind := gskSolid; FPlanner.ItemsAppearance.Stroke.Width := 2; FPlanner.ItemsAppearance.TitleStroke.Assign(FPlanner.ItemsAppearance.Stroke); FPlanner.GridCellAppearance.InActiveFill.Assign(FPlanner.GridCellAppearance.Fill); FPlanner.PositionsAppearance.Layouts := [pplTop, pplBottom]; FPlanner.ModeSettings.StartTime := Now; FPlanner.ModeSettings.EndTime := Now; FPlanner.Mode := pmDay; FPlanner.TimeLineAppearance.Layouts := [ptlLeft, ptlRight]; FPlanner.TimeLineAppearance.RightVerticalTextAlign := gtaTrailing; FPlanner.TimeLineAppearance.RightSubVerticalTextAlign := gtaLeading; FPlanner.TimeLine.CurrentTimePosition := pctpOverItems; FPlanner.TimeLine.DisplayUnitType := pduMinute; FPlanner.TimeLine.DisplayUnit := 5; FPlanner.TimeLine.DisplayStart := 0; FPlanner.TimeLine.DisplayEnd := (MinsPerDay div FPlanner.TimeLine.DisplayUnit) - 1; TTMSFNCUtils.SetFontSize(FPlanner.ItemsAppearance.TitleFont, 14); TTMSFNCUtils.SetFontSize(FPlanner.PositionsAppearance.BottomFont, 14); TTMSFNCUtils.SetFontSize(FPlanner.PositionsAppearance.TopFont, 14); FPlanner.EndUpdate; FPlanner.TimeLine.ViewStart := IncHour(Now, -2); InitChannels; UpdateResources(FindChannelByName('MTV'), 0); UpdateResources(FindChannelByName('Eurosport 1'), 1); UpdateResources(FindChannelByName('BBC 1'), 2); UpdateResources(FindChannelByName('TLC'), 3); UpdateResources(FindChannelByName('Disney XD'), 4); UpdateResources(FindChannelByName('CNN'), 5); end;
Using the cloud to access information
A TV-guide application would only be a TV-guide application if it would show some TV-channels and the TV-shows that are playing at a specific time range. In the previous code snippet we have initialized the planner to show a time range of 24 hours, and the service that is used to retrieve the TV-shows of a specific TV-channel is parameterized to always return the TV-shows of today. To keep a reference to TV-channels and TV-shows we additionally add the classes needed to retrieve and persist information. In this code snippet, we have just conditional defines because of a small difference in handling generic lists between the Delphi compiler and the FPC compiler and the TMS Cloud access classes that have a different class name for VCL, FMX and LCL.TTVChannel = class; TTVShow = class; {$IFDEF VCL} TCloudAccess = class(TCloudBase); TTVShows = TObjectList<TTVShow>; TTVChannels = TObjectList<TTVChannel>; {$ENDIF} {$IFDEF FMX} TCloudAccess = class(TTMSFMXCloudBase); TTVShows = TObjectList<TTVShow>; TTVChannels = TObjectList<TTVChannel>; {$ENDIF} {$IFDEF LCL} TCloudAccess = class(TTMSLCLCloudBase); TTVShows = specialize TFPGObjectList<TTVShow>; TTVChannels = specialize TFPGObjectList<TTVChannel>; {$ENDIF} TTVShow = class private FGenre: string; FStartTime: TDateTime; FTitle: string; FID: string; FEndTime: TDateTime; FKind: string; public property ID: string read FID write FID; property Title: string read FTitle write FTitle; property Genre: string read FGenre write FGenre; property Kind: string read FKind write FKind; property StartTime: TDateTime read FStartTime write FStartTime; property EndTime: TDateTime read FEndTime write FEndTime; end; TTVChannel = class private FName: string; FID: string; FShows: TTVShows; public constructor Create; destructor Destroy; override; property ID: string read FID write FID; property Name: string read FName write FName; property Shows: TTVShows read FShows; end;
procedure TTVGuideLogic.InitChannels; var i: integer; arr: TJSONArray; o: TJSONObject; c: TTVChannel; begin FChannels := TTVChannels.Create; FAccess := TCloudAccess.Create(nil); arr := GetJSONArray('http://www.tvgids.nl/json/lists/channels.php'); if Assigned(arr) then begin for i := 0 to GetArraySize(arr) - 1 do begin o := GetArrayItem(arr, i) as TJSONObject; c := TTVChannel.Create; c.ID := FAccess.GetJSONProp(o,'id'); c.Name := StringReplace(FAccess.GetJSONProp(o,'name'), 'é', 'é', [rfReplaceAll]); FChannels.Add(c); end; end; end;
InitChannels;
procedure TTVGuideForm.UpdateResources(AChannel: TTVChannel; AResource: Integer); var c: TTVChannel; s: TTVShow; arr: TJSONArray; i: Integer; o: TJSONObject; it: TTMSFNCPlannerItem; dt: TDateTime; begin dt := Now; TMSFNCPlanner1.BeginUpdate; for I := TMSFNCPlanner1.Items.Count - 1 downto 0 do begin if TMSFNCPlanner1.Items[I].Resource = AResource then TMSFNCPlanner1.Items[I].Free; end; TMSFNCPlanner1.Resources[AResource].Text := 'No Channel Selected'; if Assigned(AChannel) then begin c := AChannel; c.Shows.Clear; TMSFNCPlanner1.Resources[AResource].Text := c.Name; arr := GetJSONArray('http://www.tvgids.nl/json/lists/programs.php?channels='+c.ID+'&day=0', c.ID); if Assigned(arr) then begin for i := 0 to GetArraySize(arr) - 1 do begin o := GetArrayItem(arr, i) as TJSONObject; s := TTVShow.Create; s.ID := FAccess.GetJSONProp(o,'db_id'); s.Title := FAccess.GetJSONProp(o,'titel'); s.Genre := FAccess.GetJSONProp(o,'genre'); s.Kind := FAccess.GetJSONProp(o,'soort'); s.StartTime := FAccess.IsoToDateTime(FAccess.GetJSONProp(o,'datum_start')); s.EndTime := FAccess.IsoToDateTime(FAccess.GetJSONProp(o,'datum_end')); c.Shows.Add(s); it := TMSFNCPlanner1.AddOrUpdateItem(s.StartTime, s.EndTime, s.Title, s.Kind); it.Resource := AResource; it.Hint := it.Title + ' [' + TimeToStr(Frac(s.StartTime)) + ' - ' + TimeToStr(Frac(s.EndTime)) + ']'; if (dt >= it.StartTime) and (dt <= it.EndTime) then begin it.Color := gcYellowgreen; it.FontColor := gcWhite; end; end; end; end; TMSFNCPlanner1.EndUpdate; end;
UpdateResources(FindChannelByName('MTV'), 0); UpdateResources(FindChannelByName('Eurosport 1'), 1); UpdateResources(FindChannelByName('BBC 1'), 2); UpdateResources(FindChannelByName('TLC'), 3); UpdateResources(FindChannelByName('Disney XD'), 4); UpdateResources(FindChannelByName('CNN'), 5);
procedure TTVGuideForm.FormCreate(Sender: TObject); begin FTVGuideLogic := TTVGuideLogic.Create; FTVGuideLogic.InitPlanner(TMSFNCPlanner1); end; procedure TTVGuideForm.FormDestroy(Sender: TObject); begin FTVGuideLogic.Free; end;
The full source code is available for download
Click image for more screenshots.
Pieter Scheldeman
This blog post has not received any comments yet.
All Blog Posts | Next Post | Previous Post