- Implemented saving and loading of locations to/from xml

2009-12-16 16:03:35 +01:00 · 2009-12-16 16:03:35 +01:00 · 34c0e9c901
parent 797abbfa07
commit 34c0e9c901
2 changed files with 2727 additions and 2668 deletions
--- a/Client/UfrmMain.lfm
+++ b/Client/UfrmMain.lfm
@ -3,7 +3,7 @@ object frmMain: TfrmMain
  Height = 603
  Top = 135
  Width = 766
-  ActiveControl = oglGameWindow
+  ActiveControl = cbTerrain
  Caption = 'UO CentrED'
  ClientHeight = 580
  ClientWidth = 766
@ -140,7 +140,7 @@ object frmMain: TfrmMain
        AnchorSideRight.Side = asrBottom
        AnchorSideBottom.Control = spTileList
        Left = 4
-        Height = 250
+        Height = 242
        Top = 56
        Width = 210
        Anchors = [akTop, akLeft, akRight, akBottom]
@ -193,13 +193,13 @@ object frmMain: TfrmMain
        AnchorSideBottom.Control = tsTiles
        AnchorSideBottom.Side = asrBottom
        Left = 0
-        Height = 181
-        Top = 311
+        Height = 189
+        Top = 303
        Width = 218
        Align = alBottom
        Anchors = [akTop, akLeft, akRight, akBottom]
        Caption = 'Random pool'
-        ClientHeight = 167
+        ClientHeight = 175
        ClientWidth = 216
        TabOrder = 1
        object btnAddRandom: TSpeedButton
@ -363,7 +363,7 @@ object frmMain: TfrmMain
          Left = 164
          Height = 22
          Hint = 'Save Preset'
-          Top = 134
+          Top = 142
          Width = 22
          Anchors = [akTop, akRight]
          BorderSpacing.Right = 4
@ -417,7 +417,7 @@ object frmMain: TfrmMain
          Left = 190
          Height = 22
          Hint = 'Delete Preset'
-          Top = 134
+          Top = 142
          Width = 22
          Anchors = [akTop, akRight]
          BorderSpacing.Right = 4
@ -474,7 +474,7 @@ object frmMain: TfrmMain
          AnchorSideBottom.Control = cbRandomPreset
          Cursor = 63
          Left = 4
-          Height = 106
+          Height = 114
          Top = 24
          Width = 208
          Anchors = [akTop, akLeft, akRight, akBottom]
@ -505,6 +505,7 @@ object frmMain: TfrmMain
          Header.ParentFont = True
          Header.Style = hsFlatButtons
          TabOrder = 0
+          TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScroll, toAutoScrollOnExpand, toAutoTristateTracking, toAutoDeleteMovedNodes]
          TreeOptions.PaintOptions = [toHideFocusRect, toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
          TreeOptions.SelectionOptions = [toFullRowSelect, toMultiSelect]
          OnClick = vdtRandomClick
@ -522,7 +523,7 @@ object frmMain: TfrmMain
          AnchorSideBottom.Side = asrBottom
          Left = 4
          Height = 29
-          Top = 134
+          Top = 142
          Width = 156
          Anchors = [akLeft, akRight, akBottom]
          BorderSpacing.Left = 4
@ -541,7 +542,7 @@ object frmMain: TfrmMain
        Cursor = crVSplit
        Left = 0
        Height = 5
-        Top = 306
+        Top = 298
        Width = 218
        Align = alNone
        Anchors = [akLeft, akRight, akBottom]
@ -555,7 +556,7 @@ object frmMain: TfrmMain
        Left = 110
        Height = 19
        Hint = 'Append S or T to restrict the search to Statics or Terrain.'
-        Top = 279
+        Top = 271
        Width = 96
        Anchors = [akRight, akBottom]
        BorderSpacing.Right = 8
@ -640,10 +641,10 @@ object frmMain: TfrmMain
        AnchorSideLeft.Control = btnDeleteLocation
        AnchorSideLeft.Side = asrBottom
        AnchorSideTop.Control = btnDeleteLocation
-        Left = 128
+        Left = 125
        Height = 22
        Hint = 'Clear'
-        Top = 450
+        Top = 466
        Width = 23
        BorderSpacing.Left = 4
        Color = clBtnFace
@ -693,10 +694,10 @@ object frmMain: TfrmMain
        AnchorSideLeft.Side = asrCenter
        AnchorSideBottom.Control = tsLocations
        AnchorSideBottom.Side = asrBottom
-        Left = 101
+        Left = 98
        Height = 22
        Hint = 'Delete'
-        Top = 450
+        Top = 466
        Width = 23
        Anchors = [akLeft, akBottom]
        BorderSpacing.Bottom = 4
@ -745,10 +746,10 @@ object frmMain: TfrmMain
      object btnAddLocation: TSpeedButton
        AnchorSideTop.Control = btnDeleteLocation
        AnchorSideRight.Control = btnDeleteLocation
-        Left = 74
+        Left = 71
        Height = 22
        Hint = 'Add'
-        Top = 450
+        Top = 466
        Width = 23
        Anchors = [akTop, akRight]
        BorderSpacing.Right = 4
@ -802,8 +803,8 @@ object frmMain: TfrmMain
        AnchorSideBottom.Control = btnDeleteLocation
        Cursor = 63
        Left = 4
-        Height = 428
-        Top = 18
+        Height = 458
+        Top = 4
        Width = 210
        Anchors = [akTop, akLeft, akRight, akBottom]
        BorderSpacing.Around = 4
@ -819,7 +820,7 @@ object frmMain: TfrmMain
          item
            Position = 1
            Text = 'Name'
-            Width = 131
+            Width = 133
          end>
        Header.DefaultHeight = 17
        Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
--- a/Client/UfrmMain.pas
+++ b/Client/UfrmMain.pas
@ -35,7 +35,7 @@ uses
  StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
  LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList,
  XMLPropStorage, fgl, ImagingClasses, dateutils, UPlatformTypes, UMap, UPacket,
-  UGLFont;
+  UGLFont, DOM, XMLRead, XMLWrite;

 type
  TAccessChangedListener = procedure(AAccessLevel: TAccessLevel) of object;
@ -321,6 +321,7 @@ type
    function  GetSelectedRect: TRect;
    procedure InitRender;
    procedure InitSize;
+    procedure LoadLocations;
    procedure MoveBy(AOffsetX, AOffsetY: Integer); inline;
    procedure PrepareMapCell(AMapCell: TMapCell);
    procedure PrepareScreenBlock(ABlockInfo: PBlockInfo);
@ -328,6 +329,7 @@ type
    procedure ProcessAccessLevel;
    procedure RebuildScreenBuffer;
    procedure Render;
+    procedure SaveLocations;
    procedure SetCurrentTile(const AValue: TWorldItem);
    procedure SetDarkLights; inline;
    procedure SetNormalLights; inline;
@ -871,20 +873,9 @@ begin
  vstChat.NodeDataSize := SizeOf(TChatInfo);
  pnlChatHeader.AnchorSide[akBottom].Control := pnlBottom;
  
-  FLocationsFile := FConfigDir + 'Locations.dat';
+  FLocationsFile := FConfigDir + 'Locations.xml';
  vstLocations.NodeDataSize := SizeOf(TLocationInfo);
-  try
-    if FileExists(FLocationsFile) then
-      vstLocations.LoadFromFile(FLocationsFile);
-  except
-    on E: EVirtualTreeError do
-    begin
-      MessageDlg('Warning', 'The Locations could not be loaded. Most likely it is an' + LineEnding +
-        'outdated version or the file is damaged.' + LineEnding + LineEnding +
-        'A backup will be made as "Locations.bak".', mtWarning, [mbOK], 0);
-      RenameFile(FLocationsFile, FConfigDir + 'Locations.bak');
-    end;
-  end;
+  LoadLocations;

  RegisterPacketHandler($0C, TPacketHandler.Create(0, @OnClientHandlingPacket));

@ -1193,7 +1184,7 @@ begin
  CurrentTile := nil;
  SelectedTile := nil;

-  vstLocations.SaveToFile(FLocationsFile);
+  SaveLocations;

  FreeAndNil(FTextureManager);
  FreeAndNil(FScreenBuffer);
@ -1676,7 +1667,7 @@ var
  locationInfo: PLocationInfo;
 begin
  locationInfo := Sender.GetNodeData(Node);
-  locationInfo^.Name := '';
+  locationInfo^.Name := EmptyStr;
 end;

 procedure TfrmMain.vstLocationsGetText(Sender: TBaseVirtualTree;
@ -1902,6 +1893,46 @@ begin
  glLoadIdentity;
 end;

+procedure TfrmMain.LoadLocations;
+var
+  xmlDoc: TXMLDocument;
+  location: TDOMElement;
+  locationNode: PVirtualNode;
+  locationInfo: PLocationInfo;
+  locations: TDOMNodeList;
+  i, j: Integer;
+begin
+  vstLocations.Clear;
+
+  if FileExists(FLocationsFile) then
+  begin
+    ReadXMLFile(xmlDoc, FLocationsFile);
+    if xmlDoc.DocumentElement.NodeName = 'Locations' then
+    begin
+      locations := xmlDoc.DocumentElement.ChildNodes;
+      for i := 0 to locations.Count - 1 do
+      begin
+        location := TDOMElement(locations[i]);
+        locationNode := vstLocations.AddChild(nil);
+        locationInfo := vstLocations.GetNodeData(locationNode);
+        locationInfo^.Name := location.AttribStrings['Name'];
+
+        if TryStrToInt(location.AttribStrings['X'], j) then
+          locationInfo^.X := j
+        else
+          locationInfo^.X := 0;
+
+        if TryStrToInt(location.AttribStrings['Y'], j) then
+          locationInfo^.Y := j
+        else
+          locationInfo^.Y := 0;
+      end;
+    end;
+
+    xmlDoc.Free;
+  end;
+end;
+
 procedure TfrmMain.MoveBy(AOffsetX, AOffsetY: Integer); inline;
 begin
  SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1),
@ -2218,6 +2249,33 @@ begin
  FOverlayUI.Draw(oglGameWindow);
 end;

+procedure TfrmMain.SaveLocations;
+var
+  xmlDoc: TXMLDocument;
+  location: TDOMElement;
+  locationNode: PVirtualNode;
+  locationInfo: PLocationInfo;
+begin
+  xmlDoc := TXMLDocument.Create;
+  xmlDoc.AppendChild(xmlDoc.CreateElement('Locations'));
+
+  locationNode := vstLocations.GetFirst;
+  while locationNode <> nil do
+  begin
+    locationInfo := vstLocations.GetNodeData(locationNode);
+    location := xmlDoc.CreateElement('Location');
+    location.AttribStrings['Name'] := locationInfo^.Name;
+    location.AttribStrings['X'] := IntToStr(locationInfo^.X);
+    location.AttribStrings['Y'] := IntToStr(locationInfo^.Y);
+    xmlDoc.DocumentElement.AppendChild(location);
+
+    locationNode := vstLocations.GetNext(locationNode);
+  end;
+
+  WriteXMLFile(xmlDoc, FLocationsFile);
+  xmlDoc.Free;
+end;
+
 procedure TfrmMain.OnLandscapeChanged;
 begin
  InvalidateScreenBuffer;