Changeset 15 for trunk

Timestamp:

Dec 27, 2017, 8:28:45 PM (7 years ago)

Author:

chronos

Message:

• Fixed: Drawing of TWindow background.
• Fixed: Initialize TGraphicObject canvas only once.

Location:

trunk

Files:

• Forms/UFormMain.pas (modified) (6 diffs)
• Packages/Kernel/UAPI.pas (modified) (1 diff)
• Packages/Kernel/UGraphics.pas (modified) (4 diffs)
• Packages/Kernel/UKernel.pas (modified) (1 diff)
• Packages/Kernel/UScreen.pas (modified) (1 diff)

trunk/Forms/UFormMain.pas

@@ -39 +39 @@
     procedure Timer1Timer(Sender: TObject);
   private
+    TempBitmap: TBitmap;
     RedrawPending: Boolean;
     VideoDevice: TDeviceVideoBase;
@@ -73 +74 @@
   NewApp2: TApp;
 begin
+  TempBitmap := TBitmap.Create;
   PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];
 
@@ -164 +166 @@
 begin
   FreeAndNil(Kernel);
+  FreeAndNil(TempBitmap);
 end;
 
@@ -186 +189 @@
   X, Y: Integer;
   DX, DY: Integer;
-  Bitmap: TBitmap;
   P, PR: PByte;
 begin
   try
-    Bitmap := TBitmap.Create;
-    Bitmap.BeginUpdate;
-    Bitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
+    TempBitmap.BeginUpdate;
+    TempBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
 
     if Assigned(VideoDevice.VideoMemory) then begin
@@ -201 +202 @@
         PR := P;
         for X := 0 to VideoDevice.VideoMode.Size.X - 1 do begin
-          Bitmap.Canvas.Pixels[X, Y] := PInteger(PR)^ and $ffffff;
+          TempBitmap.Canvas.Pixels[X, Y] := PInteger(PR)^ and $ffffff;
           Inc(PR, DX);
         end;
@@ -208 +209 @@
     end;
   finally
-    PaintBox1.Canvas.Draw(0, 0, Bitmap);
-    Bitmap.EndUpdate;
-    Bitmap.Free;
+    PaintBox1.Canvas.Draw(0, 0, TempBitmap);
+    TempBitmap.EndUpdate;
   end;
 end;

trunk/Packages/Kernel/UAPI.pas

@@ -252 +252 @@
   if Assigned(Window) then begin
     Canvas := Window.Canvas;
-    Canvas.Parent := TKernel(Kernel).Screens.First.Canvas;
     Result := Canvas.Id;
   end else Result := -1;

trunk/Packages/Kernel/UGraphics.pas

@@ -70 +70 @@
     Id: Integer;
     Visible: Boolean;
+    constructor Create;
     procedure Paint; virtual;
     property Canvas: TCanvas read GetCanvas;
@@ -102 +103 @@
     Objects: TFPGObjectList<TGraphicObject>;
     Canvases: TFPGObjectList<TCanvas>;
+    ParentCanvas: TCanvas;
     function CreateWindow: TWindow;
     function CreateCanvas: TCanvas;
@@ -225 +227 @@
 function TGraphicObject.GetCanvas: TCanvas;
 begin
-  FCanvas := Desktop.CreateCanvas;
+  if not Assigned(FCanvas) then
+    FCanvas := Desktop.CreateCanvas;
   Result := FCanvas;
+end;
+
+constructor TGraphicObject.Create;
+begin
+  FCanvas := nil;
 end;
 
@@ -257 +265 @@
   Result := TWindow.Create;
   Result.Id := ObjectLastId;
+  Result.Desktop := Self;
+  Result.Canvas.Parent := ParentCanvas;
   Objects.Add(Result);
+  Paint;
 end;
 

trunk/Packages/Kernel/UKernel.pas

@@ -89 +89 @@
       TScreenCanvas(NewScreen.Canvas).Screen := NewScreen;
       Screens.Add(NewScreen);
+      Desktop.ParentCanvas := Screens.First.Canvas;
     end;
     Modes.Free;

trunk/Packages/Kernel/UScreen.pas

@@ -68 +68 @@
   for X := Rect.Left to Rect.Right do
     SetPixel(TPoint.Create(X, Y), Color);
+  Screen.VideoMemoryUpdated;
 end;