Changeset 16 for trunk


Ignore:
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
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/Apps/UClock.pas

    r13 r16  
    3838  WindowId := API.WindowCreate;
    3939  CanvasId := API.GetWindowCanvas(WindowId);
    40   API.WindowSetAttr(WindowId, TRectangle.Create(100, 50, 300, 200), True);
     40  API.WindowSetAttr(WindowId, TRectangle.Create(100, 150, 300, 200), True);
    4141  while not Task.Terminated do begin
    4242    API.WriteText('test');
    43     API.DrawRect(CanvasId, TRectangle.Create(60, 60, 180, 180), $ffffff);
     43    API.DrawRect(CanvasId, TRectangle.Create(60, 60, 180, 180), $b0ffff);
    4444    API.DrawText(CanvasId, TPoint.Create(10, 10), 'Text', 0);
    4545    Angle := Frac(Now / (10 * OneSecond)) * 2 * Pi;
    … …  
    6969  WindowId := API.WindowCreate;
    7070  CanvasId := API.GetWindowCanvas(WindowId);
    71   API.WindowSetAttr(WindowId, TRectangle.Create(100, 100, 300, 200), True);
     71  API.WindowSetAttr(WindowId, TRectangle.Create(120, 100, 400, 200), True);
    7272  while not Task.Terminated do begin
    7373    API.WriteText('test2');

  • trunk/Packages/Kernel/UAPI.pas

    r15 r16  
    1111type
    1212  TApiCommand = (acNone, acWriteText, acDrawText, acDrawLine, acDrawRect, acSleep,
    13     acReadMessage, acWindowCreate, acWindowSetAttr, acGetWindowCanvas);
     13    acReadMessage, acWindowCreate, acWindowSetAttr, acGetWindowCanvas,
     14    acDrawFrame);
    1415
    1516  TDrawTextParams = record
    … …  
    4849    procedure DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
    4950    procedure DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
     51    procedure DrawFrame(CanvasId: Integer; Rect: TRectangle; Color: TColor);
    5052    procedure Sleep(Time: TDateTime);
    5153    procedure ReadMessage(Message: TIPCMessage);
    … …  
    6668    procedure DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
    6769    procedure DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
     70    procedure DrawFrame(CanvasId: Integer; Rect: TRectangle; Color: TColor);
    6871    procedure Sleep(Time: TDateTime);
    6972    procedure ReadMessage(Message: TIPCMessage);
    … …  
    124127end;
    125128
     129procedure TUserApi.DrawFrame(CanvasId: Integer; Rect: TRectangle; Color: TColor
     130  );
     131var
     132  Params: TDrawRectParams;
     133begin
     134  Params.CanvasId := CanvasId;
     135  Params.Rect := Rect;
     136  Params.Color := Color;
     137  Call(acDrawFrame, @Params);
     138end;
     139
    126140procedure TUserApi.Sleep(Time: TDateTime);
    127141begin
    … …  
    163177      TDrawLineParams(Data^).P2, TDrawLineParams(Data^).Color);
    164178    acDrawRect: DrawRect(TDrawRectParams(Data^).CanvasId, TDrawRectParams(Data^).Rect,
     179      TDrawRectParams(Data^).Color);
     180    acDrawFrame: DrawFrame(TDrawRectParams(Data^).CanvasId, TDrawRectParams(Data^).Rect,
    165181      TDrawRectParams(Data^).Color);
    166182    acDrawText: DrawText(TDrawTextParams(Data^).CanvasId, TDrawTextParams(Data^).P,
    … …  
    210226procedure TKernelApi.DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
    211227var
    212   Screen: TScreen;
    213228  Canvas: TCanvas;
    214229begin
    … …  
    216231  if Assigned(Canvas) then begin
    217232    Canvas.DrawRect(Rect, Color);
     233  end;
     234end;
     235
     236procedure TKernelApi.DrawFrame(CanvasId: Integer; Rect: TRectangle;
     237  Color: TColor);
     238var
     239  Canvas: TCanvas;
     240begin
     241  Canvas := TKernel(Kernel).Desktop.FindCanvasById(CanvasId);
     242  if Assigned(Canvas) then begin
     243    Canvas.DrawFrame(Rect, Color);
    218244  end;
    219245end;
    … …  
    265291    Window.Canvas.Position := Bounds.Position;
    266292    Window.Visible := Visible;
     293    Window.Desktop.Paint;
    267294  end;
    268295end;

  • trunk/Packages/Kernel/UGraphics.pas

    r15 r16  
    1616    X: Integer;
    1717    Y: Integer;
    18     function Create(X, Y: Integer): TPoint;
     18    function Create(X, Y: Integer): TPoint; inline;
    1919    function Add(P: TPoint): TPoint;
    2020  end;
    … …  
    3636    Size: TPoint;
    3737    function PointInside(P: TPoint): Boolean;
    38     function Create(Left, Top, Width, Height: Integer): TRectangle; overload;
    39     function Create(Position, Size: TPoint): TRectangle; overload;
     38    function Create(Left, Top, Width, Height: Integer): TRectangle; overload; inline;
     39    function Create(Position, Size: TPoint): TRectangle; overload; inline;
    4040    function AddPoint(P: TPoint): TRectangle;
    4141    property Left: Integer read GetLeft write SetLeft;
    … …  
    5757    procedure DrawLine(P1, P2: TPoint; Color: TColor); virtual;
    5858    procedure DrawRect(Rect: TRectangle; Color: TColor); virtual;
     59    procedure DrawFrame(Rect: TRectangle; Color: TColor); virtual;
    5960    procedure SetPixel(P: TPoint; Color: TColor); virtual;
    6061  end;
    … …  
    217218end;
    218219
     220procedure TCanvas.DrawFrame(Rect: TRectangle; Color: TColor);
     221begin
     222  if Assigned(Parent) then
     223    Parent.DrawFrame(Rect.AddPoint(Position), Color);
     224end;
     225
    219226procedure TCanvas.SetPixel(P: TPoint; Color: TColor);
    220227begin
    … …  
    246253begin
    247254  inherited Paint;
    248   Canvas.DrawRect(Bounds, $ff0000);
     255  Canvas.DrawRect(TRectangle.Create(TPoint.Create(0, 0), Bounds.Size), $a0a0a0);
     256  Canvas.DrawFrame(TRectangle.Create(TPoint.Create(0, 0), Bounds.Size), $000000);
    249257end;
    250258

  • trunk/Packages/Kernel/UScreen.pas

    r15 r16  
    1111  TScreen = class;
    1212
     13  { TScreenCanvas }
     14
    1315  TScreenCanvas = class(TCanvas)
    1416    Screen: TScreen;
    … …  
    1618    procedure DrawLine(P1, P2: TPoint; Color: TColor); override;
    1719    procedure DrawRect(Rect: TRectangle; Color: TColor); override;
     20    procedure DrawFrame(Rect: TRectangle; Color: TColor); override;
    1821    procedure SetPixel(P: TPoint; Color: TColor); override;
    1922  end;
    … …  
    7174end;
    7275
     76procedure TScreenCanvas.DrawFrame(Rect: TRectangle; Color: TColor);
     77var
     78  X, Y: Integer;
     79begin
     80  for Y := Rect.Top to Rect.Bottom do begin
     81    SetPixel(TPoint.Create(Rect.Left, Y), Color);
     82    SetPixel(TPoint.Create(Rect.Right, Y), Color);
     83  end;
     84  for X := Rect.Left to Rect.Right do begin
     85    SetPixel(TPoint.Create(X, Rect.Top), Color);
     86    SetPixel(TPoint.Create(X, Rect.Bottom), Color);
     87  end;
     88  Screen.VideoMemoryUpdated;
     89end;
     90
    7391procedure TScreenCanvas.SetPixel(P: TPoint; Color: TColor);
    7492begin
Note: See TracChangeset for help on using the changeset viewer.