Changeset 13 for trunk/Packages/Kernel

Timestamp:

Sep 25, 2017, 2:48:08 PM (7 years ago)

Author:

chronos

Message:

• Added: Drawing relative to Canvas. In case of Window drawing relative to Window.
• Modified: Use custom TPoint and TRectangle if possible.

Location:

trunk/Packages/Kernel

Files:

• Kernel.lpk (modified) (1 diff)
• UAPI.pas (modified) (12 diffs)
• UDevice.pas (modified) (1 diff)
• UGraphics.pas (modified) (7 diffs)
• UKernel.pas (modified) (5 diffs)
• UScreen.pas (modified) (5 diffs)

trunk/Packages/Kernel/Kernel.lpk

@@ -18 +18 @@
         </SyntaxOptions>
       </Parsing>
+      <Other>
+        <CompilerMessages>
+          <IgnoredMessages idx5024="True"/>
+        </CompilerMessages>
+      </Other>
     </CompilerOptions>
     <Files Count="12">

trunk/Packages/Kernel/UAPI.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, UList, DateUtils, UMemory, UScreen, UDevice, UIPC,
-  UScheduler;
+  SysUtils, UList, DateUtils, UMemory, UGraphics, UDevice, UIPC,
+  UScheduler, UScreen;
 
 type
   TApiCommand = (acNone, acWriteText, acDrawText, acDrawLine, acDrawRect, acSleep,
-    acReadMessage, acWindowCreate, acWindowSetAttr);
+    acReadMessage, acWindowCreate, acWindowSetAttr, acGetWindowCanvas);
 
   TDrawTextParams = record
+    CanvasId: Integer;
     P: TPoint;
     Text: string;
@@ -20 +21 @@
 
   TDrawLineParams = record
+    CanvasId: Integer;
     P1: TPoint;
     P2: TPoint;
@@ -26 +28 @@
 
   TWindowSetAttrParams = record
-    Size: TPoint;
+    WindowId: Integer;
+    Bounds: TRectangle;
     Visible: Boolean;
   end;
 
   TDrawRectParams = record
-    Rect: TRect;
+    CanvasId: Integer;
+    Rect: TRectangle;
     Color: TColor;
   end;
@@ -41 +45 @@
     function Call(Command: TApiCommand; Data: Pointer): Pointer;
     procedure WriteText(Text: string);
-    procedure DrawText(P: TPoint; Text: string; Color: TColor);
-    procedure DrawLine(P1, P2: TPoint; Color: TColor);
-    procedure DrawRect(Rect: TRect; Color: TColor);
+    procedure DrawText(CanvasId: Integer; P: TPoint; Text: string; Color: TColor);
+    procedure DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
+    procedure DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
     procedure Sleep(Time: TDateTime);
     procedure ReadMessage(Message: TIPCMessage);
     function WindowCreate: Integer;
-    procedure WindowSetAttr(Size: TPoint; Visible: Boolean);
+    function GetWindowCanvas(WindowId: Integer): Integer;
+    procedure WindowSetAttr(WindowId: Integer; Bounds: TRectangle; Visible: Boolean);
   end;
 
@@ -58 +63 @@
     function Call(Command: TApiCommand; Data: Pointer): Pointer;
     procedure WriteText(Text: string);
-    procedure DrawText(P: TPoint; Text: string; Color: TColor);
-    procedure DrawLine(P1, P2: TPoint; Color: TColor);
-    procedure DrawRect(Rect: TRect; Color: TColor);
+    procedure DrawText(CanvasId: Integer; P: TPoint; Text: string; Color: TColor);
+    procedure DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
+    procedure DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
     procedure Sleep(Time: TDateTime);
     procedure ReadMessage(Message: TIPCMessage);
     function WindowCreate: Integer;
-    procedure WindowSetAttr(Size: TPoint; Visible: Boolean);
+    function GetWindowCanvas(WindowId: Integer): Integer;
+    procedure WindowSetAttr(WindowId: Integer; Bounds: TRectangle; Visible: Boolean);
   end;
 
@@ -86 +92 @@
 end;
 
-procedure TUserApi.DrawText(P: TPoint; Text: string; Color: TColor);
+procedure TUserApi.DrawText(CanvasId: Integer; P: TPoint; Text: string; Color: TColor);
 var
   Params: TDrawTextParams;
 begin
+  Params.CanvasId := CanvasId;
   Params.P := P;
   Params.Text := Text;
@@ -96 +103 @@
 end;
 
-procedure TUserApi.DrawLine(P1, P2: TPoint; Color: TColor);
+procedure TUserApi.DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
 var
   Params: TDrawLineParams;
 begin
+  Params.CanvasId := CanvasId;
   Params.P1 := P1;
   Params.P2 := P2;
@@ -106 +114 @@
 end;
 
-procedure TUserApi.DrawRect(Rect: TRect; Color: TColor);
+procedure TUserApi.DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
 var
   Params: TDrawRectParams;
 begin
+  Params.CanvasId := CanvasId;
   Params.Rect := Rect;
   Params.Color := Color;
@@ -127 +136 @@
 function TUserApi.WindowCreate: Integer;
 begin
-  Call(acWindowCreate, nil);
-end;
-
-procedure TUserApi.WindowSetAttr(Size: TPoint; Visible: Boolean);
+  Result := Integer(Call(acWindowCreate, nil));
+end;
+
+function TUserApi.GetWindowCanvas(WindowId: Integer): Integer;
+begin
+  Call(acGetWindowCanvas, Pointer(WindowId));
+end;
+
+procedure TUserApi.WindowSetAttr(WindowId: Integer; Bounds: TRectangle; Visible: Boolean);
 var
   Params: TWindowSetAttrParams;
 begin
-  Params.Size := Size;
+  Params.WindowId := WindowId;
+  Params.Bounds := Bounds;
   Params.Visible := Visible;
   Call(acWindowSetAttr, @Params);
@@ -145 +160 @@
 begin
   case Command of
-    acDrawLine: DrawLine(TDrawLineParams(Data^).P1, TDrawLineParams(Data^).P2,
-      TDrawLineParams(Data^).Color);
-    acDrawRect: DrawRect(TDrawRectParams(Data^).Rect, TDrawRectParams(Data^).Color);
-    acDrawText: DrawText(TDrawTextParams(Data^).P, TDrawTextParams(Data^).Text,
-      TDrawTextParams(Data^).Color);
+    acDrawLine: DrawLine(TDrawLineParams(Data^).CanvasId, TDrawLineParams(Data^).P1,
+      TDrawLineParams(Data^).P2, TDrawLineParams(Data^).Color);
+    acDrawRect: DrawRect(TDrawRectParams(Data^).CanvasId, TDrawRectParams(Data^).Rect,
+      TDrawRectParams(Data^).Color);
+    acDrawText: DrawText(TDrawTextParams(Data^).CanvasId, TDrawTextParams(Data^).P,
+      TDrawTextParams(Data^).Text, TDrawTextParams(Data^).Color);
     acSleep: Sleep(TDateTime(Data^));
     acWindowCreate: Result := Pointer(WindowCreate);
-    acWindowSetAttr: WindowSetAttr(TWindowSetAttrParams(Data^).Size,
-      TWindowSetAttrParams(Data^).Visible);
+    acWindowSetAttr: WindowSetAttr(TWindowSetAttrParams(Data^).WindowId,
+      TWindowSetAttrParams(Data^).Bounds, TWindowSetAttrParams(Data^).Visible);
     acWriteText: WriteText(string(Data));
     acReadMessage: ReadMessage(Data);
+    acGetWindowCanvas: Result := Pointer(GetWindowCanvas(Integer(Data)));
   end;
 end;
@@ -169 +186 @@
 end;
 
-procedure TKernelApi.DrawText(P: TPoint; Text: string; Color: TColor);
+procedure TKernelApi.DrawText(CanvasId: Integer; P: TPoint; Text: string; Color: TColor);
 var
   Screen: TScreen;
-begin
-  Screen := TScreen(TKernel(Kernel).Screens.First);
-  Screen.DrawText(P, Text, Color);
-end;
-
-procedure TKernelApi.DrawLine(P1, P2: TPoint; Color: TColor);
+  Canvas: TCanvas;
+begin
+  Canvas := TKernel(Kernel).Desktop.FindCanvasById(CanvasId);
+  if Assigned(Canvas) then begin
+    Canvas.DrawText(P, Text, Color);
+  end;
+end;
+
+procedure TKernelApi.DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
 var
   Screen: TScreen;
-begin
-  Screen := TScreen(TKernel(Kernel).Screens.First);
-  Screen.DrawLine(P1, P2, Color);
-end;
-
-procedure TKernelApi.DrawRect(Rect: TRect; Color: TColor);
+  Canvas: TCanvas;
+begin
+  Canvas := TKernel(Kernel).Desktop.FindCanvasById(CanvasId);
+  if Assigned(Canvas) then begin
+    Canvas.DrawLine(P1.Add(Canvas.Position), P2.Add(Canvas.Position), Color);
+  end;
+end;
+
+procedure TKernelApi.DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
 var
   Screen: TScreen;
-begin
-  Screen := TScreen(TKernel(Kernel).Screens.First);
-  Screen.DrawRect(Rect, Color);
+  Canvas: TCanvas;
+begin
+  Canvas := TKernel(Kernel).Desktop.FindCanvasById(CanvasId);
+  if Assigned(Canvas) then begin
+    Canvas.DrawRect(Rect, Color);
+  end;
 end;
 
@@ -210 +236 @@
 
 function TKernelApi.WindowCreate: Integer;
-begin
-
-end;
-
-procedure TKernelApi.WindowSetAttr(Size: TPoint; Visible: Boolean);
-begin
-
+var
+  Window: TWindow;
+begin
+  Window := TKernel(Kernel).Desktop.CreateWindow;
+  Window.Desktop := TKernel(Kernel).Desktop;
+  Result := Window.Id;
+end;
+
+function TKernelApi.GetWindowCanvas(WindowId: Integer): Integer;
+var
+  Window: TWindow;
+  Canvas: TCanvas;
+begin
+  Window := TWindow(TKernel(Kernel).Desktop.FindObjectById(WindowId));
+  if Assigned(Window) then begin
+    Canvas := Window.Canvas;
+    Canvas.Parent := TKernel(Kernel).Screens.First.Canvas;
+    Result := Canvas.Id;
+  end else Result := -1;
+end;
+
+procedure TKernelApi.WindowSetAttr(WindowId: Integer; Bounds: TRectangle; Visible: Boolean);
+var
+  Window: TWindow;
+begin
+  Window := TWindow(TKernel(Kernel).Desktop.FindObjectById(WindowId));
+  if Assigned(Window) then begin
+    Window.Bounds := Bounds;
+    Window.Canvas.Position := Bounds.Position;
+    Window.Visible := Visible;
+  end;
 end;
 

trunk/Packages/Kernel/UDevice.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Contnrs, UList, UScreen;
+  Classes, SysUtils, Contnrs, UList, UGraphics;
 
 type

trunk/Packages/Kernel/UGraphics.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, fgl;
+  SysUtils, fgl;
 
 type
-  TRectangle = class
+  TDesktop = class;
+
+  { TPoint }
+
+  TPoint = record
+    X: Integer;
+    Y: Integer;
+    function Create(X, Y: Integer): TPoint;
+    function Add(P: TPoint): TPoint;
+  end;
+
+  { TRectangle }
+
+  TRectangle = record
+  private
+    function GetBottom: Integer;
+    function GetLeft: Integer;
+    function GetRight: Integer;
+    function GetTop: Integer;
+    procedure SetBottom(AValue: Integer);
+    procedure SetLeft(AValue: Integer);
+    procedure SetRight(AValue: Integer);
+    procedure SetTop(AValue: Integer);
+  public
     Position: TPoint;
     Size: TPoint;
+    function PointInside(P: TPoint): Boolean;
+    function Create(Left, Top, Width, Height: Integer): TRectangle; overload;
+    function Create(Position, Size: TPoint): TRectangle; overload;
+    function AddPoint(P: TPoint): TRectangle;
+    property Left: Integer read GetLeft write SetLeft;
+    property Top: Integer read GetTop write SetTop;
+    property Right: Integer read GetRight write SetRight;
+    property Bottom: Integer read GetBottom write SetBottom;
+  end;
+
+  TColorFormat = (cfRGBA8, cfGray8);
+  TColor = Integer;
+
+  { TCanvas }
+
+  TCanvas = class
+    Parent: TCanvas;
+    Position: TPoint;
+    Id: Integer;
+    procedure DrawText(Pos: TPoint; Text: string; Color: TColor); virtual;
+    procedure DrawLine(P1, P2: TPoint; Color: TColor); virtual;
+    procedure DrawRect(Rect: TRectangle; Color: TColor); virtual;
+    procedure SetPixel(P: TPoint; Color: TColor); virtual;
   end;
 
@@ -17 +63 @@
 
   TGraphicObject = class
+  private
+    FCanvas: TCanvas;
+    function GetCanvas: TCanvas;
+  public
+    Desktop: TDesktop;
     Id: Integer;
     Visible: Boolean;
     procedure Paint; virtual;
+    property Canvas: TCanvas read GetCanvas;
   end;
 
@@ -25 +77 @@
 
   TWindow = class(TGraphicObject)
+  public
     Title: string;
     Bounds: TRectangle;
@@ -43 +96 @@
 
   TDesktop = class
+  private
+    ObjectLastId: Integer;
+    CanvasLastId: Integer;
+  public
     Objects: TFPGObjectList<TGraphicObject>;
+    Canvases: TFPGObjectList<TCanvas>;
+    function CreateWindow: TWindow;
+    function CreateCanvas: TCanvas;
+    function FindObjectById(Id: Integer): TGraphicObject;
+    function FindCanvasById(Id: Integer): TCanvas;
     procedure Paint;
     constructor Create;
@@ -51 +113 @@
 implementation
 
+{ TRectangle }
+
+function TRectangle.GetBottom: Integer;
+begin
+  Result := Position.Y + Size.Y;
+end;
+
+function TRectangle.GetLeft: Integer;
+begin
+  Result := Position.X;
+end;
+
+function TRectangle.GetRight: Integer;
+begin
+  Result := Position.X + Size.X;
+end;
+
+function TRectangle.GetTop: Integer;
+begin
+  Result := Position.Y;
+end;
+
+procedure TRectangle.SetBottom(AValue: Integer);
+begin
+  Size.Y := AValue - Position.Y;
+end;
+
+procedure TRectangle.SetLeft(AValue: Integer);
+begin
+  Position.X := AValue;
+end;
+
+procedure TRectangle.SetRight(AValue: Integer);
+begin
+  Size.X := AValue - Position.X;
+end;
+
+procedure TRectangle.SetTop(AValue: Integer);
+begin
+  Size.Y := AValue;
+end;
+
+function TRectangle.PointInside(P: TPoint): Boolean;
+begin
+  Result := (P.X >= Position.X) and (P.Y >= Position.Y) and
+    (P.X < (Position.X + Size.X)) and (P.Y < (Position.Y + Size.Y))
+end;
+
+function TRectangle.Create(Left, Top, Width, Height: Integer): TRectangle;
+begin
+  Result.Position.X := Left;
+  Result.Position.Y := Top;
+  Result.Size.X := Width;
+  Result.Size.Y := Height;
+end;
+
+function TRectangle.Create(Position, Size: TPoint): TRectangle;
+begin
+  Result.Position := Position;
+  Result.Size := Size;
+end;
+
+function TRectangle.AddPoint(P: TPoint): TRectangle;
+begin
+  Result.Size := Size;
+  Result.Position := Position.Add(P);
+end;
+
+{ TPoint }
+
+function TPoint.Create(X, Y: Integer): TPoint;
+begin
+  Result.X := X;
+  Result.Y := Y;
+end;
+
+function TPoint.Add(P: TPoint): TPoint;
+begin
+  Result.X := X + P.X;
+  Result.Y := Y + P.Y;
+end;
+
+{ TCanvas }
+
+procedure TCanvas.DrawText(Pos: TPoint; Text: string; Color: TColor);
+begin
+  if Assigned(Parent) then
+    Parent.DrawText(Pos.Add(Position), Text, Color);
+end;
+
+procedure TCanvas.DrawLine(P1, P2: TPoint; Color: TColor);
+begin
+  if Assigned(Parent) then
+    Parent.DrawLine(P1.Add(Position), P2.Add(Position), Color);
+end;
+
+procedure TCanvas.DrawRect(Rect: TRectangle; Color: TColor);
+begin
+  if Assigned(Parent) then
+    Parent.DrawRect(Rect.AddPoint(Position), Color);
+end;
+
+procedure TCanvas.SetPixel(P: TPoint; Color: TColor);
+begin
+  if Assigned(Parent) then
+    Parent.SetPixel(P.Add(Position), Color);
+end;
+
 { TGraphicObject }
 
+function TGraphicObject.GetCanvas: TCanvas;
+begin
+  FCanvas := Desktop.CreateCanvas;
+  Result := FCanvas;
+end;
+
 procedure TGraphicObject.Paint;
 begin
-
 end;
 
@@ -63 +238 @@
 begin
   inherited Paint;
+  Canvas.DrawRect(Bounds, $ff0000);
 end;
 
 constructor TWindow.Create;
 begin
-  Bounds := TRectangle.Create;
 end;
 
 destructor TWindow.Destroy;
 begin
-  Bounds.Free;
   inherited Destroy;
 end;
 
 { TDesktop }
+
+function TDesktop.CreateWindow: TWindow;
+begin
+  Inc(ObjectLastId);
+  Result := TWindow.Create;
+  Result.Id := ObjectLastId;
+  Objects.Add(Result);
+end;
+
+function TDesktop.CreateCanvas: TCanvas;
+begin
+  Inc(CanvasLastId);
+  Result := TCanvas.Create;
+  Result.Id := CanvasLastId;
+  Canvases.Add(Result);
+end;
+
+function TDesktop.FindObjectById(Id: Integer): TGraphicObject;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Objects.Count) and (Objects[I].Id <> Id) do Inc(I);
+  if I < Objects.Count then Result := Objects[I]
+    else Result := nil;
+end;
+
+function TDesktop.FindCanvasById(Id: Integer): TCanvas;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Canvases.Count) and (Canvases[I].Id <> Id) do Inc(I);
+  if I < Canvases.Count then Result := Canvases[I]
+    else Result := nil;
+end;
 
 procedure TDesktop.Paint;
@@ -89 +299 @@
 begin
   Objects := TFPGObjectList<TGraphicObject>.Create;
+  Canvases := TFPGObjectList<TCanvas>.Create;
 end;
 
 destructor TDesktop.Destroy;
 begin
-  Objects.Free;
+  FreeAndNil(Canvases);
+  FreeAndNil(Objects);
   inherited Destroy;
 end;

trunk/Packages/Kernel/UKernel.pas

@@ -6 +6 @@
 
 uses
-  Classes, Math, SysUtils, UList, Contnrs, UFileSystem, UMemory, UScreen, UDevice,
-  fgl, UApp, UScheduler, UApi;
+  Classes, SysUtils, UList, Contnrs, UFileSystem, UMemory, UScreen, UDevice,
+  fgl, UApp, UScheduler, UApi, UGraphics;
 
 type
@@ -37 +37 @@
     Devices: TNamedObjectList<TDevice>;
     Screens: TFPGObjectList<TScreen>;
+    Desktop: TDesktop;
     procedure AppExecute(AFile: TFile);
     procedure Init;
     procedure Run;
+    procedure Terminate;
     constructor Create;
     destructor Destroy; override;
@@ -84 +86 @@
       NewScreen.BytesPerLine := VideoMode.GetBytesPerLine;
       NewScreen.Device := VideoDevice;
+      NewScreen.Canvas := TScreenCanvas.Create;
+      TScreenCanvas(NewScreen.Canvas).Screen := NewScreen;
       Screens.Add(NewScreen);
     end;
@@ -150 +154 @@
 end;
 
+procedure TKernel.Terminate;
+begin
+  if Scheduler.Running then Scheduler.Stop;
+end;
+
 constructor TKernel.Create;
 begin
@@ -159 +168 @@
   Api := TKernelApi.Create;
   Api.Kernel := Self;
+  Desktop := TDesktop.Create;
 end;
 
 destructor TKernel.Destroy;
 begin
+  Terminate;
+  FreeAndNil(Desktop);
   FreeAndNil(Api);
   FreeAndNil(Screens);

trunk/Packages/Kernel/UScreen.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Math;
+  SysUtils, Math, UGraphics;
 
 type
-  TColorFormat = (cfRGBA8, cfGray8);
-  TColor = Integer;
+  TScreen = class;
+
+  TScreenCanvas = class(TCanvas)
+    Screen: TScreen;
+    procedure DrawText(Pos: TPoint; Text: string; Color: TColor); override;
+    procedure DrawLine(P1, P2: TPoint; Color: TColor); override;
+    procedure DrawRect(Rect: TRectangle; Color: TColor); override;
+    procedure SetPixel(P: TPoint; Color: TColor); override;
+  end;
 
   { TScreen }
@@ -22 +29 @@
     BytesPerLine: Integer;
     VideoMemory: PByte;
-    procedure DrawText(Pos: TPoint; Text: string; Color: TColor);
-    procedure DrawLine(P1, P2: TPoint; Color: TColor);
-    procedure DrawRect(Rect: TRect; Color: TColor);
-    procedure SetPixel(P: TPoint; Color: TColor);
+    Canvas: TCanvas;
     procedure VideoMemoryUpdated;
   end;
@@ -34 +38 @@
   UDevice;
 
-{ TScreen }
+{ TScreenCanvas }
 
-procedure TScreen.DrawText(Pos: TPoint; Text: string; Color: TColor);
+procedure TScreenCanvas.DrawText(Pos: TPoint; Text: string; Color: TColor);
 begin
 
 end;
 
-procedure TScreen.DrawLine(P1, P2: TPoint; Color: TColor);
+procedure TScreenCanvas.DrawLine(P1, P2: TPoint; Color: TColor);
 var
   I: Integer;
@@ -47 +51 @@
   if Abs(P2.X - P1.X) > Abs(P2.Y - P1.Y) then begin
     for I := 0 to Abs(P2.X - P1.X) - 1 do
-      SetPixel(Point(Trunc(P1.X + I * Sign(P2.X - P1.X)),
+      SetPixel(TPoint.Create(Trunc(P1.X + I * Sign(P2.X - P1.X)),
         Trunc(P1.Y + (P2.Y - P1.Y) / Abs(P2.X - P1.X) * I)), Color);
   end else begin
     for I := 0 to Abs(P2.Y - P1.Y) - 1 do
-      SetPixel(Point(Trunc(P1.X + (P2.X - P1.X) / Abs(P2.Y - P1.Y) * I),
+      SetPixel(TPoint.Create(Trunc(P1.X + (P2.X - P1.X) / Abs(P2.Y - P1.Y) * I),
         Trunc(P1.Y + I * Sign(P2.Y - P1.Y))), Color);
   end;
-  VideoMemoryUpdated;
+  Screen.VideoMemoryUpdated;
 end;
 
-procedure TScreen.DrawRect(Rect: TRect; Color: TColor);
+procedure TScreenCanvas.DrawRect(Rect: TRectangle; Color: TColor);
 var
   X, Y: Integer;
@@ -63 +67 @@
   for Y := Rect.Top to Rect.Bottom do
   for X := Rect.Left to Rect.Right do
-    SetPixel(Point(X, Y), Color);
+    SetPixel(TPoint.Create(X, Y), Color);
 end;
 
-procedure TScreen.SetPixel(P: TPoint; Color: TColor);
+procedure TScreenCanvas.SetPixel(P: TPoint; Color: TColor);
 begin
-  if Assigned(VideoMemory) then
-    PInteger(VideoMemory + P.X * BytesPerPixel + P.Y * BytesPerLine)^ := Color;
+  if Assigned(Screen.VideoMemory) and
+    TRectangle.Create(TPoint.Create(0, 0), Screen.Size).PointInside(P) then
+    PInteger(Screen.VideoMemory + P.X * Screen.BytesPerPixel + P.Y * Screen.BytesPerLine)^ := Color;
 end;
+
+
+{ TScreen }
 
 procedure TScreen.VideoMemoryUpdated;