Changeset 7

Timestamp:

May 9, 2015, 12:00:33 AM (9 years ago)

Author:

chronos

Message:

• Added: Action to switch to full screen mode.
• Added: Video driver registration.

Location:

trunk

Files:

• Apps/UClock.pas (modified) (1 diff)
• ChronOS.lpi (modified) (7 diffs)
• ChronOS.lpr (modified) (1 diff)
• Forms/UFormMain.lfm (modified) (2 diffs)
• Forms/UFormMain.pas (modified) (7 diffs)
• Forms/UFormTerminal.lfm (modified) (1 diff)
• Platform/Base/UPlatformBase.pas (modified) (3 diffs)

trunk/Apps/UClock.pas

@@ -24 +24 @@
 var
   Message: TIPCMessage;
+  WindowId: Integer;
 begin
   Message := TIPCMessage.Create;
+  WindowId := API.WindowCreate;
+  API.WindowSetAttr(300, 200, True);
   while not Task.Terminated do begin
     API.WriteText('test');
+    API.DrawText(Point(10, 10), 'Text');
+    API.DrawLine(Point(20, 20), Point(100, 100));
     API.Sleep(OneSecond);
     //API.ReadMessage(Message);

trunk/ChronOS.lpi

@@ -71 +71 @@
       </Item1>
     </RequiredPackages>
-    <Units Count="14">
+    <Units Count="15">
       <Unit0>
         <Filename Value="ChronOS.lpr"/>
@@ -85 +85 @@
       </Unit1>
       <Unit2>
-        <Filename Value="UKernel.pas"/>
+        <Filename Value="System/UKernel.pas"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="UKernel"/>
@@ -105 +105 @@
       </Unit5>
       <Unit6>
-        <Filename Value="UAPI.pas"/>
+        <Filename Value="System/UAPI.pas"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="UAPI"/>
@@ -120 +120 @@
       </Unit8>
       <Unit9>
-        <Filename Value="UApp.pas"/>
+        <Filename Value="System/UApp.pas"/>
         <IsPartOfProject Value="True"/>
         <UnitName Value="UApp"/>
@@ -138 +138 @@
         <IsPartOfProject Value="True"/>
         <ComponentName Value="FormTerminal"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
         <UnitName Value="UFormTerminal"/>
@@ -146 +147 @@
         <UnitName Value="UClasses"/>
       </Unit13>
+      <Unit14>
+        <Filename Value="System/UGraphics.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="UGraphics"/>
+      </Unit14>
     </Units>
   </ProjectOptions>
@@ -155 +161 @@
     <SearchPaths>
       <IncludeFiles Value="$(ProjOutDir)"/>
-      <OtherUnitFiles Value="Apps;Platform/Base;Forms"/>
+      <OtherUnitFiles Value="Apps;Platform/Base;Forms;System"/>
       <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
     </SearchPaths>

trunk/ChronOS.lpr

@@ -10 +10 @@
   {$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, SysUtils, UFormMain, UKernel, UFileSystem, UClock, UMemoryManager, UAPI,
-  UPlatformBase, UList, UApp, UThreadEx, UMemory, UFormTerminal, UClasses;
+  Forms, SysUtils, UFormMain, UKernel, UFileSystem, UClock, UMemoryManager,
+  UAPI, UPlatformBase, UList, UApp, UThreadEx, UMemory, UFormTerminal, UClasses,
+  UGraphics;
 
 {$R *.res}

trunk/Forms/UFormMain.lfm

@@ -10 +10 @@
   OnCreate = FormCreate
   OnDestroy = FormDestroy
+  OnKeyDown = FormKeyDown
   OnShow = FormShow
-  LCLVersion = '1.3'
+  LCLVersion = '1.5'
   object PaintBox1: TPaintBox
     Left = 0
@@ -19 +20 @@
     Align = alClient
     OnClick = PaintBox1Click
+    OnResize = PaintBox1Resize
   end
   object MainMenu1: TMainMenu

trunk/Forms/UFormMain.pas

@@ -29 +29 @@
     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 PaintBox1Resize(Sender: TObject);
   private
     SerialText: string;
+    OriginalBounds: TRect;
+    OriginalWindowState: TWindowState;
+    ScreenBounds: TRect;
     procedure SerialDeviceReceiveDataSync;
     procedure SerialDeviceReceiveData(Data: TMemory);
+    procedure VideoDeviceRedraw(Sender: TObject);
+    procedure SwitchFullScreen;
   public
     Kernel: TKernel;
@@ -55 +62 @@
   NewApp: TApp;
   SerialDevice: TBaseSerialDevice;
-  NewScreen: TScreen;
+  VideoDevice: TBaseVideoDevice;
 begin
   Kernel := TKernel.Create;
@@ -62 +69 @@
   SerialDevice := TBaseSerialDevice.Create;
   SerialDevice.Name := 'Serial0';
+  SerialDevice.ClassName := 'Serial port';
   SerialDevice.OnReceiveData := SerialDeviceReceiveData;
   Kernel.Devices.Add(SerialDevice);
+
+  VideoDevice := TBaseVideoDevice.Create;
+  VideoDevice.Name := 'Video0';
+  VideoDevice.ClassName := 'Graphic card';
+  VideoDevice.OnRedraw := VideoDeviceRedraw;
+  VideoDevice.DPI := Screen.PixelsPerInch;
+  VideoDevice.VideoMemorySize := Point(PaintBox1.Width, PaintBox1.Height);;
+  Kernel.Devices.Add(VideoDevice);
+
   NewApp := TAppClock.Create;
   Kernel.Apps.Add(NewApp);
-  NewScreen := TScreen.Create;
-  NewScreen.Size := Point(PaintBox1.Width, PaintBox1.Height);
-  NewScreen.DPI := Screen.PixelsPerInch;
-  Kernel.Screens.Add(NewScreen);
 end;
 
@@ -79 +92 @@
 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;
 
@@ -87 +109 @@
 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.FormDestroy(Sender: TObject);
 begin
   Kernel.Free;
+end;
+
+procedure TFormMain.FormKeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+
 end;
 
@@ -100 +154 @@
 begin
 
+end;
+
+procedure TFormMain.PaintBox1Resize(Sender: TObject);
+begin
 end;
 
@@ -114 +172 @@
 end;
 
+procedure TFormMain.VideoDeviceRedraw(Sender: TObject);
+begin
+
+end;
+
 end.
 

trunk/Forms/UFormTerminal.lfm

@@ -1 +1 @@
 object FormTerminal: TFormTerminal
-  Left = 327
+  Left = 590
   Height = 240
-  Top = 34
+  Top = 496
   Width = 320
   Caption = 'FormTerminal'
   ClientHeight = 240
   ClientWidth = 320
-  LCLVersion = '1.3'
+  LCLVersion = '1.5'
   object Memo1: TMemo
     Left = 0

trunk/Platform/Base/UPlatformBase.pas

@@ -57 +57 @@
   end;
 
+  { TBaseVideoDevice }
+
+  TBaseVideoDevice = class(TDevice)
+  private
+    FOnRedraw: TNotifyEvent;
+  public
+    VideoMemory: PByte;
+    VideoMemorySize: TPoint;
+    DPI: Integer;
+    constructor Create; override;
+    destructor Destroy; override;
+    procedure Service(Index: Integer; DataIn, DataOut: TMemory); override;
+    property OnRedraw: TNotifyEvent read FOnRedraw write FOnRedraw;
+  end;
+
 implementation
+
+{ TBaseVideoDevice }
+
+constructor TBaseVideoDevice.Create;
+begin
+  inherited Create;
+end;
+
+destructor TBaseVideoDevice.Destroy;
+begin
+  inherited Destroy;
+end;
+
+procedure TBaseVideoDevice.Service(Index: Integer; DataIn, DataOut: TMemory);
+begin
+  if Index = 0 then begin
+    // Redraw to screen
+    if Assigned(FOnRedraw) then
+      FOnRedraw(Self);
+  end else
+  if Index = 1 then begin
+    // Get video memory
+    VideoMemory := GetMem(VideoMemorySize.X * VideoMemorySize.Y * 4);
+//    DataOut^ := VideoMemory;
+//    DataOut^ := VideoMemory;
+  end else inherited;
+end;
 
 { TBaseSerialDevice }
@@ -76 +118 @@
 procedure TBaseSerialDevice.Service(Index: Integer; DataIn, DataOut: TMemory);
 begin
-  inherited Service(Index, DataIn, DataOut);
   if Index = 0 then begin
     Lock.Acquire;
@@ -82 +123 @@
       FOnReceiveData(DataIn);
     Lock.Release;
-  end else raise Exception.Create('Unsupported service ' + IntToStr(Index) + ' for driver ''' + Name + '''');
+  end else inherited;
 end;