Changeset 19 for trunk/Packages/Kernel


Ignore:
Timestamp:
Jan 21, 2018, 11:33:15 PM (7 years ago)
Author:
chronos
Message:
  • Added: Locking of video memory because it is accessed by main thread and also application threads.
Location:
trunk/Packages/Kernel
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/Packages/Kernel/UDevice.pas

    r17 r19  
    66
    77uses
    8   Classes, SysUtils, Contnrs, UList, UGraphics;
     8  Classes, SysUtils, Contnrs, UList, UGraphics, syncobjs;
    99
    1010type
    … …  
    3636    function GetVideoMemory: PByte; virtual;
    3737  public
     38    Lock: TCriticalSection;
    3839    constructor Create; override;
     40    destructor Destroy; override;
    3941    procedure GetSupportedModes(Modes: TObjectList); virtual;
    4042    procedure VideoMemoryChange; virtual;
    … …  
    104106  ClassName := 'Video device';
    105107  FVideoMode := TVideoMode.Create;
     108  Lock := TCriticalSection.Create;
     109end;
     110
     111destructor TDeviceVideo.Destroy;
     112begin
     113  Lock.Free;
     114  FVideoMode.Free;
     115  inherited Destroy;
    106116end;
    107117

  • trunk/Packages/Kernel/UScreen.pas

    r17 r19  
    1414
    1515  TScreenCanvas = class(TCanvas)
     16  private
     17    procedure SetPixelInternal(P: TPoint; Color: TColor);
     18  public
    1619    Screen: TScreen;
    1720    procedure DrawText(Pos: TPoint; Text: string; Color: TColor); override;
    … …  
    5760  I: Integer;
    5861begin
    59   if Abs(P2.X - P1.X) > Abs(P2.Y - P1.Y) then begin
    60     for I := 0 to Abs(P2.X - P1.X) - 1 do
    61       SetPixel(TPoint.Create(Trunc(P1.X + I * Sign(P2.X - P1.X)),
    62         Trunc(P1.Y + (P2.Y - P1.Y) / Abs(P2.X - P1.X) * I)), Color);
    63   end else begin
    64     for I := 0 to Abs(P2.Y - P1.Y) - 1 do
    65       SetPixel(TPoint.Create(Trunc(P1.X + (P2.X - P1.X) / Abs(P2.Y - P1.Y) * I),
    66         Trunc(P1.Y + I * Sign(P2.Y - P1.Y))), Color);
     62  TDeviceVideo(Screen.Device).Lock.Acquire;
     63  try
     64    if Abs(P2.X - P1.X) > Abs(P2.Y - P1.Y) then begin
     65      for I := 0 to Abs(P2.X - P1.X) - 1 do
     66        SetPixelInternal(TPoint.Create(Trunc(P1.X + I * Sign(P2.X - P1.X)),
     67          Trunc(P1.Y + (P2.Y - P1.Y) / Abs(P2.X - P1.X) * I)), Color);
     68    end else begin
     69      for I := 0 to Abs(P2.Y - P1.Y) - 1 do
     70        SetPixelInternal(TPoint.Create(Trunc(P1.X + (P2.X - P1.X) / Abs(P2.Y - P1.Y) * I),
     71          Trunc(P1.Y + I * Sign(P2.Y - P1.Y))), Color);
     72    end;
     73  finally
     74    TDeviceVideo(Screen.Device).Lock.Release;
    6775  end;
    6876  Screen.VideoMemoryUpdated;
    … …  
    7381  X, Y: Integer;
    7482begin
    75   for Y := Rect.Top to Rect.Bottom do
    76   for X := Rect.Left to Rect.Right do
    77     SetPixel(TPoint.Create(X, Y), Color);
     83  TDeviceVideo(Screen.Device).Lock.Acquire;
     84  try
     85    for Y := Rect.Top to Rect.Bottom do
     86    for X := Rect.Left to Rect.Right do
     87      SetPixelInternal(TPoint.Create(X, Y), Color);
     88  finally
     89    TDeviceVideo(Screen.Device).Lock.Release;
     90  end;
    7891  Screen.VideoMemoryUpdated;
    7992end;
    … …  
    8396  X, Y: Integer;
    8497begin
    85   for Y := Rect.Top to Rect.Bottom do begin
    86     SetPixel(TPoint.Create(Rect.Left, Y), Color);
    87     SetPixel(TPoint.Create(Rect.Right, Y), Color);
    88   end;
    89   for X := Rect.Left to Rect.Right do begin
    90     SetPixel(TPoint.Create(X, Rect.Top), Color);
    91     SetPixel(TPoint.Create(X, Rect.Bottom), Color);
     98  TDeviceVideo(Screen.Device).Lock.Acquire;
     99  try
     100    for Y := Rect.Top to Rect.Bottom do begin
     101      SetPixelInternal(TPoint.Create(Rect.Left, Y), Color);
     102      SetPixelInternal(TPoint.Create(Rect.Right, Y), Color);
     103    end;
     104    for X := Rect.Left to Rect.Right do begin
     105      SetPixelInternal(TPoint.Create(X, Rect.Top), Color);
     106      SetPixelInternal(TPoint.Create(X, Rect.Bottom), Color);
     107    end;
     108  finally
     109    TDeviceVideo(Screen.Device).Lock.Release;
    92110  end;
    93111  Screen.VideoMemoryUpdated;
    … …  
    95113
    96114procedure TScreenCanvas.SetPixel(P: TPoint; Color: TColor);
     115begin
     116  TDeviceVideo(Screen.Device).Lock.Acquire;
     117  try
     118    if Assigned(Screen.VideoMemory) and
     119      TRectangle.Create(TPoint.Create(0, 0), Screen.Size).PointInside(P) then
     120      PInteger(Screen.VideoMemory + P.X * Screen.BytesPerPixel + P.Y * Screen.BytesPerLine)^ := Color;
     121  finally
     122    TDeviceVideo(Screen.Device).Lock.Release;
     123  end;
     124end;
     125
     126procedure TScreenCanvas.SetPixelInternal(P: TPoint; Color: TColor);
    97127begin
    98128  if Assigned(Screen.VideoMemory) and
Note: See TracChangeset for help on using the changeset viewer.