Changeset 19 for trunk/Packages/Kernel/UScreen.pas

Timestamp:

Jan 21, 2018, 11:33:15 PM (6 years ago)

Author:

chronos

Message:

• Added: Locking of video memory because it is accessed by main thread and also application threads.

File:

• trunk/Packages/Kernel/UScreen.pas (modified) (5 diffs)

trunk/Packages/Kernel/UScreen.pas

@@ -14 +14 @@
 
   TScreenCanvas = class(TCanvas)
+  private
+    procedure SetPixelInternal(P: TPoint; Color: TColor);
+  public
     Screen: TScreen;
     procedure DrawText(Pos: TPoint; Text: string; Color: TColor); override;
@@ -57 +60 @@
   I: Integer;
 begin
-  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(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(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);
+  TDeviceVideo(Screen.Device).Lock.Acquire;
+  try
+    if Abs(P2.X - P1.X) > Abs(P2.Y - P1.Y) then begin
+      for I := 0 to Abs(P2.X - P1.X) - 1 do
+        SetPixelInternal(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
+        SetPixelInternal(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;
+  finally
+    TDeviceVideo(Screen.Device).Lock.Release;
   end;
   Screen.VideoMemoryUpdated;
@@ -73 +81 @@
   X, Y: Integer;
 begin
-  for Y := Rect.Top to Rect.Bottom do
-  for X := Rect.Left to Rect.Right do
-    SetPixel(TPoint.Create(X, Y), Color);
+  TDeviceVideo(Screen.Device).Lock.Acquire;
+  try
+    for Y := Rect.Top to Rect.Bottom do
+    for X := Rect.Left to Rect.Right do
+      SetPixelInternal(TPoint.Create(X, Y), Color);
+  finally
+    TDeviceVideo(Screen.Device).Lock.Release;
+  end;
   Screen.VideoMemoryUpdated;
 end;
@@ -83 +96 @@
   X, Y: Integer;
 begin
-  for Y := Rect.Top to Rect.Bottom do begin
-    SetPixel(TPoint.Create(Rect.Left, Y), Color);
-    SetPixel(TPoint.Create(Rect.Right, Y), Color);
-  end;
-  for X := Rect.Left to Rect.Right do begin
-    SetPixel(TPoint.Create(X, Rect.Top), Color);
-    SetPixel(TPoint.Create(X, Rect.Bottom), Color);
+  TDeviceVideo(Screen.Device).Lock.Acquire;
+  try
+    for Y := Rect.Top to Rect.Bottom do begin
+      SetPixelInternal(TPoint.Create(Rect.Left, Y), Color);
+      SetPixelInternal(TPoint.Create(Rect.Right, Y), Color);
+    end;
+    for X := Rect.Left to Rect.Right do begin
+      SetPixelInternal(TPoint.Create(X, Rect.Top), Color);
+      SetPixelInternal(TPoint.Create(X, Rect.Bottom), Color);
+    end;
+  finally
+    TDeviceVideo(Screen.Device).Lock.Release;
   end;
   Screen.VideoMemoryUpdated;
@@ -95 +113 @@
 
 procedure TScreenCanvas.SetPixel(P: TPoint; Color: TColor);
+begin
+  TDeviceVideo(Screen.Device).Lock.Acquire;
+  try
+    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;
+  finally
+    TDeviceVideo(Screen.Device).Lock.Release;
+  end;
+end;
+
+procedure TScreenCanvas.SetPixelInternal(P: TPoint; Color: TColor);
 begin
   if Assigned(Screen.VideoMemory) and