mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-08-29 09:50:31 +02:00
anchordocking: test restore
git-svn-id: trunk@39662 -
This commit is contained in:
mattias
parent
8135432816
commit
701c1e773a
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -555,6 +555,10 @@ components/anchordocking/minide/simplefrm.lfm svneol=native#text/plain
|
||||
components/anchordocking/minide/simplefrm.pas svneol=native#text/plain
|
||||
components/anchordocking/minide/unit1.lfm svneol=native#text/plain
|
||||
components/anchordocking/minide/unit1.pas svneol=native#text/plain
|
||||
components/anchordocking/restoredebugger/ADRestoreDebugger.lpi svneol=native#text/plain
|
||||
components/anchordocking/restoredebugger/ADRestoreDebugger.lpr svneol=native#text/plain
|
||||
components/anchordocking/restoredebugger/mainunit.lfm svneol=native#text/plain
|
||||
components/anchordocking/restoredebugger/mainunit.pas svneol=native#text/plain
|
||||
components/chmhelp/README.txt svneol=native#text/plain
|
||||
components/chmhelp/democontrol/ContextHelpDemo.lpi svneol=native#text/plain
|
||||
components/chmhelp/democontrol/ContextHelpDemo.lpr svneol=native#text/plain
|
||||
|
||||
@ -0,0 +1,94 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="ADRestoreDebugger"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</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"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="3">
|
||||
<Item1>
|
||||
<PackageName Value="AnchorDocking"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="SynEdit"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item3>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="ADRestoreDebugger.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="ADRestoreDebugger"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="mainunit.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="ADRestDbg"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="MainUnit"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="ADRestoreDebugger"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
@ -0,0 +1,19 @@
|
||||
program ADRestoreDebugger;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, MainUnit, anchordockpkg
|
||||
{ you can add units after this };
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TADRestDbg, ADRestDbg);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
1199
components/anchordocking/restoredebugger/mainunit.lfm
Normal file
1199
components/anchordocking/restoredebugger/mainunit.lfm
Normal file
File diff suppressed because it is too large
Load Diff
140
components/anchordocking/restoredebugger/mainunit.pas
Normal file
140
components/anchordocking/restoredebugger/mainunit.pas
Normal file
@ -0,0 +1,140 @@
|
||||
{ Main form Anchordocking Restore Debugger
|
||||
|
||||
Copyright (C) 2012 Mattias Gaertner mattias@freepascal.org
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it
|
||||
under the terms of the GNU Library General Public License as published by
|
||||
the Free Software Foundation; either version 2 of the License, or (at your
|
||||
option) any later version with the following modification:
|
||||
|
||||
As a special exception, the copyright holders of this library give you
|
||||
permission to link this library with independent modules to produce an
|
||||
executable, regardless of the license terms of these independent modules,and
|
||||
to copy and distribute the resulting executable under terms of your choice,
|
||||
provided that you also meet, for each linked independent module, the terms
|
||||
and conditions of the license of that module. An independent module is a
|
||||
module which is not derived from or based on this library. If you modify
|
||||
this library, you may extend this exception to your version of the library,
|
||||
but you are not obligated to do so. If you do not wish to do so, delete this
|
||||
exception statement from your version.
|
||||
|
||||
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. See the GNU Library General Public License
|
||||
for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public License
|
||||
along with this library; if not, write to the Free Software Foundation,
|
||||
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
||||
}
|
||||
unit MainUnit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, FileUtil, LazFileUtils, Laz2_XMLCfg, SynEdit,
|
||||
SynHighlighterXML, AnchorDocking, Forms, Controls, Graphics, Dialogs,
|
||||
ComCtrls, ExtCtrls, Buttons, StdCtrls, LazConfigStorage;
|
||||
|
||||
type
|
||||
|
||||
{ TADRestDbg }
|
||||
|
||||
TADRestDbg = class(TForm)
|
||||
OriginalFileLabel: TLabel;
|
||||
OriginalLayoutPanel: TPanel;
|
||||
RestoredFileLabel: TLabel;
|
||||
RestoredLayoutPanel: TPanel;
|
||||
RestoredLayoutToolBar: TToolBar;
|
||||
SplitterXMLLayout: TSplitter;
|
||||
SplitterBetweenXML: TSplitter;
|
||||
OriginalSynEdit: TSynEdit;
|
||||
RestoredSynEdit: TSynEdit;
|
||||
SplitterBetweenLayouts: TSplitter;
|
||||
SynXMLSyn1: TSynXMLSyn;
|
||||
MainToolBar: TToolBar;
|
||||
OpenToolButton: TToolButton;
|
||||
OpenRecentToolButton: TToolButton;
|
||||
OriginalLayoutToolBar: TToolBar;
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
private
|
||||
FSettings: TAnchorDockSettings;
|
||||
public
|
||||
procedure OpenLayout(Filename: string);
|
||||
procedure LoadSettingsFromOriginalSynedit;
|
||||
property Settings: TAnchorDockSettings read FSettings;
|
||||
end;
|
||||
|
||||
var
|
||||
ADRestDbg: TADRestDbg;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TADRestDbg }
|
||||
|
||||
procedure TADRestDbg.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Caption:='Anchordocking Restore Debugger';
|
||||
FSettings:=TAnchorDockSettings.Create;
|
||||
|
||||
if Paramcount>0 then
|
||||
OpenLayout(ParamStrUTF8(1));
|
||||
end;
|
||||
|
||||
procedure TADRestDbg.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
FreeAndNil(FSettings);
|
||||
end;
|
||||
|
||||
procedure TADRestDbg.OpenLayout(Filename: string);
|
||||
begin
|
||||
if Filename='' then exit;
|
||||
Filename:=TrimAndExpandFilename(Filename);
|
||||
if (not FileExistsUTF8(Filename)) or (DirPathExists(Filename)) then begin
|
||||
MessageDlg('Unable to load','File does not exist: "'+Filename+'"',mtError,
|
||||
[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
try
|
||||
OriginalSynEdit.Lines.LoadFromFile(Filename);
|
||||
except
|
||||
on E: Exception do begin
|
||||
MessageDlg('Unable to load','File: "'+Filename+'"'#13+E.Message,mtError,
|
||||
[mbCancel],0);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
LoadSettingsFromOriginalSynedit;
|
||||
end;
|
||||
|
||||
procedure TADRestDbg.LoadSettingsFromOriginalSynedit;
|
||||
var
|
||||
ms: TMemoryStream;
|
||||
XML: TXMLConfig;
|
||||
Config: TXMLConfigStorage;
|
||||
begin
|
||||
ms:=TMemoryStream.Create;
|
||||
XML:=TXMLConfig.Create(nil);
|
||||
Config:=nil;
|
||||
try
|
||||
OriginalSynEdit.Lines.SaveToStream(ms);
|
||||
ms.Position:=0;
|
||||
XML.Filename:=;
|
||||
Config:=TConfigStorage.Create(XML);
|
||||
FSettings.LoadFromConfig(Config);
|
||||
txmlcon
|
||||
finally
|
||||
Config.Free;
|
||||
XML.Free;
|
||||
ms.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user