source: os/trunk/lddesktop.pas

Last change on this file was 3, checked in by chronos, 12 years ago
  • Imported: Xvcl test library used for simple custom desktop environment and underlaying OS implementation.
File size: 6.2 KB
Line 
1unit lddesktop;
2
3interface
4
5uses
6 Generics.Collections;
7
8type
9 TPoint = record
10 X: Integer;
11 Y: Integer;
12 constructor Create(X, Y: Integer);
13 end;
14
15 TBounds = record
16 private
17 function GetBottom: Integer;
18 function GetPosition: TPoint;
19 function GetRight: Integer;
20 function GetSize: TPoint;
21 function GetBottomLeft: TPoint;
22 function GetBottomRight: TPoint;
23 function GetLeftTop: TPoint;
24 function GetRightTop: TPoint;
25 public
26 Left: Integer;
27 Top: Integer;
28 Width: Integer;
29 Height: Integer;
30 property Right: Integer read GetRight;
31 property Bottom: Integer read GetBottom;
32 property Size: TPoint read GetSize;
33 property Position: TPoint read GetPosition;
34 property LeftTop: TPoint read GetLeftTop;
35 property BottomRight: TPoint read GetBottomRight;
36 property RightTop: TPoint read GetRightTop;
37 property BottomLeft: TPoint read GetBottomLeft;
38 constructor Create(Left, Top, Width, Height: Integer);
39 end;
40
41 TComponent = class
42 private
43 FOwner: TComponent;
44 FName: string;
45 public
46 constructor Create; virtual;
47 property Owner: TComponent read FOwner write FOwner;
48 property Name: string read FName write FName;
49 end;
50
51 TColor = (clBlack, clWhite, clGray, clSilver, clBlue, clGreen, clRed);
52
53 TPen = class
54 Pos: TPoint;
55 Color: TColor;
56 procedure MoveTo(Pos: TPoint);
57 procedure LineTo(Pos: TPoint);
58 end;
59
60 TBrush = class
61 Color: TColor;
62 end;
63
64 TFont = class
65
66 end;
67
68 TCanvas = class
69 private
70 FPen: TPen;
71 FBrush: TBrush;
72 FFont: TFont;
73 public
74 procedure MoveTo(Position: TPoint);
75 procedure LineTo(Position: TPoint);
76 constructor Create;
77 destructor Destroy; override;
78 property Pen: TPen read FPen;
79 property Brush: TBrush read FBrush;
80 property Font: TFont read FFont;
81 end;
82
83 TControl = class;
84
85 TControlCanvas = class(TCanvas)
86 Control: TControl;
87 end;
88
89 TControl = class(TComponent)
90 private
91 FVisible: Boolean;
92 FBounds: TBounds;
93 FCanvas: TControlCanvas;
94 function GetCanvas: TCanvas;
95 public
96 Controls: TList<TControl>;
97 public
98 procedure Paint; virtual;
99 property Bounds: TBounds read FBounds write FBounds;
100 property Visible: Boolean read FVisible write FVisible;
101 property Canvas: TCanvas read GetCanvas;
102 constructor Create; override;
103 destructor Destroy; override;
104 end;
105
106 TButton = class(TControl)
107 private
108 FCaption: string;
109 public
110 procedure Paint; override;
111 property Caption: string read FCaption write FCaption;
112 end;
113
114 TForm = class(TControl)
115 end;
116
117 TBitmap = class
118 private
119 function GetPixel(X, Y: Integer): TColor;
120 procedure SetPixel(X, Y: Integer; const Value: TColor);
121 public
122 property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
123 end;
124
125 TGraphicDriver = class
126 procedure DrawBitmap(Bitmap: TBitmap);
127 end;
128
129 TScreen = class(TComponent)
130 Size: TPoint;
131 Forms: TList<TForm>;
132 GraphicDriver: TGraphicDriver;
133 procedure Paint;
134 constructor Create; override;
135 destructor Destroy; override;
136 end;
137
138
139 implementation
140
141{ TBounds }
142
143constructor TBounds.Create(Left, Top, Width, Height: Integer);
144begin
145 Self.Left := Left;
146 Self.Top := Top;
147 Self.Width := Width;
148 Self.Height := Height;
149end;
150
151function TBounds.GetBottom: Integer;
152begin
153 Result := Top + Height;
154end;
155
156function TBounds.GetBottomLeft: TPoint;
157begin
158 Result := TPoint.Create(Left, Bottom);
159end;
160
161function TBounds.GetBottomRight: TPoint;
162begin
163 Result := TPoint.Create(Right, Bottom);
164end;
165
166function TBounds.GetLeftTop: TPoint;
167begin
168 Result := TPoint.Create(Left, Top);
169end;
170
171function TBounds.GetPosition: TPoint;
172begin
173 Result := TPoint.Create(Left, Top);
174end;
175
176function TBounds.GetRight: Integer;
177begin
178 Result := Left + Width;
179end;
180
181function TBounds.GetRightTop: TPoint;
182begin
183 Result := TPoint.Create(Right, Top);
184end;
185
186function TBounds.GetSize: TPoint;
187begin
188 Result := TPoint.Create(Width, Height);
189end;
190
191{ TForm }
192
193
194{ TComponent }
195
196constructor TComponent.Create;
197begin
198end;
199
200{ TScreen }
201
202constructor TScreen.Create;
203begin
204 inherited;
205 Forms := TList<TForm>.Create;
206end;
207
208destructor TScreen.Destroy;
209begin
210 Forms.Destroy;
211 inherited;
212end;
213
214procedure TScreen.Paint;
215var
216 Form: TForm;
217begin
218 for Form in Forms do Form.Paint;
219end;
220
221{ TControl }
222
223constructor TControl.Create;
224begin
225 inherited;
226 Controls := TList<TControl>.Create;
227end;
228
229destructor TControl.Destroy;
230begin
231 Controls.Destroy;
232 if Assigned(FCanvas) then FCanvas.Destroy;
233 inherited;
234end;
235
236function TControl.GetCanvas: TCanvas;
237begin
238 if not Assigned(FCanvas) then begin
239 FCanvas := TControlCanvas.Create;
240 FCanvas.Control := Self;
241 end;
242 Result := FCanvas;
243end;
244
245procedure TControl.Paint;
246var
247 C: TControl;
248begin
249 for C in Controls do C.Paint;
250end;
251
252{ TButton }
253
254procedure TButton.Paint;
255begin
256 inherited;
257 with Canvas do begin
258 MoveTo(TPoint.Create(0, 0));
259 LineTo(TPoint.Create(Bounds.Width - 1, 0));
260 LineTo(TPoint.Create(Bounds.Width - 1, Bounds.Height - 1));
261 LineTo(TPoint.Create(0, Bounds.Height - 1));
262 LineTo(TPoint.Create(0, 0));
263 end;
264end;
265
266{ TPoint }
267
268constructor TPoint.Create(X, Y: Integer);
269begin
270 Self.X := X;
271 Self.Y := Y;
272end;
273
274{ TPen }
275
276procedure TPen.LineTo(Pos: TPoint);
277begin
278 Self.Pos := Pos;
279end;
280
281procedure TPen.MoveTo(Pos: TPoint);
282begin
283
284end;
285
286{ TCanvas }
287
288constructor TCanvas.Create;
289begin
290 FPen := TPen.Create;
291 FBrush := TBrush.Create;
292 FFont := TFont.Create;
293end;
294
295destructor TCanvas.Destroy;
296begin
297 FFont.Destroy;
298 FBrush.Destroy;
299 FPen.Destroy;
300 inherited;
301end;
302
303procedure TCanvas.LineTo(Position: TPoint);
304begin
305 Pen.LineTo(Position);
306end;
307
308procedure TCanvas.MoveTo(Position: TPoint);
309begin
310 Pen.MoveTo(Position);
311end;
312
313{ TGraphicDriver }
314
315procedure TGraphicDriver.DrawBitmap(Bitmap: TBitmap);
316begin
317
318end;
319
320{ TBitmap }
321
322function TBitmap.GetPixel(X, Y: Integer): TColor;
323begin
324
325end;
326
327procedure TBitmap.SetPixel(X, Y: Integer; const Value: TColor);
328begin
329
330end;
331
332end.
Note: See TracBrowser for help on using the repository browser.