- Added XML storage for Random Presets

This commit is contained in:
Andreas Schneider 2009-12-16 23:24:57 +01:00
parent 34c0e9c901
commit 3969493d90
2 changed files with 128 additions and 49 deletions

View File

@ -3,7 +3,7 @@ object frmMain: TfrmMain
Height = 603 Height = 603
Top = 135 Top = 135
Width = 766 Width = 766
ActiveControl = cbTerrain ActiveControl = oglGameWindow
Caption = 'UO CentrED' Caption = 'UO CentrED'
ClientHeight = 580 ClientHeight = 580
ClientWidth = 766 ClientWidth = 766
@ -531,6 +531,7 @@ object frmMain: TfrmMain
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
ItemHeight = 0 ItemHeight = 0
OnChange = cbRandomPresetChange OnChange = cbRandomPresetChange
Sorted = True
Style = csDropDownList Style = csDropDownList
TabOrder = 1 TabOrder = 1
end end
@ -820,7 +821,7 @@ object frmMain: TfrmMain
item item
Position = 1 Position = 1
Text = 'Name' Text = 'Name'
Width = 133 Width = 131
end> end>
Header.DefaultHeight = 17 Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible] Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]

View File

@ -304,7 +304,8 @@ type
FVLayerMaterial: TMaterial; FVLayerMaterial: TMaterial;
FOverlayUI: TOverlayUI; FOverlayUI: TOverlayUI;
FLocationsFile: string; FLocationsFile: string;
FRandomPresetLocation: string; FRandomPresetsFile: string;
FRandomPresetsDoc: TXMLDocument;
FLastDraw: TDateTime; FLastDraw: TDateTime;
FAccessChangedListeners: array of TAccessChangedListener; FAccessChangedListeners: array of TAccessChangedListener;
FRepaintNeeded: Boolean; FRepaintNeeded: Boolean;
@ -314,6 +315,7 @@ type
{ Methods } { Methods }
procedure BuildTileList; procedure BuildTileList;
function ConfirmAction: Boolean; function ConfirmAction: Boolean;
function FindRandomPreset(AName: String): TDOMElement;
procedure ForceUpdateCurrentTile; procedure ForceUpdateCurrentTile;
procedure GetDrawOffset(ARelativeX, ARelativeY: Integer; out DrawX, procedure GetDrawOffset(ARelativeX, ARelativeY: Integer; out DrawX,
DrawY: Integer); inline; DrawY: Integer); inline;
@ -322,6 +324,7 @@ type
procedure InitRender; procedure InitRender;
procedure InitSize; procedure InitSize;
procedure LoadLocations; procedure LoadLocations;
procedure LoadRandomPresets;
procedure MoveBy(AOffsetX, AOffsetY: Integer); inline; procedure MoveBy(AOffsetX, AOffsetY: Integer); inline;
procedure PrepareMapCell(AMapCell: TMapCell); procedure PrepareMapCell(AMapCell: TMapCell);
procedure PrepareScreenBlock(ABlockInfo: PBlockInfo); procedure PrepareScreenBlock(ABlockInfo: PBlockInfo);
@ -330,6 +333,7 @@ type
procedure RebuildScreenBuffer; procedure RebuildScreenBuffer;
procedure Render; procedure Render;
procedure SaveLocations; procedure SaveLocations;
procedure SaveRandomPresets;
procedure SetCurrentTile(const AValue: TWorldItem); procedure SetCurrentTile(const AValue: TWorldItem);
procedure SetDarkLights; inline; procedure SetDarkLights; inline;
procedure SetNormalLights; inline; procedure SetNormalLights; inline;
@ -835,8 +839,6 @@ begin
end; end;
procedure TfrmMain.FormCreate(Sender: TObject); procedure TfrmMain.FormCreate(Sender: TObject);
var
searchRec: TSearchRec;
begin begin
FAppDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)); FAppDir := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName));
FConfigDir := GetAppConfigDir(False); FConfigDir := GetAppConfigDir(False);
@ -888,17 +890,8 @@ begin
FVirtualTiles := TWorldItemList.Create(True); FVirtualTiles := TWorldItemList.Create(True);
FUndoList := TPacketList.Create(True); FUndoList := TPacketList.Create(True);
FRandomPresetLocation := FConfigDir + 'RandomPresets' + PathDelim; FRandomPresetsFile := FConfigDir + 'RandomPresets.xml';
if not DirectoryExists(FRandomPresetLocation) then LoadRandomPresets;
CreateDir(FRandomPresetLocation);
if FindFirst(FRandomPresetLocation + '*.dat', faAnyFile, searchRec) = 0 then
begin
repeat
cbRandomPreset.Items.Add(ChangeFileExt(searchRec.Name, ''));
until FindNext(searchRec) <> 0;
end;
FindClose(searchRec);
DoubleBuffered := True; DoubleBuffered := True;
pnlBottom.DoubleBuffered := True; pnlBottom.DoubleBuffered := True;
@ -912,10 +905,13 @@ begin
end; end;
procedure TfrmMain.btnRandomPresetDeleteClick(Sender: TObject); procedure TfrmMain.btnRandomPresetDeleteClick(Sender: TObject);
var
preset: TDOMElement;
begin begin
if cbRandomPreset.ItemIndex > -1 then if cbRandomPreset.ItemIndex > -1 then
begin begin
DeleteFile(FRandomPresetLocation + cbRandomPreset.Text + '.dat'); preset := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]);
FRandomPresetsDoc.DocumentElement.RemoveChild(preset);
cbRandomPreset.Items.Delete(cbRandomPreset.ItemIndex); cbRandomPreset.Items.Delete(cbRandomPreset.ItemIndex);
cbRandomPreset.ItemIndex := -1; cbRandomPreset.ItemIndex := -1;
end; end;
@ -923,39 +919,65 @@ end;
procedure TfrmMain.btnRandomPresetSaveClick(Sender: TObject); procedure TfrmMain.btnRandomPresetSaveClick(Sender: TObject);
var var
fileName: string; presetName: string;
index: Integer; i, index: Integer;
preset, tile: TDOMElement;
children: TDOMNodeList;
tileNode: PVirtualNode;
tileInfo: PTileInfo;
begin begin
fileName := cbRandomPreset.Text; presetName := cbRandomPreset.Text;
if InputQuery('Save Preset', 'Enter the name of the preset:', fileName) then if InputQuery('Save Preset', 'Enter the name of the preset:', presetName) then
begin begin
vdtRandom.SaveToFile(FRandomPresetLocation + fileName + '.dat');; preset := FindRandomPreset(presetName);
index := cbRandomPreset.Items.IndexOf(fileName); if preset = nil then
if index = -1 then
begin begin
cbRandomPreset.Items.Add(fileName); preset := FRandomPresetsDoc.CreateElement('Preset');
index := cbRandomPreset.Items.Count - 1; preset.AttribStrings['Name'] := presetName;
FRandomPresetsDoc.DocumentElement.AppendChild(preset);
cbRandomPreset.Items.AddObject(presetName, preset);
end else
begin
children := preset.ChildNodes;
for i := children.Count - 1 downto 0 do
preset.RemoveChild(children[i]);
end; end;
cbRandomPreset.ItemIndex := index;
tileNode := vdtRandom.GetFirst;
while tileNode <> nil do
begin
tileInfo := vdtRandom.GetNodeData(tileNode);
tile := FRandomPresetsDoc.CreateElement('Tile');
tile.AttribStrings['ID'] := IntToStr(tileInfo^.ID);
preset.AppendChild(tile);
tileNode := vdtRandom.GetNext(tileNode);
end;
cbRandomPreset.ItemIndex := cbRandomPreset.Items.IndexOfObject(preset);
end; end;
end; end;
procedure TfrmMain.cbRandomPresetChange(Sender: TObject); procedure TfrmMain.cbRandomPresetChange(Sender: TObject);
var
preset, tile: TDOMElement;
tiles: TDOMNodeList;
tileNode: PVirtualNode;
tileInfo: PTileInfo;
i: Integer;
begin begin
if cbRandomPreset.ItemIndex > -1 then if cbRandomPreset.ItemIndex > -1 then
begin begin
try vdtRandom.Clear;
vdtRandom.LoadFromFile(FRandomPresetLocation + cbRandomPreset.Text + '.dat'); preset := TDOMElement(cbRandomPreset.Items.Objects[cbRandomPreset.ItemIndex]);
except tiles := preset.ChildNodes;
on EVirtualTreeError do for i := 0 to tiles.Count - 1 do
begin begin
if MessageDlg('Error', 'The profile could not be loaded. Most likely it is an' + LineEnding + tile := TDOMElement(tiles[i]);
'outdated version or the file is damaged.' + LineEnding + LineEnding + if tile.NodeName = 'Tile' then
'Should this profile be deleted now?', mtError, [mbYes, mbNo], 0) = mrYes then
begin begin
DeleteFile(FRandomPresetLocation + cbRandomPreset.Text + '.dat'); tileNode := vdtRandom.AddChild(nil);
cbRandomPreset.Items.Delete(cbRandomPreset.ItemIndex); tileInfo := vdtRandom.GetNodeData(tileNode);
end; tileInfo^.ID := StrToInt(tile.AttribStrings['ID']);
end; end;
end; end;
end; end;
@ -1185,6 +1207,7 @@ begin
SelectedTile := nil; SelectedTile := nil;
SaveLocations; SaveLocations;
SaveRandomPresets;
FreeAndNil(FTextureManager); FreeAndNil(FTextureManager);
FreeAndNil(FScreenBuffer); FreeAndNil(FScreenBuffer);
@ -1194,6 +1217,7 @@ begin
FreeAndNil(FVirtualTiles); FreeAndNil(FVirtualTiles);
FreeAndNil(FUndoList); FreeAndNil(FUndoList);
FreeAndNil(FGLFont); FreeAndNil(FGLFont);
FreeAndNil(FRandomPresetsDoc);
RegisterPacketHandler($0C, nil); RegisterPacketHandler($0C, nil);
end; end;
@ -1913,6 +1937,8 @@ begin
for i := 0 to locations.Count - 1 do for i := 0 to locations.Count - 1 do
begin begin
location := TDOMElement(locations[i]); location := TDOMElement(locations[i]);
if location.NodeName = 'Location' then
begin
locationNode := vstLocations.AddChild(nil); locationNode := vstLocations.AddChild(nil);
locationInfo := vstLocations.GetNodeData(locationNode); locationInfo := vstLocations.GetNodeData(locationNode);
locationInfo^.Name := location.AttribStrings['Name']; locationInfo^.Name := location.AttribStrings['Name'];
@ -1928,11 +1954,39 @@ begin
locationInfo^.Y := 0; locationInfo^.Y := 0;
end; end;
end; end;
end;
xmlDoc.Free; xmlDoc.Free;
end; end;
end; end;
procedure TfrmMain.LoadRandomPresets;
var
presets: TDOMNodeList;
i: Integer;
begin
cbRandomPreset.Clear;
FreeAndNil(FRandomPresetsDoc);
if FileExists(FRandomPresetsFile) then
begin
ReadXMLFile(FRandomPresetsDoc, FRandomPresetsFile);
presets := FRandomPresetsDoc.DocumentElement.ChildNodes;
for i := 0 to presets.Count - 1 do
begin
if presets[i].NodeName = 'Preset' then
begin
cbRandomPreset.Items.AddObject(TDOMElement(presets[i]).AttribStrings['Name'],
presets[i]);
end;
end;
end else
begin
FRandomPresetsDoc := TXMLDocument.Create;
FRandomPresetsDoc.AppendChild(FRandomPresetsDoc.CreateElement('RandomPresets'));
end;
end;
procedure TfrmMain.MoveBy(AOffsetX, AOffsetY: Integer); inline; procedure TfrmMain.MoveBy(AOffsetX, AOffsetY: Integer); inline;
begin begin
SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1), SetPos(EnsureRange(FX + AOffsetX, 0, FLandscape.CellWidth - 1),
@ -2276,6 +2330,11 @@ begin
xmlDoc.Free; xmlDoc.Free;
end; end;
procedure TfrmMain.SaveRandomPresets;
begin
WriteXMLFile(FRandomPresetsDoc, FRandomPresetsFile);
end;
procedure TfrmMain.OnLandscapeChanged; procedure TfrmMain.OnLandscapeChanged;
begin begin
InvalidateScreenBuffer; InvalidateScreenBuffer;
@ -2896,6 +2955,25 @@ begin
oglGameWindowMouseLeave(nil); oglGameWindowMouseLeave(nil);
end; end;
function TfrmMain.FindRandomPreset(AName: String): TDOMElement;
var
preset: TDOMElement;
presets: TDOMNodeList;
i: Integer;
begin
presets := FRandomPresetsDoc.DocumentElement.ChildNodes;
Result := nil;
i := 0;
while (i < presets.Count) and (Result = nil) do
begin
preset := TDOMElement(presets[i]);
if SameText(preset.AttribStrings['Name'], AName) then
Result := preset
else
Inc(i);
end;
end;
procedure TfrmMain.ForceUpdateCurrentTile; procedure TfrmMain.ForceUpdateCurrentTile;
begin begin
CurrentTile := nil; CurrentTile := nil;