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

unit Kernel.Screen;

interface

uses
  SysUtils, Math, Kernel.Graphics, Kernel.Device;

type
  TScreen = class;

  { TScreenCanvas }

  TScreenCanvas = class(TCanvas)
  private
    procedure SetPixelInternal(P: TPoint; Color: TColor);
  public
    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 DrawFrame(Rect: TRectangle; Color: TColor); override;
    procedure SetPixel(P: TPoint; Color: TColor); override;
  end;

  { TScreen }

  TScreen = class
  private
    function GetBytesPerLine: Integer;
    function GetBytesPerPixel: Integer;
    function GetVideoMemory: PByte;
  public
    Device: TDeviceVideo;
    Size: TPoint;
    DPI: Integer;
    ColorFormat: TColorFormat;
    Canvas: TCanvas;
    procedure VideoMemoryUpdated;
    property BytesPerPixel: Integer read GetBytesPerPixel;
    property BytesPerLine: Integer read GetBytesPerLine;
    property VideoMemory: PByte read GetVideoMemory;
  end;


implementation

{ TScreenCanvas }

procedure TScreenCanvas.DrawText(Pos: TPoint; Text: string; Color: TColor);
begin

end;

procedure TScreenCanvas.DrawLine(P1, P2: TPoint; Color: TColor);
var
  I: Integer;
begin
  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;
end;

procedure TScreenCanvas.DrawRect(Rect: TRectangle; Color: TColor);
var
  X, Y: Integer;
begin
  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;

procedure TScreenCanvas.DrawFrame(Rect: TRectangle; Color: TColor);
var
  X, Y: Integer;
begin
  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;
end;

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
    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 }

function TScreen.GetBytesPerLine: Integer;
begin
  Result := TDeviceVideo(Device).VideoMode.GetBytesPerLine;
end;

function TScreen.GetBytesPerPixel: Integer;
begin
  Result := TDeviceVideo(Device).VideoMode.GetBytesPerPixel;
end;

function TScreen.GetVideoMemory: PByte;
begin
  Result := TDeviceVideo(Device).VideoMemory;
end;

procedure TScreen.VideoMemoryUpdated;
begin
  if Assigned(Device) then
    TDeviceVideo(Device).VideoMemoryChange;
end;


end.