Changeset 16 for trunk/Packages

Timestamp:

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

Author:

chronos

Message:

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

Location:

trunk/Packages/Kernel

Files:

• UAPI.pas (modified) (8 diffs)
• UGraphics.pas (modified) (5 diffs)
• UScreen.pas (modified) (3 diffs)

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