Changeset 13


Ignore:
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.
Location:
trunk
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • trunk/Apps/UClock.pas

    r12 r13  
    66
    77uses
    8   Classes, SysUtils, UApp, dateutils, UKernel, UScheduler, UIPC;
     8  SysUtils, UApp, dateutils, UKernel, UScheduler, UIPC, UGraphics;
    99
    1010type
    … …  
    3232  Message: TIPCMessage;
    3333  WindowId: Integer;
     34  CanvasId: Integer;
    3435  Angle: Double;
    3536begin
    3637  Message := TIPCMessage.Create;
    3738  WindowId := API.WindowCreate;
    38   API.WindowSetAttr(Point(300, 200), True);
     39  CanvasId := API.GetWindowCanvas(WindowId);
     40  API.WindowSetAttr(WindowId, TRectangle.Create(100, 50, 300, 200), True);
    3941  while not Task.Terminated do begin
    4042    API.WriteText('test');
    41     API.DrawRect(Rect(60, 60, 180, 180), $ffffff);
    42     API.DrawText(Point(10, 10), 'Text', 0);
     43    API.DrawRect(CanvasId, TRectangle.Create(60, 60, 180, 180), $ffffff);
     44    API.DrawText(CanvasId, TPoint.Create(10, 10), 'Text', 0);
    4345    Angle := Frac(Now / (10 * OneSecond)) * 2 * Pi;
    44     API.DrawLine(Point(120, 120), Point(Trunc(120 + Cos(Angle) * 60), Trunc(120 + Sin(Angle) * 60)), 0);
     46    API.DrawLine(CanvasId, TPoint.Create(120, 120), TPoint.Create(Trunc(120 + Cos(Angle) * 60), Trunc(120 + Sin(Angle) * 60)), 0);
    4547    API.Sleep(OneMillisecond * 10);
    4648    //API.ReadMessage(Message);
    … …  
    6163  Message: TIPCMessage;
    6264  WindowId: Integer;
     65  CanvasId: Integer;
    6366  Angle: Double;
    6467begin
    6568  Message := TIPCMessage.Create;
    6669  WindowId := API.WindowCreate;
    67   API.WindowSetAttr(Point(300, 200), True);
     70  CanvasId := API.GetWindowCanvas(WindowId);
     71  API.WindowSetAttr(WindowId, TRectangle.Create(100, 100, 300, 200), True);
    6872  while not Task.Terminated do begin
    6973    API.WriteText('test2');
    70     API.DrawRect(Rect(260, 160, 380, 280), $ffff80);
    71     API.DrawText(Point(210, 110), 'Text', 0);
     74    API.DrawRect(CanvasId, TRectangle.Create(460, 160, 380, 280), $ffff80);
     75    API.DrawText(CanvasId, TPoint.Create(210, 110), 'Text', 0);
    7276    Angle := Frac(Now / (10 * OneSecond)) * 2 * Pi;
    73     API.DrawLine(Point(320, 220), Point(Trunc(320 + Cos(Angle) * 60), Trunc(220 + Sin(Angle) * 60)), 0);
     77    API.DrawLine(CanvasId, TPoint.Create(320, 220), TPoint.Create(Trunc(320 + Cos(Angle) * 120), Trunc(220 + Sin(Angle) * 120)), 0);
    7478    API.Sleep(OneMillisecond * 300);
    7579    //API.ReadMessage(Message);

  • trunk/Forms/UFormMain.lfm

    r11 r13  
    11object FormMain: TFormMain
    2   Left = 565
     2  Left = 566
    33  Height = 687
    4   Top = 259
     4  Top = 262
    55  Width = 932
    66  Caption = 'Screen 1 - ChronOS'
    … …  
    1212  OnKeyDown = FormKeyDown
    1313  OnShow = FormShow
    14   LCLVersion = '1.6.0.4'
     14  LCLVersion = '1.6.4.0'
    1515  object PaintBox1: TPaintBox
    1616    Left = 0

  • trunk/Forms/UFormMain.pas

    r11 r13  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
    9   ExtCtrls, Menus, ActnList, UKernel, UMemory, UDevice, UPlatformBase, LCLType;
     9  ExtCtrls, Menus, ActnList, UKernel, UMemory, UDevice, UPlatformBase, LCLType,
     10  UGraphics;
    1011
    1112type
    … …  
    8889  VideoDevice.OnRedraw := VideoDeviceRedraw;
    8990  VideoDevice.DPI := Screen.PixelsPerInch;
    90   VideoDevice.VideoMemorySize := Point(PaintBox1.Width, PaintBox1.Height);
     91  VideoDevice.VideoMemorySize := TPoint.Create(PaintBox1.Width, PaintBox1.Height);
    9192  VideoDevice.OnModeChanged := VideoDeviceRedraw;
    9293  Kernel.Devices.Add(VideoDevice);
    … …  
    156157procedure TFormMain.FormDestroy(Sender: TObject);
    157158begin
    158   Kernel.Free;
     159  FreeAndNil(Kernel);
    159160end;
    160161

  • trunk/Packages/Kernel/Kernel.lpk

    r9 r13  
    1818        </SyntaxOptions>
    1919      </Parsing>
     20      <Other>
     21        <CompilerMessages>
     22          <IgnoredMessages idx5024="True"/>
     23        </CompilerMessages>
     24      </Other>
    2025    </CompilerOptions>
    2126    <Files Count="12">

  • trunk/Packages/Kernel/UAPI.pas

    r12 r13  
    66
    77uses
    8   Classes, SysUtils, UList, DateUtils, UMemory, UScreen, UDevice, UIPC,
    9   UScheduler;
     8  SysUtils, UList, DateUtils, UMemory, UGraphics, UDevice, UIPC,
     9  UScheduler, UScreen;
    1010
    1111type
    1212  TApiCommand = (acNone, acWriteText, acDrawText, acDrawLine, acDrawRect, acSleep,
    13     acReadMessage, acWindowCreate, acWindowSetAttr);
     13    acReadMessage, acWindowCreate, acWindowSetAttr, acGetWindowCanvas);
    1414
    1515  TDrawTextParams = record
     16    CanvasId: Integer;
    1617    P: TPoint;
    1718    Text: string;
    … …  
    2021
    2122  TDrawLineParams = record
     23    CanvasId: Integer;
    2224    P1: TPoint;
    2325    P2: TPoint;
    … …  
    2628
    2729  TWindowSetAttrParams = record
    28     Size: TPoint;
     30    WindowId: Integer;
     31    Bounds: TRectangle;
    2932    Visible: Boolean;
    3033  end;
    3134
    3235  TDrawRectParams = record
    33     Rect: TRect;
     36    CanvasId: Integer;
     37    Rect: TRectangle;
    3438    Color: TColor;
    3539  end;
    … …  
    4145    function Call(Command: TApiCommand; Data: Pointer): Pointer;
    4246    procedure WriteText(Text: string);
    43     procedure DrawText(P: TPoint; Text: string; Color: TColor);
    44     procedure DrawLine(P1, P2: TPoint; Color: TColor);
    45     procedure DrawRect(Rect: TRect; Color: TColor);
     47    procedure DrawText(CanvasId: Integer; P: TPoint; Text: string; Color: TColor);
     48    procedure DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
     49    procedure DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
    4650    procedure Sleep(Time: TDateTime);
    4751    procedure ReadMessage(Message: TIPCMessage);
    4852    function WindowCreate: Integer;
    49     procedure WindowSetAttr(Size: TPoint; Visible: Boolean);
     53    function GetWindowCanvas(WindowId: Integer): Integer;
     54    procedure WindowSetAttr(WindowId: Integer; Bounds: TRectangle; Visible: Boolean);
    5055  end;
    5156
    … …  
    5863    function Call(Command: TApiCommand; Data: Pointer): Pointer;
    5964    procedure WriteText(Text: string);
    60     procedure DrawText(P: TPoint; Text: string; Color: TColor);
    61     procedure DrawLine(P1, P2: TPoint; Color: TColor);
    62     procedure DrawRect(Rect: TRect; Color: TColor);
     65    procedure DrawText(CanvasId: Integer; P: TPoint; Text: string; Color: TColor);
     66    procedure DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
     67    procedure DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
    6368    procedure Sleep(Time: TDateTime);
    6469    procedure ReadMessage(Message: TIPCMessage);
    6570    function WindowCreate: Integer;
    66     procedure WindowSetAttr(Size: TPoint; Visible: Boolean);
     71    function GetWindowCanvas(WindowId: Integer): Integer;
     72    procedure WindowSetAttr(WindowId: Integer; Bounds: TRectangle; Visible: Boolean);
    6773  end;
    6874
    … …  
    8692end;
    8793
    88 procedure TUserApi.DrawText(P: TPoint; Text: string; Color: TColor);
     94procedure TUserApi.DrawText(CanvasId: Integer; P: TPoint; Text: string; Color: TColor);
    8995var
    9096  Params: TDrawTextParams;
    9197begin
     98  Params.CanvasId := CanvasId;
    9299  Params.P := P;
    93100  Params.Text := Text;
    … …  
    96103end;
    97104
    98 procedure TUserApi.DrawLine(P1, P2: TPoint; Color: TColor);
     105procedure TUserApi.DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
    99106var
    100107  Params: TDrawLineParams;
    101108begin
     109  Params.CanvasId := CanvasId;
    102110  Params.P1 := P1;
    103111  Params.P2 := P2;
    … …  
    106114end;
    107115
    108 procedure TUserApi.DrawRect(Rect: TRect; Color: TColor);
     116procedure TUserApi.DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
    109117var
    110118  Params: TDrawRectParams;
    111119begin
     120  Params.CanvasId := CanvasId;
    112121  Params.Rect := Rect;
    113122  Params.Color := Color;
    … …  
    127136function TUserApi.WindowCreate: Integer;
    128137begin
    129   Call(acWindowCreate, nil);
    130 end;
    131 
    132 procedure TUserApi.WindowSetAttr(Size: TPoint; Visible: Boolean);
     138  Result := Integer(Call(acWindowCreate, nil));
     139end;
     140
     141function TUserApi.GetWindowCanvas(WindowId: Integer): Integer;
     142begin
     143  Call(acGetWindowCanvas, Pointer(WindowId));
     144end;
     145
     146procedure TUserApi.WindowSetAttr(WindowId: Integer; Bounds: TRectangle; Visible: Boolean);
    133147var
    134148  Params: TWindowSetAttrParams;
    135149begin
    136   Params.Size := Size;
     150  Params.WindowId := WindowId;
     151  Params.Bounds := Bounds;
    137152  Params.Visible := Visible;
    138153  Call(acWindowSetAttr, @Params);
    … …  
    145160begin
    146161  case Command of
    147     acDrawLine: DrawLine(TDrawLineParams(Data^).P1, TDrawLineParams(Data^).P2,
    148       TDrawLineParams(Data^).Color);
    149     acDrawRect: DrawRect(TDrawRectParams(Data^).Rect, TDrawRectParams(Data^).Color);
    150     acDrawText: DrawText(TDrawTextParams(Data^).P, TDrawTextParams(Data^).Text,
    151       TDrawTextParams(Data^).Color);
     162    acDrawLine: DrawLine(TDrawLineParams(Data^).CanvasId, TDrawLineParams(Data^).P1,
     163      TDrawLineParams(Data^).P2, TDrawLineParams(Data^).Color);
     164    acDrawRect: DrawRect(TDrawRectParams(Data^).CanvasId, TDrawRectParams(Data^).Rect,
     165      TDrawRectParams(Data^).Color);
     166    acDrawText: DrawText(TDrawTextParams(Data^).CanvasId, TDrawTextParams(Data^).P,
     167      TDrawTextParams(Data^).Text, TDrawTextParams(Data^).Color);
    152168    acSleep: Sleep(TDateTime(Data^));
    153169    acWindowCreate: Result := Pointer(WindowCreate);
    154     acWindowSetAttr: WindowSetAttr(TWindowSetAttrParams(Data^).Size,
    155       TWindowSetAttrParams(Data^).Visible);
     170    acWindowSetAttr: WindowSetAttr(TWindowSetAttrParams(Data^).WindowId,
     171      TWindowSetAttrParams(Data^).Bounds, TWindowSetAttrParams(Data^).Visible);
    156172    acWriteText: WriteText(string(Data));
    157173    acReadMessage: ReadMessage(Data);
     174    acGetWindowCanvas: Result := Pointer(GetWindowCanvas(Integer(Data)));
    158175  end;
    159176end;
    … …  
    169186end;
    170187
    171 procedure TKernelApi.DrawText(P: TPoint; Text: string; Color: TColor);
     188procedure TKernelApi.DrawText(CanvasId: Integer; P: TPoint; Text: string; Color: TColor);
    172189var
    173190  Screen: TScreen;
    174 begin
    175   Screen := TScreen(TKernel(Kernel).Screens.First);
    176   Screen.DrawText(P, Text, Color);
    177 end;
    178 
    179 procedure TKernelApi.DrawLine(P1, P2: TPoint; Color: TColor);
     191  Canvas: TCanvas;
     192begin
     193  Canvas := TKernel(Kernel).Desktop.FindCanvasById(CanvasId);
     194  if Assigned(Canvas) then begin
     195    Canvas.DrawText(P, Text, Color);
     196  end;
     197end;
     198
     199procedure TKernelApi.DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor);
    180200var
    181201  Screen: TScreen;
    182 begin
    183   Screen := TScreen(TKernel(Kernel).Screens.First);
    184   Screen.DrawLine(P1, P2, Color);
    185 end;
    186 
    187 procedure TKernelApi.DrawRect(Rect: TRect; Color: TColor);
     202  Canvas: TCanvas;
     203begin
     204  Canvas := TKernel(Kernel).Desktop.FindCanvasById(CanvasId);
     205  if Assigned(Canvas) then begin
     206    Canvas.DrawLine(P1.Add(Canvas.Position), P2.Add(Canvas.Position), Color);
     207  end;
     208end;
     209
     210procedure TKernelApi.DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor);
    188211var
    189212  Screen: TScreen;
    190 begin
    191   Screen := TScreen(TKernel(Kernel).Screens.First);
    192   Screen.DrawRect(Rect, Color);
     213  Canvas: TCanvas;
     214begin
     215  Canvas := TKernel(Kernel).Desktop.FindCanvasById(CanvasId);
     216  if Assigned(Canvas) then begin
     217    Canvas.DrawRect(Rect, Color);
     218  end;
    193219end;
    194220
    … …  
    210236
    211237function TKernelApi.WindowCreate: Integer;
    212 begin
    213 
    214 end;
    215 
    216 procedure TKernelApi.WindowSetAttr(Size: TPoint; Visible: Boolean);
    217 begin
    218 
     238var
     239  Window: TWindow;
     240begin
     241  Window := TKernel(Kernel).Desktop.CreateWindow;
     242  Window.Desktop := TKernel(Kernel).Desktop;
     243  Result := Window.Id;
     244end;
     245
     246function TKernelApi.GetWindowCanvas(WindowId: Integer): Integer;
     247var
     248  Window: TWindow;
     249  Canvas: TCanvas;
     250begin
     251  Window := TWindow(TKernel(Kernel).Desktop.FindObjectById(WindowId));
     252  if Assigned(Window) then begin
     253    Canvas := Window.Canvas;
     254    Canvas.Parent := TKernel(Kernel).Screens.First.Canvas;
     255    Result := Canvas.Id;
     256  end else Result := -1;
     257end;
     258
     259procedure TKernelApi.WindowSetAttr(WindowId: Integer; Bounds: TRectangle; Visible: Boolean);
     260var
     261  Window: TWindow;
     262begin
     263  Window := TWindow(TKernel(Kernel).Desktop.FindObjectById(WindowId));
     264  if Assigned(Window) then begin
     265    Window.Bounds := Bounds;
     266    Window.Canvas.Position := Bounds.Position;
     267    Window.Visible := Visible;
     268  end;
    219269end;
    220270

  • trunk/Packages/Kernel/UDevice.pas

    r8 r13  
    66
    77uses
    8   Classes, SysUtils, Contnrs, UList, UScreen;
     8  Classes, SysUtils, Contnrs, UList, UGraphics;
    99
    1010type

  • trunk/Packages/Kernel/UGraphics.pas

    r11 r13  
    66
    77uses
    8   Classes, SysUtils, fgl;
     8  SysUtils, fgl;
    99
    1010type
    11   TRectangle = class
     11  TDesktop = class;
     12
     13  { TPoint }
     14
     15  TPoint = record
     16    X: Integer;
     17    Y: Integer;
     18    function Create(X, Y: Integer): TPoint;
     19    function Add(P: TPoint): TPoint;
     20  end;
     21
     22  { TRectangle }
     23
     24  TRectangle = record
     25  private
     26    function GetBottom: Integer;
     27    function GetLeft: Integer;
     28    function GetRight: Integer;
     29    function GetTop: Integer;
     30    procedure SetBottom(AValue: Integer);
     31    procedure SetLeft(AValue: Integer);
     32    procedure SetRight(AValue: Integer);
     33    procedure SetTop(AValue: Integer);
     34  public
    1235    Position: TPoint;
    1336    Size: TPoint;
     37    function PointInside(P: TPoint): Boolean;
     38    function Create(Left, Top, Width, Height: Integer): TRectangle; overload;
     39    function Create(Position, Size: TPoint): TRectangle; overload;
     40    function AddPoint(P: TPoint): TRectangle;
     41    property Left: Integer read GetLeft write SetLeft;
     42    property Top: Integer read GetTop write SetTop;
     43    property Right: Integer read GetRight write SetRight;
     44    property Bottom: Integer read GetBottom write SetBottom;
     45  end;
     46
     47  TColorFormat = (cfRGBA8, cfGray8);
     48  TColor = Integer;
     49
     50  { TCanvas }
     51
     52  TCanvas = class
     53    Parent: TCanvas;
     54    Position: TPoint;
     55    Id: Integer;
     56    procedure DrawText(Pos: TPoint; Text: string; Color: TColor); virtual;
     57    procedure DrawLine(P1, P2: TPoint; Color: TColor); virtual;
     58    procedure DrawRect(Rect: TRectangle; Color: TColor); virtual;
     59    procedure SetPixel(P: TPoint; Color: TColor); virtual;
    1460  end;
    1561
    … …  
    1763
    1864  TGraphicObject = class
     65  private
     66    FCanvas: TCanvas;
     67    function GetCanvas: TCanvas;
     68  public
     69    Desktop: TDesktop;
    1970    Id: Integer;
    2071    Visible: Boolean;
    2172    procedure Paint; virtual;
     73    property Canvas: TCanvas read GetCanvas;
    2274  end;
    2375
    … …  
    2577
    2678  TWindow = class(TGraphicObject)
     79  public
    2780    Title: string;
    2881    Bounds: TRectangle;
    … …  
    4396
    4497  TDesktop = class
     98  private
     99    ObjectLastId: Integer;
     100    CanvasLastId: Integer;
     101  public
    45102    Objects: TFPGObjectList<TGraphicObject>;
     103    Canvases: TFPGObjectList<TCanvas>;
     104    function CreateWindow: TWindow;
     105    function CreateCanvas: TCanvas;
     106    function FindObjectById(Id: Integer): TGraphicObject;
     107    function FindCanvasById(Id: Integer): TCanvas;
    46108    procedure Paint;
    47109    constructor Create;
    … …  
    51113implementation
    52114
     115{ TRectangle }
     116
     117function TRectangle.GetBottom: Integer;
     118begin
     119  Result := Position.Y + Size.Y;
     120end;
     121
     122function TRectangle.GetLeft: Integer;
     123begin
     124  Result := Position.X;
     125end;
     126
     127function TRectangle.GetRight: Integer;
     128begin
     129  Result := Position.X + Size.X;
     130end;
     131
     132function TRectangle.GetTop: Integer;
     133begin
     134  Result := Position.Y;
     135end;
     136
     137procedure TRectangle.SetBottom(AValue: Integer);
     138begin
     139  Size.Y := AValue - Position.Y;
     140end;
     141
     142procedure TRectangle.SetLeft(AValue: Integer);
     143begin
     144  Position.X := AValue;
     145end;
     146
     147procedure TRectangle.SetRight(AValue: Integer);
     148begin
     149  Size.X := AValue - Position.X;
     150end;
     151
     152procedure TRectangle.SetTop(AValue: Integer);
     153begin
     154  Size.Y := AValue;
     155end;
     156
     157function TRectangle.PointInside(P: TPoint): Boolean;
     158begin
     159  Result := (P.X >= Position.X) and (P.Y >= Position.Y) and
     160    (P.X < (Position.X + Size.X)) and (P.Y < (Position.Y + Size.Y))
     161end;
     162
     163function TRectangle.Create(Left, Top, Width, Height: Integer): TRectangle;
     164begin
     165  Result.Position.X := Left;
     166  Result.Position.Y := Top;
     167  Result.Size.X := Width;
     168  Result.Size.Y := Height;
     169end;
     170
     171function TRectangle.Create(Position, Size: TPoint): TRectangle;
     172begin
     173  Result.Position := Position;
     174  Result.Size := Size;
     175end;
     176
     177function TRectangle.AddPoint(P: TPoint): TRectangle;
     178begin
     179  Result.Size := Size;
     180  Result.Position := Position.Add(P);
     181end;
     182
     183{ TPoint }
     184
     185function TPoint.Create(X, Y: Integer): TPoint;
     186begin
     187  Result.X := X;
     188  Result.Y := Y;
     189end;
     190
     191function TPoint.Add(P: TPoint): TPoint;
     192begin
     193  Result.X := X + P.X;
     194  Result.Y := Y + P.Y;
     195end;
     196
     197{ TCanvas }
     198
     199procedure TCanvas.DrawText(Pos: TPoint; Text: string; Color: TColor);
     200begin
     201  if Assigned(Parent) then
     202    Parent.DrawText(Pos.Add(Position), Text, Color);
     203end;
     204
     205procedure TCanvas.DrawLine(P1, P2: TPoint; Color: TColor);
     206begin
     207  if Assigned(Parent) then
     208    Parent.DrawLine(P1.Add(Position), P2.Add(Position), Color);
     209end;
     210
     211procedure TCanvas.DrawRect(Rect: TRectangle; Color: TColor);
     212begin
     213  if Assigned(Parent) then
     214    Parent.DrawRect(Rect.AddPoint(Position), Color);
     215end;
     216
     217procedure TCanvas.SetPixel(P: TPoint; Color: TColor);
     218begin
     219  if Assigned(Parent) then
     220    Parent.SetPixel(P.Add(Position), Color);
     221end;
     222
    53223{ TGraphicObject }
    54224
     225function TGraphicObject.GetCanvas: TCanvas;
     226begin
     227  FCanvas := Desktop.CreateCanvas;
     228  Result := FCanvas;
     229end;
     230
    55231procedure TGraphicObject.Paint;
    56232begin
    57 
    58233end;
    59234
    … …  
    63238begin
    64239  inherited Paint;
     240  Canvas.DrawRect(Bounds, $ff0000);
    65241end;
    66242
    67243constructor TWindow.Create;
    68244begin
    69   Bounds := TRectangle.Create;
    70245end;
    71246
    72247destructor TWindow.Destroy;
    73248begin
    74   Bounds.Free;
    75249  inherited Destroy;
    76250end;
    77251
    78252{ TDesktop }
     253
     254function TDesktop.CreateWindow: TWindow;
     255begin
     256  Inc(ObjectLastId);
     257  Result := TWindow.Create;
     258  Result.Id := ObjectLastId;
     259  Objects.Add(Result);
     260end;
     261
     262function TDesktop.CreateCanvas: TCanvas;
     263begin
     264  Inc(CanvasLastId);
     265  Result := TCanvas.Create;
     266  Result.Id := CanvasLastId;
     267  Canvases.Add(Result);
     268end;
     269
     270function TDesktop.FindObjectById(Id: Integer): TGraphicObject;
     271var
     272  I: Integer;
     273begin
     274  I := 0;
     275  while (I < Objects.Count) and (Objects[I].Id <> Id) do Inc(I);
     276  if I < Objects.Count then Result := Objects[I]
     277    else Result := nil;
     278end;
     279
     280function TDesktop.FindCanvasById(Id: Integer): TCanvas;
     281var
     282  I: Integer;
     283begin
     284  I := 0;
     285  while (I < Canvases.Count) and (Canvases[I].Id <> Id) do Inc(I);
     286  if I < Canvases.Count then Result := Canvases[I]
     287    else Result := nil;
     288end;
    79289
    80290procedure TDesktop.Paint;
    … …  
    89299begin
    90300  Objects := TFPGObjectList<TGraphicObject>.Create;
     301  Canvases := TFPGObjectList<TCanvas>.Create;
    91302end;
    92303
    93304destructor TDesktop.Destroy;
    94305begin
    95   Objects.Free;
     306  FreeAndNil(Canvases);
     307  FreeAndNil(Objects);
    96308  inherited Destroy;
    97309end;

  • trunk/Packages/Kernel/UKernel.pas

    r12 r13  
    66
    77uses
    8   Classes, Math, SysUtils, UList, Contnrs, UFileSystem, UMemory, UScreen, UDevice,
    9   fgl, UApp, UScheduler, UApi;
     8  Classes, SysUtils, UList, Contnrs, UFileSystem, UMemory, UScreen, UDevice,
     9  fgl, UApp, UScheduler, UApi, UGraphics;
    1010
    1111type
    … …  
    3737    Devices: TNamedObjectList<TDevice>;
    3838    Screens: TFPGObjectList<TScreen>;
     39    Desktop: TDesktop;
    3940    procedure AppExecute(AFile: TFile);
    4041    procedure Init;
    4142    procedure Run;
     43    procedure Terminate;
    4244    constructor Create;
    4345    destructor Destroy; override;
    … …  
    8486      NewScreen.BytesPerLine := VideoMode.GetBytesPerLine;
    8587      NewScreen.Device := VideoDevice;
     88      NewScreen.Canvas := TScreenCanvas.Create;
     89      TScreenCanvas(NewScreen.Canvas).Screen := NewScreen;
    8690      Screens.Add(NewScreen);
    8791    end;
    … …  
    150154end;
    151155
     156procedure TKernel.Terminate;
     157begin
     158  if Scheduler.Running then Scheduler.Stop;
     159end;
     160
    152161constructor TKernel.Create;
    153162begin
    … …  
    159168  Api := TKernelApi.Create;
    160169  Api.Kernel := Self;
     170  Desktop := TDesktop.Create;
    161171end;
    162172
    163173destructor TKernel.Destroy;
    164174begin
     175  Terminate;
     176  FreeAndNil(Desktop);
    165177  FreeAndNil(Api);
    166178  FreeAndNil(Screens);

  • trunk/Packages/Kernel/UScreen.pas

    r8 r13  
    66
    77uses
    8   Classes, SysUtils, Math;
     8  SysUtils, Math, UGraphics;
    99
    1010type
    11   TColorFormat = (cfRGBA8, cfGray8);
    12   TColor = Integer;
     11  TScreen = class;
     12
     13  TScreenCanvas = class(TCanvas)
     14    Screen: TScreen;
     15    procedure DrawText(Pos: TPoint; Text: string; Color: TColor); override;
     16    procedure DrawLine(P1, P2: TPoint; Color: TColor); override;
     17    procedure DrawRect(Rect: TRectangle; Color: TColor); override;
     18    procedure SetPixel(P: TPoint; Color: TColor); override;
     19  end;
    1320
    1421  { TScreen }
    … …  
    2229    BytesPerLine: Integer;
    2330    VideoMemory: PByte;
    24     procedure DrawText(Pos: TPoint; Text: string; Color: TColor);
    25     procedure DrawLine(P1, P2: TPoint; Color: TColor);
    26     procedure DrawRect(Rect: TRect; Color: TColor);
    27     procedure SetPixel(P: TPoint; Color: TColor);
     31    Canvas: TCanvas;
    2832    procedure VideoMemoryUpdated;
    2933  end;
    … …  
    3438  UDevice;
    3539
    36 { TScreen }
     40{ TScreenCanvas }
    3741
    38 procedure TScreen.DrawText(Pos: TPoint; Text: string; Color: TColor);
     42procedure TScreenCanvas.DrawText(Pos: TPoint; Text: string; Color: TColor);
    3943begin
    4044
    4145end;
    4246
    43 procedure TScreen.DrawLine(P1, P2: TPoint; Color: TColor);
     47procedure TScreenCanvas.DrawLine(P1, P2: TPoint; Color: TColor);
    4448var
    4549  I: Integer;
    … …  
    4751  if Abs(P2.X - P1.X) > Abs(P2.Y - P1.Y) then begin
    4852    for I := 0 to Abs(P2.X - P1.X) - 1 do
    49       SetPixel(Point(Trunc(P1.X + I * Sign(P2.X - P1.X)),
     53      SetPixel(TPoint.Create(Trunc(P1.X + I * Sign(P2.X - P1.X)),
    5054        Trunc(P1.Y + (P2.Y - P1.Y) / Abs(P2.X - P1.X) * I)), Color);
    5155  end else begin
    5256    for I := 0 to Abs(P2.Y - P1.Y) - 1 do
    53       SetPixel(Point(Trunc(P1.X + (P2.X - P1.X) / Abs(P2.Y - P1.Y) * I),
     57      SetPixel(TPoint.Create(Trunc(P1.X + (P2.X - P1.X) / Abs(P2.Y - P1.Y) * I),
    5458        Trunc(P1.Y + I * Sign(P2.Y - P1.Y))), Color);
    5559  end;
    56   VideoMemoryUpdated;
     60  Screen.VideoMemoryUpdated;
    5761end;
    5862
    59 procedure TScreen.DrawRect(Rect: TRect; Color: TColor);
     63procedure TScreenCanvas.DrawRect(Rect: TRectangle; Color: TColor);
    6064var
    6165  X, Y: Integer;
    … …  
    6367  for Y := Rect.Top to Rect.Bottom do
    6468  for X := Rect.Left to Rect.Right do
    65     SetPixel(Point(X, Y), Color);
     69    SetPixel(TPoint.Create(X, Y), Color);
    6670end;
    6771
    68 procedure TScreen.SetPixel(P: TPoint; Color: TColor);
     72procedure TScreenCanvas.SetPixel(P: TPoint; Color: TColor);
    6973begin
    70   if Assigned(VideoMemory) then
    71     PInteger(VideoMemory + P.X * BytesPerPixel + P.Y * BytesPerLine)^ := Color;
     74  if Assigned(Screen.VideoMemory) and
     75    TRectangle.Create(TPoint.Create(0, 0), Screen.Size).PointInside(P) then
     76    PInteger(Screen.VideoMemory + P.X * Screen.BytesPerPixel + P.Y * Screen.BytesPerLine)^ := Color;
    7277end;
     78
     79
     80{ TScreen }
    7381
    7482procedure TScreen.VideoMemoryUpdated;

  • trunk/Platform/Base/UPlatformBase.pas

    r9 r13  
    77uses
    88  Classes, SysUtils, UFileSystem, UKernel, syncobjs, UThreadEx, UMemory,
    9   DateUtils, UDevice, Contnrs, Graphics, Forms, UScreen, UScheduler;
     9  DateUtils, UDevice, Contnrs, Graphics, Forms, UScreen, UScheduler, UGraphics;
    1010
    1111type
    … …  
    107107  Modes.Clear;
    108108  NewMode := TVideoMode.Create;
    109   NewMode.Size := Point(320, 240);
    110   NewMode.ColorFormat := cfRGBA8;
    111   Modes.Add(NewMode);
    112   NewMode := TVideoMode.Create;
    113   NewMode.Size := Point(640, 480);
     109  NewMode.Size := TPoint.Create(320, 240);
     110  NewMode.ColorFormat := cfRGBA8;
     111  Modes.Add(NewMode);
     112  NewMode := TVideoMode.Create;
     113  NewMode.Size := TPoint.Create(640, 480);
    114114  NewMode.ColorFormat := cfRGBA8;
    115115  Modes.Add(NewMode);
    … …  
    235235  Task := TBaseTask(inherited AddTask(Name, EntryPoint));
    236236  if Running then Task.Thread.Start;
     237  Result := Task;
    237238end;
    238239
Note: See TracChangeset for help on using the changeset viewer.