Changeset 447 for GraphicTest
- Timestamp:
- Nov 22, 2012, 2:32:10 PM (12 years ago)
- Location:
- GraphicTest
- Files:
-
- 12 added
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
GraphicTest/GraphicTest.lpi
r446 r447 66 66 </local> 67 67 </RunParams> 68 <RequiredPackages Count=" 3">68 <RequiredPackages Count="4"> 69 69 <Item1> 70 <PackageName Value=" bgrabitmappack"/>70 <PackageName Value="SynEdit"/> 71 71 </Item1> 72 72 <Item2> 73 <PackageName Value=" lazopenglcontext"/>73 <PackageName Value="bgrabitmappack"/> 74 74 </Item2> 75 75 <Item3> 76 <PackageName Value="lazopenglcontext"/> 77 </Item3> 78 <Item4> 76 79 <PackageName Value="LCL"/> 77 </Item 3>80 </Item4> 78 81 </RequiredPackages> 79 <Units Count=" 6">82 <Units Count="17"> 80 83 <Unit0> 81 84 <Filename Value="GraphicTest.lpr"/> … … 113 116 <UnitName Value="UDrawForm"/> 114 117 </Unit5> 118 <Unit6> 119 <Filename Value="Methods/UCanvasPixels.pas"/> 120 <IsPartOfProject Value="True"/> 121 <UnitName Value="UCanvasPixels"/> 122 </Unit6> 123 <Unit7> 124 <Filename Value="Methods/UCanvasPixelsUpdateLock.pas"/> 125 <IsPartOfProject Value="True"/> 126 <UnitName Value="UCanvasPixelsUpdateLock"/> 127 </Unit7> 128 <Unit8> 129 <Filename Value="Methods/ULazIntfImageColorsCopy.pas"/> 130 <IsPartOfProject Value="True"/> 131 <UnitName Value="ULazIntfImageColorsCopy"/> 132 </Unit8> 133 <Unit9> 134 <Filename Value="Methods/ULazIntfImageColorsNoCopy.pas"/> 135 <IsPartOfProject Value="True"/> 136 <UnitName Value="ULazIntfImageColorsNoCopy"/> 137 </Unit9> 138 <Unit10> 139 <Filename Value="Methods/UBGRABitmapPaintBox.pas"/> 140 <IsPartOfProject Value="True"/> 141 <UnitName Value="UBGRABitmapPaintBox"/> 142 </Unit10> 143 <Unit11> 144 <Filename Value="Methods/UBitmapRawImageDataPaintBox.pas"/> 145 <IsPartOfProject Value="True"/> 146 <UnitName Value="UBitmapRawImageDataPaintBox"/> 147 </Unit11> 148 <Unit12> 149 <Filename Value="Methods/UBitmapRawImageData.pas"/> 150 <IsPartOfProject Value="True"/> 151 <UnitName Value="UBitmapRawImageData"/> 152 </Unit12> 153 <Unit13> 154 <Filename Value="Methods/UDummyMethod.pas"/> 155 <IsPartOfProject Value="True"/> 156 <UnitName Value="UDummyMethod"/> 157 </Unit13> 158 <Unit14> 159 <Filename Value="Methods/UBitmapRawImageDataMove.pas"/> 160 <IsPartOfProject Value="True"/> 161 <UnitName Value="UBitmapRawImageDataMove"/> 162 </Unit14> 163 <Unit15> 164 <Filename Value="Methods/UOpenGLMethod.pas"/> 165 <IsPartOfProject Value="True"/> 166 <UnitName Value="UOpenGLMethod"/> 167 </Unit15> 168 <Unit16> 169 <Filename Value="Methods/UOpenGLPBOMethod.pas"/> 170 <IsPartOfProject Value="True"/> 171 <UnitName Value="UOpenGLPBOMethod"/> 172 </Unit16> 115 173 </Units> 116 174 </ProjectOptions> … … 122 180 <SearchPaths> 123 181 <IncludeFiles Value="$(ProjOutDir)"/> 182 <OtherUnitFiles Value="Methods"/> 124 183 <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> 125 184 </SearchPaths> -
GraphicTest/GraphicTest.lpr
r443 r447 9 9 Interfaces, // this includes the LCL widgetset 10 10 Forms, lazopenglcontext, UMainForm, UPlatform, UDrawMethod, UFastBitmap, 11 bgrabitmappack, UDrawForm; 11 bgrabitmappack, UDrawForm, UCanvasPixels, UCanvasPixelsUpdateLock, 12 ULazIntfImageColorsCopy, ULazIntfImageColorsNoCopy, UBGRABitmapPaintBox, 13 UBitmapRawImageDataPaintBox, UBitmapRawImageData, UDummyMethod, 14 UBitmapRawImageDataMove, UOpenGLMethod, UOpenGLPBOMethod; 12 15 13 16 {$R *.res} -
GraphicTest/UDrawMethod.pas
r443 r447 7 7 uses 8 8 Classes, SysUtils, ExtCtrls, UPlatform, UFastBitmap, Graphics, Controls, 9 LCLType, IntfGraphics, fpImage, GraphType, BGRABitmap, BGRABitmapTypes,9 LCLType, IntfGraphics, fpImage, GraphType, 10 10 LclIntf{$IFDEF opengl}, GL, GLExt, OpenGLContext{$ENDIF}; 11 11 … … 19 19 private 20 20 FControl: TControl; 21 TempBitmap: TBitmap;22 21 public 23 22 Caption: string; 23 Description: TStringList; 24 24 Terminated: Boolean; 25 25 FrameDuration: TDateTime; 26 26 StepDuration: TDateTime; 27 27 PaintObject: TPaintObject; 28 TempBitmap: TBitmap; 28 29 procedure Init(Parent: TWinControl; Size: TPoint); virtual; 29 30 procedure Done; virtual; … … 52 53 procedure Init(Parent: TWinControl; Size: TPoint); override; 53 54 procedure Done; override; 54 end;55 56 { TDummyMethod }57 58 TDummyMethod = class(TDrawMethod)59 constructor Create; override;60 procedure DrawFrame(FastBitmap: TFastBitmap); override;61 end;62 63 { TCanvasPixels }64 65 TCanvasPixels = class(TDrawMethodImage)66 constructor Create; override;67 procedure DrawFrame(FastBitmap: TFastBitmap); override;68 end;69 70 { TCanvasPixelsUpdateLock }71 72 TCanvasPixelsUpdateLock = class(TDrawMethodImage)73 constructor Create; override;74 procedure DrawFrame(FastBitmap: TFastBitmap); override;75 end;76 77 { TLazIntfImageColorsCopy }78 79 TLazIntfImageColorsCopy = class(TDrawMethodImage)80 TempIntfImage: TLazIntfImage;81 constructor Create; override;82 destructor Destroy; override;83 procedure DrawFrame(FastBitmap: TFastBitmap); override;84 end;85 86 { TLazIntfImageColorsNoCopy }87 88 TLazIntfImageColorsNoCopy = class(TDrawMethodImage)89 TempIntfImage: TLazIntfImage;90 procedure Init(Parent: TWinControl; Size: TPoint); override;91 constructor Create; override;92 destructor Destroy; override;93 procedure DrawFrame(FastBitmap: TFastBitmap); override;94 end;95 96 { TBitmapRawImageData }97 98 TBitmapRawImageData = class(TDrawMethodImage)99 constructor Create; override;100 procedure DrawFrame(FastBitmap: TFastBitmap); override;101 end;102 103 { TBitmapRawImageDataPaintBox }104 105 TBitmapRawImageDataPaintBox = class(TDrawMethodPaintBox)106 constructor Create; override;107 procedure Paint(Sender: TObject); override;108 procedure DrawFrame(FastBitmap: TFastBitmap); override;109 end;110 111 { TBitmapRawImageDataMove }112 113 TBitmapRawImageDataMove = class(TDrawMethodImage)114 constructor Create; override;115 procedure DrawFrame(FastBitmap: TFastBitmap); override;116 end;117 118 { TBGRABitmapPaintBox }119 120 TBGRABitmapPaintBox = class(TDrawMethodPaintBox)121 BGRABitmap: TBGRABitmap;122 procedure Paint(Sender: TObject); override;123 procedure Init(Parent: TWinControl; Size: TPoint); override;124 constructor Create; override;125 destructor Destroy; override;126 procedure DrawFrame(FastBitmap: TFastBitmap); override;127 55 end; 128 56 … … 140 68 end; 141 69 142 { TOpenGLMethod }143 144 TOpenGLMethod = class(TDrawMethodOpenGL)145 constructor Create; override;146 destructor Destroy; override;147 procedure DrawFrame(FastBitmap: TFastBitmap); override;148 end;149 150 { TOpenGLPBOMethod }151 152 TOpenGLPBOMethod = class(TDrawMethodOpenGL)153 pboIds: array[0..1] of GLuint;154 Index, NextIndex: Integer;155 procedure Init(AParent: TWinControl; Size: TPoint); override;156 constructor Create; override;157 destructor Destroy; override;158 procedure DrawFrame(FastBitmap: TFastBitmap); override;159 end;160 70 {$ENDIF} 161 71 162 const163 DrawMethodClasses: array[0..{$IFDEF opengl}10{$ELSE}8{$ENDIF}] of TDrawMethodClass = (164 TCanvasPixels, TCanvasPixelsUpdateLock, TLazIntfImageColorsCopy,165 TLazIntfImageColorsNoCopy, TBitmapRawImageData, TBitmapRawImageDataPaintBox,166 TBitmapRawImageDataMove, TBGRABitmapPaintBox{$IFDEF opengl}, TOpenGLMethod, TOpenGLPBOMethod{$ENDIF}167 ,TDummyMethod);168 72 169 73 implementation … … 212 116 end; 213 117 214 { TDummyMethod }215 216 constructor TDummyMethod.Create;217 begin218 inherited Create;219 Caption := 'Dummy';220 end;221 222 procedure TDummyMethod.DrawFrame(FastBitmap: TFastBitmap);223 begin224 end;225 226 { TBitmapRawImageDataMove }227 228 constructor TBitmapRawImageDataMove.Create;229 begin230 inherited;231 Caption := 'TBitmap.RawImage.Data Move';232 end;233 234 procedure TBitmapRawImageDataMove.DrawFrame(FastBitmap: TFastBitmap);235 var236 Y, X: Integer;237 PixelPtr: PInteger;238 RowPtr: PInteger;239 P: TPixelFormat;240 RawImage: TRawImage;241 BytePerPixel: Integer;242 BytePerRow: Integer;243 begin244 P := Image.Picture.Bitmap.PixelFormat;245 with FastBitmap do246 try247 Image.Picture.Bitmap.BeginUpdate(False);248 RawImage := Image.Picture.Bitmap.RawImage;249 RowPtr := PInteger(RawImage.Data);250 BytePerPixel := RawImage.Description.BitsPerPixel div 8;251 BytePerRow := RawImage.Description.BytesPerLine;252 Move(FastBitmap.PixelsData^, RowPtr^, Size.Y * BytePerRow);253 finally254 Image.Picture.Bitmap.EndUpdate(False);255 end;256 end;257 118 258 119 {$IFDEF opengl} 259 { TOpenGLPBOMethod }260 261 //procedure glGenBuffersARB2 : procedure(n : GLsizei; buffers : PGLuint); extdecl;262 263 procedure TOpenGLPBOMethod.Init(AParent: TWinControl; Size: TPoint);264 var265 DataSize: Integer;266 glExtensions: string;267 begin268 inherited;269 270 OpenGLControl.MakeCurrent;271 DataSize := OpenGLControl.Width * OpenGLControl.Height * SizeOf(Integer);272 // glGenBuffersARB(Length(pboIds), PGLuint(pboIds));273 //if glext_LoadExtension('GL_ARB_pixel_buffer_object') then274 if Load_GL_ARB_vertex_buffer_object then begin275 glGenBuffersARB(2, @pboIds);276 glBindBufferARB(GL_PIXEL_PACK_BUFFER_ARB, pboIds[0]);277 glBufferDataARB(GL_PIXEL_PACK_BUFFER_ARB, DataSize, Pointer(0), GL_STREAM_READ_ARB);278 glBindBufferARB(GL_PIXEL_PACK_BUFFER_ARB, pboIds[1]);279 glBufferDataARB(GL_PIXEL_PACK_BUFFER_ARB, DataSize, Pointer(0), GL_STREAM_READ_ARB);280 281 end else raise Exception.Create('GL_ARB_pixel_buffer_object not supported');282 283 glEnable(GL_TEXTURE_2D);284 glBindTexture(GL_TEXTURE_2D, TextureId);285 //glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);286 //glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);287 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);288 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);289 glTexImage2D(GL_TEXTURE_2D, 0, 4, OpenGLControl.Width, OpenGLControl.Height,290 0, GL_RGBA, GL_UNSIGNED_BYTE, OpenGLBitmap);291 end;292 293 constructor TOpenGLPBOMethod.Create;294 begin295 inherited Create;296 Caption := 'OpenGL PBO';297 PaintObject := poOpenGL;298 // SetLength(pboIds, 2);299 Index := 0;300 NextIndex := 1;301 end;302 303 destructor TOpenGLPBOMethod.Destroy;304 begin305 inherited Destroy;306 end;307 308 procedure TOpenGLPBOMethod.DrawFrame(FastBitmap: TFastBitmap);309 var310 X, Y: Integer;311 P: PCardinal;312 R: PCardinal;313 Ptr: ^GLubyte;314 TextureShift: TPoint;315 TextureShift2: TPoint;316 const317 GL_CLAMP_TO_EDGE = $812F;318 begin319 // "index" is used to read pixels from framebuffer to a PBO320 // "nextIndex" is used to update pixels in the other PBO321 Index := (Index + 1) mod 2;322 NextIndex := (Index + 1) mod 2;323 324 glLoadIdentity;325 326 glBindTexture(GL_TEXTURE_2D, TextureId);327 //glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);328 //glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);329 //glTexImage2D(GL_TEXTURE_2D, 0, 4, OpenGLControl.Width, OpenGLControl.Height,330 // 0, GL_RGBA, GL_UNSIGNED_BYTE, OpenGLBitmap);331 //glTexImage2D(GL_TEXTURE_2D, 0, 4, 512, 256,332 //0, GL_RGBA, GL_UNSIGNED_BYTE, OpenGLBitmap);333 334 // bind the texture and PBO335 //glBindTexture(GL_TEXTURE_2D, textureId);336 glBindBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB, pboIds[index]);337 338 // copy pixels from PBO to texture object339 // Use offset instead of ponter.340 glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, OpenGLControl.Width, OpenGLControl.Height,341 GL_BGRA, GL_UNSIGNED_BYTE, Pointer(0));342 343 344 // bind PBO to update texture source345 glBindBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB, pboIds[nextIndex]);346 347 // Note that glMapBufferARB() causes sync issue.348 // If GPU is working with this buffer, glMapBufferARB() will wait(stall)349 // until GPU to finish its job. To avoid waiting (idle), you can call350 // first glBufferDataARB() with NULL pointer before glMapBufferARB().351 // If you do that, the previous data in PBO will be discarded and352 // glMapBufferARB() returns a new allocated pointer immediately353 // even if GPU is still working with the previous data.354 glBufferDataARB(GL_PIXEL_UNPACK_BUFFER_ARB, OpenGLControl.Width * OpenGLControl.Height * SizeOf(Integer), Pointer(0), GL_STREAM_DRAW_ARB);355 356 // map the buffer object into client's memory357 ptr := glMapBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB, GL_WRITE_ONLY_ARB);358 if Assigned(ptr) then begin359 // update data directly on the mapped buffer360 P := PCardinal(Ptr);361 with FastBitmap do362 for Y := 0 to Size.Y - 2 do begin363 R := P;364 for X := 0 to Size.X - 1 do begin365 R^ := NoSwapBRComponent(Pixels[X, Y]) or $ff000000;366 Inc(R);367 end;368 Inc(P, Size.X);369 end;370 glUnmapBufferARB(GL_PIXEL_PACK_BUFFER_ARB);371 end;372 373 // it is good idea to release PBOs with ID 0 after use.374 // Once bound with 0, all pixel operations are back to normal ways.375 glBindBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB, 0);376 377 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);378 //glRotatef(30.0, 0, 0, 1.0);379 glTranslatef(-OpenGLControl.Width / 2, -OpenGLControl.Height / 2, 0.0);380 glBindTexture(GL_TEXTURE_2D, TextureId);381 382 TextureShift := Point(0, 0);383 TextureShift2 := Point(0, 0);384 glBegin(GL_QUADS);385 glColor3ub(255, 255, 255);386 glTexCoord2f(TextureShift.X, TextureShift.Y);387 glVertex3f(TextureShift2.X, TextureShift2.Y, 0);388 glTexCoord2f(TextureShift.X + OpenGLControl.Width div 2, TextureShift.Y);389 glVertex3f(TextureShift2.X + OpenGLControl.Width, TextureShift2.Y, 0);390 glTexCoord2f(TextureShift.X + OpenGLControl.Width div 2, TextureShift.Y + OpenGLControl.Height div 2);391 glVertex3f(TextureShift2.X + OpenGLControl.Width, TextureShift2.Y + OpenGLControl.Height, 0);392 glTexCoord2f(TextureShift.X, TextureShift.Y + OpenGLControl.Height div 2);393 glVertex3f(TextureShift2.X, TextureShift2.Y + OpenGLControl.Height, 0);394 glEnd();395 396 OpenGLControl.SwapBuffers;397 end;398 399 { TOpenGLMethod }400 401 constructor TOpenGLMethod.Create;402 begin403 inherited Create;404 Caption := 'OpenGL';405 PaintObject := poOpenGL;406 end;407 408 destructor TOpenGLMethod.Destroy;409 begin410 inherited Destroy;411 end;412 413 procedure TOpenGLMethod.DrawFrame(FastBitmap: TFastBitmap);414 var415 X, Y: Integer;416 P: PCardinal;417 R: PCardinal;418 const419 GL_CLAMP_TO_EDGE = $812F;420 begin421 glLoadIdentity;422 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);423 //glLoadIdentity; { clear the matrix }424 //glTranslatef(0.0, 0.0, -3.0); // -2.5); { viewing transformation }425 426 P := OpenGLBitmap;427 with FastBitmap do428 for Y := 0 to Size.Y - 1 do begin429 R := P;430 for X := 0 to Size.X - 1 do begin431 //R^ := Round($ff * (Y / Size.Y)) or $ff000000;432 R^ := NoSwapBRComponent(Pixels[X, Y]) or $ff000000;433 Inc(R);434 end;435 Inc(P, Size.X);436 end;437 438 //glRotatef(30.0, 0, 0, 1.0);439 glTranslatef(-OpenGLControl.Width div 2, -OpenGLControl.Height div 2, 0.0);440 441 glEnable(GL_TEXTURE_2D);442 glBindTexture(GL_TEXTURE_2D, TextureId);443 //glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);444 //glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);445 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);446 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);447 glTexImage2D(GL_TEXTURE_2D, 0, 4, OpenGLControl.Width, OpenGLControl.Height,448 0, GL_RGBA, GL_UNSIGNED_BYTE, OpenGLBitmap);449 //glTexImage2D(GL_TEXTURE_2D, 0, 4, 512, 256,450 //0, GL_RGBA, GL_UNSIGNED_BYTE, OpenGLBitmap);451 452 //Define how alpha blending will work and enable alpha blending.453 //glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);454 //glEnable(GL_BLEND);455 456 glBegin(GL_QUADS);457 //glBegin(GL_POLYGON);458 glColor3ub(255, 255, 255);459 glTexCoord2f(0, 0);460 glVertex3f(0, 0, 0);461 glTexCoord2f(OpenGLControl.Width div 2, 0);462 glVertex3f(OpenGLControl.Width, 0, 0);463 glTexCoord2f(OpenGLControl.Width div 2, OpenGLControl.Height div 2);464 glVertex3f(OpenGLControl.Width, OpenGLControl.Height, 0);465 glTexCoord2f(0, OpenGLControl.Height div 2);466 glVertex3f(0, OpenGLControl.Height, 0);467 glEnd();468 469 OpenGLControl.SwapBuffers;470 end;471 120 472 121 { TDrawMethodOpenGL } … … 521 170 {$ENDIF} 522 171 523 { TBGRABitmapPaintBox }524 525 procedure TBGRABitmapPaintBox.Paint(Sender: TObject);526 begin527 //BGRABitmap.Draw(Bitmap.Canvas, 0, 0, True);528 BGRABitmap.Draw(PaintBox.Canvas, 0, 0, True);529 end;530 531 procedure TBGRABitmapPaintBox.Init(Parent: TWinControl; Size: TPoint);532 begin533 inherited Init(Parent, Size);534 BGRABitmap.SetSize(PaintBox.Width, PaintBox.Height);535 end;536 537 constructor TBGRABitmapPaintBox.Create;538 begin539 inherited;540 Caption := 'TBGRABitmap PaintBox';541 BGRABitmap := TBGRABitmap.Create(0, 0);542 PaintObject := poPaintBox;543 end;544 545 destructor TBGRABitmapPaintBox.Destroy;546 begin547 BGRABitmap.Free;548 inherited Destroy;549 end;550 551 procedure TBGRABitmapPaintBox.DrawFrame(FastBitmap: TFastBitmap);552 var553 X, Y: Integer;554 P: PCardinal;555 begin556 with FastBitmap do557 for Y := 0 to Size.Y - 1 do begin558 P := PCardinal(BGRABitmap.ScanLine[Y]);559 for X := 0 to Size.X - 1 do begin560 P^ := NoSwapBRComponent(Pixels[X, Y]) or $ff000000;561 //P^ := Pixels[X, Y] or $ff000000;562 (*P^.red := Pixels[X, Y];563 P^.green := Pixels[X, Y];564 P^.blue := Pixels[X, Y];565 P^.alpha := 255; *)566 Inc(P);567 end;568 end;569 BGRABitmap.InvalidateBitmap; // changed by direct access570 PaintBox.Repaint;571 end;572 573 { TBitmapRawImageDataPaintBox }574 575 constructor TBitmapRawImageDataPaintBox.Create;576 begin577 inherited;578 Caption := 'TBitmap.RawImage.Data PaintBox';579 PaintObject := poPaintBox;580 end;581 582 procedure TBitmapRawImageDataPaintBox.Paint(Sender: TObject);583 var584 hPaint, hBmp: HDC;585 begin586 hBmp := TempBitmap.Canvas.Handle;587 hPaint := PaintBox.Canvas.Handle;588 PaintBox.Canvas.CopyRect(Rect(0, 0, PaintBox.Width, PaintBox.Height), TempBitmap.Canvas,589 Rect(0, 0, TempBitmap.Width, TempBitmap.Height));590 // PaintBox.Canvas.Draw(0, 0, TempBitmap);591 //BitBlt(hPaint, 0, 0, TempBitmap.Width, TempBitmap.Height, hBmp, 0, 0, srcCopy);592 end;593 594 procedure TBitmapRawImageDataPaintBox.DrawFrame(FastBitmap: TFastBitmap);595 var596 Y, X: Integer;597 PixelPtr: PCardinal;598 RowPtr: PCardinal;599 P: TPixelFormat;600 RawImage: TRawImage;601 BytePerPixel: Integer;602 BytePerRow: Integer;603 begin604 P := TempBitmap.PixelFormat;605 with FastBitmap do606 try607 TempBitmap.BeginUpdate(False);608 RawImage := TempBitmap.RawImage;609 RowPtr := PCardinal(RawImage.Data);610 BytePerPixel := RawImage.Description.BitsPerPixel div 8;611 BytePerRow := RawImage.Description.BytesPerLine;612 for Y := 0 to Size.Y - 1 do begin613 PixelPtr := RowPtr;614 for X := 0 to Size.X - 1 do begin615 PixelPtr^ := Pixels[X, Y];616 Inc(PByte(PixelPtr), BytePerPixel);617 end;618 Inc(PByte(RowPtr), BytePerRow);619 end;620 finally621 TempBitmap.EndUpdate(False);622 end;623 PaintBox.Repaint;624 end;625 626 { TBitmapRawImageData }627 628 constructor TBitmapRawImageData.Create;629 begin630 inherited;631 Caption := 'TBitmap.RawImage.Data';632 end;633 634 procedure TBitmapRawImageData.DrawFrame(FastBitmap: TFastBitmap);635 var636 Y, X: Integer;637 PixelPtr: PCardinal;638 RowPtr: PCardinal;639 P: TPixelFormat;640 RawImage: TRawImage;641 BytePerPixel: Integer;642 BytePerRow: Integer;643 begin644 P := Image.Picture.Bitmap.PixelFormat;645 with FastBitmap do646 try647 Image.Picture.Bitmap.BeginUpdate(False);648 RawImage := Image.Picture.Bitmap.RawImage;649 RowPtr := PCardinal(RawImage.Data);650 BytePerPixel := RawImage.Description.BitsPerPixel div 8;651 BytePerRow := RawImage.Description.BytesPerLine;652 for Y := 0 to Size.Y - 1 do begin653 PixelPtr := RowPtr;654 for X := 0 to Size.X - 1 do begin655 PixelPtr^ := Pixels[X, Y];656 Inc(PByte(PixelPtr), BytePerPixel);657 end;658 Inc(PByte(RowPtr), BytePerRow);659 end;660 finally661 Image.Picture.Bitmap.EndUpdate(False);662 end;663 end;664 665 { TLazIntfImageColorsNoCopy }666 667 procedure TLazIntfImageColorsNoCopy.Init(Parent: TWinControl; Size: TPoint);668 begin669 inherited Init(Parent, Size);670 TempIntfImage.Free;671 TempIntfImage := Image.Picture.Bitmap.CreateIntfImage;672 end;673 674 constructor TLazIntfImageColorsNoCopy.Create;675 begin676 inherited;677 Caption := 'TLazIntfImage.Colors no copy';678 end;679 680 destructor TLazIntfImageColorsNoCopy.Destroy;681 begin682 TempIntfImage.Free;683 inherited Destroy;684 end;685 686 procedure TLazIntfImageColorsNoCopy.DrawFrame(FastBitmap: TFastBitmap);687 var688 Y, X: Integer;689 begin690 with FastBitmap do begin691 for X := 0 to Size.X - 1 do692 for Y := 0 to Size.Y - 1 do693 TempIntfImage.Colors[X, Y] := TColorToFPColor(SwapBRComponent(Pixels[X, Y]));694 Image.Picture.Bitmap.LoadFromIntfImage(TempIntfImage);695 end;696 end;697 698 { TLazIntfImageColorsCopy }699 700 constructor TLazIntfImageColorsCopy.Create;701 begin702 inherited;703 Caption := 'TLazIntfImage.Colors copy';704 TempIntfImage := TLazIntfImage.Create(0, 0);705 end;706 707 destructor TLazIntfImageColorsCopy.Destroy;708 begin709 TempIntfImage.Free;710 inherited Destroy;711 end;712 713 procedure TLazIntfImageColorsCopy.DrawFrame(FastBitmap: TFastBitmap);714 var715 Y, X: Integer;716 begin717 with FastBitmap do begin718 TempIntfImage.LoadFromBitmap(Image.Picture.Bitmap.Handle,719 Image.Picture.Bitmap.MaskHandle);720 for X := 0 to Size.X - 1 do721 for Y := 0 to Size.Y - 1 do722 TempIntfImage.Colors[X, Y] := TColorToFPColor(SwapBRComponent(Pixels[X, Y]));723 Image.Picture.Bitmap.LoadFromIntfImage(TempIntfImage);724 end;725 end;726 727 { TCanvasPixelsUpdateLock }728 729 constructor TCanvasPixelsUpdateLock.Create;730 begin731 inherited;732 Caption := 'TBitmap.Canvas.Pixels Update locking';733 end;734 735 procedure TCanvasPixelsUpdateLock.DrawFrame(FastBitmap: TFastBitmap);736 var737 Y, X: Integer;738 begin739 with FastBitmap do740 try741 Image.Picture.Bitmap.BeginUpdate(True);742 for Y := 0 to Size.Y - 1 do743 for X := 0 to Size.X - 1 do744 Image.Picture.Bitmap.Canvas.Pixels[X, Y] := TColor(SwapBRComponent(Pixels[X, Y]));745 finally746 Image.Picture.Bitmap.EndUpdate(False);747 end;748 end;749 750 { TCanvasPixels }751 752 constructor TCanvasPixels.Create;753 begin754 inherited;755 Caption := 'TBitmap.Canvas.Pixels';756 end;757 758 procedure TCanvasPixels.DrawFrame(FastBitmap: TFastBitmap);759 var760 Y, X: Integer;761 begin762 with FastBitmap do begin763 for Y := 0 to Size.Y - 1 do764 for X := 0 to Size.X - 1 do765 Image.Picture.Bitmap.Canvas.Pixels[X, Y] := TColor(SwapBRComponent(Pixels[X, Y]));766 end;767 end;768 172 769 173 { TDrawMethod } … … 783 187 begin 784 188 TempBitmap := TBitmap.Create; 189 Description := TStringList.Create; 785 190 end; 786 191 787 192 destructor TDrawMethod.Destroy; 788 193 begin 194 FreeAndNil(Description); 789 195 FreeAndNil(TempBitmap); 790 196 inherited Destroy; -
GraphicTest/UMainForm.lfm
r446 r447 1 1 object MainForm: TMainForm 2 Left = 3363 Height = 3084 Top = 1 945 Width = 5542 Left = 165 3 Height = 411 4 Top = 117 5 Width = 846 6 6 Caption = 'Graphic test' 7 ClientHeight = 3088 ClientWidth = 5547 ClientHeight = 411 8 ClientWidth = 846 9 9 OnClose = FormClose 10 10 OnCreate = FormCreate … … 12 12 OnShow = FormShow 13 13 LCLVersion = '1.1' 14 object ListViewMethods: TListView 15 Left = 8 16 Height = 232 17 Top = 8 18 Width = 542 19 Anchors = [akTop, akLeft, akRight, akBottom] 20 Columns = < 21 item 22 Caption = 'Method' 23 Width = 200 24 end 25 item 26 Caption = 'Step draw duration [ms]' 27 Width = 80 28 end 29 item 30 Caption = 'FPS' 31 Width = 75 32 end 33 item 34 Caption = 'Total step duration [ms]' 35 Width = 80 36 end 37 item 38 Caption = 'Step FPS' 39 Width = 75 40 end> 41 OwnerData = True 42 ReadOnly = True 43 RowSelect = True 14 object PageControl1: TPageControl 15 Left = 544 16 Height = 411 17 Top = 0 18 Width = 302 19 ActivePage = TabSheet1 20 Align = alRight 21 TabIndex = 0 44 22 TabOrder = 0 45 ViewStyle = vsReport 46 OnData = ListViewMethodsData 47 OnSelectItem = ListViewMethodsSelectItem 23 object TabSheet1: TTabSheet 24 Caption = 'Description' 25 ClientHeight = 385 26 ClientWidth = 294 27 object Memo1: TMemo 28 Left = 0 29 Height = 385 30 Top = 0 31 Width = 294 32 Align = alClient 33 ReadOnly = True 34 ScrollBars = ssAutoBoth 35 TabOrder = 0 36 end 37 end 38 object TabSheet2: TTabSheet 39 Caption = 'Code' 40 ClientHeight = 385 41 ClientWidth = 294 42 inline SynMemo1: TSynMemo 43 Cursor = crIBeam 44 Left = 0 45 Height = 385 46 Top = 0 47 Width = 294 48 Align = alClient 49 Font.Height = -13 50 Font.Name = 'Courier New' 51 Font.Pitch = fpFixed 52 Font.Quality = fqNonAntialiased 53 ParentColor = False 54 ParentFont = False 55 TabOrder = 0 56 Gutter.Width = 57 57 Gutter.MouseActions = <> 58 Highlighter = SynPasSyn1 59 Keystrokes = < 60 item 61 Command = ecUp 62 ShortCut = 38 63 end 64 item 65 Command = ecSelUp 66 ShortCut = 8230 67 end 68 item 69 Command = ecScrollUp 70 ShortCut = 16422 71 end 72 item 73 Command = ecDown 74 ShortCut = 40 75 end 76 item 77 Command = ecSelDown 78 ShortCut = 8232 79 end 80 item 81 Command = ecScrollDown 82 ShortCut = 16424 83 end 84 item 85 Command = ecLeft 86 ShortCut = 37 87 end 88 item 89 Command = ecSelLeft 90 ShortCut = 8229 91 end 92 item 93 Command = ecWordLeft 94 ShortCut = 16421 95 end 96 item 97 Command = ecSelWordLeft 98 ShortCut = 24613 99 end 100 item 101 Command = ecRight 102 ShortCut = 39 103 end 104 item 105 Command = ecSelRight 106 ShortCut = 8231 107 end 108 item 109 Command = ecWordRight 110 ShortCut = 16423 111 end 112 item 113 Command = ecSelWordRight 114 ShortCut = 24615 115 end 116 item 117 Command = ecPageDown 118 ShortCut = 34 119 end 120 item 121 Command = ecSelPageDown 122 ShortCut = 8226 123 end 124 item 125 Command = ecPageBottom 126 ShortCut = 16418 127 end 128 item 129 Command = ecSelPageBottom 130 ShortCut = 24610 131 end 132 item 133 Command = ecPageUp 134 ShortCut = 33 135 end 136 item 137 Command = ecSelPageUp 138 ShortCut = 8225 139 end 140 item 141 Command = ecPageTop 142 ShortCut = 16417 143 end 144 item 145 Command = ecSelPageTop 146 ShortCut = 24609 147 end 148 item 149 Command = ecLineStart 150 ShortCut = 36 151 end 152 item 153 Command = ecSelLineStart 154 ShortCut = 8228 155 end 156 item 157 Command = ecEditorTop 158 ShortCut = 16420 159 end 160 item 161 Command = ecSelEditorTop 162 ShortCut = 24612 163 end 164 item 165 Command = ecLineEnd 166 ShortCut = 35 167 end 168 item 169 Command = ecSelLineEnd 170 ShortCut = 8227 171 end 172 item 173 Command = ecEditorBottom 174 ShortCut = 16419 175 end 176 item 177 Command = ecSelEditorBottom 178 ShortCut = 24611 179 end 180 item 181 Command = ecToggleMode 182 ShortCut = 45 183 end 184 item 185 Command = ecCopy 186 ShortCut = 16429 187 end 188 item 189 Command = ecPaste 190 ShortCut = 8237 191 end 192 item 193 Command = ecDeleteChar 194 ShortCut = 46 195 end 196 item 197 Command = ecCut 198 ShortCut = 8238 199 end 200 item 201 Command = ecDeleteLastChar 202 ShortCut = 8 203 end 204 item 205 Command = ecDeleteLastChar 206 ShortCut = 8200 207 end 208 item 209 Command = ecDeleteLastWord 210 ShortCut = 16392 211 end 212 item 213 Command = ecUndo 214 ShortCut = 32776 215 end 216 item 217 Command = ecRedo 218 ShortCut = 40968 219 end 220 item 221 Command = ecLineBreak 222 ShortCut = 13 223 end 224 item 225 Command = ecSelectAll 226 ShortCut = 16449 227 end 228 item 229 Command = ecCopy 230 ShortCut = 16451 231 end 232 item 233 Command = ecBlockIndent 234 ShortCut = 24649 235 end 236 item 237 Command = ecLineBreak 238 ShortCut = 16461 239 end 240 item 241 Command = ecInsertLine 242 ShortCut = 16462 243 end 244 item 245 Command = ecDeleteWord 246 ShortCut = 16468 247 end 248 item 249 Command = ecBlockUnindent 250 ShortCut = 24661 251 end 252 item 253 Command = ecPaste 254 ShortCut = 16470 255 end 256 item 257 Command = ecCut 258 ShortCut = 16472 259 end 260 item 261 Command = ecDeleteLine 262 ShortCut = 16473 263 end 264 item 265 Command = ecDeleteEOL 266 ShortCut = 24665 267 end 268 item 269 Command = ecUndo 270 ShortCut = 16474 271 end 272 item 273 Command = ecRedo 274 ShortCut = 24666 275 end 276 item 277 Command = ecGotoMarker0 278 ShortCut = 16432 279 end 280 item 281 Command = ecGotoMarker1 282 ShortCut = 16433 283 end 284 item 285 Command = ecGotoMarker2 286 ShortCut = 16434 287 end 288 item 289 Command = ecGotoMarker3 290 ShortCut = 16435 291 end 292 item 293 Command = ecGotoMarker4 294 ShortCut = 16436 295 end 296 item 297 Command = ecGotoMarker5 298 ShortCut = 16437 299 end 300 item 301 Command = ecGotoMarker6 302 ShortCut = 16438 303 end 304 item 305 Command = ecGotoMarker7 306 ShortCut = 16439 307 end 308 item 309 Command = ecGotoMarker8 310 ShortCut = 16440 311 end 312 item 313 Command = ecGotoMarker9 314 ShortCut = 16441 315 end 316 item 317 Command = ecSetMarker0 318 ShortCut = 24624 319 end 320 item 321 Command = ecSetMarker1 322 ShortCut = 24625 323 end 324 item 325 Command = ecSetMarker2 326 ShortCut = 24626 327 end 328 item 329 Command = ecSetMarker3 330 ShortCut = 24627 331 end 332 item 333 Command = ecSetMarker4 334 ShortCut = 24628 335 end 336 item 337 Command = ecSetMarker5 338 ShortCut = 24629 339 end 340 item 341 Command = ecSetMarker6 342 ShortCut = 24630 343 end 344 item 345 Command = ecSetMarker7 346 ShortCut = 24631 347 end 348 item 349 Command = ecSetMarker8 350 ShortCut = 24632 351 end 352 item 353 Command = ecSetMarker9 354 ShortCut = 24633 355 end 356 item 357 Command = EcFoldLevel1 358 ShortCut = 41009 359 end 360 item 361 Command = EcFoldLevel2 362 ShortCut = 41010 363 end 364 item 365 Command = EcFoldLevel1 366 ShortCut = 41011 367 end 368 item 369 Command = EcFoldLevel1 370 ShortCut = 41012 371 end 372 item 373 Command = EcFoldLevel1 374 ShortCut = 41013 375 end 376 item 377 Command = EcFoldLevel6 378 ShortCut = 41014 379 end 380 item 381 Command = EcFoldLevel7 382 ShortCut = 41015 383 end 384 item 385 Command = EcFoldLevel8 386 ShortCut = 41016 387 end 388 item 389 Command = EcFoldLevel9 390 ShortCut = 41017 391 end 392 item 393 Command = EcFoldLevel0 394 ShortCut = 41008 395 end 396 item 397 Command = EcFoldCurrent 398 ShortCut = 41005 399 end 400 item 401 Command = EcUnFoldCurrent 402 ShortCut = 41003 403 end 404 item 405 Command = EcToggleMarkupWord 406 ShortCut = 32845 407 end 408 item 409 Command = ecNormalSelect 410 ShortCut = 24654 411 end 412 item 413 Command = ecColumnSelect 414 ShortCut = 24643 415 end 416 item 417 Command = ecLineSelect 418 ShortCut = 24652 419 end 420 item 421 Command = ecTab 422 ShortCut = 9 423 end 424 item 425 Command = ecShiftTab 426 ShortCut = 8201 427 end 428 item 429 Command = ecMatchBracket 430 ShortCut = 24642 431 end 432 item 433 Command = ecColSelUp 434 ShortCut = 40998 435 end 436 item 437 Command = ecColSelDown 438 ShortCut = 41000 439 end 440 item 441 Command = ecColSelLeft 442 ShortCut = 40997 443 end 444 item 445 Command = ecColSelRight 446 ShortCut = 40999 447 end 448 item 449 Command = ecColSelPageDown 450 ShortCut = 40994 451 end 452 item 453 Command = ecColSelPageBottom 454 ShortCut = 57378 455 end 456 item 457 Command = ecColSelPageUp 458 ShortCut = 40993 459 end 460 item 461 Command = ecColSelPageTop 462 ShortCut = 57377 463 end 464 item 465 Command = ecColSelLineStart 466 ShortCut = 40996 467 end 468 item 469 Command = ecColSelLineEnd 470 ShortCut = 40995 471 end 472 item 473 Command = ecColSelEditorTop 474 ShortCut = 57380 475 end 476 item 477 Command = ecColSelEditorBottom 478 ShortCut = 57379 479 end> 480 MouseActions = <> 481 MouseSelActions = <> 482 SelectedColor.BackPriority = 50 483 SelectedColor.ForePriority = 50 484 SelectedColor.FramePriority = 50 485 SelectedColor.BoldPriority = 50 486 SelectedColor.ItalicPriority = 50 487 SelectedColor.UnderlinePriority = 50 488 inline SynLeftGutterPartList1: TSynGutterPartList 489 object SynGutterMarks1: TSynGutterMarks 490 Width = 24 491 MouseActions = <> 492 end 493 object SynGutterLineNumber1: TSynGutterLineNumber 494 Width = 17 495 MouseActions = <> 496 MarkupInfo.Background = clBtnFace 497 MarkupInfo.Foreground = clNone 498 DigitCount = 2 499 ShowOnlyLineNumbersMultiplesOf = 1 500 ZeroStart = False 501 LeadingZeros = False 502 end 503 object SynGutterChanges1: TSynGutterChanges 504 Width = 4 505 MouseActions = <> 506 ModifiedColor = 59900 507 SavedColor = clGreen 508 end 509 object SynGutterSeparator1: TSynGutterSeparator 510 Width = 2 511 MouseActions = <> 512 end 513 object SynGutterCodeFolding1: TSynGutterCodeFolding 514 MouseActions = <> 515 MarkupInfo.Background = clNone 516 MarkupInfo.Foreground = clGray 517 MouseActionsExpanded = <> 518 MouseActionsCollapsed = <> 519 end 520 end 521 end 522 end 48 523 end 49 object ButtonSingleTest: TButton 50 Left = 8 51 Height = 25 52 Top = 247 53 Width = 115 54 Anchors = [akLeft, akBottom] 55 Caption = 'Test one method' 56 OnClick = ButtonSingleTestClick 524 object Panel1: TPanel 525 Left = 0 526 Height = 411 527 Top = 0 528 Width = 539 529 Align = alClient 530 BevelOuter = bvNone 531 ClientHeight = 411 532 ClientWidth = 539 57 533 TabOrder = 1 534 object ListViewMethods: TListView 535 Left = 8 536 Height = 335 537 Top = 8 538 Width = 528 539 Anchors = [akTop, akLeft, akRight, akBottom] 540 Columns = < 541 item 542 Caption = 'Method' 543 Width = 200 544 end 545 item 546 Caption = 'Step draw duration [ms]' 547 Width = 80 548 end 549 item 550 Caption = 'FPS' 551 Width = 75 552 end 553 item 554 Caption = 'Total step duration [ms]' 555 Width = 80 556 end 557 item 558 Caption = 'Step FPS' 559 Width = 75 560 end> 561 OwnerData = True 562 ReadOnly = True 563 RowSelect = True 564 TabOrder = 0 565 ViewStyle = vsReport 566 OnData = ListViewMethodsData 567 OnSelectItem = ListViewMethodsSelectItem 568 end 569 object ButtonSingleTest: TButton 570 Left = 8 571 Height = 25 572 Top = 350 573 Width = 115 574 Anchors = [akLeft, akBottom] 575 Caption = 'Test one method' 576 OnClick = ButtonSingleTestClick 577 TabOrder = 1 578 end 579 object ButtonBenchmark: TButton 580 Left = 136 581 Height = 25 582 Top = 350 583 Width = 112 584 Anchors = [akLeft, akBottom] 585 Caption = 'Test all methods' 586 OnClick = ButtonBenchmarkClick 587 TabOrder = 2 588 end 589 object FloatSpinEdit1: TFloatSpinEdit 590 Left = 88 591 Height = 21 592 Top = 382 593 Width = 58 594 Anchors = [akLeft, akBottom] 595 Increment = 1 596 MaxValue = 100 597 MinValue = 0 598 TabOrder = 3 599 Value = 1 600 end 601 object ButtonStop: TButton 602 Left = 256 603 Height = 25 604 Top = 350 605 Width = 75 606 Anchors = [akLeft, akBottom] 607 Caption = 'Stop' 608 OnClick = ButtonStopClick 609 TabOrder = 4 610 end 611 object Label1: TLabel 612 Left = 8 613 Height = 13 614 Top = 386 615 Width = 69 616 Anchors = [akLeft, akBottom] 617 Caption = 'Step duration:' 618 ParentColor = False 619 end 620 object Label2: TLabel 621 Left = 152 622 Height = 13 623 Top = 386 624 Width = 5 625 Anchors = [akLeft, akBottom] 626 Caption = 's' 627 ParentColor = False 628 end 629 object SpinEditWidth: TSpinEdit 630 Left = 219 631 Height = 21 632 Top = 382 633 Width = 58 634 Anchors = [akLeft, akBottom] 635 MaxValue = 1000 636 OnChange = SpinEditWidthChange 637 TabOrder = 5 638 Value = 320 639 end 640 object SpinEditHeight: TSpinEdit 641 Left = 288 642 Height = 21 643 Top = 382 644 Width = 58 645 Anchors = [akLeft, akBottom] 646 MaxValue = 1000 647 OnChange = SpinEditHeightChange 648 TabOrder = 6 649 Value = 240 650 end 651 object Label3: TLabel 652 Left = 184 653 Height = 13 654 Top = 387 655 Width = 23 656 Anchors = [akLeft, akBottom] 657 Caption = 'Size:' 658 ParentColor = False 659 end 660 object Label4: TLabel 661 Left = 280 662 Height = 13 663 Top = 386 664 Width = 6 665 Anchors = [akLeft, akBottom] 666 Caption = 'x' 667 ParentColor = False 668 end 669 object CheckBoxDoubleBuffered: TCheckBox 670 Left = 408 671 Height = 17 672 Top = 350 673 Width = 98 674 Anchors = [akLeft, akBottom] 675 Caption = 'Double buffered' 676 OnChange = CheckBoxDoubleBufferedChange 677 TabOrder = 7 678 end 679 object CheckBoxEraseBackground: TCheckBox 680 Left = 408 681 Height = 17 682 Top = 367 683 Width = 106 684 Anchors = [akLeft, akBottom] 685 Caption = 'Erase background' 686 OnChange = CheckBoxEraseBackgroundChange 687 TabOrder = 8 688 end 58 689 end 59 object ButtonBenchmark: TButton 60 Left = 136 61 Height = 25 62 Top = 247 63 Width = 112 64 Anchors = [akLeft, akBottom] 65 Caption = 'Test all methods' 66 OnClick = ButtonBenchmarkClick 67 TabOrder = 2 690 object Splitter1: TSplitter 691 Left = 539 692 Height = 411 693 Top = 0 694 Width = 5 695 Align = alRight 696 ResizeAnchor = akRight 68 697 end 69 object FloatSpinEdit1: TFloatSpinEdit 70 Left = 88 71 Height = 21 72 Top = 279 73 Width = 58 74 Anchors = [akLeft, akBottom] 75 Increment = 1 76 MaxValue = 100 77 MinValue = 0 78 TabOrder = 3 79 Value = 1 80 end 81 object ButtonStop: TButton 82 Left = 256 83 Height = 25 84 Top = 247 85 Width = 75 86 Anchors = [akLeft, akBottom] 87 Caption = 'Stop' 88 OnClick = ButtonStopClick 89 TabOrder = 4 90 end 91 object Label1: TLabel 92 Left = 8 93 Height = 13 94 Top = 283 95 Width = 69 96 Anchors = [akLeft, akBottom] 97 Caption = 'Step duration:' 98 ParentColor = False 99 end 100 object Label2: TLabel 101 Left = 152 102 Height = 13 103 Top = 283 104 Width = 5 105 Anchors = [akLeft, akBottom] 106 Caption = 's' 107 ParentColor = False 108 end 109 object SpinEditWidth: TSpinEdit 110 Left = 219 111 Height = 21 112 Top = 279 113 Width = 58 114 Anchors = [akLeft, akBottom] 115 MaxValue = 1000 116 OnChange = SpinEditWidthChange 117 TabOrder = 5 118 Value = 320 119 end 120 object SpinEditHeight: TSpinEdit 121 Left = 288 122 Height = 21 123 Top = 279 124 Width = 58 125 Anchors = [akLeft, akBottom] 126 MaxValue = 1000 127 OnChange = SpinEditHeightChange 128 TabOrder = 6 129 Value = 240 130 end 131 object Label3: TLabel 132 Left = 184 133 Height = 13 134 Top = 284 135 Width = 23 136 Anchors = [akLeft, akBottom] 137 Caption = 'Size:' 138 ParentColor = False 139 end 140 object Label4: TLabel 141 Left = 280 142 Height = 13 143 Top = 283 144 Width = 6 145 Anchors = [akLeft, akBottom] 146 Caption = 'x' 147 ParentColor = False 148 end 149 object CheckBoxDoubleBuffered: TCheckBox 150 Left = 408 151 Height = 17 152 Top = 247 153 Width = 98 154 Anchors = [akLeft, akBottom] 155 Caption = 'Double buffered' 156 OnChange = CheckBoxDoubleBufferedChange 157 TabOrder = 7 158 end 159 object CheckBoxEraseBackground: TCheckBox 160 Left = 408 161 Height = 17 162 Top = 264 163 Width = 106 164 Anchors = [akLeft, akBottom] 165 Caption = 'Erase background' 166 OnChange = CheckBoxEraseBackgroundChange 167 TabOrder = 8 698 object SynPasSyn1: TSynPasSyn 699 Enabled = False 700 AsmAttri.FrameEdges = sfeAround 701 CommentAttri.FrameEdges = sfeAround 702 IDEDirectiveAttri.FrameEdges = sfeAround 703 IdentifierAttri.FrameEdges = sfeAround 704 KeyAttri.FrameEdges = sfeAround 705 NumberAttri.FrameEdges = sfeAround 706 SpaceAttri.FrameEdges = sfeAround 707 StringAttri.FrameEdges = sfeAround 708 SymbolAttri.FrameEdges = sfeAround 709 CaseLabelAttri.FrameEdges = sfeAround 710 DirectiveAttri.FrameEdges = sfeAround 711 CompilerMode = pcmDelphi 712 NestedComments = False 713 left = 649 714 top = 86 168 715 end 169 716 object TimerUpdateList: TTimer 170 717 Interval = 500 171 718 OnTimer = TimerUpdateListTimer 172 left = 2 38173 top = 1 36719 left = 266 720 top = 164 174 721 end 175 722 end -
GraphicTest/UMainForm.pas
r446 r447 6 6 7 7 uses 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, 9 ExtCtrls, StdCtrls, DateUtils, UPlatform, LCLType, IntfGraphics, fpImage, 10 Math, GraphType, Contnrs, LclIntf, Spin, UFastBitmap, UDrawMethod; 8 Classes, SysUtils, FileUtil, SynHighlighterPas, SynMemo, Forms, Controls, 9 Graphics, Dialogs, ComCtrls, ExtCtrls, StdCtrls, DateUtils, UPlatform, 10 LCLType, IntfGraphics, fpImage, Math, GraphType, Contnrs, LclIntf, Spin, 11 UFastBitmap, UDrawMethod; 11 12 12 13 const … … 15 16 type 16 17 17 18 18 { TMainForm } 19 19 20 20 TMainForm = class(TForm) 21 ButtonStop: TButton;22 21 ButtonBenchmark: TButton; 23 22 ButtonSingleTest: TButton; 23 ButtonStop: TButton; 24 CheckBoxDoubleBuffered: TCheckBox; 24 25 CheckBoxEraseBackground: TCheckBox; 25 CheckBoxDoubleBuffered: TCheckBox;26 26 FloatSpinEdit1: TFloatSpinEdit; 27 27 Label1: TLabel; … … 30 30 Label4: TLabel; 31 31 ListViewMethods: TListView; 32 Memo1: TMemo; 33 PageControl1: TPageControl; 34 Panel1: TPanel; 35 SpinEditHeight: TSpinEdit; 32 36 SpinEditWidth: TSpinEdit; 33 SpinEditHeight: TSpinEdit; 37 Splitter1: TSplitter; 38 SynMemo1: TSynMemo; 39 SynPasSyn1: TSynPasSyn; 40 TabSheet1: TTabSheet; 41 TabSheet2: TTabSheet; 34 42 TimerUpdateList: TTimer; 35 43 procedure ButtonBenchmarkClick(Sender: TObject); … … 74 82 75 83 uses 76 UDrawForm; 84 UDrawForm, ULazIntfImageColorsCopy, ULazIntfImageColorsNoCopy, UCanvasPixels, 85 UCanvasPixelsUpdateLock, UBGRABitmapPaintBox, UBitmapRawImageDataPaintBox, 86 UBitmapRawImageData, UBitmapRawImageDataMove, UDummyMethod, UOpenGLMethod, 87 UOpenGLPBOMethod; 88 89 const 90 DrawMethodClasses: array[0..{$IFDEF opengl}10{$ELSE}8{$ENDIF}] of TDrawMethodClass = ( 91 TCanvasPixels, TCanvasPixelsUpdateLock, TLazIntfImageColorsCopy, 92 TLazIntfImageColorsNoCopy, TBitmapRawImageData, TBitmapRawImageDataPaintBox, 93 TBitmapRawImageDataMove, TBGRABitmapPaintBox{$IFDEF opengl}, TOpenGLMethod, TOpenGLPBOMethod{$ENDIF} 94 ,TDummyMethod); 95 77 96 78 97 … … 94 113 DrawMethods.Add(NewDrawMethod); 95 114 end; 115 116 PageControl1.TabIndex := 0; 96 117 end; 97 118 … … 213 234 procedure TMainForm.ListViewMethodsSelectItem(Sender: TObject; Item: TListItem; 214 235 Selected: Boolean); 236 var 237 FileName: string; 215 238 begin 216 239 UpdateInterface; 240 if Assigned(ListViewMethods.Selected) then begin 241 FileName := 'Methods' + DirectorySeparator + 'U' + 242 Copy(TDrawMethod(DrawMethods[ListViewMethods.Selected.Index]).ClassName, 2, High(Integer)) + '.pas'; 243 244 if FileExistsUTF8(FileName) then 245 SynMemo1.Lines.LoadFromFile(FileName) 246 else SynMemo1.Lines.Clear; 247 Memo1.Lines.Assign(TDrawMethod(DrawMethods[ListViewMethods.Selected.Index]).Description); 248 end; 217 249 end; 218 250
Note:
See TracChangeset
for help on using the changeset viewer.