source: trunk/Forms/FormMain.pas

unit FormMain;

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, Menus, ActnList, Kernel.Core, Kernel.Memory, Kernel.Device,
  PlatformBase, LCLType, Kernel.Graphics, GraphType;

type

  { TFormMain }

  TFormMain = class(TForm)
    AShowTerminal: TAction;
    AExit: TAction;
    AFullscreen: TAction;
    ActionList1: TActionList;
    MainMenu1: TMainMenu;
    MenuItem1: TMenuItem;
    MenuItem2: TMenuItem;
    MenuItem3: TMenuItem;
    MenuItem4: TMenuItem;
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure AExitExecute(Sender: TObject);
    procedure AFullscreenExecute(Sender: TObject);
    procedure AShowTerminalExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure PaintBox1Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure PaintBox1Resize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    TempBitmap: TBitmap;
    RedrawPending: Boolean;
    VideoDevice: TDeviceVideoBase;
    SerialDevice: TBaseSerialDevice;
    SerialText: string;
    OriginalBounds: TRect;
    OriginalWindowState: TWindowState;
    ScreenBounds: TRect;
    procedure SerialDeviceReceiveDataSync;
    procedure SerialDeviceReceiveData(Text: string);
    procedure VideoDeviceRedraw(Sender: TObject);
    procedure VideoDeviceRedrawSync;
    procedure SwitchFullScreen;
  public
    Kernel: TKernel;
    procedure EraseBackground(DC: HDC); override;
  end;

var
  FormMain: TFormMain;


implementation

uses
  Kernel.List, Kernel.App, Kernel.API, Clock, ThreadEx, FormTerminal;

{$R *.lfm}

{ TFormMain }

procedure TFormMain.FormCreate(Sender: TObject);
var
  NewApp: TApp;
  NewApp2: TApp;
begin
  TempBitmap := TBitmap.Create;
  PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];

  Kernel := TKernel.Create;
  Kernel.SchedulerClass := TBaseScheduler;
  Kernel.FileSystemClass := TBaseFileSystem;

  SerialDevice := TBaseSerialDevice.Create;
  SerialDevice.Name := 'Serial0';
  SerialDevice.ClassName := 'Serial port';
  SerialDevice.OnReceiveData := SerialDeviceReceiveData;
  Kernel.Devices.Add(SerialDevice);

  VideoDevice := TDeviceVideoBase.Create;
  VideoDevice.Name := 'Video0';
  VideoDevice.ClassName := 'Graphic card';
  VideoDevice.OnRedraw := VideoDeviceRedraw;
  VideoDevice.DPI := Screen.PixelsPerInch;
  VideoDevice.OnModeChanged := VideoDeviceRedraw;
  PaintBox1Resize(Self);
  Kernel.Devices.Add(VideoDevice);

  NewApp := TAppClock.Create;
  Kernel.Apps.Add(NewApp);

  NewApp2 := TAppClock2.Create;
  Kernel.Apps.Add(NewApp2);
end;

procedure TFormMain.AExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TFormMain.AFullscreenExecute(Sender: TObject);
begin
  SwitchFullScreen;
{  AFullscreen.Checked := not AFullscreen.Checked;
  if AFullscreen.Checked then begin
    WindowState := wsFullScreen;
    BorderStyle := bsNone;
  end else begin
    BorderStyle := bsSingle;
    WindowState := wsNormal;
  end;
  }
end;

procedure TFormMain.AShowTerminalExecute(Sender: TObject);
begin
  FormTerminal.FormTerminal.Show;
end;

procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  Kernel.Terminate;
end;

procedure TFormMain.SwitchFullScreen;
begin
  if WindowState <> wsFullScreen then begin
    // To full screen
    OriginalWindowState := WindowState;
    OriginalBounds := BoundsRect;

    WindowState := wsFullScreen;
  end else begin
    // From full screen
    WindowState := OriginalWindowState;
    BoundsRect := OriginalBounds;
    {$IFDEF MSWINDOWS}
    BorderStyle := bsSizeable;
    {$ENDIF}
    if OriginalWindowState = wsMaximized then
      WindowState := wsMaximized
    else
      with OriginalBounds do
        SetBounds(Left, Top, Right - Left, Bottom - Top) ;
    {$IFDEF LINUX}
    BorderStyle := bsSizeable;
    {$ENDIF}
  end;
end;

procedure TFormMain.EraseBackground(DC: HDC);
begin
  //inherited EraseBackground(DC);
end;

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

procedure TFormMain.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

end;

procedure TFormMain.FormShow(Sender: TObject);
begin
  Kernel.Run;
end;

procedure TFormMain.PaintBox1Click(Sender: TObject);
begin

end;

procedure TFormMain.PaintBox1Paint(Sender: TObject);
var
  X, Y: Integer;
  SourceBytePerPixel: Integer;
  SourceBytePerLine: Integer;
  SourcePixelPtr: PByte;
  SourcePixelRowPtr: PByte;
  RawImage: TRawImage;
  DestPixelRowPtr: PByte;
  DestPixelPtr: PByte;
  DestBytePerPixel: Integer;
  DestBytePerLine: Integer;
  SizeX: Integer;
  SizeY: Integer;
begin
  try
    TempBitmap.SetSize(VideoDevice.VideoMode.Size.X, VideoDevice.VideoMode.Size.Y);
    TempBitmap.BeginUpdate;
    RawImage := TempBitmap.RawImage;
    DestPixelRowPtr := RawImage.Data;
    DestBytePerPixel := RawImage.Description.BitsPerPixel div 8;
    DestBytePerLine := RawImage.Description.BytesPerLine;
    VideoDevice.Lock.Acquire;
    if Assigned(VideoDevice.VideoMemory) then begin
      SourceBytePerPixel := VideoDevice.VideoMode.GetBytesPerPixel;
      SourceBytePerLine := VideoDevice.VideoMode.GetBytesPerLine;
      SourcePixelRowPtr := VideoDevice.VideoMemory;
      SizeX := VideoDevice.VideoMode.Size.X;
      SizeY := VideoDevice.VideoMode.Size.Y;
      for Y := 0 to SizeY - 1 do begin
        SourcePixelPtr := SourcePixelRowPtr;
        DestPixelPtr := DestPixelRowPtr;
        for X := 0 to SizeX - 1 do begin
          PInteger(DestPixelPtr)^ := PInteger(SourcePixelPtr)^ and $ffffff;
          Inc(SourcePixelPtr, SourceBytePerPixel);
          Inc(DestPixelPtr, DestBytePerPixel);
        end;
        Inc(SourcePixelRowPtr, SourceBytePerLine);
        Inc(DestPixelRowPtr, DestBytePerLine);
      end;
    end;
    VideoDevice.Lock.Release;
  finally
    TempBitmap.EndUpdate;
    PaintBox1.Canvas.Draw(0, 0, TempBitmap);
  end;
end;

procedure TFormMain.PaintBox1Resize(Sender: TObject);
var
  VideoMode: TVideoMode;
begin
  VideoMode := TVideoMode.Create;
  VideoMode.Assign(VideoDevice.VideoMode);
  VideoMode.Size := TPoint.Create(Width, Height);
  VideoDevice.VideoMode := VideoMode;
  VideoMode.Free;
end;

procedure TFormMain.Timer1Timer(Sender: TObject);
begin
  if RedrawPending then begin
    PaintBox1.Refresh;
    RedrawPending := False;
  end;
end;

procedure TFormMain.SerialDeviceReceiveDataSync;
begin
  FormTerminal.FormTerminal.Memo1.Lines.AddText(SerialText);
end;

procedure TFormMain.SerialDeviceReceiveData(Text: string);
begin
  SerialText := Text;
  TThreadEx.Synchronize(TThreadEx.CurrentThread, SerialDeviceReceiveDataSync);
end;

procedure TFormMain.VideoDeviceRedraw(Sender: TObject);
begin
  TThreadEx.Synchronize(TThreadEx.CurrentThread, VideoDeviceRedrawSync);
end;

procedure TFormMain.VideoDeviceRedrawSync;
begin
  RedrawPending := True;
end;

end.