Changeset 7 for trunk/Forms

Timestamp:

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

Author:

chronos

Message:

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

Location:

trunk/Forms

Files:

• UFormMain.lfm (modified) (2 diffs)
• UFormMain.pas (modified) (7 diffs)
• UFormTerminal.lfm (modified) (1 diff)

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