LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
unit FGUILayoutEditor;
5

6
interface
7

8
{$I GLScene.inc}
9

10
uses
11
  lresources, 
12
{$IFDEF MSWINDOWS}
13
  Windows, ShellApi,
14
{$ENDIF}
15
  LCLType,
16

17
 SysUtils, 
18
 Variants, 
19
 Classes,
20
 Graphics,  
21
 Controls,  
22
 Forms,  
23
 Dialogs,  
24
 Buttons,  
25
 ExtDlgs,  
26
 StdCtrls,
27
 ExtCtrls,  
28
 Spin,  
29
 Grids,
30

31
 GLCrossPlatform,  
32
 GLGui, 
33
 GLUtils
34
 {$IFDEF LINUX}, Process {$ENDIF};
35

36
type
37
  TLayouts_form = class(TForm)
38
    Panel1: TPanel;
39
    Panel2: TPanel;
40
    items_list: TListBox;
41
    x_label: TLabel;
42
    y_label: TLabel;
43
    open_image_button: TBitBtn;
44
    open_button: TBitBtn;
45
    save_button: TBitBtn;
46
    OpenDialog1: TOpenDialog;
47
    SaveDialog1: TSaveDialog;
48
    delete_item_button: TBitBtn;
49
    add_button: TBitBtn;
50
    Label1: TLabel;
51
    Label2: TLabel;
52
    left_edit: TSpinEdit;
53
    top_edit: TSpinEdit;
54
    Label3: TLabel;
55
    Label4: TLabel;
56
    height_edit: TSpinEdit;
57
    width_edit: TSpinEdit;
58
    Label5: TLabel;
59
    name_edit: TEdit;
60
    elements_grid: TStringGrid;
61
    Panel3: TPanel;
62
    BitBtn4: TBitBtn;
63
    BitBtn5: TBitBtn;
64
    ScrollBox1: TScrollBox;
65
    Image2: TImage;
66
    PaintBox1: TPaintBox;
67
    Image1: TImage;
68
    BitBtn6: TBitBtn;
69
    BitBtn1: TBitBtn;
70
    GLGuiLayout1: TGLGuiLayout;
71
    procedure open_image_buttonClick(Sender: TObject);
72
    procedure open_buttonClick(Sender: TObject);
73
    procedure save_buttonClick(Sender: TObject);
74
    procedure FormCreate(Sender: TObject);
75
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
76
      Y: Integer);
77
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
78
      Shift: TShiftState; X, Y: Integer);
79
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
80
      Shift: TShiftState; X, Y: Integer);
81
    procedure add_buttonClick(Sender: TObject);
82
    procedure delete_item_buttonClick(Sender: TObject);
83
    procedure items_listClick(Sender: TObject);
84
    procedure name_editExit(Sender: TObject);
85
    procedure name_editKeyPress(Sender: TObject; var Key: Char);
86
    procedure elements_gridClick(Sender: TObject);
87
    procedure left_editChange(Sender: TObject);
88
    procedure top_editChange(Sender: TObject);
89
    procedure width_editChange(Sender: TObject);
90
    procedure height_editChange(Sender: TObject);
91
    procedure BitBtn4Click(Sender: TObject);
92
    procedure BitBtn6Click(Sender: TObject);
93
    procedure elements_gridDblClick(Sender: TObject);
94
  private
95
     
96
    procedure SyncImages;
97
    procedure DrawCurrentElement;
98
    procedure RefreshComponentBox;
99
    function GetEnabledSpins: Boolean;
100
    procedure SetEnabledSpins(Value: Boolean);
101
  public
102
     
103
    procedure Execute(AGUILayout: TGLGuiLayout);
104
    property EnabledSpins: Boolean read GetEnabledSpins write SetEnabledSpins;
105
  end;
106

107
function GUILayoutEditorForm: TLayouts_form;
108
procedure ReleaseGUILayoutEditor;
109

110
//--------------------------------------------------------------------------
111
implementation
112
//--------------------------------------------------------------------------
113

114
var
115
  vGUILayoutEditor: Tlayouts_form;
116
  rect_point1, rect_point2: TPoint;
117
  zoom: integer = 1;
118
  sorted_elements: array[0..9] of TGLGuiElement;
119

120
function GUILayoutEditorForm: Tlayouts_form;
121
begin
122
  if not Assigned(vGUILayoutEditor) then
123
    vGUILayoutEditor := Tlayouts_form.Create(nil);
124
  Result := vGUILayoutEditor;
125
end;
126

127
procedure ReleaseGUILayoutEditor;
128
begin
129
  if Assigned(vGUILayoutEditor) then
130
  begin
131
    vGUILayoutEditor.Free;
132
    vGUILayoutEditor := nil;
133
  end;
134
end;
135

136
function SnapPoint(X, Y: integer): TPoint;
137
begin
138
  Result.X := (X div zoom) * zoom;
139
  Result.Y := (Y div zoom) * zoom;
140
end;
141

142
procedure TLayouts_form.SetEnabledSpins(Value: Boolean);
143
begin
144
  left_edit.Enabled := Value;
145
  top_edit.Enabled := Value;
146
  height_edit.Enabled := Value;
147
  width_edit.Enabled := Value;
148
end;
149

150
procedure TLayouts_form.SyncImages;
151
begin
152
  Image2.Width := Image1.Width;
153
  Image2.Height := Image1.Height;
154
  Image2.Picture.Bitmap.Width := Image1.Width;
155
  Image2.Picture.Bitmap.Height := Image1.Height;
156
  PaintBox1.Width := Image1.Width;
157
  PaintBox1.Height := Image1.Height;
158
  ScrollBox1.HorzScrollBar.Range := Image1.Width;
159
  ScrollBox1.VertScrollBar.Range := Image1.Height;
160
  PaintBox1.Canvas.CopyRect(PaintBox1.Canvas.ClipRect,
161
    Image1.Canvas, Image1.Canvas.ClipRect);
162
end;
163

164
procedure TLayouts_form.DrawCurrentElement;
165
begin
166
  with elements_grid do
167
    if (items_list.ItemIndex > -1) and (sorted_elements[Col + 3 * Row] <> nil)
168
      then
169
      with sorted_elements[Col + 3 * Row], Image2.Canvas do
170
      begin
171
        FillRect(ClipRect);
172
        Rectangle(Rect(zoom * Round(TopLeft.X), zoom * Round(TopLeft.Y),
173
          zoom * Round(BottomRight.X), zoom * Round(BottomRight.Y)));
174
      end;
175
end;
176

177
procedure TLayouts_form.open_image_buttonClick(Sender: TObject);
178
var
179
  LFileName: string;
180
begin
181
  LFileName := '';
182
  if OpenPictureDialog(LFileName) then
183
    try
184
      Image1.Stretch := false;
185
      Image1.AutoSize := true;
186
      Image1.Picture.LoadFromFile(LFileName);
187
      Image1.AutoSize := false;
188
      Image1.Stretch := true;
189
      Image2.Canvas.Pen.Width := 1;
190
      SyncImages;
191
      zoom := 1;
192
    except
193
      Application.MessageBox('Unable to load picture!', 'Error', MB_ICONERROR);
194
    end;
195
end;
196

197
procedure TLayouts_form.RefreshComponentBox;
198
var
199
  i: integer;
200
begin
201
  items_list.Clear;
202
  for i := 0 to GLGuiLayout1.GuiComponents.Count - 1 do
203
    items_list.Items.Add(GLGuiLayout1.GuiComponents[i].Name);
204
  items_list.ItemIndex := 0;
205
  items_listClick(nil);
206
end;
207

208
procedure TLayouts_form.open_buttonClick(Sender: TObject);
209

210
begin
211
  case Application.MessageBox('Save layout?',
212
    'Question', MB_ICONQUESTION + MB_YESNOCANCEL) of
213
    mrYes: save_buttonClick(nil);
214
    mrCancel: Exit;
215
  end;
216

217
  if OpenDialog1.Execute then
218
    try
219
      GLGuiLayout1.Clear;
220
      GLGuiLayout1.LoadFromFile(OpenDialog1.FileName);
221
      RefreshComponentBox;
222
    except
223
      Application.MessageBox('Unable to load layout!', 'Error', MB_ICONERROR);
224
    end;
225
end;
226

227
procedure TLayouts_form.save_buttonClick(Sender: TObject);
228
begin
229
  if SaveDialog1.FileName = '' then
230
    if SaveDialog1.Execute then
231
      GLGuiLayout1.SaveToFile(SaveDialog1.FileName)
232
    else
233
  else
234
    GLGuiLayout1.SaveToFile(SaveDialog1.FileName);
235
end;
236

237
procedure TLayouts_form.FormCreate(Sender: TObject);
238
begin
239
  rect_point1.X := -1;
240
  Image2.Canvas.FillRect(Image2.Canvas.ClipRect);
241
  Image2.Canvas.Pen.Color := clAqua;
242
end;
243

244
function TLayouts_form.GetEnabledSpins: Boolean;
245
begin
246
  Result := left_edit.Enabled;
247
end;
248

249
procedure TLayouts_form.Image1MouseMove(Sender: TObject;
250
  Shift: TShiftState; X, Y: Integer);
251
begin
252
  x_label.Caption := 'X: ' + IntToStr(X div zoom);
253
  y_label.Caption := 'Y: ' + IntToStr(Y div zoom);
254

255
  if not (ssRight in Shift) then
256
    Exit;
257
  if (X < 0) or (Y < 0) or (X > Image2.Width) or (Y > Image2.Height) then
258
    Exit;
259

260
  if rect_point1.X < 0 then
261
    rect_point1 := SnapPoint(X, Y)
262
  else
263
    with Image2.Canvas do
264
    begin
265
      FillRect(ClipRect);
266
      rect_point2 := SnapPoint(X, Y);
267
      Rectangle(rect_point1.x, rect_point1.y, X, Y);
268
    end;
269

270
  if items_list.ItemIndex = -1 then
271
    Exit;
272
  if rect_point1.X < rect_point2.X then
273
    left_edit.Value := rect_point1.X div zoom
274
  else
275
    left_edit.Value := rect_point2.X div zoom;
276
  if rect_point1.Y > rect_point2.Y then
277
    top_edit.Value := rect_point2.Y div zoom
278
  else
279
    top_edit.Value := rect_point1.Y div zoom;
280

281
  width_edit.Value := Abs(rect_point2.X - rect_point1.X) div zoom;
282
  height_edit.Value := Abs(rect_point2.Y - rect_point1.Y) div zoom;
283
end;
284

285
procedure TLayouts_form.Image1MouseDown(Sender: TObject;
286
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
287
begin
288
  if not (ssRight in Shift) then
289
    Exit;
290
  with Image2.Canvas do
291
  begin
292
    FillRect(ClipRect);
293
    rect_point1 := SnapPoint(X, Y);
294
    rect_point2 := rect_point1;
295
  end;
296
end;
297

298
procedure TLayouts_form.Image1MouseUp(Sender: TObject;
299
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
300
begin
301
  if not (ssRight in Shift) then
302
    Exit;
303
  rect_point1.X := -1;
304
end;
305

306
procedure TLayouts_form.add_buttonClick(Sender: TObject);
307
var
308
  i: integer;
309
begin
310
  with TGLGuiComponent(GLGuiLayout1.GuiComponents.Add) do
311
  begin
312
    Name := InputBox('Question', 'Name of new region:', '');
313
    if Name = '' then
314
    begin
315
      Free;
316
      Exit;
317
    end;
318
    items_list.Items.Add(Name);
319
    items_list.ItemIndex := items_list.Count - 1;
320
    for i := 0 to 9 do
321
    begin
322
      sorted_elements[i] := TGLGuiElement(Elements.Add);
323
      sorted_elements[i].Align := TGUIAlignments(i);
324
    end;
325
    name_edit.Text := Name;
326
  end;
327
end;
328

329
procedure TLayouts_form.delete_item_buttonClick(Sender: TObject);
330
begin
331
  if items_list.ItemIndex = -1 then
332
    Exit;
333
  GLGuiLayout1.GuiComponents.Delete(items_list.ItemIndex);
334

335
  items_list.ClearSelection;
336
  if items_list.ItemIndex > -1 then
337
    name_edit.Text := GLGuiLayout1.GuiComponents[items_list.ItemIndex].Name
338
  else
339
    name_edit.Text := '';
340
end;
341

342
procedure TLayouts_form.items_listClick(Sender: TObject);
343
var
344
  i, p: integer;
345
begin
346
  if items_list.ItemIndex = -1 then
347
    Exit;
348

349
  name_edit.Text := GLGuiLayout1.GuiComponents[
350
    items_list.ItemIndex].Name;
351
  elements_grid.Row := 0;
352
  elements_grid.Col := 0;
353
  for i := 0 to Length(sorted_elements) - 1 do
354
  begin
355
    sorted_elements[i] := nil;
356
    if I < 9 then
357
      elements_grid.Cells[i mod 3, i div 3] := #32;
358
  end;
359

360
  with GLGuiLayout1.GuiComponents[items_list.ItemIndex] do
361
    for i := 0 to Elements.Count - 1 do
362
    begin
363
      p := Integer(Elements[i].Align);
364
      sorted_elements[p] := Elements[i];
365
      elements_grid.Cells[p mod 3, p div 3] := '+';
366
    end;
367
  elements_gridClick(nil);
368
end;
369

370
procedure TLayouts_form.name_editExit(Sender: TObject);
371
begin
372
  if items_list.ItemIndex > -1 then
373
  begin
374
    GLGuiLayout1.GuiComponents[items_list.
375
      ItemIndex].Name := name_edit.Text;
376
    items_list.Items[items_list.ItemIndex] := name_edit.Text;
377
    items_listClick(nil);
378
  end;
379
end;
380

381
procedure TLayouts_form.name_editKeyPress(Sender: TObject; var Key: Char);
382
begin
383
  if Key = #13 then
384
    name_editExit(nil);
385
end;
386

387
procedure TLayouts_form.elements_gridClick(Sender: TObject);
388
begin
389
  with elements_grid do
390
    if (items_list.ItemIndex > -1) and (sorted_elements[Col + 3 * Row] <> nil)
391
      then
392
      with sorted_elements[Col + 3 * Row] do
393
      begin
394
        EnabledSpins := True;
395
        left_edit.Value := Round(TopLeft.X);
396
        top_edit.Value := Round(TopLeft.Y);
397
        width_edit.Value := Round(BottomRight.X - TopLeft.X);
398
        height_edit.Value := Round(BottomRight.Y - TopLeft.Y);
399
        DrawCurrentElement;
400
      end
401
    else
402
    begin
403
      EnabledSpins := False;
404
      Image2.Canvas.FillRect(Image2.Canvas.ClipRect);
405
    end;
406
end;
407

408
procedure TLayouts_form.elements_gridDblClick(Sender: TObject);
409
var
410
  I: Integer;
411
  E: TGLGuiElement;
412
begin
413
  if items_list.ItemIndex > -1 then
414
    with elements_grid do
415
    begin
416
      if Assigned(sorted_elements[Col + 3 * Row]) then
417
      begin
418
        I := GLGuiLayout1.GuiComponents[items_list.ItemIndex].Elements.IndexOf(sorted_elements[Col + 3 * Row]);
419
        GLGuiLayout1.GuiComponents[items_list.ItemIndex].Elements.Delete(I);
420
        sorted_elements[Col + 3 * Row] := nil;
421
        Cells[Col, Row] := #32;
422
        elements_gridClick(nil);
423
      end
424
      else begin
425
        E := TGLGuiElement(GLGuiLayout1.GuiComponents[items_list.ItemIndex].Elements.Add);
426
        E.Align := TGUIAlignments(Col + 3 * Row);
427
        sorted_elements[Col + 3 * Row] := E;
428
        Cells[Col, Row] := '+';
429
        elements_gridClick(nil);
430
      end;
431
    end;
432
end;
433

434
procedure TLayouts_form.left_editChange(Sender: TObject);
435
begin
436
  if (items_list.ItemIndex = -1) or not EnabledSpins then
437
    Exit;
438
  if left_edit.Value + width_edit.Value > Image2.Width div zoom then
439
    left_edit.Value := (Image2.Width div zoom) - width_edit.Value;
440
  if left_edit.Value < 0 then
441
    left_edit.Value := 0;
442
  with elements_grid do
443
    sorted_elements[Col + 3 * Row].TopLeft.X := left_edit.Value;
444
  DrawCurrentElement;
445
end;
446

447
procedure TLayouts_form.top_editChange(Sender: TObject);
448
begin
449
  if (items_list.ItemIndex = -1) or not EnabledSpins then
450
    Exit;
451
  if top_edit.Value + height_edit.Value > Image2.Height div zoom then
452
    top_edit.Value := (Image2.Height div zoom) - height_edit.Value;
453
  if top_edit.Value < 0 then
454
    top_edit.Value := 0;
455
  with elements_grid do
456
    sorted_elements[Col + 3 * Row].TopLeft.Y := top_edit.Value;
457
  DrawCurrentElement;
458
end;
459

460
procedure TLayouts_form.width_editChange(Sender: TObject);
461
begin
462
  if (items_list.ItemIndex = -1) or not EnabledSpins then
463
    Exit;
464
  with elements_grid do
465
    sorted_elements[Col + 3 * Row].BottomRight.X := left_edit.Value +
466
      width_edit.Value;
467
  if left_edit.Value + width_edit.Value > Image2.Width div zoom then
468
    width_edit.Value := (Image2.Width div zoom) - left_edit.Value;
469
  if width_edit.Value < 0 then
470
    width_edit.Value := 0;
471
  DrawCurrentElement;
472
end;
473

474
procedure TLayouts_form.height_editChange(Sender: TObject);
475
begin
476
  if (items_list.ItemIndex = -1) or not EnabledSpins  then
477
    Exit;
478
  with elements_grid do
479
    sorted_elements[Col + 3 * Row].BottomRight.Y := top_edit.Value +
480
      height_edit.Value;
481
  if top_edit.Value + height_edit.Value > Image2.Height div zoom then
482
    height_edit.Value := (Image2.Height div zoom) - top_edit.Value;
483
  if height_edit.Value < 0 then
484
    height_edit.Value := 0;
485
  DrawCurrentElement;
486
end;
487

488
procedure TLayouts_form.BitBtn4Click(Sender: TObject);
489
begin
490
  if zoom + TBitBtn(Sender).Tag < 1 then
491
    Exit;
492
  Image1.Width := (Image1.Width div zoom) * (zoom + TBitBtn(Sender).Tag);
493
  Image1.Height := (Image1.Height div zoom) * (zoom + TBitBtn(Sender).Tag);
494
  SyncImages;
495
  zoom := zoom + TBitBtn(Sender).Tag;
496
  Image2.Canvas.Pen.Width := zoom;
497
  elements_gridClick(nil);
498
end;
499

500
procedure TLayouts_form.BitBtn6Click(Sender: TObject);
501
{$IFDEF LINUX}
502
var
503
  lProcess: TProcess;
504
{$ENDIF}
505
begin
506
{$IFDEF MSWINDOWS}
507
  ShellExecuteW(0, 'open', 'mspaint', '', '', SW_SHOW)
508
{$ENDIF}
509
{$IFDEF LINUX}
510
  lProcess := TProcess.Create(nil);
511
  lProcess.CommandLine := 'gimp';
512
  try
513
    lProcess.Execute;
514
  finally
515
    lProcess.Destroy;
516
  end;
517
{$ENDIF}
518
end;
519

520
procedure TLayouts_form.Execute(AGUILayout: TGLGuiLayout);
521
begin
522
  GLGuiLayout1.Assign(AGUILayout);
523
  Image1.Stretch := false;
524
  Image1.AutoSize := true;
525
  Image1.Picture.Assign(AGUILayout.Material.GetActualPrimaryTexture.Image.GetBitmap32.Create32BitsBitmap);
526
  Image1.AutoSize := false;
527
  Image1.Stretch := true;
528
  Image2.Canvas.Pen.Width := 1;
529
  SyncImages;
530
  zoom := 1;
531

532
  RefreshComponentBox;
533
  if ShowModal = mrOk then
534
    AGUILayout.Assign(GLGuiLayout1);
535
end;
536

537
initialization
538

539
{$I FGUILayoutEditor.lrs}
540

541
finalization
542

543
  ReleaseGUILayoutEditor;
544

545
end.
546

547