source: branches/virtcpu varint/Forms/UFormScreen.pas

unit UFormScreen;

{$mode delphi}

interface

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

type

  { TFormScreen }

  TFormScreen = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure FormShow(Sender: TObject);
    procedure Image1Resize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    procedure ScreenRepaing;

  public
    Machine: TMachine;
    procedure Reload;
  end;

var
  FormScreen: TFormScreen;

implementation

{$R *.lfm}

{ TFormScreen }

procedure TFormScreen.ScreenRepaing;
var
  B: Byte;
  P: Integer;
begin
  with Machine, Screen do begin
    if ChangedAreaFrom < ChangedAreaTo then begin
      if (Image1.Picture.Bitmap.Width <> Image1.Width) or
      (Image1.Picture.Bitmap.Height <> Image1.Height) then
        Image1.Picture.Bitmap.SetSize(Image1.Width, Image1.Height);
      Image1.Picture.Bitmap.BeginUpdate(True);
      P := ChangedAreaFrom;
      while P <= ChangedAreaTo do begin
        B := PByte(Memory + MemoryBase + P)^;
        Image1.Canvas.Pixels[P mod Size.X, P div Size.X] := B * $010101;
        Inc(P);
      end;
      ChangedAreaTo := MemoryBase;
      ChangedAreaFrom := MemoryBase + MemorySize;
      Image1.Picture.Bitmap.EndUpdate;
    end;
  end;
end;

procedure TFormScreen.Image1Resize(Sender: TObject);
begin
  Reload;
  ScreenRepaing;
end;

procedure TFormScreen.FormShow(Sender: TObject);
begin
  Reload;
  ScreenRepaing;
end;

procedure TFormScreen.Timer1Timer(Sender: TObject);
begin
  ScreenRepaing;
end;

procedure TFormScreen.Reload;
begin
  Machine.Screen.Size := Point(Image1.Width, Image1.Height);
end;

end.