MathgeomGLS

1
unit fVor2dPick;
2

3
interface
4

5
uses
6
  Winapi.Windows,
7
  Winapi.Messages,
8
  System.SysUtils,
9
  System.Variants,
10
  System.Classes,
11
  Vcl.Graphics,
12
  Vcl.Controls,
13
  Vcl.Forms,
14
  Vcl.Dialogs,
15
  Vcl.ExtCtrls,
16
  Vcl.StdCtrls,
17
  Vor.GraphObjects,
18
  GLS.Material,
19
  GLS.Cadencer,
20
  GLS.SceneViewer,
21

22
  GLS.BaseClasses,
23
  GLS.Scene,
24
  GLS.Canvas,
25
  GLS.RenderContextInfo,
26
  Vor.Shamos,
27
  GLS.Coordinates;
28

29
type
30
  TFormVor2dPick = class(TForm)
31
    GroupBox1: TGroupBox;
32
    CheckBox1: TCheckBox;
33
    CheckBox2: TCheckBox;
34
    CheckBox3: TCheckBox;
35
    Button1: TButton;
36
    Label1: TLabel;
37
    GLScene1: TGLScene;
38
    GLCadencer1: TGLCadencer;
39
    GLMaterialLibrary1: TGLMaterialLibrary;
40
    GLDirectOpenGL: TGLDirectOpenGL;
41
    GLCamera: TGLCamera;
42
    GLLightSource: TGLLightSource;
43
    PanelPB: TPanel;
44
    PaintBox: TPaintBox;
45
    GLSceneViewer: TGLSceneViewer;
46
    procedure PaintBoxPaint(Sender: TObject);
47
    procedure PaintBoxMouseMove(Sender: TObject; Shift: TShiftState;
48
      X, Y: Integer);
49
    procedure FormCreate(Sender: TObject);
50
    procedure Button1Click(Sender: TObject);
51
    procedure CheckBox1Click(Sender: TObject);
52
    procedure PaintBoxMouseDown(Sender: TObject; Button: TMouseButton;
53
      Shift: TShiftState; X, Y: Integer);
54
    procedure PaintBoxMouseUp(Sender: TObject; Button: TMouseButton;
55
      Shift: TShiftState; X, Y: Integer);
56
    procedure GLDirectOpenGLRender(Sender: TObject;
57
      var rci: TGLRenderContextInfo);
58
  private
59
  end;
60

61
var
62
  FormVor2dPick: TFormVor2dPick;
63

64
implementation
65

66
{$R *.dfm}
67

68
var
69
  List: TList;
70
  Vor: TVoronoi;
71
  mx, my, i: Integer;
72
  Down: Boolean;
73

74
procedure TFormVor2dPick.PaintBoxPaint(Sender: TObject);
75
var
76
  z: Integer;
77
begin
78
  // for Paintbox.Color
79
  PaintBox.Canvas.FillRect(Rect(0, 0, PanelPB.Width , PanelPB.Height));
80
//  PaintBox.Canvas.FloodFill(0, 0, Paintbox.Color, fsSurface);
81
  if List = nil then
82
    Exit;
83
  PaintBox.Canvas.Font.Color := clWhite;
84
  for z := 0 to List.Count - 1 do
85
  begin
86
    TGraphObject(List.items[z]).draw;
87
    if (TObject(List.items[z]) is TGPoint) and CheckBox3.Checked then
88
      PaintBox.Canvas.TextOut(
89
        Round(TGPoint(List.items[z]).GetX + 1),
90
        Round(TGPoint(List.items[z]).GetY + 1), IntToStr(z));
91
  end;
92
end;
93

94
procedure TFormVor2dPick.PaintBoxMouseMove(Sender: TObject; Shift: TShiftState;
95
  X, Y: Integer);
96
begin
97
  mx := X;
98
  my := Y;
99
  FormVor2dPick.Caption := IntToStr(mx) + ' ' + IntToStr(my);
100
  if down then
101
  begin
102
    TGPoint(List.items[i]).MoveTo(X, Y);
103
    CheckBox1Click(FormVor2dPick);
104
  end;
105
end;
106

107
procedure TFormVor2dPick.FormCreate(Sender: TObject);
108
begin
109
  List := TList.Create;
110
  down := false;
111
end;
112

113
procedure TFormVor2dPick.GLDirectOpenGLRender(Sender: TObject;
114
  var rci: TGLRenderContextInfo);
115
var
116
  i, x, y: Integer;
117
  GLCanvas: TGLCanvas;
118
  r: TRect;
119
  Color: TColor;
120
begin
121
  GLCanvas := TGLCanvas.Create(256, 256);
122
(*
123
  GLCanvas.PenWidth := vPenWidth;
124
  case vWhat of
125
    wLines:
126
      begin
127
        for i := 1 to cNbLines do
128
        begin
129
          GLCanvas.PenColor := Random(256 * 256 * 256);
130
          GLCanvas.MoveTo(Random(256), Random(256)); // first point
131
          GLCanvas.LineTo(Random(256), Random(256)); // second point
132
        end;
133
      end;
134
    wEllipses:
135
      for i := 1 to cNbEllipses do
136
      begin
137
        GLCanvas.PenColor := Random(256 * 256 * 256);
138
        GLCanvas.EllipseBB(Random(256), Random(256), Random(256), Random(256));
139
      end;
140
    wRects:
141
      for i := 1 to cNbRects do
142
      begin
143
        GLCanvas.PenColor := Random(256 * 256 * 256);
144
        r := Rect(Random(256), Random(256), Random(256), Random(256));
145
        GLCanvas.FillRect(r.Left, r.Top, r.Right, r.Bottom);
146
      end;
147
    wPoints:
148
      begin
149
        for i := 1 to cNbPoints do
150
        begin
151
          GLCanvas.PenColor := Random(256 * 256 * 256);
152
          GLCanvas.PlotPixel(Random(256), Random(256));
153
        end;
154
      end;
155
    wTextOut:
156
      begin
157
        for i := 1 to cNbTextOuts do
158
        begin
159
          Color := Random(256 * 256 * 256);
160
          x := Random(256);
161
          y := Random(256);
162
          WindowsBitmapFont.TextOut(rci, x, y, 'Hello', Color);
163
        end;
164
      end;
165
    wArcs:
166
      begin
167
        for i := 1 to cNbEllipses do
168
        begin
169
          GLCanvas.PenColor := Random(256 * 256 * 256);
170
          GLCanvas.Arc(Random(256), Random(256), Random(256), Random(256),
171
            Random(256), Random(256), Random(256), Random(256))
172
        end;
173
      end;
174
  end;
175
*)
176
  GLCanvas.Free;
177
end;
178

179
procedure TFormVor2dPick.Button1Click(Sender: TObject);
180
begin
181
  List.Clear;
182
  PaintBox.OnPaint(FormVor2dPick);
183
end;
184

185
procedure TFormVor2dPick.CheckBox1Click(Sender: TObject);
186
begin
187
  Vor := TVoronoi.Create(PaintBox.Canvas, List);
188
  Vor.ClearLines;
189
  Vor.CalcVoronoi(CheckBox1.Checked, CheckBox2.Checked);
190
  Vor.Free;
191
  PaintBox.OnPaint(FormVor2dPick);
192

193
end;
194

195
procedure TFormVor2dPick.PaintBoxMouseDown(Sender: TObject; Button: TMouseButton;
196
  Shift: TShiftState; X, Y: Integer);
197
var
198
  p: TGPoint;
199
  z: Integer;
200
begin
201
  p := TGPoint.Create(X, Y, nil, nil);
202
  p.closeDist := 5;
203
  for z := 0 to List.Count - 1 do
204
  begin
205
    if TObject(List.items[z]) is TGPoint then
206
      if p.Match(TGPoint(List.Items[z])) then
207
      begin
208
        if (Button = TMouseButton.mbRight) then
209
          TGPoint(List.Items[z]).Delete(true)
210
        else
211
        begin
212
          down := True;
213
          i := z;
214
        end;
215
        CheckBox1Click(FormVor2dPick);
216
        exit;
217
      end;
218
  end;
219
  p.Free;
220

221
  TGPoint.Create(X, Y, List, PaintBox.Canvas);
222
  CheckBox1Click(FormVor2dPick);
223
end;
224

225
procedure TFormVor2dPick.PaintBoxMouseUp(Sender: TObject; Button: TMouseButton;
226
  Shift: TShiftState; X, Y: Integer);
227
begin
228
  down := false;
229
end;
230

231
end.
232