unit DemoBase; interface uses Classes, SysUtils, DemoFrame, CategoryFrame, DBAccess, MemUtils, {$IFDEF LINUX} QControls, QGraphics, QComCtrls, QForms {$ELSE} Windows, ComCtrls, Controls, Graphics, Forms, HTMLConsts, ShellAPI {$ENDIF} ; type TDemoType = (dtDemo, dtCategory); TDemo = class protected FName: string; FFileName: string; FHint: string; FDescription: string; FDemoType: TDemoType; FFrameClass: TDemoFrameClass; FFrame: TDemoFrame; public constructor Create(Name, Hint, Description: string; DemoType: TDemoType; FrameClass: TDemoFrameClass; FileName: string = ''); destructor Destroy; override; procedure LoadDemoCode(Strings: TStrings); procedure LoadFormCode(Strings: TStrings); procedure OpenDemoFolder; procedure FreeFrame; property Name: string read FName; property Hint: string read FHint; property Description: string read FDescription; property DemoType: TDemoType read FDemoType; property FrameClass: TDemoFrameClass read FFrameClass; property Frame: TDemoFrame read FFrame; end; TDemos = class protected FDemoTreeNodes: TTreeNodes; FSelectedDemo: TDemo; FSupplementaryDemosDescription: TStrings; function GetSelectedDemo: TDemo; function GetItems(Index: integer): TDemo; function WrapDescription(Demo: TDemo): TStrings; public constructor Create(TreeNodes: TTreeNodes); virtual; destructor Destroy; override; procedure RegisterCategory(CategoryName, Hint: string; ImgIndex: integer = -1; SupplementaryDemo: boolean = False); procedure RegisterDemo(DemoName, DemoHint, DemoDescription, DemoCategory: string; FrameClass: TDemoFrameClass; ImgIndex: integer; FileName: string = ''; SupplementaryDemo: boolean = False); procedure Clear; //Navigation function SelectDemo(DemoIndex: integer): TDemo; //Create demo frame by DemoIndex function GetDemoIndex(AbsoluteIndex: integer): integer; property Items[Index: integer]: TDemo read GetItems; default; property SelectedDemo: TDemo read GetSelectedDemo; end; implementation const MainDemosHeader = 'Main Demo Projects'; SupplementaryDemosHeader = 'Supplementary Demo Projects'; SupplementaryDemosNote = ' Note, the demo projects listed below are separate projects. ' {$IFNDEF WIN32} + #13#10 {$ENDIF} + ' This project contains only their descriptions and links to their folders.'; {$IFNDEF WIN32} procedure WriteTable(CategoryName, CategoryDescription: string; List: TStrings); var strs: TStringList; begin List.Add(' '); List.Add(' ' + CategoryName); strs := TStringList.Create; strs.Text := CategoryDescription; List.AddStrings(strs); strs.Free; end; {$ELSE} procedure WriteTable(CategoryName, CategoryDescription: string; List: TStrings); begin if CategoryName = '' then begin // used to close virtual category List.Add(''); Exit; end; List.Add('
| Demo | '); List.Add('Description | '); List.Add('
|---|
' + SupplementaryDemosNote + '
'); {$ENDIF} Result.AddStrings(FSupplementaryDemosDescription); end; {$IFDEF WIN32} Result.Add(HTMLFooter); {$ENDIF} end; function TDemos.SelectDemo(DemoIndex: integer): TDemo; //Init and show demo by DemoIndex var Descriptions: TStrings; begin Result := GetItems(DemoIndex); if (FSelectedDemo <> nil) and (Result <> FSelectedDemo) then if FSelectedDemo.DemoType <> dtCategory then FSelectedDemo.FreeFrame //In case of demo selection change we should free demo frame except category description else FSelectedDemo.Frame.Hide; FSelectedDemo := Result; with FSelectedDemo do if FFrame = nil then begin FFrame := FFrameClass.Create(nil); if DemoType = dtCategory then begin Descriptions := WrapDescription(FSelectedDemo); try TCategoryFrame(FFrame).SetDemoDescriptions(Descriptions); finally Descriptions.Free; end; end; end else FFrame.Show; end; {TDemo} constructor TDemo.Create(Name, Hint, Description: string; DemoType: TDemoType; FrameClass: TDemoFrameClass; FileName: string = ''); begin inherited Create; FName := Name; if FileName = '' then FFileName := Name else FFileName := FileName; FHint := Hint; FDescription := Description; FFrameClass := FrameClass; FDemoType := DemoType; end; destructor TDemo.Destroy; begin FreeFrame; inherited; end; procedure TDemo.LoadDemoCode(Strings: TStrings); var FileName: string; begin if DemoType = dtCategory then Strings.Clear else begin {$IFDEF LINUX} FileName := Format('%s/%s/%s.pas', [ExtractFilePath(Application.ExeName), Name, FFileName]); {$ELSE} FileName := Format('%s\%s\%s.pas', [ExtractFilePath(Application.ExeName), Name, FFileName]); {$ENDIF} if FileExists(FileName) then Strings.LoadFromFile(FileName) else Strings.Clear; end; end; procedure TDemo.LoadFormCode(Strings: TStrings); var FileName: string; begin if DemoType = dtCategory then Strings.Clear else begin {$IFDEF LINUX} FileName := Format('%s/%s/%s.xfm', [ExtractFilePath(Application.ExeName), Name, FFileName]); {$ENDIF} {$IFDEF CLR} FileName := Format('%s\%s\%s.nfm', [ExtractFilePath(Application.ExeName), Name, FFileName]); {$ENDIF} {$IFDEF WIN32} FileName := Format('%s\%s\%s.dfm', [ExtractFilePath(Application.ExeName), Name, FFileName]); {$ENDIF} if FileExists(FileName) then Strings.LoadFromFile(FileName) else Strings.Clear; end; end; procedure TDemo.OpenDemoFolder; {$IFNDEF LINUX} var FolderName: string; begin if DemoType = dtDemo then begin FolderName := ExtractFilePath(Application.ExeName) + Name; ShellExecute(0, 'open', PChar(FolderName), '', '.', SW_SHOW); end; end; {$ELSE} begin end; {$ENDIF} procedure TDemo.FreeFrame; begin FFrame.Free; FFrame := nil; end; end.