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

Timestamp:

Sep 25, 2017, 2:48:08 PM (7 years ago)

Author:

chronos

Message:

• Added: Drawing relative to Canvas. In case of Window drawing relative to Window.
• Modified: Use custom TPoint and TRectangle if possible.

File:

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

trunk/Packages/Kernel/UGraphics.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, fgl;
+  SysUtils, fgl;
 
 type
-  TRectangle = class
+  TDesktop = class;
+
+  { TPoint }
+
+  TPoint = record
+    X: Integer;
+    Y: Integer;
+    function Create(X, Y: Integer): TPoint;
+    function Add(P: TPoint): TPoint;
+  end;
+
+  { TRectangle }
+
+  TRectangle = record
+  private
+    function GetBottom: Integer;
+    function GetLeft: Integer;
+    function GetRight: Integer;
+    function GetTop: Integer;
+    procedure SetBottom(AValue: Integer);
+    procedure SetLeft(AValue: Integer);
+    procedure SetRight(AValue: Integer);
+    procedure SetTop(AValue: Integer);
+  public
     Position: TPoint;
     Size: TPoint;
+    function PointInside(P: TPoint): Boolean;
+    function Create(Left, Top, Width, Height: Integer): TRectangle; overload;
+    function Create(Position, Size: TPoint): TRectangle; overload;
+    function AddPoint(P: TPoint): TRectangle;
+    property Left: Integer read GetLeft write SetLeft;
+    property Top: Integer read GetTop write SetTop;
+    property Right: Integer read GetRight write SetRight;
+    property Bottom: Integer read GetBottom write SetBottom;
+  end;
+
+  TColorFormat = (cfRGBA8, cfGray8);
+  TColor = Integer;
+
+  { TCanvas }
+
+  TCanvas = class
+    Parent: TCanvas;
+    Position: TPoint;
+    Id: Integer;
+    procedure DrawText(Pos: TPoint; Text: string; Color: TColor); virtual;
+    procedure DrawLine(P1, P2: TPoint; Color: TColor); virtual;
+    procedure DrawRect(Rect: TRectangle; Color: TColor); virtual;
+    procedure SetPixel(P: TPoint; Color: TColor); virtual;
   end;
 
@@ -17 +63 @@
 
   TGraphicObject = class
+  private
+    FCanvas: TCanvas;
+    function GetCanvas: TCanvas;
+  public
+    Desktop: TDesktop;
     Id: Integer;
     Visible: Boolean;
     procedure Paint; virtual;
+    property Canvas: TCanvas read GetCanvas;
   end;
 
@@ -25 +77 @@
 
   TWindow = class(TGraphicObject)
+  public
     Title: string;
     Bounds: TRectangle;
@@ -43 +96 @@
 
   TDesktop = class
+  private
+    ObjectLastId: Integer;
+    CanvasLastId: Integer;
+  public
     Objects: TFPGObjectList<TGraphicObject>;
+    Canvases: TFPGObjectList<TCanvas>;
+    function CreateWindow: TWindow;
+    function CreateCanvas: TCanvas;
+    function FindObjectById(Id: Integer): TGraphicObject;
+    function FindCanvasById(Id: Integer): TCanvas;
     procedure Paint;
     constructor Create;
@@ -51 +113 @@
 implementation
 
+{ TRectangle }
+
+function TRectangle.GetBottom: Integer;
+begin
+  Result := Position.Y + Size.Y;
+end;
+
+function TRectangle.GetLeft: Integer;
+begin
+  Result := Position.X;
+end;
+
+function TRectangle.GetRight: Integer;
+begin
+  Result := Position.X + Size.X;
+end;
+
+function TRectangle.GetTop: Integer;
+begin
+  Result := Position.Y;
+end;
+
+procedure TRectangle.SetBottom(AValue: Integer);
+begin
+  Size.Y := AValue - Position.Y;
+end;
+
+procedure TRectangle.SetLeft(AValue: Integer);
+begin
+  Position.X := AValue;
+end;
+
+procedure TRectangle.SetRight(AValue: Integer);
+begin
+  Size.X := AValue - Position.X;
+end;
+
+procedure TRectangle.SetTop(AValue: Integer);
+begin
+  Size.Y := AValue;
+end;
+
+function TRectangle.PointInside(P: TPoint): Boolean;
+begin
+  Result := (P.X >= Position.X) and (P.Y >= Position.Y) and
+    (P.X < (Position.X + Size.X)) and (P.Y < (Position.Y + Size.Y))
+end;
+
+function TRectangle.Create(Left, Top, Width, Height: Integer): TRectangle;
+begin
+  Result.Position.X := Left;
+  Result.Position.Y := Top;
+  Result.Size.X := Width;
+  Result.Size.Y := Height;
+end;
+
+function TRectangle.Create(Position, Size: TPoint): TRectangle;
+begin
+  Result.Position := Position;
+  Result.Size := Size;
+end;
+
+function TRectangle.AddPoint(P: TPoint): TRectangle;
+begin
+  Result.Size := Size;
+  Result.Position := Position.Add(P);
+end;
+
+{ TPoint }
+
+function TPoint.Create(X, Y: Integer): TPoint;
+begin
+  Result.X := X;
+  Result.Y := Y;
+end;
+
+function TPoint.Add(P: TPoint): TPoint;
+begin
+  Result.X := X + P.X;
+  Result.Y := Y + P.Y;
+end;
+
+{ TCanvas }
+
+procedure TCanvas.DrawText(Pos: TPoint; Text: string; Color: TColor);
+begin
+  if Assigned(Parent) then
+    Parent.DrawText(Pos.Add(Position), Text, Color);
+end;
+
+procedure TCanvas.DrawLine(P1, P2: TPoint; Color: TColor);
+begin
+  if Assigned(Parent) then
+    Parent.DrawLine(P1.Add(Position), P2.Add(Position), Color);
+end;
+
+procedure TCanvas.DrawRect(Rect: TRectangle; Color: TColor);
+begin
+  if Assigned(Parent) then
+    Parent.DrawRect(Rect.AddPoint(Position), Color);
+end;
+
+procedure TCanvas.SetPixel(P: TPoint; Color: TColor);
+begin
+  if Assigned(Parent) then
+    Parent.SetPixel(P.Add(Position), Color);
+end;
+
 { TGraphicObject }
 
+function TGraphicObject.GetCanvas: TCanvas;
+begin
+  FCanvas := Desktop.CreateCanvas;
+  Result := FCanvas;
+end;
+
 procedure TGraphicObject.Paint;
 begin
-
 end;
 
@@ -63 +238 @@
 begin
   inherited Paint;
+  Canvas.DrawRect(Bounds, $ff0000);
 end;
 
 constructor TWindow.Create;
 begin
-  Bounds := TRectangle.Create;
 end;
 
 destructor TWindow.Destroy;
 begin
-  Bounds.Free;
   inherited Destroy;
 end;
 
 { TDesktop }
+
+function TDesktop.CreateWindow: TWindow;
+begin
+  Inc(ObjectLastId);
+  Result := TWindow.Create;
+  Result.Id := ObjectLastId;
+  Objects.Add(Result);
+end;
+
+function TDesktop.CreateCanvas: TCanvas;
+begin
+  Inc(CanvasLastId);
+  Result := TCanvas.Create;
+  Result.Id := CanvasLastId;
+  Canvases.Add(Result);
+end;
+
+function TDesktop.FindObjectById(Id: Integer): TGraphicObject;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Objects.Count) and (Objects[I].Id <> Id) do Inc(I);
+  if I < Objects.Count then Result := Objects[I]
+    else Result := nil;
+end;
+
+function TDesktop.FindCanvasById(Id: Integer): TCanvas;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Canvases.Count) and (Canvases[I].Id <> Id) do Inc(I);
+  if I < Canvases.Count then Result := Canvases[I]
+    else Result := nil;
+end;
 
 procedure TDesktop.Paint;
@@ -89 +299 @@
 begin
   Objects := TFPGObjectList<TGraphicObject>.Create;
+  Canvases := TFPGObjectList<TCanvas>.Create;
 end;
 
 destructor TDesktop.Destroy;
 begin
-  Objects.Free;
+  FreeAndNil(Canvases);
+  FreeAndNil(Objects);
   inherited Destroy;
 end;