Changeset 13 for trunk/Packages
- Timestamp:
- Sep 25, 2017, 2:48:08 PM (7 years ago)
- Location:
- trunk/Packages/Kernel
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Kernel/Kernel.lpk
r9 r13 18 18 </SyntaxOptions> 19 19 </Parsing> 20 <Other> 21 <CompilerMessages> 22 <IgnoredMessages idx5024="True"/> 23 </CompilerMessages> 24 </Other> 20 25 </CompilerOptions> 21 26 <Files Count="12"> -
trunk/Packages/Kernel/UAPI.pas
r12 r13 6 6 7 7 uses 8 Classes, SysUtils, UList, DateUtils, UMemory, UScreen, UDevice, UIPC,9 UScheduler ;8 SysUtils, UList, DateUtils, UMemory, UGraphics, UDevice, UIPC, 9 UScheduler, UScreen; 10 10 11 11 type 12 12 TApiCommand = (acNone, acWriteText, acDrawText, acDrawLine, acDrawRect, acSleep, 13 acReadMessage, acWindowCreate, acWindowSetAttr );13 acReadMessage, acWindowCreate, acWindowSetAttr, acGetWindowCanvas); 14 14 15 15 TDrawTextParams = record 16 CanvasId: Integer; 16 17 P: TPoint; 17 18 Text: string; … … 20 21 21 22 TDrawLineParams = record 23 CanvasId: Integer; 22 24 P1: TPoint; 23 25 P2: TPoint; … … 26 28 27 29 TWindowSetAttrParams = record 28 Size: TPoint; 30 WindowId: Integer; 31 Bounds: TRectangle; 29 32 Visible: Boolean; 30 33 end; 31 34 32 35 TDrawRectParams = record 33 Rect: TRect; 36 CanvasId: Integer; 37 Rect: TRectangle; 34 38 Color: TColor; 35 39 end; … … 41 45 function Call(Command: TApiCommand; Data: Pointer): Pointer; 42 46 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); 46 50 procedure Sleep(Time: TDateTime); 47 51 procedure ReadMessage(Message: TIPCMessage); 48 52 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); 50 55 end; 51 56 … … 58 63 function Call(Command: TApiCommand; Data: Pointer): Pointer; 59 64 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); 63 68 procedure Sleep(Time: TDateTime); 64 69 procedure ReadMessage(Message: TIPCMessage); 65 70 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); 67 73 end; 68 74 … … 86 92 end; 87 93 88 procedure TUserApi.DrawText( P: TPoint; Text: string; Color: TColor);94 procedure TUserApi.DrawText(CanvasId: Integer; P: TPoint; Text: string; Color: TColor); 89 95 var 90 96 Params: TDrawTextParams; 91 97 begin 98 Params.CanvasId := CanvasId; 92 99 Params.P := P; 93 100 Params.Text := Text; … … 96 103 end; 97 104 98 procedure TUserApi.DrawLine( P1, P2: TPoint; Color: TColor);105 procedure TUserApi.DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor); 99 106 var 100 107 Params: TDrawLineParams; 101 108 begin 109 Params.CanvasId := CanvasId; 102 110 Params.P1 := P1; 103 111 Params.P2 := P2; … … 106 114 end; 107 115 108 procedure TUserApi.DrawRect( Rect: TRect; Color: TColor);116 procedure TUserApi.DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor); 109 117 var 110 118 Params: TDrawRectParams; 111 119 begin 120 Params.CanvasId := CanvasId; 112 121 Params.Rect := Rect; 113 122 Params.Color := Color; … … 127 136 function TUserApi.WindowCreate: Integer; 128 137 begin 129 Call(acWindowCreate, nil); 130 end; 131 132 procedure TUserApi.WindowSetAttr(Size: TPoint; Visible: Boolean); 138 Result := Integer(Call(acWindowCreate, nil)); 139 end; 140 141 function TUserApi.GetWindowCanvas(WindowId: Integer): Integer; 142 begin 143 Call(acGetWindowCanvas, Pointer(WindowId)); 144 end; 145 146 procedure TUserApi.WindowSetAttr(WindowId: Integer; Bounds: TRectangle; Visible: Boolean); 133 147 var 134 148 Params: TWindowSetAttrParams; 135 149 begin 136 Params.Size := Size; 150 Params.WindowId := WindowId; 151 Params.Bounds := Bounds; 137 152 Params.Visible := Visible; 138 153 Call(acWindowSetAttr, @Params); … … 145 160 begin 146 161 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); 152 168 acSleep: Sleep(TDateTime(Data^)); 153 169 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); 156 172 acWriteText: WriteText(string(Data)); 157 173 acReadMessage: ReadMessage(Data); 174 acGetWindowCanvas: Result := Pointer(GetWindowCanvas(Integer(Data))); 158 175 end; 159 176 end; … … 169 186 end; 170 187 171 procedure TKernelApi.DrawText( P: TPoint; Text: string; Color: TColor);188 procedure TKernelApi.DrawText(CanvasId: Integer; P: TPoint; Text: string; Color: TColor); 172 189 var 173 190 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; 192 begin 193 Canvas := TKernel(Kernel).Desktop.FindCanvasById(CanvasId); 194 if Assigned(Canvas) then begin 195 Canvas.DrawText(P, Text, Color); 196 end; 197 end; 198 199 procedure TKernelApi.DrawLine(CanvasId: Integer; P1, P2: TPoint; Color: TColor); 180 200 var 181 201 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; 203 begin 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; 208 end; 209 210 procedure TKernelApi.DrawRect(CanvasId: Integer; Rect: TRectangle; Color: TColor); 188 211 var 189 212 Screen: TScreen; 190 begin 191 Screen := TScreen(TKernel(Kernel).Screens.First); 192 Screen.DrawRect(Rect, Color); 213 Canvas: TCanvas; 214 begin 215 Canvas := TKernel(Kernel).Desktop.FindCanvasById(CanvasId); 216 if Assigned(Canvas) then begin 217 Canvas.DrawRect(Rect, Color); 218 end; 193 219 end; 194 220 … … 210 236 211 237 function TKernelApi.WindowCreate: Integer; 212 begin 213 214 end; 215 216 procedure TKernelApi.WindowSetAttr(Size: TPoint; Visible: Boolean); 217 begin 218 238 var 239 Window: TWindow; 240 begin 241 Window := TKernel(Kernel).Desktop.CreateWindow; 242 Window.Desktop := TKernel(Kernel).Desktop; 243 Result := Window.Id; 244 end; 245 246 function TKernelApi.GetWindowCanvas(WindowId: Integer): Integer; 247 var 248 Window: TWindow; 249 Canvas: TCanvas; 250 begin 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; 257 end; 258 259 procedure TKernelApi.WindowSetAttr(WindowId: Integer; Bounds: TRectangle; Visible: Boolean); 260 var 261 Window: TWindow; 262 begin 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; 219 269 end; 220 270 -
trunk/Packages/Kernel/UDevice.pas
r8 r13 6 6 7 7 uses 8 Classes, SysUtils, Contnrs, UList, U Screen;8 Classes, SysUtils, Contnrs, UList, UGraphics; 9 9 10 10 type -
trunk/Packages/Kernel/UGraphics.pas
r11 r13 6 6 7 7 uses 8 Classes,SysUtils, fgl;8 SysUtils, fgl; 9 9 10 10 type 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 12 35 Position: TPoint; 13 36 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; 14 60 end; 15 61 … … 17 63 18 64 TGraphicObject = class 65 private 66 FCanvas: TCanvas; 67 function GetCanvas: TCanvas; 68 public 69 Desktop: TDesktop; 19 70 Id: Integer; 20 71 Visible: Boolean; 21 72 procedure Paint; virtual; 73 property Canvas: TCanvas read GetCanvas; 22 74 end; 23 75 … … 25 77 26 78 TWindow = class(TGraphicObject) 79 public 27 80 Title: string; 28 81 Bounds: TRectangle; … … 43 96 44 97 TDesktop = class 98 private 99 ObjectLastId: Integer; 100 CanvasLastId: Integer; 101 public 45 102 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; 46 108 procedure Paint; 47 109 constructor Create; … … 51 113 implementation 52 114 115 { TRectangle } 116 117 function TRectangle.GetBottom: Integer; 118 begin 119 Result := Position.Y + Size.Y; 120 end; 121 122 function TRectangle.GetLeft: Integer; 123 begin 124 Result := Position.X; 125 end; 126 127 function TRectangle.GetRight: Integer; 128 begin 129 Result := Position.X + Size.X; 130 end; 131 132 function TRectangle.GetTop: Integer; 133 begin 134 Result := Position.Y; 135 end; 136 137 procedure TRectangle.SetBottom(AValue: Integer); 138 begin 139 Size.Y := AValue - Position.Y; 140 end; 141 142 procedure TRectangle.SetLeft(AValue: Integer); 143 begin 144 Position.X := AValue; 145 end; 146 147 procedure TRectangle.SetRight(AValue: Integer); 148 begin 149 Size.X := AValue - Position.X; 150 end; 151 152 procedure TRectangle.SetTop(AValue: Integer); 153 begin 154 Size.Y := AValue; 155 end; 156 157 function TRectangle.PointInside(P: TPoint): Boolean; 158 begin 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)) 161 end; 162 163 function TRectangle.Create(Left, Top, Width, Height: Integer): TRectangle; 164 begin 165 Result.Position.X := Left; 166 Result.Position.Y := Top; 167 Result.Size.X := Width; 168 Result.Size.Y := Height; 169 end; 170 171 function TRectangle.Create(Position, Size: TPoint): TRectangle; 172 begin 173 Result.Position := Position; 174 Result.Size := Size; 175 end; 176 177 function TRectangle.AddPoint(P: TPoint): TRectangle; 178 begin 179 Result.Size := Size; 180 Result.Position := Position.Add(P); 181 end; 182 183 { TPoint } 184 185 function TPoint.Create(X, Y: Integer): TPoint; 186 begin 187 Result.X := X; 188 Result.Y := Y; 189 end; 190 191 function TPoint.Add(P: TPoint): TPoint; 192 begin 193 Result.X := X + P.X; 194 Result.Y := Y + P.Y; 195 end; 196 197 { TCanvas } 198 199 procedure TCanvas.DrawText(Pos: TPoint; Text: string; Color: TColor); 200 begin 201 if Assigned(Parent) then 202 Parent.DrawText(Pos.Add(Position), Text, Color); 203 end; 204 205 procedure TCanvas.DrawLine(P1, P2: TPoint; Color: TColor); 206 begin 207 if Assigned(Parent) then 208 Parent.DrawLine(P1.Add(Position), P2.Add(Position), Color); 209 end; 210 211 procedure TCanvas.DrawRect(Rect: TRectangle; Color: TColor); 212 begin 213 if Assigned(Parent) then 214 Parent.DrawRect(Rect.AddPoint(Position), Color); 215 end; 216 217 procedure TCanvas.SetPixel(P: TPoint; Color: TColor); 218 begin 219 if Assigned(Parent) then 220 Parent.SetPixel(P.Add(Position), Color); 221 end; 222 53 223 { TGraphicObject } 54 224 225 function TGraphicObject.GetCanvas: TCanvas; 226 begin 227 FCanvas := Desktop.CreateCanvas; 228 Result := FCanvas; 229 end; 230 55 231 procedure TGraphicObject.Paint; 56 232 begin 57 58 233 end; 59 234 … … 63 238 begin 64 239 inherited Paint; 240 Canvas.DrawRect(Bounds, $ff0000); 65 241 end; 66 242 67 243 constructor TWindow.Create; 68 244 begin 69 Bounds := TRectangle.Create;70 245 end; 71 246 72 247 destructor TWindow.Destroy; 73 248 begin 74 Bounds.Free;75 249 inherited Destroy; 76 250 end; 77 251 78 252 { TDesktop } 253 254 function TDesktop.CreateWindow: TWindow; 255 begin 256 Inc(ObjectLastId); 257 Result := TWindow.Create; 258 Result.Id := ObjectLastId; 259 Objects.Add(Result); 260 end; 261 262 function TDesktop.CreateCanvas: TCanvas; 263 begin 264 Inc(CanvasLastId); 265 Result := TCanvas.Create; 266 Result.Id := CanvasLastId; 267 Canvases.Add(Result); 268 end; 269 270 function TDesktop.FindObjectById(Id: Integer): TGraphicObject; 271 var 272 I: Integer; 273 begin 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; 278 end; 279 280 function TDesktop.FindCanvasById(Id: Integer): TCanvas; 281 var 282 I: Integer; 283 begin 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; 288 end; 79 289 80 290 procedure TDesktop.Paint; … … 89 299 begin 90 300 Objects := TFPGObjectList<TGraphicObject>.Create; 301 Canvases := TFPGObjectList<TCanvas>.Create; 91 302 end; 92 303 93 304 destructor TDesktop.Destroy; 94 305 begin 95 Objects.Free; 306 FreeAndNil(Canvases); 307 FreeAndNil(Objects); 96 308 inherited Destroy; 97 309 end; -
trunk/Packages/Kernel/UKernel.pas
r12 r13 6 6 7 7 uses 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; 10 10 11 11 type … … 37 37 Devices: TNamedObjectList<TDevice>; 38 38 Screens: TFPGObjectList<TScreen>; 39 Desktop: TDesktop; 39 40 procedure AppExecute(AFile: TFile); 40 41 procedure Init; 41 42 procedure Run; 43 procedure Terminate; 42 44 constructor Create; 43 45 destructor Destroy; override; … … 84 86 NewScreen.BytesPerLine := VideoMode.GetBytesPerLine; 85 87 NewScreen.Device := VideoDevice; 88 NewScreen.Canvas := TScreenCanvas.Create; 89 TScreenCanvas(NewScreen.Canvas).Screen := NewScreen; 86 90 Screens.Add(NewScreen); 87 91 end; … … 150 154 end; 151 155 156 procedure TKernel.Terminate; 157 begin 158 if Scheduler.Running then Scheduler.Stop; 159 end; 160 152 161 constructor TKernel.Create; 153 162 begin … … 159 168 Api := TKernelApi.Create; 160 169 Api.Kernel := Self; 170 Desktop := TDesktop.Create; 161 171 end; 162 172 163 173 destructor TKernel.Destroy; 164 174 begin 175 Terminate; 176 FreeAndNil(Desktop); 165 177 FreeAndNil(Api); 166 178 FreeAndNil(Screens); -
trunk/Packages/Kernel/UScreen.pas
r8 r13 6 6 7 7 uses 8 Classes, SysUtils, Math;8 SysUtils, Math, UGraphics; 9 9 10 10 type 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; 13 20 14 21 { TScreen } … … 22 29 BytesPerLine: Integer; 23 30 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; 28 32 procedure VideoMemoryUpdated; 29 33 end; … … 34 38 UDevice; 35 39 36 { TScreen }40 { TScreenCanvas } 37 41 38 procedure TScreen .DrawText(Pos: TPoint; Text: string; Color: TColor);42 procedure TScreenCanvas.DrawText(Pos: TPoint; Text: string; Color: TColor); 39 43 begin 40 44 41 45 end; 42 46 43 procedure TScreen .DrawLine(P1, P2: TPoint; Color: TColor);47 procedure TScreenCanvas.DrawLine(P1, P2: TPoint; Color: TColor); 44 48 var 45 49 I: Integer; … … 47 51 if Abs(P2.X - P1.X) > Abs(P2.Y - P1.Y) then begin 48 52 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)), 50 54 Trunc(P1.Y + (P2.Y - P1.Y) / Abs(P2.X - P1.X) * I)), Color); 51 55 end else begin 52 56 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), 54 58 Trunc(P1.Y + I * Sign(P2.Y - P1.Y))), Color); 55 59 end; 56 VideoMemoryUpdated;60 Screen.VideoMemoryUpdated; 57 61 end; 58 62 59 procedure TScreen .DrawRect(Rect: TRect; Color: TColor);63 procedure TScreenCanvas.DrawRect(Rect: TRectangle; Color: TColor); 60 64 var 61 65 X, Y: Integer; … … 63 67 for Y := Rect.Top to Rect.Bottom do 64 68 for X := Rect.Left to Rect.Right do 65 SetPixel( Point(X, Y), Color);69 SetPixel(TPoint.Create(X, Y), Color); 66 70 end; 67 71 68 procedure TScreen .SetPixel(P: TPoint; Color: TColor);72 procedure TScreenCanvas.SetPixel(P: TPoint; Color: TColor); 69 73 begin 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; 72 77 end; 78 79 80 { TScreen } 73 81 74 82 procedure TScreen.VideoMemoryUpdated;
Note:
See TracChangeset
for help on using the changeset viewer.