Changeset 17 for trunk

Timestamp:

Jan 21, 2018, 10:01:14 PM (7 years ago)

Author:

chronos

Message:

• Added: Resize virtual screen according form size.

Location:

trunk

Files:

• Forms/UFormMain.lfm (modified) (2 diffs)
• Forms/UFormMain.pas (modified) (2 diffs)
• Packages/Kernel/UDevice.pas (modified) (4 diffs)
• Packages/Kernel/UKernel.pas (modified) (1 diff)
• Packages/Kernel/UScreen.pas (modified) (2 diffs)
• Platform/Base/UPlatformBase.pas (modified) (5 diffs)

trunk/Forms/UFormMain.lfm

@@ -5 +5 @@
   Width = 932
   Caption = 'Screen 1 - ChronOS'
-  ClientHeight = 656
+  ClientHeight = 653
   ClientWidth = 932
   Menu = MainMenu1
@@ -16 +16 @@
   object PaintBox1: TPaintBox
     Left = 0
-    Height = 656
+    Height = 653
     Top = 0
     Width = 932

trunk/Forms/UFormMain.pas

@@ -92 +92 @@
   VideoDevice.OnRedraw := VideoDeviceRedraw;
   VideoDevice.DPI := Screen.PixelsPerInch;
-  VideoDevice.VideoMemorySize := TPoint.Create(PaintBox1.Width, PaintBox1.Height);
   VideoDevice.OnModeChanged := VideoDeviceRedraw;
+  PaintBox1Resize(Self);
   Kernel.Devices.Add(VideoDevice);
 
@@ -215 +215 @@
 
 procedure TFormMain.PaintBox1Resize(Sender: TObject);
-begin
+var
+  VideoMode: TVideoMode;
+begin
+  VideoMode := TVideoMode.Create;
+  VideoMode.Assign(VideoDevice.VideoMode);
+  VideoMode.Size := TPoint.Create(Width, Height);
+  VideoDevice.VideoMode := VideoMode;
 end;
 

trunk/Packages/Kernel/UDevice.pas

@@ -24 +24 @@
     function GetBytesPerLine: Integer;
     function GetBytesPerImage: Integer;
+    procedure Assign(Source: TVideoMode);
   end;
 
@@ -29 +30 @@
 
   TDeviceVideo = class(TDevice)
+  private
+    FVideoMode: TVideoMode;
+  protected
+    procedure SetVideoMode(Mode: TVideoMode); virtual;
+    function GetVideoMemory: PByte; virtual;
+  public
     constructor Create; override;
-    procedure SetMode(Mode: TVideoMode); virtual;
     procedure GetSupportedModes(Modes: TObjectList); virtual;
-    function GetVideoMemory: PByte; virtual;
     procedure VideoMemoryChange; virtual;
+    property VideoMode: TVideoMode read FVideoMode write SetVideoMode;
+    property VideoMemory: PByte read GetVideoMemory;
   end;
 
@@ -64 +71 @@
 end;
 
+procedure TVideoMode.Assign(Source: TVideoMode);
+begin
+  Size := Source.Size;
+  ColorFormat := ColorFormat;
+end;
+
 { TDeviceSerial }
 
@@ -90 +103 @@
   inherited Create;
   ClassName := 'Video device';
+  FVideoMode := TVideoMode.Create;
 end;
 
-procedure TDeviceVideo.SetMode(Mode: TVideoMode);
+procedure TDeviceVideo.SetVideoMode(Mode: TVideoMode);
 begin
 end;

trunk/Packages/Kernel/UKernel.pas

@@ -74 +74 @@
   if Assigned(VideoDevice) then begin
     NewScreen := TScreen.Create;
-    NewScreen.VideoMemory := nil;
     Modes := TObjectList.Create;
     VideoDevice.GetSupportedModes(Modes);
     if Modes.Count > 0 then begin
       VideoMode := TVideoMode(Modes.Last);
-      VideoDevice.SetMode(VideoMode);
+      VideoDevice.VideoMode := VideoMode;
       NewScreen.Size := VideoMode.Size;
       NewScreen.ColorFormat := VideoMode.ColorFormat;
-      NewScreen.VideoMemory := VideoDevice.GetVideoMemory;
-      NewScreen.BytesPerPixel := VideoMode.GetBytesPerPixel;
-      NewScreen.BytesPerLine := VideoMode.GetBytesPerLine;
       NewScreen.Device := VideoDevice;
       NewScreen.Canvas := TScreenCanvas.Create;

trunk/Packages/Kernel/UScreen.pas

@@ -25 +25 @@
 
   TScreen = class
+  private
+    function GetBytesPerLine: Integer;
+    function GetBytesPerPixel: Integer;
+    function GetVideoMemory: PByte;
+  public
     Device: TObject; // TDeviceVideo;
     Size: TPoint;
     DPI: Integer;
     ColorFormat: TColorFormat;
-    BytesPerPixel: Integer;
-    BytesPerLine: Integer;
-    VideoMemory: PByte;
     Canvas: TCanvas;
     procedure VideoMemoryUpdated;
+    property BytesPerPixel: Integer read GetBytesPerPixel;
+    property BytesPerLine: Integer read GetBytesPerLine;
+    property VideoMemory: PByte read GetVideoMemory;
   end;
 
@@ -99 +104 @@
 { TScreen }
 
+function TScreen.GetBytesPerLine: Integer;
+begin
+  Result := TDeviceVideo(Device).VideoMode.GetBytesPerLine;
+end;
+
+function TScreen.GetBytesPerPixel: Integer;
+begin
+  Result := TDeviceVideo(Device).VideoMode.GetBytesPerPixel;
+end;
+
+function TScreen.GetVideoMemory: PByte;
+begin
+  Result := TDeviceVideo(Device).VideoMemory;
+end;
+
 procedure TScreen.VideoMemoryUpdated;
 begin

trunk/Platform/Base/UPlatformBase.pas

@@ -64 +64 @@
     FOnRedraw: TNotifyEvent;
     procedure DoRedraw;
+  protected
+    procedure SetVideoMode(Mode: TVideoMode); override;
   public
     VideoMemory: PByte;
-    VideoMemorySize: TPoint;
     DPI: Integer;
     Canvas: TCanvas;
-    VideoMode: TVideoMode;
-    procedure SetMode(Mode: TVideoMode); override;
     procedure GetSupportedModes(Modes: TObjectList); override;
     function GetVideoMemory: PByte; override;
@@ -89 +88 @@
 end;
 
-procedure TDeviceVideoBase.SetMode(Mode: TVideoMode);
+procedure TDeviceVideoBase.SetVideoMode(Mode: TVideoMode);
 begin
   if (VideoMode.Size.X <> Mode.Size.X) or
@@ -96 +95 @@
       VideoMode.Size := Mode.Size;
       VideoMode.ColorFormat := Mode.ColorFormat;
+      ReAllocMem(VideoMemory, VideoMode.GetBytesPerImage);
+      FillDWord(VideoMemory^, VideoMode.GetBytesPerImage div 4, $ffffff);
       if Assigned(FOnModeChanged) then
         FOnModeChanged(Self);
@@ -135 +136 @@
 function TDeviceVideoBase.GetVideoMemory: PByte;
 begin
-  VideoMemory := GetMem(VideoMode.GetBytesPerImage);
-  FillDWord(VideoMemory^, VideoMode.GetBytesPerImage div 4, $ffffff);
   Result := VideoMemory;
 end;
@@ -148 +147 @@
 begin
   inherited Create;
-  VideoMode := TVideoMode.Create;
 end;