Changeset 15 for trunk/Packages/Kernel/UGraphics.pas

Timestamp:

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

Author:

chronos

Message:

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

File:

• trunk/Packages/Kernel/UGraphics.pas (modified) (4 diffs)

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;