Revision 13:c78b5eafa10e

b/Client/CentrED.lpi
40 40
        <MinVersion Major="4" Minor="5" Release="1" Valid="True"/>
41 41
      </Item4>
42 42
    </RequiredPackages>
43
    <Units Count="26">
43
    <Units Count="29">
44 44
      <Unit0>
45 45
        <Filename Value="CentrED.lpr"/>
46 46
        <IsPartOfProject Value="True"/>
......
229 229
        <IsPartOfProject Value="True"/>
230 230
        <UnitName Value="UPackets"/>
231 231
      </Unit25>
232
      <Unit26>
233
        <Filename Value="ULandscape.pas"/>
234
        <IsPartOfProject Value="True"/>
235
        <UnitName Value="ULandscape"/>
236
      </Unit26>
237
      <Unit27>
238
        <Filename Value="UGameResources.pas"/>
239
        <IsPartOfProject Value="True"/>
240
        <UnitName Value="UGameResources"/>
241
      </Unit27>
242
      <Unit28>
243
        <Filename Value="UAdminHandling.pas"/>
244
        <IsPartOfProject Value="True"/>
245
        <UnitName Value="UAdminHandling"/>
246
      </Unit28>
232 247
    </Units>
233 248
  </ProjectOptions>
234 249
  <CompilerOptions>
235
    <Version Value="5"/>
250
    <Version Value="8"/>
236 251
    <Target>
237 252
      <Filename Value="../bin/CentrED"/>
238 253
    </Target>
......
249 264
    </Parsing>
250 265
    <CodeGeneration>
251 266
      <SmartLinkUnit Value="True"/>
252
      <Generate Value="Faster"/>
253 267
      <Optimizations>
254 268
        <OptimizationLevel Value="3"/>
255 269
      </Optimizations>
b/Client/CentrED.lpr
39 39
  UfrmMoveSettings, UfrmAbout, UfrmHueSettings, UfrmRadar,
40 40
  UfrmLargeScaleCommand, UfrmVirtualLayer, UfrmFilter, UfrmTileInfo,
41 41
  UGUIPlatformUtils, UPlatformTypes, UfrmRegionControl, UPackets,
42
  UPacketHandlers;
42
  UPacketHandlers, UAdminHandling, UGameResources, ULandscape;
43 43
  
44 44
{$IFDEF Windows}
45 45
  {$R *.res}
b/Client/UAdminHandling.pas
1
(*
2
 * CDDL HEADER START
3
 *
4
 * The contents of this file are subject to the terms of the
5
 * Common Development and Distribution License, Version 1.0 only
6
 * (the "License").  You may not use this file except in compliance
7
 * with the License.
8
 *
9
 * You can obtain a copy of the license at
10
 * http://www.opensource.org/licenses/cddl1.php.
11
 * See the License for the specific language governing permissions
12
 * and limitations under the License.
13
 *
14
 * When distributing Covered Code, include this CDDL HEADER in each
15
 * file and include the License file at
16
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
17
 * add the following below this CDDL HEADER, with the fields enclosed
18
 * by brackets "[]" replaced with your own identifying * information:
19
 *      Portions Copyright [yyyy] [name of copyright owner]
20
 *
21
 * CDDL HEADER END
22
 *
23
 *
24
 *      Portions Copyright 2007 Andreas Schneider
25
 *)
26
unit UAdminHandling;
27

  
28
{$mode objfpc}{$H+}
29

  
30
interface
31

  
32
uses
33
  Classes, SysUtils, UPacket, UPacketHandlers, UEnhancedMemoryStream, UEnums;
34
  
35
type
36

  
37
  { TFlushServerPacket }
38

  
39
  TFlushServerPacket = class(TPacket)
40
    constructor Create;
41
  end;
42
  
43
  { TQuitServerPacket }
44

  
45
  TQuitServerPacket = class(TPacket)
46
    constructor Create(AReason: string);
47
  end;
48
  
49
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
50

  
51
var
52
  AdminPacketHandlers: array[0..$FF] of TPacketHandler;
53

  
54
implementation
55

  
56
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
57
var
58
  packetHandler: TPacketHandler;
59
begin
60
  packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
61
  if packetHandler <> nil then
62
    packetHandler.Process(ABuffer);
63
end;
64

  
65
{ TFlushServerPacket }
66

  
67
constructor TFlushServerPacket.Create;
68
begin
69
  inherited Create($03, 0);
70
  FStream.WriteByte($01);
71
end;
72

  
73
{ TQuitServerPacket }
74

  
75
constructor TQuitServerPacket.Create(AReason: string);
76
begin
77
  inherited Create($03, 0);
78
  FStream.WriteByte($02);
79
  FStream.WriteStringNull(AReason);
80
end;
81

  
82
{$WARNINGS OFF}
83
var
84
  i: Integer;
85

  
86
initialization
87
  for i := 0 to $FF do
88
    AdminPacketHandlers[i] := nil;
89
finalization
90
  for i := 0 to $FF do
91
    if AdminPacketHandlers[i] <> nil then
92
      AdminPacketHandlers[i].Free;
93
{$WARNINGS ON}
94

  
95
end.
96

  
1
(*
2
 * CDDL HEADER START
3
 *
4
 * The contents of this file are subject to the terms of the
5
 * Common Development and Distribution License, Version 1.0 only
6
 * (the "License").  You may not use this file except in compliance
7
 * with the License.
8
 *
9
 * You can obtain a copy of the license at
10
 * http://www.opensource.org/licenses/cddl1.php.
11
 * See the License for the specific language governing permissions
12
 * and limitations under the License.
13
 *
14
 * When distributing Covered Code, include this CDDL HEADER in each
15
 * file and include the License file at
16
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
17
 * add the following below this CDDL HEADER, with the fields enclosed
18
 * by brackets "[]" replaced with your own identifying * information:
19
 *      Portions Copyright [yyyy] [name of copyright owner]
20
 *
21
 * CDDL HEADER END
22
 *
23
 *
24
 *      Portions Copyright 2007 Andreas Schneider
25
 *)
26
unit UAdminHandling;
27

  
28
{$mode objfpc}{$H+}
29

  
30
interface
31

  
32
uses
33
  Classes, SysUtils, UPacket, UPacketHandlers, UEnhancedMemoryStream, UEnums;
34
  
35
type
36

  
37
  TAdminHandlerAlreadyAssignedException = class(Exception);
38

  
39
  { TFlushServerPacket }
40

  
41
  TFlushServerPacket = class(TPacket)
42
    constructor Create;
43
  end;
44
  
45
  { TQuitServerPacket }
46

  
47
  TQuitServerPacket = class(TPacket)
48
    constructor Create(AReason: string);
49
  end;
50
  
51
procedure AssignAdminPacketHandler(APacketID: Byte; AHandler: TPacketHandler);
52
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
53

  
54
var
55
  AdminPacketHandlers: array[0..$FF] of TPacketHandler;
56

  
57
implementation
58

  
59
procedure AssignAdminPacketHandler(APacketID: Byte; AHandler: TPacketHandler);
60
begin
61
  if AdminPacketHandlers[APacketID] <> nil then
62
    raise TAdminHandlerAlreadyAssignedException.CreateFmt(
63
      'The AdminPacketHandler $%.2x is already assigned!', [APacketID]);
64

  
65
  AdminPacketHandlers[APacketID] := AHandler;
66
end;
67

  
68
procedure OnAdminHandlerPacket(ABuffer: TEnhancedMemoryStream);
69
var
70
  packetHandler: TPacketHandler;
71
begin
72
  packetHandler := AdminPacketHandlers[ABuffer.ReadByte];
73
  if packetHandler <> nil then
74
    packetHandler.Process(ABuffer);
75
end;
76

  
77
{ TFlushServerPacket }
78

  
79
constructor TFlushServerPacket.Create;
80
begin
81
  inherited Create($03, 0);
82
  FStream.WriteByte($01);
83
end;
84

  
85
{ TQuitServerPacket }
86

  
87
constructor TQuitServerPacket.Create(AReason: string);
88
begin
89
  inherited Create($03, 0);
90
  FStream.WriteByte($02);
91
  FStream.WriteStringNull(AReason);
92
end;
93

  
94
{$WARNINGS OFF}
95
var
96
  i: Integer;
97

  
98
initialization
99
  for i := 0 to $FF do
100
    AdminPacketHandlers[i] := nil;
101
finalization
102
  for i := 0 to $FF do
103
    if AdminPacketHandlers[i] <> nil then
104
      AdminPacketHandlers[i].Free;
105
{$WARNINGS ON}
106

  
107
end.
108

  
b/Client/UfrmAccountControl.pas
140 140
begin
141 141
  vstAccounts.NodeDataSize := SizeOf(TAccountInfo);
142 142
  
143
  AdminPacketHandlers[$05] := TPacketHandler.Create(0, @OnModifyUserResponse);
144
  AdminPacketHandlers[$06] := TPacketHandler.Create(0, @OnDeleteUserResponse);
145
  AdminPacketHandlers[$07] := TPacketHandler.Create(0, @OnListUsersPacket);
143
  AssignAdminPacketHandler($05, TPacketHandler.Create(0, @OnModifyUserResponse));
144
  AssignAdminPacketHandler($06, TPacketHandler.Create(0, @OnDeleteUserResponse));
145
  AssignAdminPacketHandler($07, TPacketHandler.Create(0, @OnListUsersPacket));
146 146
end;
147 147

  
148 148
procedure TfrmAccountControl.FormClose(Sender: TObject;
b/Client/UfrmLargeScaleCommand.lfm
3 3
  Height = 397
4 4
  Top = 171
5 5
  Width = 620
6
  ActiveControl = vdtDeleteStaticsTiles
6
  ActiveControl = vstActions
7 7
  Caption = 'Large Scale Commands'
8 8
  ClientHeight = 397
9 9
  ClientWidth = 620
......
27 27
    TabOrder = 0
28 28
    object pgArea: TPage
29 29
      Caption = 'pgArea'
30
      ClientWidth = 468
31
      ClientHeight = 360
30
      ClientWidth = 464
31
      ClientHeight = 335
32 32
      ParentFont = True
33 33
      object sbArea: TScrollBox
34
        Height = 360
35
        Width = 468
34
        Height = 335
35
        Width = 464
36 36
        Align = alClient
37 37
        TabOrder = 0
38 38
        object pbArea: TPaintBox
......
46 46
    end
47 47
    object pgCopyMove: TPage
48 48
      Caption = 'Copy/Move'
49
      ClientWidth = 468
50
      ClientHeight = 360
49
      ClientWidth = 464
50
      ClientHeight = 335
51 51
      ParentFont = True
52 52
      object rgCMAction: TRadioGroup
53 53
        Left = 12
......
64 64
        ChildSizing.ShrinkVertical = crsScaleChilds
65 65
        ChildSizing.Layout = cclLeftToRightThenTopToBottom
66 66
        ChildSizing.ControlsPerLine = 2
67
        ClientHeight = 40
68
        ClientWidth = 184
67
        ClientHeight = 23
68
        ClientWidth = 180
69 69
        Columns = 2
70 70
        ItemIndex = 0
71 71
        Items.Strings = (
......
132 132
    end
133 133
    object pgModifyAltitude: TPage
134 134
      Caption = 'Modify altitude'
135
      ClientWidth = 468
136
      ClientHeight = 360
135
      ClientWidth = 464
136
      ClientHeight = 335
137 137
      ParentFont = True
138 138
      object Label2: TLabel
139 139
        Left = 28
......
218 218
    end
219 219
    object pgDrawTerrain: TPage
220 220
      Caption = 'Draw Terrain'
221
      ClientWidth = 468
222
      ClientHeight = 360
221
      ClientWidth = 464
222
      ClientHeight = 335
223 223
      ParentFont = True
224 224
      object gbDrawTerrainTiles: TGroupBox
225 225
        Left = 8
226
        Height = 344
226
        Height = 319
227 227
        Top = 8
228 228
        Width = 225
229 229
        Align = alLeft
230 230
        BorderSpacing.Around = 8
231 231
        Caption = 'Tiles'
232
        ClientHeight = 328
232
        ClientHeight = 315
233 233
        ClientWidth = 221
234 234
        ParentFont = True
235 235
        TabOrder = 0
......
250 250
          Tag = 1
251 251
          Cursor = 63
252 252
          Left = 4
253
          Height = 236
253
          Height = 223
254 254
          Top = 62
255 255
          Width = 213
256 256
          Align = alClient
......
288 288
        end
289 289
        object pnlDrawTerrainTilesControls: TPanel
290 290
          Height = 26
291
          Top = 302
291
          Top = 289
292 292
          Width = 221
293 293
          Align = alBottom
294 294
          BevelOuter = bvNone
......
408 408
        Align = alLeft
409 409
        BorderSpacing.Around = 8
410 410
        Caption = 'Tiles'
411
        ClientHeight = 327
411
        ClientHeight = 329
412 412
        ClientWidth = 221
413 413
        ParentFont = True
414 414
        TabOrder = 0
415 415
        object lblDeleteStaticsTilesDesc: TLabel
416 416
          Left = 4
417
          Height = 73
417
          Height = 78
418 418
          Width = 213
419 419
          Align = alTop
420 420
          BorderSpacing.Left = 4
......
429 429
          Tag = 1
430 430
          Cursor = 63
431 431
          Left = 4
432
          Height = 220
433
          Top = 77
432
          Height = 217
433
          Top = 82
434 434
          Width = 213
435 435
          Align = alClient
436 436
          BorderSpacing.Left = 4
......
467 467
        end
468 468
        object pnlDrawTerrainTilesControls2: TPanel
469 469
          Height = 26
470
          Top = 301
470
          Top = 303
471 471
          Width = 221
472 472
          Align = alBottom
473 473
          BevelOuter = bvNone
......
579 579
        Top = 8
580 580
        Width = 185
581 581
        Caption = 'Z Boundaries'
582
        ClientHeight = 75
582
        ClientHeight = 77
583 583
        ClientWidth = 181
584 584
        ParentFont = True
585 585
        TabOrder = 1
586 586
        object Label7: TLabel
587 587
          Left = 4
588
          Height = 28
588
          Height = 30
589 589
          Width = 173
590 590
          Align = alTop
591 591
          BorderSpacing.Left = 4
......
598 598
        end
599 599
        object Label8: TLabel
600 600
          Left = 64
601
          Height = 13
601
          Height = 14
602 602
          Top = 42
603 603
          Width = 12
604 604
          Caption = 'to'
......
632 632
    object pgInsertStatics: TPage
633 633
      Caption = 'Insert statics'
634 634
      ClientWidth = 464
635
      ClientHeight = 360
635
      ClientHeight = 335
636 636
      ParentFont = True
637 637
      object gbInserStaticsTiles: TGroupBox
638 638
        Left = 8
639
        Height = 344
639
        Height = 319
640 640
        Top = 8
641 641
        Width = 225
642 642
        Align = alLeft
643 643
        BorderSpacing.Around = 8
644 644
        Caption = 'Tiles'
645
        ClientHeight = 327
645
        ClientHeight = 315
646 646
        ClientWidth = 221
647 647
        ParentFont = True
648 648
        TabOrder = 0
......
662 662
        object vdtInsertStaticsTiles: TVirtualDrawTree
663 663
          Tag = 1
664 664
          Left = 4
665
          Height = 235
665
          Height = 223
666 666
          Top = 62
667 667
          Width = 213
668 668
          Align = alClient
......
700 700
        end
701 701
        object pnlDrawTerrainTilesControls1: TPanel
702 702
          Height = 26
703
          Top = 301
703
          Top = 289
704 704
          Width = 221
705 705
          Align = alBottom
706 706
          BevelOuter = bvNone
b/Client/UfrmMain.lfm
5 5
  Width = 766
6 6
  ActiveControl = pcLeft
7 7
  Caption = 'UO CentrED'
8
  ClientHeight = 574
8
  ClientHeight = 578
9 9
  ClientWidth = 766
10 10
  Constraints.MinHeight = 603
11 11
  Constraints.MinWidth = 766
......
21 21
  WindowState = wsMaximized
22 22
  object pnlBottom: TPanel
23 23
    Height = 31
24
    Top = 543
24
    Top = 547
25 25
    Width = 766
26 26
    Align = alBottom
27 27
    BevelOuter = bvNone
......
110 110
    end
111 111
  end
112 112
  object pcLeft: TPageControl
113
    Height = 519
113
    Height = 523
114 114
    Top = 24
115 115
    Width = 224
116 116
    ActivePage = tsTiles
......
120 120
    TabOrder = 1
121 121
    object tsTiles: TTabSheet
122 122
      Caption = 'Tiles'
123
      ClientHeight = 488
123
      ClientHeight = 494
124 124
      ClientWidth = 220
125 125
      ParentFont = True
126 126
      object pnlTileListSettings: TPanel
......
134 134
        TabOrder = 0
135 135
        object lblFilter: TLabel
136 136
          Left = 84
137
          Height = 13
137
          Height = 14
138 138
          Top = 8
139
          Width = 33
139
          Width = 30
140 140
          Caption = 'Filter:'
141 141
          ParentColor = False
142 142
          ParentFont = True
143 143
        end
144 144
        object cbTerrain: TCheckBox
145 145
          Left = 4
146
          Height = 20
146
          Height = 21
147 147
          Top = 8
148
          Width = 66
148
          Width = 60
149 149
          Caption = 'Terrain'
150 150
          Checked = True
151 151
          OnChange = cbTerrainChange
......
155 155
        end
156 156
        object cbStatics: TCheckBox
157 157
          Left = 4
158
          Height = 20
158
          Height = 21
159 159
          Top = 32
160
          Width = 64
160
          Width = 59
161 161
          Caption = 'Statics'
162 162
          Checked = True
163 163
          OnChange = cbStaticsChange
......
177 177
      end
178 178
      object vdtTiles: TVirtualDrawTree
179 179
        Tag = 1
180
        Height = 234
180
        Height = 240
181 181
        Top = 56
182 182
        Width = 220
183 183
        Align = alClient
......
221 221
      end
222 222
      object gbRandom: TGroupBox
223 223
        Height = 193
224
        Top = 295
224
        Top = 301
225 225
        Width = 220
226 226
        Align = alBottom
227 227
        Caption = 'Random pool'
228
        ClientHeight = 176
228
        ClientHeight = 178
229 229
        ClientWidth = 216
230 230
        ParentFont = True
231 231
        TabOrder = 2
232 232
        object vdtRandom: TVirtualDrawTree
233 233
          Tag = 1
234 234
          Cursor = 63
235
          Height = 124
235
          Height = 126
236 236
          Top = 22
237 237
          Width = 216
238 238
          Align = alClient
......
420 420
        object pnlRandomPreset: TPanel
421 421
          Left = 4
422 422
          Height = 22
423
          Top = 150
423
          Top = 152
424 424
          Width = 208
425 425
          Align = alBottom
426 426
          BorderSpacing.Around = 4
......
540 540
      object spTileList: TSplitter
541 541
        Cursor = crVSplit
542 542
        Height = 5
543
        Top = 290
543
        Top = 296
544 544
        Width = 220
545 545
        Align = alBottom
546 546
        ResizeAnchor = akBottom
......
563 563
    end
564 564
    object tsClients: TTabSheet
565 565
      Caption = 'Clients'
566
      ClientHeight = 519
567
      ClientWidth = 224
566
      ClientHeight = 494
567
      ClientWidth = 220
568 568
      ParentFont = True
569 569
      object lbClients: TListBox
570
        Height = 519
571
        Width = 224
570
        Height = 494
571
        Width = 220
572 572
        Align = alClient
573 573
        OnDblClick = mnuGoToClientClick
574 574
        ParentFont = True
......
580 580
    end
581 581
    object tsLocations: TTabSheet
582 582
      Caption = 'Locations'
583
      ClientHeight = 519
584
      ClientWidth = 224
583
      ClientHeight = 494
584
      ClientWidth = 220
585 585
      ParentFont = True
586 586
      object vstLocations: TVirtualStringTree
587 587
        Cursor = 63
588 588
        Left = 4
589
        Height = 483
589
        Height = 458
590 590
        Top = 4
591
        Width = 216
591
        Width = 212
592 592
        Align = alClient
593 593
        BorderSpacing.Around = 4
594 594
        BorderStyle = bsSingle
......
614 614
          end        
615 615
          item
616 616
            Position = 1
617
            Width = 141
617
            Width = 137
618 618
            WideText = 'Name'
619 619
          end>
620 620
      end
621 621
      object pnlLocationControls: TPanel
622 622
        Left = 4
623 623
        Height = 24
624
        Top = 491
625
        Width = 216
624
        Top = 466
625
        Width = 212
626 626
        Align = alBottom
627 627
        BorderSpacing.Around = 4
628 628
        BevelOuter = bvNone
629 629
        ClientHeight = 24
630
        ClientWidth = 216
630
        ClientWidth = 212
631 631
        ParentFont = True
632 632
        TabOrder = 1
633 633
        object btnClearLocations: TSpeedButton
......
951 951
  end
952 952
  object pnlMain: TPanel
953 953
    Left = 224
954
    Height = 519
954
    Height = 523
955 955
    Top = 24
956 956
    Width = 542
957 957
    Align = alClient
958 958
    BevelOuter = bvNone
959
    ClientHeight = 519
959
    ClientHeight = 523
960 960
    ClientWidth = 542
961 961
    ParentFont = True
962 962
    TabOrder = 3
963 963
    object oglGameWindow: TOpenGLControl
964
      Height = 368
964
      Height = 372
965 965
      Width = 542
966 966
      Align = alClient
967 967
      OnDblClick = oglGameWindowDblClick
......
975 975
    end
976 976
    object pnlChatHeader: TPanel
977 977
      Height = 24
978
      Top = 368
978
      Top = 372
979 979
      Width = 542
980 980
      Align = alBottom
981 981
      BevelInner = bvRaised
......
1003 1003
    end
1004 1004
    object pnlChat: TPanel
1005 1005
      Height = 122
1006
      Top = 397
1006
      Top = 401
1007 1007
      Width = 542
1008 1008
      Align = alBottom
1009 1009
      BevelOuter = bvNone
......
1059 1059
    object spChat: TSplitter
1060 1060
      Cursor = crVSplit
1061 1061
      Height = 5
1062
      Top = 392
1062
      Top = 396
1063 1063
      Width = 542
1064 1064
      Align = alBottom
1065 1065
      AutoSnap = False
b/Client/UfrmMain.pas
32 32
uses
33 33
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Menus,
34 34
  ComCtrls, OpenGLContext, GL, GLU, UGameResources, ULandscape, ExtCtrls,
35
  StdCtrls, Spin, UEnums, VTHeaderPopup, VirtualTrees, Buttons, UMulBlock,
36
  UWorldItem, math, LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream,
37
  ActnList, ImagingClasses, contnrs, dateutils, UPlatformTypes;
35
  StdCtrls, Spin, UEnums, VirtualTrees, Buttons, UMulBlock, UWorldItem, math,
36
  LCLIntf, UOverlayUI, UStatics, UEnhancedMemoryStream, ActnList,
37
  ImagingClasses, dateutils, UPlatformTypes;
38 38

  
39 39
type
40 40

  
......
1030 1030
    end else
1031 1031
      Delete(enteredText, Length(enteredText), 1);
1032 1032
    
1033
    tileID := 0;
1033 1034
    if not TryStrToInt(enteredText, tileID) then
1034 1035
    begin
1035 1036
      //edSearchID.Font.Color := clRed;
......
1306 1307

  
1307 1308
procedure TfrmMain.vdtTilesHotChange(Sender: TBaseVirtualTree; OldNode,
1308 1309
  NewNode: PVirtualNode);
1310
{$IFDEF Windows}
1309 1311
var
1310 1312
  tileInfo: PTileInfo;
1313
{$ENDIF Windows}
1311 1314
begin
1312 1315
  {TODO : Fix mouse over on !Windows platforms}
1313 1316
  {$IFDEF Windows}
......
1440 1443
  locationInfo := Sender.GetNodeData(Node);
1441 1444
  Stream.Read(locationInfo^.X, SizeOf(Word));
1442 1445
  Stream.Read(locationInfo^.Y, SizeOf(Word));
1446
  stringLength := 0;
1443 1447
  Stream.Read(stringLength, SizeOf(Integer));
1444 1448
  SetLength(s, stringLength);
1445 1449
  Stream.Read(s[1], stringLength);
......
1570 1574
  virtualTile: TVirtualTile;
1571 1575
  staticsFilter: TStaticFilter;
1572 1576

  
1573
  procedure GetMapDrawOffset(x, y: Integer; var drawX, drawY: Single);
1577
  procedure GetMapDrawOffset(x, y: Integer; out drawX, drawY: Single);
1574 1578
  begin
1575 1579
    drawX := (oglGameWindow.Width div 2) + (x - y) * 22;
1576 1580
    drawY := (oglGamewindow.Height div 2) + (x + y) * 22;
......
1578 1582
begin
1579 1583
  drawDistance := Trunc(Sqrt(oglGameWindow.Width * oglGameWindow.Width + oglGamewindow.Height * oglGamewindow.Height) / 44);
1580 1584

  
1585
  {$HINTS off}{$WARNINGS off}
1581 1586
  if FX - drawDistance < 0 then lowOffX := -FX else lowOffX := -drawDistance;
1582 1587
  if FY - drawDistance < 0 then lowOffY := -FY else lowOffY := -drawDistance;
1583 1588
  if FX + drawDistance >= FLandscape.Width * 8 then highOffX := FLandscape.Width * 8 - FX - 1 else highOffX := drawDistance;
1584 1589
  if FY + drawDistance >= FLandscape.Height * 8 then highOffY := FLandscape.Height * 8 - FY - 1 else highOffY := drawDistance;
1590
  {$HINTS on}{$WARNINGS on}
1585 1591

  
1586 1592
  FLandscape.PrepareBlocks((FX + lowOffX) div 8, (FY + lowOffY) div 8, (FX + highOffX) div 8 + 1, (FY + highOffY) div 8 + 1);
1587 1593

  
b/Client/UfrmRegionControl.lfm
287 287
      TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toThemeAware, toUseBlendedImages]
288 288
      TreeOptions.SelectionOptions = [toFullRowSelect]
289 289
      OnChange = vstRegionsChange
290
      OnEditing = vstRegionsOnEditing
291 290
      OnFreeNode = vstRegionsFreeNode
292 291
      OnGetText = vstRegionsGetText
293
      OnNewText = vstRegionsNewText
294 292
      Columns = <      
295 293
        item
296 294
          Width = 158
......
337 335
    ClientWidth = 612
338 336
    ParentFont = True
339 337
    TabOrder = 2
340
    object btnExit: TButton
338
    object btnClose: TButton
341 339
      Left = 548
342 340
      Height = 25
343 341
      Width = 64
344 342
      Align = alRight
345 343
      Anchors = [akTop, akRight]
346 344
      BorderSpacing.Left = 4
347
      Caption = 'Exit'
345
      Caption = 'Close'
348 346
      OnClick = btnCloseClick
349 347
      ParentFont = True
350 348
      TabOrder = 0
......
368 366
    top = 43
369 367
    object mnuAddRegion: TMenuItem
370 368
      Caption = 'Add'
371
      OnClick = acAddGroup
369
      OnClick = mnuAddRegionClick
372 370
    end
373 371
    object mnuRemoveRegion: TMenuItem
374 372
      Caption = 'Remove'
375
      OnClick = accRemoveGroup
373
      Enabled = False
374
      OnClick = mnuRemoveRegionClick
376 375
    end
377 376
  end
378 377
end
b/Client/UfrmRegionControl.pas
30 30
interface
31 31

  
32 32
uses
33
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, CheckLst,
33
  Classes, SysUtils, math, LResources, Forms, Controls, Graphics, Dialogs,
34 34
  VirtualTrees, ExtCtrls, ImagingComponents, StdCtrls, Buttons, Spin, LCLIntf,
35
  math, UPlatformTypes, UEnhancedMemoryStream, Menus, contnrs, URectList;
35
  UEnhancedMemoryStream, Menus, URectList;
36 36

  
37 37
type
38 38
  TAreaMoveType = (amLeft, amTop, amRight, amBottom);
......
44 44
    btnAddArea: TSpeedButton;
45 45
    btnClearArea: TSpeedButton;
46 46
    btnDeleteArea: TSpeedButton;
47
    btnExit: TButton;
47
    btnClose: TButton;
48 48
    btnSave: TButton;
49 49
    Label1: TLabel;
50 50
    lblX: TLabel;
......
64 64
    seY2: TSpinEdit;
65 65
    vstRegions: TVirtualStringTree;
66 66
    vstArea: TVirtualStringTree;
67
    procedure acAddGroup(Sender: TObject);
68
    procedure accRemoveGroup(Sender: TObject);
67
    procedure mnuAddRegionClick(Sender: TObject);
68
    procedure mnuRemoveRegionClick(Sender: TObject);
69 69
    procedure btnAddAreaClick(Sender: TObject);
70 70
    procedure btnClearAreaClick(Sender: TObject);
71 71
    procedure btnCloseClick(Sender: TObject);
......
87 87
    procedure vstRegionsFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode);
88 88
    procedure vstRegionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
89 89
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
90
    procedure vstRegionsNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
91
      Column: TColumnIndex; const NewText: WideString);
92
    procedure vstRegionsOnEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
93
      Column: TColumnIndex; var Allowed: Boolean);
94 90
  protected
95 91
    FLastX: Integer;
96 92
    FLastY: Integer;
97 93
    FAreaMove: TAreaMove;
94
    function FindRegion(AName: string): PVirtualNode;
95
    procedure OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream);
96
    procedure OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream);
98 97
    procedure OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
99 98
  private
100 99
    { private declarations }
......
108 107
implementation
109 108

  
110 109
uses
111
  UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UPackets,
112
  UGUIPlatformUtils, UAdminHandling, UPacketHandlers;
110
  UGameResources, UfrmRadar, UfrmMain, UdmNetwork, UPacket, UGUIPlatformUtils,
111
  UAdminHandling, UPacketHandlers;
113 112

  
114 113
type
115 114

  
115
  PRegionInfo = ^TRegionInfo;
116
  TRegionInfo = record
117
    Name: string;
118
    Areas: TRectList;
119
  end;
120

  
121
  { TModifyRegionPacket }
122

  
123
  TModifyRegionPacket = class(TPacket)
124
    constructor Create(ARegionInfo: TRegionInfo);
125
  end;
126

  
127
  { TDeleteRegionPacket }
128

  
129
  TDeleteRegionPacket = class(TPacket)
130
    constructor Create(AName: string);
131
  end;
132

  
116 133
  { TRequestRegionListPacket }
117 134

  
118 135
  TRequestRegionListPacket = class(TPacket)
119 136
    constructor Create;
120 137
  end;
121
  
122
  PRegionInfo = ^TRegionInfo;
123
  TRegionInfo = record
124
    Name: string;
125
    Areas: TRectList;
138

  
139
{ TModifyRegionPacket }
140

  
141
constructor TModifyRegionPacket.Create(ARegionInfo: TRegionInfo);
142
var
143
  i: Integer;
144
  count: Byte;
145
  area: TRect;
146
begin
147
  inherited Create($03, 0); //Admin Packet
148
  FStream.WriteByte($08); //Admin PacketID
149
  FStream.WriteStringNull(ARegionInfo.Name);
150
  count := Min(ARegionInfo.Areas.Count, 256);
151
  FStream.WriteByte(count);
152
  for i := 0 to count - 1 do
153
  begin
154
    area := ARegionInfo.Areas.Rects[i];
155
    FStream.WriteWord(area.Left);
156
    FStream.WriteWord(area.Top);
157
    FStream.WriteWord(area.Right);
158
    FStream.WriteWord(area.Bottom);
126 159
  end;
160
end;
161

  
162
{ TDeleteRegionPacket }
163

  
164
constructor TDeleteRegionPacket.Create(AName: string);
165
begin
166
  inherited Create($03, 0); //Admin Packet
167
  FStream.WriteByte($09); //Admin PacketID
168
  FStream.WriteStringNull(AName);
169
end;
127 170

  
128 171
{ TRequestRegionListPacket }
129 172

  
130 173
constructor TRequestRegionListPacket.Create;
131 174
begin
132
  inherited Create($03, 0);
133
  FStream.WriteByte($0A);
175
  inherited Create($03, 0); //Admin Packet
176
  FStream.WriteByte($0A); //Admin PacketID
134 177
end;
135 178

  
136 179
{ TfrmRegionControl }
137 180

  
181
procedure TfrmRegionControl.FormCreate(Sender: TObject);
182
begin
183
  pbArea.Width := frmRadarMap.Radar.Width;
184
  pbArea.Height := frmRadarMap.Radar.Height;
185
  seX1.MaxValue := ResMan.Landscape.CellWidth;
186
  seX2.MaxValue := ResMan.Landscape.CellWidth;
187
  seY1.MaxValue := ResMan.Landscape.CellHeight;
188
  seY2.MaxValue := ResMan.Landscape.CellHeight;
189
  
190
  vstArea.NodeDataSize := SizeOf(TRect);
191
  vstRegions.NodeDataSize := SizeOf(TRegionInfo);
192
  
193
  frmRadarMap.Dependencies.Add(pbArea);
194

  
195
  AssignAdminPacketHandler($08, TPacketHandler.Create(0, @OnModifyRegionPacket));
196
  AssignAdminPacketHandler($09, TPacketHandler.Create(0, @OnDeleteRegionPacket));
197
  AssignAdminPacketHandler($0A, TPacketHandler.Create(0, @OnListRegionsPacket));
198
end;
199

  
200
procedure TfrmRegionControl.FormDestroy(Sender: TObject);
201
begin
202
  frmRadarMap.Dependencies.Remove(pbArea);
203
  if AdminPacketHandlers[$08] <> nil then FreeAndNil(AdminPacketHandlers[$08]);
204
  if AdminPacketHandlers[$09] <> nil then FreeAndNil(AdminPacketHandlers[$09]);
205
  if AdminPacketHandlers[$0A] <> nil then FreeAndNil(AdminPacketHandlers[$0A]);
206
end;
207

  
208
procedure TfrmRegionControl.FormShow(Sender: TObject);
209
begin
210
  SetWindowParent(Handle, frmMain.Handle);
211
  btnSave.Enabled := False; //no changes yet
212
  dmNetwork.Send(TRequestRegionListPacket.Create);
213
end;
214

  
215
procedure TfrmRegionControl.btnSaveClick(Sender: TObject);
216
var
217
  regionNode: PVirtualNode;
218
  regionInfo: PRegionInfo;
219
  areaNode: PVirtualNode;
220
  areaInfo: PRect;
221
begin
222
  btnSave.Enabled := False;
223

  
224
  //Refresh the current region
225
  regionNode := vstRegions.GetFirstSelected;
226
  if regionNode <> nil then
227
  begin
228
    regionInfo := vstRegions.GetNodeData(regionNode);
229
    regionInfo^.Areas.Clear;
230
    areaNode := vstArea.GetFirst;
231
    while areaNode <> nil do
232
    begin
233
      areaInfo := vstArea.GetNodeData(areaNode);
234
      regionInfo^.Areas.Add(areaInfo^.Left, areaInfo^.Top, areaInfo^.Right,
235
        areaInfo^.Bottom);
236
      areaNode := vstArea.GetNext(areaNode);
237
    end;
238

  
239
    //Send the modified values
240
    dmNetwork.Send(TModifyRegionPacket.Create(regionInfo^));
241
  end;
242

  
243
  //Clear the selection
244
  vstRegions.ClearSelection;
245
end;
246

  
247
procedure TfrmRegionControl.mnuAddRegionClick(Sender: TObject);
248
var
249
  regionName: string;
250
  node: PVirtualNode;
251
  regionInfo: PRegionInfo;
252
begin
253
  regionName := '';
254
  if InputQuery('New Region', 'Enter the name for the new region:', regionName) then
255
  begin
256
    if FindRegion(regionName) = nil then
257
    begin
258
      node := vstRegions.AddChild(nil);
259
      regionInfo := vstRegions.GetNodeData(node);
260
      regionInfo^.Name := regionName;
261
      regionInfo^.Areas := TRectList.Create;
262
      vstRegions.ClearSelection;
263
      vstRegions.Selected[node] := True;
264
      btnSave.Enabled := True;
265
    end else
266
    begin
267
      MessageDlg('New Region', 'The region could not be added. A region with ' +
268
        'that name already exists.', mtError, [mbOK], 0);
269
    end;
270
  end;
271
end;
272

  
273
procedure TfrmRegionControl.mnuRemoveRegionClick(Sender: TObject);
274
var
275
  regionNode: PVirtualNode;
276
  regionInfo: PRegionInfo;
277
begin
278
  regionNode := vstRegions.GetFirstSelected;
279
  if (regionNode <> nil) and (MessageDlg('Delete Region', 'Are you sure, you ' +
280
    'want to delete the selected region?', mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
281
  begin
282
    regionInfo := vstRegions.GetNodeData(regionNode);
283
    dmNetwork.Send(TDeleteRegionPacket.Create(regionInfo^.Name));
284
    vstRegions.Selected[regionNode] := False;
285
  end;
286
end;
287

  
288
procedure TfrmRegionControl.btnAddAreaClick(Sender: TObject);
289
var
290
  node: PVirtualNode;
291
  areaInfo: PRect;
292
begin
293
  node := vstArea.AddChild(nil);
294
  areaInfo := vstArea.GetNodeData(node);
295
  areaInfo^.Left := 0;
296
  areaInfo^.Top := 0;
297
  areaInfo^.Right := 0;
298
  areaInfo^.Bottom := 0;
299
  vstArea.ClearSelection;
300
  vstArea.Selected[node] := True;
301
  vstArea.FocusedNode := node;
302

  
303
  btnSave.Enabled := True; //possible change to be saved
304
end;
305

  
306
procedure TfrmRegionControl.btnClearAreaClick(Sender: TObject);
307
begin
308
  vstArea.Clear;
309
  vstAreaChange(vstArea, nil);
310
end;
311

  
312
procedure TfrmRegionControl.btnCloseClick(Sender: TObject);
313
begin
314
  if btnSave.Enabled and (MessageDlg('Unsaved changes', 'There are unsaved ' +
315
    'changes.' + #13#10+#13#10+ 'Do you want to save them now?',
316
    mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
317
  begin
318
    btnSaveClick(Sender);
319
  end;
320

  
321
  Close;
322
end;
323

  
324
procedure TfrmRegionControl.btnDeleteAreaClick(Sender: TObject);
325
begin
326
  vstArea.DeleteSelectedNodes;
327
  vstAreaChange(vstArea, nil);
328

  
329
  btnSave.Enabled := True; //possible change to be saved
330
end;
331

  
332
procedure TfrmRegionControl.pbAreaMouseDown(Sender: TObject;
333
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
334
var
335
  areaNode, match: PVirtualNode;
336
  areaInfo: PRect;
337
  p: TPoint;
338
begin
339
  FAreaMove := [];
340
  p := Point(X * 8, Y * 8);
341
  match := nil;
342
  areaNode := vstArea.GetFirst;
343
  while areaNode <> nil do //find the last matching area
344
  begin
345
    areaInfo := vstArea.GetNodeData(areaNode);
346
    if PtInRect(areaInfo^, p) then
347
      match := areaNode;
348
    areaNode := vstArea.GetNext(areaNode);
349
  end;
350
  if match <> nil then
351
  begin
352
    areaInfo := vstArea.GetNodeData(match);
353
    if p.x - areaInfo^.Left <= 64 then Include(FAreaMove, amLeft);
354
    if p.y - areaInfo^.Top <= 64 then Include(FAreaMove, amTop);
355
    if areaInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight);
356
    if areaInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom);
357
    if FAreaMove = [] then
358
      FAreaMove := [amLeft, amTop, amRight, amBottom];
359
  end else
360
  begin
361
    match := vstArea.AddChild(nil);
362
    areaInfo := vstArea.GetNodeData(match);
363
    areaInfo^.Left := p.x;
364
    areaInfo^.Top := p.y;
365
    areaInfo^.Right := p.x;
366
    areaInfo^.Bottom := p.y;
367
    pbArea.Repaint;
368
    FAreaMove := [amRight, amBottom];
369
  end;
370
  vstArea.ClearSelection;
371
  vstArea.Selected[match] := True;
372
  FLastX := X;
373
  FLastY := Y;
374
end;
375

  
376
procedure TfrmRegionControl.pbAreaMouseMove(Sender: TObject;
377
  Shift: TShiftState; X, Y: Integer);
378
var
379
  offsetX, offsetY: Integer;
380
begin
381
  if (ssLeft in Shift) and (vstArea.GetFirstSelected <> nil) then
382
  begin
383
    offsetX := (X - FLastX) * 8;
384
    offsetY := (Y - FLastY) * 8;
385
    if amLeft in FAreaMove then seX1.Value := seX1.Value + offsetX;
386
    if amRight in FAreaMove then seX2.Value := seX2.Value + offsetX;
387
    if amTop in FAreaMove then seY1.Value := seY1.Value + offsetY;
388
    if amBottom in FAreaMove then seY2.Value := seY2.Value + offsetY;
389
    FLastX := X;
390
    FLastY := Y;
391
    seX1Change(nil);
392
  end;
393
end;
394

  
395
procedure TfrmRegionControl.pbAreaPaint(Sender: TObject);
396
var
397
  node: PVirtualNode;
398
  areaInfo: PRect;
399
begin
400
  DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar);
401
  pbArea.Canvas.Pen.Color := clRed;
402
  pbArea.Canvas.Brush.Color := clMaroon;
403
  pbArea.Canvas.Brush.Style := bsFDiagonal;
404
  node := vstArea.GetFirst;
405
  while node <> nil do
406
  begin
407
    if vstArea.Selected[node] then
408
    begin
409
      pbArea.Canvas.Pen.Width := 2;
410
      pbArea.Canvas.Pen.Style := psSolid;
411
    end else
412
    begin
413
      pbArea.Canvas.Pen.Width := 1;
414
      pbArea.Canvas.Pen.Style := psDot;
415
    end;
416
    areaInfo := vstArea.GetNodeData(node);
417
    pbArea.Canvas.Rectangle(areaInfo^.Left div 8, areaInfo^.Top div 8,
418
      areaInfo^.Right div 8 + 1, areaInfo^.Bottom div 8 + 1);
419
    node := vstArea.GetNext(node);
420
  end;
421
end;
422

  
423
procedure TfrmRegionControl.seX1Change(Sender: TObject);
424
var
425
  node: PVirtualNode;
426
  areaInfo: PRect;
427
begin
428
  node := vstArea.GetFirstSelected;
429
  if node <> nil then
430
  begin
431
    areaInfo := vstArea.GetNodeData(node);
432
    areaInfo^.Left := seX1.Value;
433
    areaInfo^.Right := seX2.Value;
434
    areaInfo^.Top := seY1.Value;
435
    areaInfo^.Bottom := seY2.Value;
436
    vstArea.InvalidateNode(node);
437
    pbArea.Repaint;
438

  
439
    btnSave.Enabled := True; //possible change to be saved
440
  end;
441
end;
442

  
443
procedure TfrmRegionControl.vstAreaChange(Sender: TBaseVirtualTree;
444
  Node: PVirtualNode);
445
var
446
  areaInfo: PRect;
447
  selected: Boolean;
448
begin
449
  selected := (Node <> nil) and Sender.Selected[Node];
450
  btnDeleteArea.Enabled := selected;
451
  lblX.Enabled := selected;
452
  lblY.Enabled := selected;
453
  seX1.Enabled := selected;
454
  seX2.Enabled := selected;
455
  seY1.Enabled := selected;
456
  seY2.Enabled := selected;
457
  if selected then
458
  begin
459
    areaInfo := Sender.GetNodeData(Node);
460
    seX1.Value := areaInfo^.Left;
461
    seX2.Value := areaInfo^.Right;
462
    seY1.Value := areaInfo^.Top;
463
    seY2.Value := areaInfo^.Bottom;
464
  end;
465
  pbArea.Repaint;
466
end;
467

  
468
procedure TfrmRegionControl.vstAreaGetText(Sender: TBaseVirtualTree;
469
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
470
  var CellText: WideString);
471
var
472
  areaInfo: PRect;
473
begin
474
  areaInfo := Sender.GetNodeData(Node);
475
  CellText := Format('(%d, %d), (%d, %d)', [areaInfo^.Left, areaInfo^.Top,
476
    areaInfo^.Right, areaInfo^.Bottom]);
477
end;
478

  
479
procedure TfrmRegionControl.vstRegionsChange(Sender: TBaseVirtualTree;
480
  Node: PVirtualNode);
481
var
482
  i: Integer;
483
  selected, areaNode: PVirtualNode;
484
  regionInfo: PRegionInfo;
485
  areaInfo: PRect;
486
begin
487
  if btnSave.Enabled and (MessageDlg('Unsaved changes', 'There are unsaved ' +
488
    'changes.' + #13#10+#13#10+ 'Do you want to save them now?',
489
    mtConfirmation, [mbYes, mbNo], 0) = mrYes) then
490
  begin
491
    btnSaveClick(Sender);
492
  end;
493

  
494
  vstArea.BeginUpdate;
495
  vstArea.Clear;
496
  selected := Sender.GetFirstSelected;
497
  if selected <> nil then
498
  begin
499
    btnAddArea.Enabled := True;
500
    btnClearArea.Enabled := True;
501
    mnuRemoveRegion.Enabled := True;
502

  
503
    regionInfo := Sender.GetNodeData(selected);
504
    for i := 0 to regionInfo^.Areas.Count - 1 do
505
    begin
506
      areaNode := vstArea.AddChild(nil);
507
      areaInfo := vstArea.GetNodeData(areaNode);
508
      with regionInfo^.Areas.Rects[i] do
509
      begin
510
        areaInfo^.Left   := Left;
511
        areaInfo^.Top    := Top;
512
        areaInfo^.Right  := Right;
513
        areaInfo^.Bottom := Bottom;
514
      end;
515
    end;
516
  end else
517
  begin
518
    btnAddArea.Enabled := False;
519
    btnDeleteArea.Enabled := False;
520
    btnClearArea.Enabled := False;
521
    mnuRemoveRegion.Enabled := False;
522
  end;
523
  vstArea.EndUpdate;
524
  pbArea.Repaint;
525

  
526
  btnSave.Enabled := False; //no changes to be saved
527
end;
528

  
529
procedure TfrmRegionControl.vstRegionsFreeNode(Sender: TBaseVirtualTree;
530
  Node: PVirtualNode);
531
var
532
  regionInfo: PRegionInfo;
533
begin
534
  regionInfo := Sender.GetNodeData(Node);
535
  if regionInfo^.Areas <> nil then FreeAndNil(regionInfo^.Areas);
536
end;
537

  
538
procedure TfrmRegionControl.vstRegionsGetText(Sender: TBaseVirtualTree;
539
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
540
  var CellText: WideString);
541
var
542
  regionInfo: PRegionInfo;
543
begin
544
  regionInfo := Sender.GetNodeData(Node);
545
  CellText := regionInfo^.Name;
546
end;
547

  
548
function TfrmRegionControl.FindRegion(AName: string): PVirtualNode;
549
var
550
  regionInfo: PRegionInfo;
551
  found: Boolean;
552
begin
553
  found := False;
554
  Result := vstRegions.GetFirst;
555
  while (Result <> nil) and (not found) do
556
  begin
557
    regionInfo := vstRegions.GetNodeData(Result);
558
    if regionInfo^.Name = AName then
559
      found := True
560
    else
561
      Result := vstRegions.GetNext(Result);
562
  end;
563
end;
564

  
565
procedure TfrmRegionControl.OnModifyRegionPacket(ABuffer: TEnhancedMemoryStream);
566
var
567
  regionName: string;
568
  regionNode: PVirtualNode;
569
  regionInfo: PRegionInfo;
570
  areaCount: Byte;
571
  i: Integer;
572
  x1, y1, x2, y2: Word;
573
begin
574
  ABuffer.ReadByte; //status, not used yet
575

  
576
  //TODO : Ask user how to proceed, if the added/modified packet conflicts with the currently edited region
577

  
578
  regionName := ABuffer.ReadStringNull;
579
  regionNode := FindRegion(regionName);
580
  if regionNode = nil then
581
  begin
582
    regionNode := vstRegions.AddChild(nil);
583
    regionInfo := vstRegions.GetNodeData(regionNode);
584
    regionInfo^.Name := regionName;
585
    regionInfo^.Areas := TRectList.Create;
586
  end else
587
  begin
588
    regionInfo := vstRegions.GetNodeData(regionNode);
589
    regionInfo^.Areas.Clear;
590
  end;
591

  
592
  areaCount := ABuffer.ReadByte;
593
  for i := 0 to areaCount - 1 do
594
  begin
595
    x1 := ABuffer.ReadWord;
596
    y1 := ABuffer.ReadWord;
597
    x2 := ABuffer.ReadWord;
598
    y2 := ABuffer.ReadWord;
599
    regionInfo^.Areas.Add(x1, y1, x2, y2);
600
  end;
601

  
602
  if vstRegions.Selected[regionNode] then
603
  begin
604
    btnSave.Enabled := False;
605
    vstRegionsChange(vstRegions, regionNode);
606
  end;
607
end;
608

  
609
procedure TfrmRegionControl.OnDeleteRegionPacket(ABuffer: TEnhancedMemoryStream);
610
var
611
  regionName: string;
612
  regionNode: PVirtualNode;
613
begin
614
  ABuffer.ReadByte; //status, not used yet
615
  regionName := ABuffer.ReadStringNull;
616
  regionNode := FindRegion(regionName);
617

  
618
  //TODO : Ask user how to proceed, if the deleted packet conflicts with the currently edited region
619

  
620
  if regionNode <> nil then
621
    vstRegions.DeleteNode(regionNode);
622
end;
623

  
138 624
procedure TfrmRegionControl.OnListRegionsPacket(ABuffer: TEnhancedMemoryStream);
139 625
var
140 626
  regionCount, areaCount: Byte;
......
164 650
  vstRegions.EndUpdate;
165 651
end;
166 652

  
167

  
168
procedure TfrmRegionControl.FormCreate(Sender: TObject);
169
begin
170
  pbArea.Width := frmRadarMap.Radar.Width;
171
  pbArea.Height := frmRadarMap.Radar.Height;
172
  seX1.MaxValue := ResMan.Landscape.CellWidth;
173
  seX2.MaxValue := ResMan.Landscape.CellWidth;
174
  seY1.MaxValue := ResMan.Landscape.CellHeight;
175
  seY2.MaxValue := ResMan.Landscape.CellHeight;
176
  
177
  vstArea.NodeDataSize := SizeOf(TRect);
178
  vstRegions.NodeDataSize := SizeOf(TRegionInfo);
179
  
180
  frmRadarMap.Dependencies.Add(pbArea);
181

  
182
  AdminPacketHandlers[$0A] := TPacketHandler.Create(0, @OnListRegionsPacket);
183
end;
184

  
185
procedure TfrmRegionControl.btnDeleteAreaClick(Sender: TObject);
186
var
187
  infoGroup: PRegionInfo;
188
  i: Integer;
189
begin
190
  if vstRegions.GetFirstSelected <> nil then
191
  begin
192
   infoGroup := vstRegions.GetNodeData(vstRegions.GetFirstSelected);
193
   infoGroup^.Areas.Delete(vstArea.AbsoluteIndex(vstArea.GetFirstSelected));
194
   vstRegionsChange(vstRegions, vstRegions.GetFirstSelected);
195
  end;
196
end;
197

  
198
procedure TfrmRegionControl.btnSaveClick(Sender: TObject);
199
var
200
  packet: TPacket;
201
  stream: TEnhancedMemoryStream;
202
  groupCount,areaCount: Byte;
203
  i, j: Integer;
204
  node: PVirtualNode;
205
  groupInfo: PRegionInfo;
206
begin
207
  packet := TPacket.Create($03, 0);
208
  stream := packet.Stream;
209
  stream.Position := stream.Size;
210
  stream.WriteByte($09);
211

  
212
  groupCount := Min(vstRegions.RootNodeCount, 255);
213
  stream.WriteByte(groupCount);
214
  if groupCount = 0 then Exit;
215

  
216
  i := 0;
217
  node := vstRegions.GetFirst;
218
  while (node <> nil) and (i < groupCount) do
219
  begin
220
    groupInfo := vstRegions.GetNodeData(node);
221
    stream.WriteStringNull(groupInfo^.Name);
222
    areaCount:=Min(groupInfo^.Areas.Count,255);
223
    stream.WriteByte(areaCount);
224
    for j := 0 to areaCount-1 do
225
      with groupInfo^.Areas.Rects[j] do
226
      begin
227
        stream.WriteWord(Min(Left, Right));
228
        stream.WriteWord(Min(Top,  Bottom));
229
        stream.WriteWord(Max(Left, Right));
230
        stream.WriteWord(Max(Top,  Bottom));
231
      end;
232
    node := vstRegions.GetNext(node);
233
    Inc(i);
234
  end;
235
  dmNetwork.Send(TCompressedPacket.Create(packet));
236
  Close;
237
end;
238

  
239
procedure TfrmRegionControl.acAddGroup(Sender: TObject);
240
var
241
  node : PVirtualNode;
242
  infoGroup : PRegionInfo;
243
begin
244
  node := vstRegions.AddChild(nil);
245
  infoGroup := vstRegions.GetNodeData(node);
246
  infoGroup^.Name := 'Unnamed';
247
  infoGroup^.Areas := TRectList.Create;
248
end;
249

  
250
procedure TfrmRegionControl.accRemoveGroup(Sender: TObject);
... This diff was truncated because it exceeds the maximum size that can be displayed.

Also available in: Unified diff