source: branches/CpuSingleSize/Forms/FormScreen.pas

unit FormScreen;

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Machine;

type

  { TFormScreen }

  TFormScreen = class(TFormDevice)
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    TempBitmap: TBitmap;
  protected
    function GetDevice: TDevice; override;
    procedure SetDevice(AValue: TDevice); override;
  public
    Screen: TDeviceScreen;
  end;


implementation

{$R *.lfm}

{ TFormScreen }

procedure TFormScreen.Timer1Timer(Sender: TObject);
var
  P: ^Integer;
  X, Y: Integer;
begin
  if Assigned(Screen) and Screen.Modified then begin
    Screen.Modified := False;
    TempBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
    TempBitmap.BeginUpdate;
    for Y := 0 to Screen.Size.Y - 1 do begin
      P := TempBitmap.ScanLine[Y];
      for X := 0 to Screen.Size.X - 1 do begin
        P^ := Screen.VideoMem[Y * Screen.Size.Y + X] * $010101;
        Inc(P);
      end;
    end;
    TempBitmap.EndUpdate;
    PaintBox1.Refresh;
  end;
end;

function TFormScreen.GetDevice: TDevice;
begin
  Result := Screen;
end;

procedure TFormScreen.SetDevice(AValue: TDevice);
begin
  if AValue is TDeviceScreen then
    Screen := TDeviceScreen(AValue);
end;

procedure TFormScreen.PaintBox1Paint(Sender: TObject);
begin
  PaintBox1.Canvas.Draw(0, 0, TempBitmap);
end;

procedure TFormScreen.FormCreate(Sender: TObject);
begin
  TempBitmap := TBitmap.Create;
end;

procedure TFormScreen.FormDestroy(Sender: TObject);
begin
  FreeAndNil(TempBitmap);
end;

end.