Changeset 16

Timestamp:

Dec 28, 2017, 1:14:31 AM (6 years ago)

Author:

chronos

Message:

• Added: API function DrawFrame.
• Fixed: Drawing position of TWindow frame.

Location:

trunk

Files:

• Apps/UClock.pas (modified) (2 diffs)
• Packages/Kernel/UAPI.pas (modified) (8 diffs)
• Packages/Kernel/UGraphics.pas (modified) (5 diffs)
• Packages/Kernel/UScreen.pas (modified) (3 diffs)

trunk/Apps/UClock.pas

@@ -38 +38 @@
   WindowId := API.WindowCreate;
   CanvasId := API.GetWindowCanvas(WindowId);
-  API.WindowSetAttr(WindowId, TRectangle.Create(100, 50, 300, 200), True);
+  API.WindowSetAttr(WindowId, TRectangle.Create(100, 150, 300, 200), True);
   while not Task.Terminated do begin
     API.WriteText('test');
-    API.DrawRect(CanvasId, TRectangle.Create(60, 60, 180, 180), $ffffff);
+    API.DrawRect(CanvasId, TRectangle.Create(60, 60, 180, 180), $b0ffff);
     API.DrawText(CanvasId, TPoint.Create(10, 10), 'Text', 0);
     Angle := Frac(Now / (10 * OneSecond)) * 2 * Pi;
@@ -69 +69 @@
   WindowId := API.WindowCreate;
   CanvasId := API.GetWindowCanvas(WindowId);
-  API.WindowSetAttr(WindowId, TRectangle.Create(100, 100, 300, 200), True);
+  API.WindowSetAttr(WindowId, TRectangle.Create(120, 100, 400, 200), True);
   while not Task.Terminated do begin
     API.WriteText('test2');

trunk/Packages/Kernel/UAPI.pas

@@ -11 +11 @@
 type
   TApiCommand = (acNone, acWriteText, acDrawText, acDrawLine, acDrawRect, acSleep,
-    acReadMessage, acWindowCreate, acWindowSetAttr, acGetWindowCanvas);
+    acReadMessage, acWindowCreate, acWindowSetAttr, acGetWindowCanvas,
+    acDrawFrame);
 
   TDrawTextParams = record
@@ -48 +49 @@
     procedure DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
     procedure DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
+    procedure DrawFrame(CanvasId: Integer; Rect: TRectangle; Color: TColor);
     procedure Sleep(Time: TDateTime);
     procedure ReadMessage(Message: TIPCMessage);
@@ -66 +68 @@
     procedure DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
     procedure DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
+    procedure DrawFrame(CanvasId: Integer; Rect: TRectangle; Color: TColor);
     procedure Sleep(Time: TDateTime);
     procedure ReadMessage(Message: TIPCMessage);
@@ -124 +127 @@
 end;
 
+procedure TUserApi.DrawFrame(CanvasId: Integer; Rect: TRectangle; Color: TColor
+  );
+var
+  Params: TDrawRectParams;
+begin
+  Params.CanvasId := CanvasId;
+  Params.Rect := Rect;
+  Params.Color := Color;
+  Call(acDrawFrame, @Params);
+end;
+
 procedure TUserApi.Sleep(Time: TDateTime);
 begin
@@ -163 +177 @@
       TDrawLineParams(Data^).P2, TDrawLineParams(Data^).Color);
     acDrawRect: DrawRect(TDrawRectParams(Data^).CanvasId, TDrawRectParams(Data^).Rect,
+      TDrawRectParams(Data^).Color);
+    acDrawFrame: DrawFrame(TDrawRectParams(Data^).CanvasId, TDrawRectParams(Data^).Rect,
       TDrawRectParams(Data^).Color);
     acDrawText: DrawText(TDrawTextParams(Data^).CanvasId, TDrawTextParams(Data^).P,
@@ -210 +226 @@
 procedure TKernelApi.DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
 var
-  Screen: TScreen;
   Canvas: TCanvas;
 begin
@@ -216 +231 @@
   if Assigned(Canvas) then begin
     Canvas.DrawRect(Rect, Color);
+  end;
+end;
+
+procedure TKernelApi.DrawFrame(CanvasId: Integer; Rect: TRectangle;
+  Color: TColor);
+var
+  Canvas: TCanvas;
+begin
+  Canvas := TKernel(Kernel).Desktop.FindCanvasById(CanvasId);
+  if Assigned(Canvas) then begin
+    Canvas.DrawFrame(Rect, Color);
   end;
 end;
@@ -265 +291 @@
     Window.Canvas.Position := Bounds.Position;
     Window.Visible := Visible;
+    Window.Desktop.Paint;
   end;
 end;

trunk/Packages/Kernel/UGraphics.pas

@@ -16 +16 @@
     X: Integer;
     Y: Integer;
-    function Create(X, Y: Integer): TPoint;
+    function Create(X, Y: Integer): TPoint; inline;
     function Add(P: TPoint): TPoint;
   end;
@@ -36 +36 @@
     Size: TPoint;
     function PointInside(P: TPoint): Boolean;
-    function Create(Left, Top, Width, Height: Integer): TRectangle; overload;
-    function Create(Position, Size: TPoint): TRectangle; overload;
+    function Create(Left, Top, Width, Height: Integer): TRectangle; overload; inline;
+    function Create(Position, Size: TPoint): TRectangle; overload; inline;
     function AddPoint(P: TPoint): TRectangle;
     property Left: Integer read GetLeft write SetLeft;
@@ -57 +57 @@
     procedure DrawLine(P1, P2: TPoint; Color: TColor); virtual;
     procedure DrawRect(Rect: TRectangle; Color: TColor); virtual;
+    procedure DrawFrame(Rect: TRectangle; Color: TColor); virtual;
     procedure SetPixel(P: TPoint; Color: TColor); virtual;
   end;
@@ -217 +218 @@
 end;
 
+procedure TCanvas.DrawFrame(Rect: TRectangle; Color: TColor);
+begin
+  if Assigned(Parent) then
+    Parent.DrawFrame(Rect.AddPoint(Position), Color);
+end;
+
 procedure TCanvas.SetPixel(P: TPoint; Color: TColor);
 begin
@@ -246 +253 @@
 begin
   inherited Paint;
-  Canvas.DrawRect(Bounds, $ff0000);
+  Canvas.DrawRect(TRectangle.Create(TPoint.Create(0, 0), Bounds.Size), $a0a0a0);
+  Canvas.DrawFrame(TRectangle.Create(TPoint.Create(0, 0), Bounds.Size), $000000);
 end;
 

trunk/Packages/Kernel/UScreen.pas

@@ -11 +11 @@
   TScreen = class;
 
+  { TScreenCanvas }
+
   TScreenCanvas = class(TCanvas)
     Screen: TScreen;
@@ -16 +18 @@
     procedure DrawLine(P1, P2: TPoint; Color: TColor); override;
     procedure DrawRect(Rect: TRectangle; Color: TColor); override;
+    procedure DrawFrame(Rect: TRectangle; Color: TColor); override;
     procedure SetPixel(P: TPoint; Color: TColor); override;
   end;
@@ -71 +74 @@
 end;
 
+procedure TScreenCanvas.DrawFrame(Rect: TRectangle; Color: TColor);
+var
+  X, Y: Integer;
+begin
+  for Y := Rect.Top to Rect.Bottom do begin
+    SetPixel(TPoint.Create(Rect.Left, Y), Color);
+    SetPixel(TPoint.Create(Rect.Right, Y), Color);
+  end;
+  for X := Rect.Left to Rect.Right do begin
+    SetPixel(TPoint.Create(X, Rect.Top), Color);
+    SetPixel(TPoint.Create(X, Rect.Bottom), Color);
+  end;
+  Screen.VideoMemoryUpdated;
+end;
+
 procedure TScreenCanvas.SetPixel(P: TPoint; Color: TColor);
 begin