Changeset 447


Ignore:
Timestamp:
Nov 22, 2012, 2:32:10 PM (12 years ago)
Author:
chronos
Message:
  • Modified: Each methods separated to own unit. Code from unit is displayed to user in main form after method selection.
Location:
GraphicTest
Files:
12 added
5 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/GraphicTest.lpi

    r446 r447  
    6666      </local>
    6767    </RunParams>
    68     <RequiredPackages Count="3">
     68    <RequiredPackages Count="4">
    6969      <Item1>
    70         <PackageName Value="bgrabitmappack"/>
     70        <PackageName Value="SynEdit"/>
    7171      </Item1>
    7272      <Item2>
    73         <PackageName Value="lazopenglcontext"/>
     73        <PackageName Value="bgrabitmappack"/>
    7474      </Item2>
    7575      <Item3>
     76        <PackageName Value="lazopenglcontext"/>
     77      </Item3>
     78      <Item4>
    7679        <PackageName Value="LCL"/>
    77       </Item3>
     80      </Item4>
    7881    </RequiredPackages>
    79     <Units Count="6">
     82    <Units Count="17">
    8083      <Unit0>
    8184        <Filename Value="GraphicTest.lpr"/>
    … …  
    113116        <UnitName Value="UDrawForm"/>
    114117      </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>
    115173    </Units>
    116174  </ProjectOptions>
    … …  
    122180    <SearchPaths>
    123181      <IncludeFiles Value="$(ProjOutDir)"/>
     182      <OtherUnitFiles Value="Methods"/>
    124183      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
    125184    </SearchPaths>

  • GraphicTest/GraphicTest.lpr

    r443 r447  
    99  Interfaces, // this includes the LCL widgetset
    1010  Forms, lazopenglcontext, UMainForm, UPlatform, UDrawMethod, UFastBitmap,
    11   bgrabitmappack, UDrawForm;
     11  bgrabitmappack, UDrawForm, UCanvasPixels, UCanvasPixelsUpdateLock,
     12  ULazIntfImageColorsCopy, ULazIntfImageColorsNoCopy, UBGRABitmapPaintBox,
     13UBitmapRawImageDataPaintBox, UBitmapRawImageData, UDummyMethod,
     14UBitmapRawImageDataMove, UOpenGLMethod, UOpenGLPBOMethod;
    1215
    1316{$R *.res}

  • GraphicTest/UDrawMethod.pas

    r443 r447  
    77uses
    88  Classes, SysUtils, ExtCtrls, UPlatform, UFastBitmap, Graphics, Controls,
    9   LCLType, IntfGraphics, fpImage, GraphType, BGRABitmap, BGRABitmapTypes,
     9  LCLType, IntfGraphics, fpImage, GraphType,
    1010  LclIntf{$IFDEF opengl}, GL, GLExt, OpenGLContext{$ENDIF};
    1111
    … …  
    1919  private
    2020    FControl: TControl;
    21     TempBitmap: TBitmap;
    2221  public
    2322    Caption: string;
     23    Description: TStringList;
    2424    Terminated: Boolean;
    2525    FrameDuration: TDateTime;
    2626    StepDuration: TDateTime;
    2727    PaintObject: TPaintObject;
     28    TempBitmap: TBitmap;
    2829    procedure Init(Parent: TWinControl; Size: TPoint); virtual;
    2930    procedure Done; virtual;
    … …  
    5253    procedure Init(Parent: TWinControl; Size: TPoint); override;
    5354    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;
    12755  end;
    12856
    … …  
    14068  end;
    14169
    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;
    16070  {$ENDIF}
    16171
    162 const
    163   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);
    16872
    16973implementation
    … …  
    212116end;
    213117
    214 { TDummyMethod }
    215 
    216 constructor TDummyMethod.Create;
    217 begin
    218   inherited Create;
    219   Caption := 'Dummy';
    220 end;
    221 
    222 procedure TDummyMethod.DrawFrame(FastBitmap: TFastBitmap);
    223 begin
    224 end;
    225 
    226 { TBitmapRawImageDataMove }
    227 
    228 constructor TBitmapRawImageDataMove.Create;
    229 begin
    230   inherited;
    231   Caption := 'TBitmap.RawImage.Data Move';
    232 end;
    233 
    234 procedure TBitmapRawImageDataMove.DrawFrame(FastBitmap: TFastBitmap);
    235 var
    236   Y, X: Integer;
    237   PixelPtr: PInteger;
    238   RowPtr: PInteger;
    239   P: TPixelFormat;
    240   RawImage: TRawImage;
    241   BytePerPixel: Integer;
    242   BytePerRow: Integer;
    243 begin
    244   P := Image.Picture.Bitmap.PixelFormat;
    245     with FastBitmap do
    246     try
    247       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     finally
    254       Image.Picture.Bitmap.EndUpdate(False);
    255     end;
    256 end;
    257118
    258119{$IFDEF opengl}
    259 { TOpenGLPBOMethod }
    260 
    261 //procedure glGenBuffersARB2 : procedure(n : GLsizei; buffers : PGLuint); extdecl;
    262 
    263 procedure TOpenGLPBOMethod.Init(AParent: TWinControl; Size: TPoint);
    264 var
    265   DataSize: Integer;
    266   glExtensions: string;
    267 begin
    268   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') then
    274   if Load_GL_ARB_vertex_buffer_object then begin
    275     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 begin
    295   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 begin
    305   inherited Destroy;
    306 end;
    307 
    308 procedure TOpenGLPBOMethod.DrawFrame(FastBitmap: TFastBitmap);
    309 var
    310   X, Y: Integer;
    311   P: PCardinal;
    312   R: PCardinal;
    313   Ptr: ^GLubyte;
    314   TextureShift: TPoint;
    315   TextureShift2: TPoint;
    316 const
    317   GL_CLAMP_TO_EDGE = $812F;
    318 begin
    319   // "index" is used to read pixels from framebuffer to a PBO
    320   // "nextIndex" is used to update pixels in the other PBO
    321   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 PBO
    335   //glBindTexture(GL_TEXTURE_2D, textureId);
    336   glBindBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB, pboIds[index]);
    337 
    338   // copy pixels from PBO to texture object
    339   // 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 source
    345   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 call
    350   // first glBufferDataARB() with NULL pointer before glMapBufferARB().
    351   // If you do that, the previous data in PBO will be discarded and
    352   // glMapBufferARB() returns a new allocated pointer immediately
    353   // 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 memory
    357   ptr := glMapBufferARB(GL_PIXEL_UNPACK_BUFFER_ARB, GL_WRITE_ONLY_ARB);
    358   if Assigned(ptr) then begin
    359     // update data directly on the mapped buffer
    360     P := PCardinal(Ptr);
    361     with FastBitmap do
    362     for Y := 0 to Size.Y - 2 do begin
    363       R := P;
    364       for X := 0 to Size.X - 1 do begin
    365         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 begin
    403   inherited Create;
    404   Caption := 'OpenGL';
    405   PaintObject := poOpenGL;
    406 end;
    407 
    408 destructor TOpenGLMethod.Destroy;
    409 begin
    410   inherited Destroy;
    411 end;
    412 
    413 procedure TOpenGLMethod.DrawFrame(FastBitmap: TFastBitmap);
    414 var
    415   X, Y: Integer;
    416   P: PCardinal;
    417   R: PCardinal;
    418 const
    419   GL_CLAMP_TO_EDGE = $812F;
    420 begin
    421   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 do
    428   for Y := 0 to Size.Y - 1 do begin
    429     R := P;
    430     for X := 0 to Size.X - 1 do begin
    431       //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;
    471120
    472121{ TDrawMethodOpenGL }
    … …  
    521170{$ENDIF}
    522171
    523 { TBGRABitmapPaintBox }
    524 
    525 procedure TBGRABitmapPaintBox.Paint(Sender: TObject);
    526 begin
    527   //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 begin
    533   inherited Init(Parent, Size);
    534   BGRABitmap.SetSize(PaintBox.Width, PaintBox.Height);
    535 end;
    536 
    537 constructor TBGRABitmapPaintBox.Create;
    538 begin
    539   inherited;
    540   Caption := 'TBGRABitmap PaintBox';
    541   BGRABitmap := TBGRABitmap.Create(0, 0);
    542   PaintObject := poPaintBox;
    543 end;
    544 
    545 destructor TBGRABitmapPaintBox.Destroy;
    546 begin
    547   BGRABitmap.Free;
    548   inherited Destroy;
    549 end;
    550 
    551 procedure TBGRABitmapPaintBox.DrawFrame(FastBitmap: TFastBitmap);
    552 var
    553   X, Y: Integer;
    554   P: PCardinal;
    555 begin
    556   with FastBitmap do
    557   for Y := 0 to Size.Y - 1 do begin
    558     P := PCardinal(BGRABitmap.ScanLine[Y]);
    559     for X := 0 to Size.X - 1 do begin
    560       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 access
    570   PaintBox.Repaint;
    571 end;
    572 
    573 { TBitmapRawImageDataPaintBox }
    574 
    575 constructor TBitmapRawImageDataPaintBox.Create;
    576 begin
    577   inherited;
    578   Caption := 'TBitmap.RawImage.Data PaintBox';
    579   PaintObject := poPaintBox;
    580 end;
    581 
    582 procedure TBitmapRawImageDataPaintBox.Paint(Sender: TObject);
    583 var
    584   hPaint, hBmp: HDC;
    585 begin
    586   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 var
    596   Y, X: Integer;
    597   PixelPtr: PCardinal;
    598   RowPtr: PCardinal;
    599   P: TPixelFormat;
    600   RawImage: TRawImage;
    601   BytePerPixel: Integer;
    602   BytePerRow: Integer;
    603 begin
    604   P := TempBitmap.PixelFormat;
    605     with FastBitmap do
    606     try
    607       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 begin
    613         PixelPtr := RowPtr;
    614         for X := 0 to Size.X - 1 do begin
    615           PixelPtr^ := Pixels[X, Y];
    616           Inc(PByte(PixelPtr), BytePerPixel);
    617         end;
    618         Inc(PByte(RowPtr), BytePerRow);
    619       end;
    620     finally
    621       TempBitmap.EndUpdate(False);
    622     end;
    623   PaintBox.Repaint;
    624 end;
    625 
    626 { TBitmapRawImageData }
    627 
    628 constructor TBitmapRawImageData.Create;
    629 begin
    630   inherited;
    631   Caption := 'TBitmap.RawImage.Data';
    632 end;
    633 
    634 procedure TBitmapRawImageData.DrawFrame(FastBitmap: TFastBitmap);
    635 var
    636   Y, X: Integer;
    637   PixelPtr: PCardinal;
    638   RowPtr: PCardinal;
    639   P: TPixelFormat;
    640   RawImage: TRawImage;
    641   BytePerPixel: Integer;
    642   BytePerRow: Integer;
    643 begin
    644   P := Image.Picture.Bitmap.PixelFormat;
    645     with FastBitmap do
    646     try
    647       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 begin
    653         PixelPtr := RowPtr;
    654         for X := 0 to Size.X - 1 do begin
    655           PixelPtr^ := Pixels[X, Y];
    656           Inc(PByte(PixelPtr), BytePerPixel);
    657         end;
    658         Inc(PByte(RowPtr), BytePerRow);
    659       end;
    660     finally
    661       Image.Picture.Bitmap.EndUpdate(False);
    662     end;
    663 end;
    664 
    665 { TLazIntfImageColorsNoCopy }
    666 
    667 procedure TLazIntfImageColorsNoCopy.Init(Parent: TWinControl; Size: TPoint);
    668 begin
    669   inherited Init(Parent, Size);
    670   TempIntfImage.Free;
    671   TempIntfImage := Image.Picture.Bitmap.CreateIntfImage;
    672 end;
    673 
    674 constructor TLazIntfImageColorsNoCopy.Create;
    675 begin
    676   inherited;
    677   Caption := 'TLazIntfImage.Colors no copy';
    678 end;
    679 
    680 destructor TLazIntfImageColorsNoCopy.Destroy;
    681 begin
    682   TempIntfImage.Free;
    683   inherited Destroy;
    684 end;
    685 
    686 procedure TLazIntfImageColorsNoCopy.DrawFrame(FastBitmap: TFastBitmap);
    687 var
    688   Y, X: Integer;
    689 begin
    690   with FastBitmap do begin
    691     for X := 0 to Size.X - 1 do
    692       for Y := 0 to Size.Y - 1 do
    693         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 begin
    702   inherited;
    703   Caption := 'TLazIntfImage.Colors copy';
    704   TempIntfImage := TLazIntfImage.Create(0, 0);
    705 end;
    706 
    707 destructor TLazIntfImageColorsCopy.Destroy;
    708 begin
    709   TempIntfImage.Free;
    710   inherited Destroy;
    711 end;
    712 
    713 procedure TLazIntfImageColorsCopy.DrawFrame(FastBitmap: TFastBitmap);
    714 var
    715   Y, X: Integer;
    716 begin
    717   with FastBitmap do begin
    718     TempIntfImage.LoadFromBitmap(Image.Picture.Bitmap.Handle,
    719       Image.Picture.Bitmap.MaskHandle);
    720     for X := 0 to Size.X - 1 do
    721       for Y := 0 to Size.Y - 1 do
    722         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 begin
    731   inherited;
    732   Caption := 'TBitmap.Canvas.Pixels Update locking';
    733 end;
    734 
    735 procedure TCanvasPixelsUpdateLock.DrawFrame(FastBitmap: TFastBitmap);
    736 var
    737   Y, X: Integer;
    738 begin
    739   with FastBitmap do
    740   try
    741     Image.Picture.Bitmap.BeginUpdate(True);
    742     for Y := 0 to Size.Y - 1 do
    743       for X := 0 to Size.X - 1 do
    744         Image.Picture.Bitmap.Canvas.Pixels[X, Y] := TColor(SwapBRComponent(Pixels[X, Y]));
    745   finally
    746     Image.Picture.Bitmap.EndUpdate(False);
    747   end;
    748 end;
    749 
    750 { TCanvasPixels }
    751 
    752 constructor TCanvasPixels.Create;
    753 begin
    754   inherited;
    755   Caption := 'TBitmap.Canvas.Pixels';
    756 end;
    757 
    758 procedure TCanvasPixels.DrawFrame(FastBitmap: TFastBitmap);
    759 var
    760   Y, X: Integer;
    761 begin
    762   with FastBitmap do begin
    763     for Y := 0 to Size.Y - 1 do
    764       for X := 0 to Size.X - 1 do
    765         Image.Picture.Bitmap.Canvas.Pixels[X, Y] := TColor(SwapBRComponent(Pixels[X, Y]));
    766   end;
    767 end;
    768172
    769173{ TDrawMethod }
    … …  
    783187begin
    784188  TempBitmap := TBitmap.Create;
     189  Description := TStringList.Create;
    785190end;
    786191
    787192destructor TDrawMethod.Destroy;
    788193begin
     194  FreeAndNil(Description);
    789195  FreeAndNil(TempBitmap);
    790196  inherited Destroy;

  • GraphicTest/UMainForm.lfm

    r446 r447  
    11object MainForm: TMainForm
    2   Left = 336
    3   Height = 308
    4   Top = 194
    5   Width = 554
     2  Left = 165
     3  Height = 411
     4  Top = 117
     5  Width = 846
    66  Caption = 'Graphic test'
    7   ClientHeight = 308
    8   ClientWidth = 554
     7  ClientHeight = 411
     8  ClientWidth = 846
    99  OnClose = FormClose
    1010  OnCreate = FormCreate
    … …  
    1212  OnShow = FormShow
    1313  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
    4422    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
    48523  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
    57533    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
    58689  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
    68697  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
    168715  end
    169716  object TimerUpdateList: TTimer
    170717    Interval = 500
    171718    OnTimer = TimerUpdateListTimer
    172     left = 238
    173     top = 136
     719    left = 266
     720    top = 164
    174721  end
    175722end

  • GraphicTest/UMainForm.pas

    r446 r447  
    66
    77uses
    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;
    1112
    1213const
    … …  
    1516type
    1617
    17 
    1818  { TMainForm }
    1919
    2020  TMainForm = class(TForm)
    21     ButtonStop: TButton;
    2221    ButtonBenchmark: TButton;
    2322    ButtonSingleTest: TButton;
     23    ButtonStop: TButton;
     24    CheckBoxDoubleBuffered: TCheckBox;
    2425    CheckBoxEraseBackground: TCheckBox;
    25     CheckBoxDoubleBuffered: TCheckBox;
    2626    FloatSpinEdit1: TFloatSpinEdit;
    2727    Label1: TLabel;
    … …  
    3030    Label4: TLabel;
    3131    ListViewMethods: TListView;
     32    Memo1: TMemo;
     33    PageControl1: TPageControl;
     34    Panel1: TPanel;
     35    SpinEditHeight: TSpinEdit;
    3236    SpinEditWidth: TSpinEdit;
    33     SpinEditHeight: TSpinEdit;
     37    Splitter1: TSplitter;
     38    SynMemo1: TSynMemo;
     39    SynPasSyn1: TSynPasSyn;
     40    TabSheet1: TTabSheet;
     41    TabSheet2: TTabSheet;
    3442    TimerUpdateList: TTimer;
    3543    procedure ButtonBenchmarkClick(Sender: TObject);
    … …  
    7482
    7583uses
    76   UDrawForm;
     84  UDrawForm, ULazIntfImageColorsCopy, ULazIntfImageColorsNoCopy, UCanvasPixels,
     85  UCanvasPixelsUpdateLock, UBGRABitmapPaintBox, UBitmapRawImageDataPaintBox,
     86  UBitmapRawImageData, UBitmapRawImageDataMove, UDummyMethod, UOpenGLMethod,
     87  UOpenGLPBOMethod;
     88
     89const
     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
    7796
    7897
    … …  
    94113    DrawMethods.Add(NewDrawMethod);
    95114  end;
     115
     116  PageControl1.TabIndex := 0;
    96117end;
    97118
    … …  
    213234procedure TMainForm.ListViewMethodsSelectItem(Sender: TObject; Item: TListItem;
    214235  Selected: Boolean);
     236var
     237  FileName: string;
    215238begin
    216239  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;
    217249end;
    218250
Note: See TracChangeset for help on using the changeset viewer.