Changeset 8 for trunk/Forms/UFormMain.pas

Timestamp:

May 9, 2015, 1:32:38 AM (9 years ago)

Author:

chronos

Message:

• Moved: Kernel related files moved to separate lazarus package named Kernel.
• Modified: Implemented simple graphic device driver and drawin example.

File:

• trunk/Forms/UFormMain.pas (modified) (10 diffs)

trunk/Forms/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
-  ExtCtrls, Menus, ActnList, UKernel, UMemory;
+  ExtCtrls, Menus, ActnList, UKernel, UMemory, UDevice, UPlatformBase, LCLType;
 
 type
@@ -32 +32 @@
     procedure FormShow(Sender: TObject);
     procedure PaintBox1Click(Sender: TObject);
+    procedure PaintBox1Paint(Sender: TObject);
     procedure PaintBox1Resize(Sender: TObject);
   private
+    VideoDevice: TDeviceVideoBase;
+    SerialDevice: TBaseSerialDevice;
     SerialText: string;
     OriginalBounds: TRect;
@@ -39 +42 @@
     ScreenBounds: TRect;
     procedure SerialDeviceReceiveDataSync;
-    procedure SerialDeviceReceiveData(Data: TMemory);
+    procedure SerialDeviceReceiveData(Text: string);
     procedure VideoDeviceRedraw(Sender: TObject);
+    procedure VideoDeviceRedrawSync;
     procedure SwitchFullScreen;
+    procedure EraseBackground(DC: HDC); override;
   public
     Kernel: TKernel;
@@ -52 +57 @@
 
 uses
-  UList, UApp, UAPI, UClock, UPlatformBase, UThreadEx, UFormTerminal;
+  UList, UApp, UAPI, UClock, UThreadEx, UFormTerminal;
 
 {$R *.lfm}
@@ -61 +66 @@
 var
   NewApp: TApp;
-  SerialDevice: TBaseSerialDevice;
-  VideoDevice: TBaseVideoDevice;
-begin
+begin
+  PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];
+
   Kernel := TKernel.Create;
   Kernel.SchedulerClass := TBaseScheduler;
   Kernel.FileSystemClass := TBaseFileSystem;
+
   SerialDevice := TBaseSerialDevice.Create;
   SerialDevice.Name := 'Serial0';
@@ -73 +79 @@
   Kernel.Devices.Add(SerialDevice);
 
-  VideoDevice := TBaseVideoDevice.Create;
+  VideoDevice := TDeviceVideoBase.Create;
   VideoDevice.Name := 'Video0';
   VideoDevice.ClassName := 'Graphic card';
   VideoDevice.OnRedraw := VideoDeviceRedraw;
   VideoDevice.DPI := Screen.PixelsPerInch;
-  VideoDevice.VideoMemorySize := Point(PaintBox1.Width, PaintBox1.Height);;
+  VideoDevice.VideoMemorySize := Point(PaintBox1.Width, PaintBox1.Height);
+  VideoDevice.OnModeChanged := VideoDeviceRedraw;
   Kernel.Devices.Add(VideoDevice);
 
@@ -135 +142 @@
 end;
 
+procedure TFormMain.EraseBackground(DC: HDC);
+begin
+  //inherited EraseBackground(DC);
+end;
+
 procedure TFormMain.FormDestroy(Sender: TObject);
 begin
@@ -156 +168 @@
 end;
 
+procedure TFormMain.PaintBox1Paint(Sender: TObject);
+var
+  X, Y: Integer;
+  Bitmap: TBitmap;
+begin
+  try
+    Bitmap := TBitmap.Create;
+    Bitmap.BeginUpdate;
+    Bitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
+
+    if Assigned(VideoDevice.VideoMemory) then begin
+      for Y := 0 to VideoDevice.VideoMode.Size.Y - 1 do
+      for X := 0 to VideoDevice.VideoMode.Size.X - 1 do begin
+        Bitmap.Canvas.Pixels[X, Y] := PInteger(VideoDevice.VideoMemory + X * VideoDevice.VideoMode.GetBytesPerPixel +
+        Y * VideoDevice.VideoMode.GetBytesPerLine)^ and $ffffff;
+      end;
+    end;
+  finally
+    PaintBox1.Canvas.Draw(0, 0, Bitmap);
+    Bitmap.EndUpdate;
+    Bitmap.Free;
+  end;
+end;
+
 procedure TFormMain.PaintBox1Resize(Sender: TObject);
 begin
@@ -165 +201 @@
 end;
 
-procedure TFormMain.SerialDeviceReceiveData(Data: TMemory);
-begin
-  SetLength(SerialText, Data.Size);
-  Move(Data.Data^, SerialText[1], Data.Size);
+procedure TFormMain.SerialDeviceReceiveData(Text: string);
+begin
+  SerialText := Text;
   TThreadEx.Synchronize(TThreadEx.CurrentThread, SerialDeviceReceiveDataSync);
 end;
@@ -174 +209 @@
 procedure TFormMain.VideoDeviceRedraw(Sender: TObject);
 begin
-
+  TThreadEx.Synchronize(TThreadEx.CurrentThread, VideoDeviceRedrawSync);
+end;
+
+procedure TFormMain.VideoDeviceRedrawSync;
+begin
+  PaintBox1.Refresh;
 end;