source: trunk/Packages/Kernel/Kernel.Screen.pas

Last change on this file was 61, checked in by chronos, 2 months ago
  • Modified: Kernel API class definition improvement.
File size: 4.0 KB
Line 
1unit Kernel.Screen;
2
3interface
4
5uses
6 SysUtils, Math, Kernel.Graphics, Kernel.Device;
7
8type
9 TScreen = class;
10
11 { TScreenCanvas }
12
13 TScreenCanvas = class(TCanvas)
14 private
15 procedure SetPixelInternal(P: TPoint; Color: TColor);
16 public
17 Screen: TScreen;
18 procedure DrawText(Pos: TPoint; Text: string; Color: TColor); override;
19 procedure DrawLine(P1, P2: TPoint; Color: TColor); override;
20 procedure DrawRect(Rect: TRectangle; Color: TColor); override;
21 procedure DrawFrame(Rect: TRectangle; Color: TColor); override;
22 procedure SetPixel(P: TPoint; Color: TColor); override;
23 end;
24
25 { TScreen }
26
27 TScreen = class
28 private
29 function GetBytesPerLine: Integer;
30 function GetBytesPerPixel: Integer;
31 function GetVideoMemory: PByte;
32 public
33 Device: TDeviceVideo;
34 Size: TPoint;
35 DPI: Integer;
36 ColorFormat: TColorFormat;
37 Canvas: TCanvas;
38 procedure VideoMemoryUpdated;
39 property BytesPerPixel: Integer read GetBytesPerPixel;
40 property BytesPerLine: Integer read GetBytesPerLine;
41 property VideoMemory: PByte read GetVideoMemory;
42 end;
43
44
45implementation
46
47{ TScreenCanvas }
48
49procedure TScreenCanvas.DrawText(Pos: TPoint; Text: string; Color: TColor);
50begin
51
52end;
53
54procedure TScreenCanvas.DrawLine(P1, P2: TPoint; Color: TColor);
55var
56 I: Integer;
57begin
58 TDeviceVideo(Screen.Device).Lock.Acquire;
59 try
60 if Abs(P2.X - P1.X) > Abs(P2.Y - P1.Y) then begin
61 for I := 0 to Abs(P2.X - P1.X) - 1 do
62 SetPixelInternal(TPoint.Create(Trunc(P1.X + I * Sign(P2.X - P1.X)),
63 Trunc(P1.Y + (P2.Y - P1.Y) / Abs(P2.X - P1.X) * I)), Color);
64 end else begin
65 for I := 0 to Abs(P2.Y - P1.Y) - 1 do
66 SetPixelInternal(TPoint.Create(Trunc(P1.X + (P2.X - P1.X) / Abs(P2.Y - P1.Y) * I),
67 Trunc(P1.Y + I * Sign(P2.Y - P1.Y))), Color);
68 end;
69 finally
70 TDeviceVideo(Screen.Device).Lock.Release;
71 end;
72 Screen.VideoMemoryUpdated;
73end;
74
75procedure TScreenCanvas.DrawRect(Rect: TRectangle; Color: TColor);
76var
77 X, Y: Integer;
78begin
79 TDeviceVideo(Screen.Device).Lock.Acquire;
80 try
81 for Y := Rect.Top to Rect.Bottom do
82 for X := Rect.Left to Rect.Right do
83 SetPixelInternal(TPoint.Create(X, Y), Color);
84 finally
85 TDeviceVideo(Screen.Device).Lock.Release;
86 end;
87 Screen.VideoMemoryUpdated;
88end;
89
90procedure TScreenCanvas.DrawFrame(Rect: TRectangle; Color: TColor);
91var
92 X, Y: Integer;
93begin
94 TDeviceVideo(Screen.Device).Lock.Acquire;
95 try
96 for Y := Rect.Top to Rect.Bottom do begin
97 SetPixelInternal(TPoint.Create(Rect.Left, Y), Color);
98 SetPixelInternal(TPoint.Create(Rect.Right, Y), Color);
99 end;
100 for X := Rect.Left to Rect.Right do begin
101 SetPixelInternal(TPoint.Create(X, Rect.Top), Color);
102 SetPixelInternal(TPoint.Create(X, Rect.Bottom), Color);
103 end;
104 finally
105 TDeviceVideo(Screen.Device).Lock.Release;
106 end;
107 Screen.VideoMemoryUpdated;
108end;
109
110procedure TScreenCanvas.SetPixel(P: TPoint; Color: TColor);
111begin
112 TDeviceVideo(Screen.Device).Lock.Acquire;
113 try
114 if Assigned(Screen.VideoMemory) and
115 TRectangle.Create(TPoint.Create(0, 0), Screen.Size).PointInside(P) then
116 PInteger(Screen.VideoMemory + P.X * Screen.BytesPerPixel + P.Y * Screen.BytesPerLine)^ := Color;
117 finally
118 TDeviceVideo(Screen.Device).Lock.Release;
119 end;
120end;
121
122procedure TScreenCanvas.SetPixelInternal(P: TPoint; Color: TColor);
123begin
124 if Assigned(Screen.VideoMemory) and
125 TRectangle.Create(TPoint.Create(0, 0), Screen.Size).PointInside(P) then
126 PInteger(Screen.VideoMemory + P.X * Screen.BytesPerPixel + P.Y * Screen.BytesPerLine)^ := Color;
127end;
128
129
130{ TScreen }
131
132function TScreen.GetBytesPerLine: Integer;
133begin
134 Result := TDeviceVideo(Device).VideoMode.GetBytesPerLine;
135end;
136
137function TScreen.GetBytesPerPixel: Integer;
138begin
139 Result := TDeviceVideo(Device).VideoMode.GetBytesPerPixel;
140end;
141
142function TScreen.GetVideoMemory: PByte;
143begin
144 Result := TDeviceVideo(Device).VideoMemory;
145end;
146
147procedure TScreen.VideoMemoryUpdated;
148begin
149 if Assigned(Device) then
150 TDeviceVideo(Device).VideoMemoryChange;
151end;
152
153
154end.
155
Note: See TracBrowser for help on using the repository browser.