Revision 13:c78b5eafa10e Client/UfrmRegionControl.pas

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);
251
begin
252
  vstRegions.DeleteSelectedNodes;
253
  vstRegionsChange(vstRegions, nil);
254
end;
255

  
256
procedure TfrmRegionControl.btnAddAreaClick(Sender: TObject);
257
var
258
  node, selected: PVirtualNode;
259
  areaInfo: ^TRect;
260
  regionInfo: PRegionInfo;
261
begin
262
  selected := vstRegions.GetFirstSelected;
263
  if selected <> nil then
264
  begin
265
    regionInfo := vstRegions.GetNodeData(selected);
266
    node := vstArea.AddChild(nil);
267
    areaInfo := vstArea.GetNodeData(node);
268
    areaInfo^.Left := 0;
269
    areaInfo^.Top := 0;
270
    areaInfo^.Right := 0;
271
    areaInfo^.Bottom := 0;
272
    regionInfo^.Areas.Add(0, 0, 0, 0);
273
    vstArea.ClearSelection;
274
    vstArea.Selected[node] := True;
275
    vstArea.FocusedNode := node;
276
  end;
277
end;
278

  
279
procedure TfrmRegionControl.btnClearAreaClick(Sender: TObject);
280
var
281
  regionNode: PVirtualNode;
282
  regionInfo: PRegionInfo;
283
  i: Integer;
284
begin
285
  regionNode := vstRegions.GetFirstSelected;
286
  if regionNode <> nil then
287
  begin
288
    regionInfo := vstRegions.GetNodeData(regionNode);
289
    regionInfo^.Areas.Clear;
290
    vstRegionsChange(vstRegions, vstRegions.GetFirstSelected);
291
  end;
292
end;
293

  
294
procedure TfrmRegionControl.btnCloseClick(Sender: TObject);
295
begin
296
  Close;
297
end;
298

  
299
procedure TfrmRegionControl.FormDestroy(Sender: TObject);
300
begin
301
  frmRadarMap.Dependencies.Remove(pbArea);
302
  if AdminPacketHandlers[$0A] <> nil then FreeAndNil(AdminPacketHandlers[$0A]);
303
end;
304

  
305
procedure TfrmRegionControl.FormShow(Sender: TObject);
306
begin
307
  SetWindowParent(Handle, frmMain.Handle);
308
  dmNetwork.Send(TRequestRegionListPacket.Create);
309
end;
310

  
311
procedure TfrmRegionControl.pbAreaMouseDown(Sender: TObject;
312
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
313
var
314
  areaNode, regionNode, match: PVirtualNode;
315
  areaInfo: ^TRect;
316
  p: TPoint;
317
  i: Integer;
318
  regionInfo: PRegionInfo;
319
begin
320
  FAreaMove := [];
321
  p := Point(X * 8, Y * 8);
322
  match := nil;
323
  areaNode := vstArea.GetFirst;
324
  while areaNode <> nil do //find the last matching area
325
  begin
326
    areaInfo := vstArea.GetNodeData(areaNode);
327
    if PtInRect(areaInfo^, p) then
328
      match := areaNode;
329
    areaNode := vstArea.GetNext(areaNode);
330
  end;
331
  if match <> nil then
332
  begin
333
    areaInfo := vstArea.GetNodeData(match);
334
    if p.x - areaInfo^.Left <= 64 then Include(FAreaMove, amLeft);
335
    if p.y - areaInfo^.Top <= 64 then Include(FAreaMove, amTop);
336
    if areaInfo^.Right - p.x <= 64 then Include(FAreaMove, amRight);
337
    if areaInfo^.Bottom - p.y <= 64 then Include(FAreaMove, amBottom);
338
    if FAreaMove = [] then
339
      FAreaMove := [amLeft, amTop, amRight, amBottom];
340
  end else
341
  begin
342
    regionNode := vstRegions.GetFirstSelected;
343
    if regionNode <> nil then
344
    begin
345
      regionInfo := vstRegions.GetNodeData(regionNode);
346
      match := vstArea.AddChild(nil);
347
      areaInfo := vstArea.GetNodeData(match);
348
      areaInfo^.Left := p.x;
349
      areaInfo^.Top := p.y;
350
      areaInfo^.Right := p.x;
351
      areaInfo^.Bottom := p.y;
352
      regionInfo^.Areas.Add(p.x, p.y, p.x, p.y);
353

  
354
      pbArea.Repaint;
355

  
356
      FAreaMove := [amRight, amBottom];
357
    end;
358
  end;
359
  vstArea.ClearSelection;
360
  vstArea.Selected[match] := True;
361
  FLastX := X;
362
  FLastY := Y;
363
end;
364

  
365
procedure TfrmRegionControl.pbAreaMouseMove(Sender: TObject;
366
  Shift: TShiftState; X, Y: Integer);
367
var
368
  offsetX, offsetY: Integer;
369
begin
370
  if (ssLeft in Shift) and (vstArea.GetFirstSelected <> nil) then
371
  begin
372
    offsetX := (X - FLastX) * 8;
373
    offsetY := (Y - FLastY) * 8;
374
    if amLeft in FAreaMove then seX1.Value := seX1.Value + offsetX;
375
    if amRight in FAreaMove then seX2.Value := seX2.Value + offsetX;
376
    if amTop in FAreaMove then seY1.Value := seY1.Value + offsetY;
377
    if amBottom in FAreaMove then seY2.Value := seY2.Value + offsetY;
378
    FLastX := X;
379
    FLastY := Y;
380
    seX1Change(nil);
381
  end;
382
end;
383

  
384
procedure TfrmRegionControl.pbAreaPaint(Sender: TObject);
385
var
386
  i: Integer;
387
  node: PVirtualNode;
388
  areaInfo: ^TRect;
389
begin
390
  DisplayImage(pbArea.Canvas, 0, 0, frmRadarMap.Radar);
391
  pbArea.Canvas.Pen.Color := clRed;
392
  pbArea.Canvas.Brush.Color := clMaroon;
393
  pbArea.Canvas.Brush.Style := bsFDiagonal;
394
  node := vstArea.GetFirst;
395
  while node <> nil do
396
  begin
397
    if vstArea.Selected[node] then
398
    begin
399
      pbArea.Canvas.Pen.Width := 2;
400
      pbArea.Canvas.Pen.Style := psSolid;
401
    end else
402
    begin
403
      pbArea.Canvas.Pen.Width := 1;
404
      pbArea.Canvas.Pen.Style := psDot;
405
    end;
406
    areaInfo := vstArea.GetNodeData(node);
407
    pbArea.Canvas.Rectangle(areaInfo^.Left div 8, areaInfo^.Top div 8,
408
      areaInfo^.Right div 8 + 1, areaInfo^.Bottom div 8 + 1);
409
    node := vstArea.GetNext(node);
410
  end;
411
end;
412

  
413
procedure TfrmRegionControl.seX1Change(Sender: TObject);
414
var
415
  node: PVirtualNode;
416
  areaInfo: ^TRect;
417
  regionInfo: PRegionInfo;
418
begin
419
  node := vstArea.GetFirstSelected;
420
  if node <> nil then
421
  begin
422
    areaInfo := vstArea.GetNodeData(node);
423
    areaInfo^.Left := seX1.Value;
424
    areaInfo^.Right := seX2.Value;
425
    areaInfo^.Top := seY1.Value;
426
    areaInfo^.Bottom := seY2.Value;
427
    regionInfo:= vstRegions.GetNodeData(vstRegions.GetFirstSelected);
428
    regionInfo^.Areas.Rects[vstArea.AbsoluteIndex(node)] := areaInfo^;
429
    vstArea.InvalidateNode(node);
430
    pbArea.Repaint;
431
  end;
432
end;
433

  
434
procedure TfrmRegionControl.vstAreaChange(Sender: TBaseVirtualTree;
435
  Node: PVirtualNode);
436
var
437
  areaInfo: ^TRect;
438
  selected: Boolean;
439
begin
440
  selected := (Node <> nil) and Sender.Selected[Node];
441
  btnDeleteArea.Enabled := selected;
442
  lblX.Enabled := selected;
443
  lblY.Enabled := selected;
444
  seX1.Enabled := selected;
445
  seX2.Enabled := selected;
446
  seY1.Enabled := selected;
447
  seY2.Enabled := selected;
448
  if selected then
449
  begin
450
    areaInfo := Sender.GetNodeData(Node);
451
    seX1.Value := areaInfo^.Left;
452
    seX2.Value := areaInfo^.Right;
453
    seY1.Value := areaInfo^.Top;
454
    seY2.Value := areaInfo^.Bottom;
455
  end;
456
  pbArea.Repaint;
457
end;
458

  
459
procedure TfrmRegionControl.vstAreaGetText(Sender: TBaseVirtualTree;
460
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
461
  var CellText: WideString);
462
var
463
  areaInfo: ^TRect;
464
begin
465
  areaInfo := Sender.GetNodeData(Node);
466
  CellText := Format('(%d, %d), (%d, %d)', [areaInfo^.Left, areaInfo^.Top,
467
    areaInfo^.Right, areaInfo^.Bottom]);
468
end;
469

  
470
procedure TfrmRegionControl.vstRegionsChange(Sender: TBaseVirtualTree;
471
  Node: PVirtualNode);
472
var
473
  i: Integer;
474
  areaNode: PVirtualNode;
475
  regionInfo: PRegionInfo;
476
  areaInfo: ^TRect;
477
begin
478
  vstArea.BeginUpdate;
479
  vstArea.Clear;
480
  if Node <> nil then
481
  begin
482
    regionInfo := Sender.GetNodeData(Node);
483
    for i := 0 to regionInfo^.Areas.Count - 1 do
484
    begin
485
      areaNode := vstArea.AddChild(nil);
486
      areaInfo := vstArea.GetNodeData(areaNode);
487
      with regionInfo^.Areas.Rects[i] do
488
      begin
489
        areaInfo^.Left   := Left;
490
        areaInfo^.Top    := Top;
491
        areaInfo^.Right  := Right;
492
        areaInfo^.Bottom := Bottom;
493
      end;
494
    end;
495
  end;
496
  vstArea.EndUpdate;
497
  pbArea.Repaint;
498
end;
499

  
500
procedure TfrmRegionControl.vstRegionsFreeNode(Sender: TBaseVirtualTree;
501
  Node: PVirtualNode);
502
var
503
  regionInfo: PRegionInfo;
504
begin
505
  regionInfo := Sender.GetNodeData(Node);
506
  if regionInfo^.Areas <> nil then FreeAndNil(regionInfo^.Areas);
507
end;
508

  
509
procedure TfrmRegionControl.vstRegionsGetText(Sender: TBaseVirtualTree;
510
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
511
  var CellText: WideString);
512
var
513
  regionInfo: PRegionInfo;
514
begin
515
  regionInfo := Sender.GetNodeData(Node);
516
  CellText := regionInfo^.Name;
517
end;
518

  
519
procedure TfrmRegionControl.vstRegionsNewText(Sender: TBaseVirtualTree;
520
  Node: PVirtualNode; Column: TColumnIndex; const NewText: WideString);
521
var
522
  regionInfo: PRegionInfo;
523
begin
524
  if (Node <> nil) then begin
525
    regionInfo := Sender.GetNodeData(Node);
526
    regionInfo^.Name := NewText;
527
  end;
528
end;
529

  
530
procedure TfrmRegionControl.vstRegionsOnEditing(Sender: TBaseVirtualTree;
531
  Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
532
begin
533
  Allowed := True;
534
end;
535

  
536 653
initialization
537 654
  {$I UfrmRegionControl.lrs}
538 655

  

Also available in: Unified diff