Changeset 15 for trunk/Packages

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/Packages/Kernel

Files:

• UAPI.pas (modified) (1 diff)
• UGraphics.pas (modified) (4 diffs)
• UKernel.pas (modified) (1 diff)
• UScreen.pas (modified) (1 diff)

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;