diff options
Diffstat (limited to 'gui/application.inc')
-rw-r--r-- | gui/application.inc | 206 |
1 files changed, 206 insertions, 0 deletions
diff --git a/gui/application.inc b/gui/application.inc new file mode 100644 index 00000000..c431e69f --- /dev/null +++ b/gui/application.inc @@ -0,0 +1,206 @@ +{ + fpGUI - Free Pascal Graphical User Interface + Copyright (C) 2000 - 2001 by + Areca Systems GmbH / Sebastian Guenther + Copyright (C) 2006 by Graeme Geldenhuys + member of the fpGUI development team. + + Application class declarations + + See the file COPYING.fpGUI, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + + +{%mainunit fpgui.pp} + +{$IFDEF read_interface} + + { Application class declarations } + + { TApplication } + + TApplication = class(TDefApplication) + private +// FDisplay: TGfxDisplay; +// FDisplayName: String; +// FForms: TList; + FUserStyle: TStyle; +// function GetDisplay: TGfxDisplay; +// procedure SetDisplayName(const AValue: String); + protected + FDefaultStyle: TStyle; + FTitle: String; + XMLDoc: TXMLDocument; + function GetDefaultStyle: TStyle; + procedure SetTitle(const ATitle: String); + public +// constructor Create; reintroduce; + destructor Destroy; override; + procedure SetupXMLStreaming(const AXMLFilename: String); +// procedure CreateForm(InstanceClass: TComponentClass; var Reference); +// procedure AddForm(AForm: TCustomForm); +// procedure Run; + procedure SetStyle(pNewStyle: TStyle); +// property Display: TGfxDisplay read GetDisplay; +// property DisplayName: String read FDisplayName write SetDisplayName; + property DefaultStyle: TStyle read GetDefaultStyle; + property Title: String read FTitle write SetTitle; + end; + +{$ENDIF read_interface} + + + +{$IFDEF read_implementation} + +// =================================================================== +// TApplication +// =================================================================== +{ +constructor TApplication.Create; +begin + inherited Create(nil); + FForms := TList.Create; +end; +} + +destructor TApplication.Destroy; +begin + FUserStyle := nil; +// FForms.Free; + // !!!: Only auto-created styles should be destroyed, not user-provided + if Assigned(FDefaultStyle) then + FDefaultStyle.Free; +// if Assigned(FDisplay) then +// FDisplay.Free; + inherited Destroy; +end; + + +procedure TApplication.SetupXMLStreaming(const AXMLFilename: String); +begin + ReadXMLFile(XMLDoc, AXMLFilename); +end; + +{ +procedure TApplication.CreateForm(InstanceClass: TComponentClass; var Reference); +type + PForm = ^TCustomForm; +var + form: PForm; + Filename: String; + TextStream, BinStream: TStream; +begin + form := @Reference; + form^ := TCustomForm(InstanceClass.Create(Self)); + + Filename := LowerCase(Copy(InstanceClass.ClassName, 2, 255)) + '.frm'; + + TextStream := TFileStream.Create(Filename, fmOpenRead); + BinStream := TMemoryStream.Create; + ObjectTextToBinary(TextStream, BinStream); + TextStream.Free; + + BinStream.Position := 0; + BinStream.ReadComponent(Form^); + BinStream.Free; + + Form^.Show; +end; +} +{ +procedure TApplication.AddForm(AForm: TCustomForm); +begin + FForms.Add(AForm); + AForm.Show; +end; +} +{ +procedure TApplication.Run; +begin + Display.Run; +end; +} + +procedure TApplication.SetStyle(pNewStyle: TStyle); +begin + if Assigned(FUserStyle) then + FUserStyle.Free; + FUserStyle := pNewStyle; +end; +{ +function TApplication.GetDisplay: TGfxDisplay; +begin + if FDisplay = nil then FDisplay := TDefDisplay.Create(FDisplayName); + Result := FDisplay; +end; +} +{ +procedure TApplication.SetDisplayName(const AValue: String); +begin + // The display name cannot be changed after we have created it. + if (FDisplayName=AValue) or (FDisplay<>nil) then exit; + FDisplayName:=AValue; +end; +} +function TApplication.GetDefaultStyle: TStyle; +begin + if Assigned(FUserStyle) then + Result := FUserStyle + else + begin + if not Assigned(FDefaultStyle) then + FDefaultStyle := TDefaultStyle.Create(self); + Result := FDefaultStyle; + end; +end; + + +procedure TApplication.SetTitle(const ATitle: String); +begin + if ATitle <> FTitle then + begin + FTitle := ATitle; + // !!!: Change title of all forms with Text='' to FTitle + end; +end; + + +{!!!: Remove this ASAP +function TApplication.XMLReadFormProc(Instance: TComponent): Boolean; +var + Node: TDOMNode; + Reader: TXMLStreamingReader; +begin + Result := False; + if not Assigned(XMLDoc) then + exit; + Node := XMLDoc.DocumentElement.FirstChild; + + // Search the correct serialisation node + while True do + begin + if not Assigned(Node) then + exit; + if (Node.NodeType = ELEMENT_NODE) and (Node.NodeName = 'component') and + (UpperCase(TDOMElement(Node).GetAttribute('class')) = Instance.ClassName) then + break; + Node := Node.NextSibling; + end; + Reader := TXMLStreamingReader.Create(Node as TDOMElement); + try + Reader.ReadRootComponent(Instance); + finally + Reader.Free; + end; + Result := True; +end;} + +{$ENDIF read_implementation} + |