Changeset 17 for trunk/Packages/Kernel

Timestamp:

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

Author:

chronos

Message:

• Added: Resize virtual screen according form size.

Location:

trunk/Packages/Kernel

Files:

• UDevice.pas (modified) (4 diffs)
• UKernel.pas (modified) (1 diff)
• UScreen.pas (modified) (2 diffs)

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