Changeset 443


Ignore:
Timestamp:
Nov 22, 2012, 12:28:54 PM (12 years ago)
Author:
chronos
Message:
  • Modified: Draw frame moved to separated form without TPageControl. Each draw method is responsible for creating own TWinControl visual control.
Location:
GraphicTest
Files:
2 added
5 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/GraphicTest.lpi

    r442 r443  
    7373      </Item3>
    7474    </RequiredPackages>
    75     <Units Count="5">
     75    <Units Count="6">
    7676      <Unit0>
    7777        <Filename Value="GraphicTest.lpr"/>
    … …  
    102102        <UnitName Value="UFastBitmap"/>
    103103      </Unit4>
     104      <Unit5>
     105        <Filename Value="UDrawForm.pas"/>
     106        <IsPartOfProject Value="True"/>
     107        <ComponentName Value="DrawForm"/>
     108        <ResourceBaseClass Value="Form"/>
     109        <UnitName Value="UDrawForm"/>
     110      </Unit5>
    104111    </Units>
    105112  </ProjectOptions>
    … …  
    130137    <Linking>
    131138      <Debugging>
    132         <UseHeaptrc Value="True"/>
    133139        <UseExternalDbgSyms Value="True"/>
    134140      </Debugging>
    … …  
    143149        <UseMsgFile Value="True"/>
    144150      </CompilerMessages>
     151      <CustomOptions Value="-dopengl"/>
    145152      <CompilerPath Value="$(CompPath)"/>
    146153    </Other>

  • GraphicTest/GraphicTest.lpr

    r317 r443  
    99  Interfaces, // this includes the LCL widgetset
    1010  Forms, lazopenglcontext, UMainForm, UPlatform, UDrawMethod, UFastBitmap,
    11   bgrabitmappack;
     11  bgrabitmappack, UDrawForm;
    1212
    1313{$R *.res}
    … …  
    1717  Application.Initialize;
    1818  Application.CreateForm(TMainForm, MainForm);
     19  Application.CreateForm(TDrawForm, DrawForm);
    1920  Application.Run;
    2021end.

  • GraphicTest/UDrawMethod.pas

    r442 r443  
    66
    77uses
    8   Classes, SysUtils, ExtCtrls, UPlatform, UFastBitmap, Graphics,
     8  Classes, SysUtils, ExtCtrls, UPlatform, UFastBitmap, Graphics, Controls,
    99  LCLType, IntfGraphics, fpImage, GraphType, BGRABitmap, BGRABitmapTypes,
    1010  LclIntf{$IFDEF opengl}, GL, GLExt, OpenGLContext{$ENDIF};
    … …  
    1818  TDrawMethod = class
    1919  private
    20     FBitmap: TBitmap;
     20    FControl: TControl;
    2121    TempBitmap: TBitmap;
    22     FPaintBox: TPaintBox;
    23     procedure SetBitmap(const AValue: TBitmap); virtual;
    24     procedure SetPaintBox(const AValue: TPaintBox);
    2522  public
    2623    Caption: string;
    … …  
    2926    StepDuration: TDateTime;
    3027    PaintObject: TPaintObject;
    31     {$IFDEF opengl}
    32     OpenGLBitmap: Pointer;
    33     OpenGLControl: TOpenGLControl;
    34     TextureId: GLuint;
    35     {$ENDIF}
    36     procedure Init; virtual;
     28    procedure Init(Parent: TWinControl; Size: TPoint); virtual;
     29    procedure Done; virtual;
    3730    constructor Create; virtual;
    3831    destructor Destroy; override;
    3932    procedure DrawFrame(FastBitmap: TFastBitmap); virtual;
    4033    procedure DrawFrameTiming(FastBitmap: TFastBitmap);
    41     property Bitmap: TBitmap read FBitmap write SetBitmap;
    42     property PaintBox: TPaintBox read FPaintBox write SetPaintBox;
     34    property Control: TControl read FControl;
    4335  end;
    4436
    4537  TDrawMethodClass = class of TDrawMethod;
    4638
     39  { TDrawMethodImage }
     40
     41  TDrawMethodImage = class(TDrawMethod)
     42    Image: TImage;
     43    procedure Init(Parent: TWinControl; Size: TPoint); override;
     44    procedure Done; override;
     45  end;
     46
     47  { TDrawMethodPaintBox }
     48
     49  TDrawMethodPaintBox = class(TDrawMethod)
     50    PaintBox: TPaintBox;
     51    procedure Paint(Sender: TObject); virtual;
     52    procedure Init(Parent: TWinControl; Size: TPoint); override;
     53    procedure Done; override;
     54  end;
     55
    4756  { TDummyMethod }
    4857
    … …  
    5463  { TCanvasPixels }
    5564
    56   TCanvasPixels = class(TDrawMethod)
     65  TCanvasPixels = class(TDrawMethodImage)
    5766    constructor Create; override;
    5867    procedure DrawFrame(FastBitmap: TFastBitmap); override;
    … …  
    6170  { TCanvasPixelsUpdateLock }
    6271
    63   TCanvasPixelsUpdateLock = class(TDrawMethod)
     72  TCanvasPixelsUpdateLock = class(TDrawMethodImage)
    6473    constructor Create; override;
    6574    procedure DrawFrame(FastBitmap: TFastBitmap); override;
    … …  
    6877  { TLazIntfImageColorsCopy }
    6978
    70   TLazIntfImageColorsCopy = class(TDrawMethod)
     79  TLazIntfImageColorsCopy = class(TDrawMethodImage)
    7180    TempIntfImage: TLazIntfImage;
    7281    constructor Create; override;
    … …  
    7786  { TLazIntfImageColorsNoCopy }
    7887
    79   TLazIntfImageColorsNoCopy = class(TDrawMethod)
     88  TLazIntfImageColorsNoCopy = class(TDrawMethodImage)
    8089    TempIntfImage: TLazIntfImage;
    81     procedure SetBitmap(const AValue: TBitmap); override;
     90    procedure Init(Parent: TWinControl; Size: TPoint); override;
    8291    constructor Create; override;
    8392    destructor Destroy; override;
    … …  
    8796  { TBitmapRawImageData }
    8897
    89   TBitmapRawImageData = class(TDrawMethod)
     98  TBitmapRawImageData = class(TDrawMethodImage)
    9099    constructor Create; override;
    91100    procedure DrawFrame(FastBitmap: TFastBitmap); override;
    … …  
    94103  { TBitmapRawImageDataPaintBox }
    95104
    96   TBitmapRawImageDataPaintBox = class(TDrawMethod)
    97     constructor Create; override;
     105  TBitmapRawImageDataPaintBox = class(TDrawMethodPaintBox)
     106    constructor Create; override;
     107    procedure Paint(Sender: TObject); override;
    98108    procedure DrawFrame(FastBitmap: TFastBitmap); override;
    99109  end;
    … …  
    101111  { TBitmapRawImageDataMove }
    102112
    103   TBitmapRawImageDataMove = class(TDrawMethod)
     113  TBitmapRawImageDataMove = class(TDrawMethodImage)
    104114    constructor Create; override;
    105115    procedure DrawFrame(FastBitmap: TFastBitmap); override;
    … …  
    108118  { TBGRABitmapPaintBox }
    109119
    110   TBGRABitmapPaintBox = class(TDrawMethod)
     120  TBGRABitmapPaintBox = class(TDrawMethodPaintBox)
    111121    BGRABitmap: TBGRABitmap;
    112     procedure SetBitmap(const AValue: TBitmap); override;
     122    procedure Paint(Sender: TObject); override;
     123    procedure Init(Parent: TWinControl; Size: TPoint); override;
    113124    constructor Create; override;
    114125    destructor Destroy; override;
    … …  
    117128
    118129  {$IFDEF opengl}
     130  { TDrawMethodOpenGL }
     131
     132  TDrawMethodOpenGL = class(TDrawMethod)
     133    OpenGLControl: TOpenGLControl;
     134    TextureId: GLuint;
     135    OpenGLBitmap: Pointer;
     136    procedure InitGL;
     137    procedure OpenGLControlResize(Sender: TObject);
     138    procedure Init(AParent: TWinControl; Size: TPoint); override;
     139    procedure Done; override;
     140  end;
     141
    119142  { TOpenGLMethod }
    120143
    121   TOpenGLMethod = class(TDrawMethod)
    122     procedure SetBitmap(const AValue: TBitmap); override;
    123     constructor Create; override;
    124     procedure Init; override;
     144  TOpenGLMethod = class(TDrawMethodOpenGL)
     145    constructor Create; override;
    125146    destructor Destroy; override;
    126147    procedure DrawFrame(FastBitmap: TFastBitmap); override;
    … …  
    129150  { TOpenGLPBOMethod }
    130151
    131   TOpenGLPBOMethod = class(TDrawMethod)
     152  TOpenGLPBOMethod = class(TDrawMethodOpenGL)
    132153    pboIds: array[0..1] of GLuint;
    133154    Index, NextIndex: Integer;
    134     procedure SetBitmap(const AValue: TBitmap); override;
    135     procedure Init; override;
     155    procedure Init(AParent: TWinControl; Size: TPoint); override;
    136156    constructor Create; override;
    137157    destructor Destroy; override;
    … …  
    149169implementation
    150170
     171
     172{ TDrawMethodPaintBox }
     173
     174procedure TDrawMethodPaintBox.Paint(Sender: TObject);
     175begin
     176
     177end;
     178
     179procedure TDrawMethodPaintBox.Init(Parent: TWinControl; Size: TPoint);
     180begin
     181  inherited Init(Parent, Size);
     182  PaintBox := TPaintBox.Create(Parent);
     183  PaintBox.Parent := Parent;
     184  PaintBox.SetBounds(0, 0, Size.X, Size.Y);
     185  PaintBox.OnPaint := Paint;
     186  PaintBox.Show;
     187end;
     188
     189procedure TDrawMethodPaintBox.Done;
     190begin
     191  FreeAndNil(PaintBox);
     192  inherited Done;
     193end;
     194
     195{ TDrawMethodImage }
     196
     197procedure TDrawMethodImage.Init(Parent: TWinControl; Size: TPoint);
     198begin
     199  inherited Init(Parent, Size);
     200  Image := TImage.Create(Parent);
     201  Image.Parent := Parent;
     202  Image.SetBounds(0, 0, Size.X, Size.Y);
     203  Image.Picture.Bitmap.SetSize(Size.X, Size.Y);
     204  Image.Picture.Bitmap.PixelFormat := pf32bit;
     205  Image.Show;
     206end;
     207
     208procedure TDrawMethodImage.Done;
     209begin
     210  FreeAndNil(Image);
     211  inherited Done;
     212end;
     213
    151214{ TDummyMethod }
    152215
    … …  
    158221
    159222procedure TDummyMethod.DrawFrame(FastBitmap: TFastBitmap);
     223begin
     224end;
     225
     226{ TBitmapRawImageDataMove }
     227
     228constructor TBitmapRawImageDataMove.Create;
     229begin
     230  inherited;
     231  Caption := 'TBitmap.RawImage.Data Move';
     232end;
     233
     234procedure TBitmapRawImageDataMove.DrawFrame(FastBitmap: TFastBitmap);
    160235var
    161236  Y, X: Integer;
    … …  
    167242  BytePerRow: Integer;
    168243begin
    169   P := Bitmap.PixelFormat;
     244  P := Image.Picture.Bitmap.PixelFormat;
    170245    with FastBitmap do
    171246    try
    172       //Bitmap.BeginUpdate(False);
    173       RawImage := Bitmap.RawImage;
    174       RowPtr := PInteger(RawImage.Data);
    175       BytePerPixel := RawImage.Description.BitsPerPixel div 8;
    176       BytePerRow := RawImage.Description.BytesPerLine;
    177     finally
    178       //Bitmap.EndUpdate(False);
    179     end;
    180 end;
    181 
    182 { TBitmapRawImageDataMove }
    183 
    184 constructor TBitmapRawImageDataMove.Create;
    185 begin
    186   inherited;
    187   Caption := 'TBitmap.RawImage.Data Move';
    188 end;
    189 
    190 procedure TBitmapRawImageDataMove.DrawFrame(FastBitmap: TFastBitmap);
    191 var
    192   Y, X: Integer;
    193   PixelPtr: PInteger;
    194   RowPtr: PInteger;
    195   P: TPixelFormat;
    196   RawImage: TRawImage;
    197   BytePerPixel: Integer;
    198   BytePerRow: Integer;
    199 begin
    200   P := Bitmap.PixelFormat;
    201     with FastBitmap do
    202     try
    203       Bitmap.BeginUpdate(False);
    204       RawImage := Bitmap.RawImage;
     247      Image.Picture.Bitmap.BeginUpdate(False);
     248      RawImage := Image.Picture.Bitmap.RawImage;
    205249      RowPtr := PInteger(RawImage.Data);
    206250      BytePerPixel := RawImage.Description.BitsPerPixel div 8;
    … …  
    208252      Move(FastBitmap.PixelsData^, RowPtr^, Size.Y * BytePerRow);
    209253    finally
    210       Bitmap.EndUpdate(False);
     254      Image.Picture.Bitmap.EndUpdate(False);
    211255    end;
    212256end;
    … …  
    215259{ TOpenGLPBOMethod }
    216260
    217 procedure TOpenGLPBOMethod.SetBitmap(const AValue: TBitmap);
    218 begin
    219   inherited SetBitmap(AValue);
    220 end;
    221 
    222261//procedure glGenBuffersARB2 : procedure(n : GLsizei; buffers : PGLuint); extdecl;
    223262
    224 procedure TOpenGLPBOMethod.Init;
     263procedure TOpenGLPBOMethod.Init(AParent: TWinControl; Size: TPoint);
    225264var
    226265  DataSize: Integer;
    227266  glExtensions: string;
    228267begin
     268  inherited;
     269
    229270  OpenGLControl.MakeCurrent;
    230271  DataSize := OpenGLControl.Width * OpenGLControl.Height * SizeOf(Integer);
    … …  
    268309var
    269310  X, Y: Integer;
    270   P: PInteger;
    271   R: PInteger;
     311  P: PCardinal;
     312  R: PCardinal;
    272313  Ptr: ^GLubyte;
    273314  TextureShift: TPoint;
    … …  
    317358  if Assigned(ptr) then begin
    318359    // update data directly on the mapped buffer
    319     P := PInteger(Ptr);
     360    P := PCardinal(Ptr);
    320361    with FastBitmap do
    321362    for Y := 0 to Size.Y - 2 do begin
    … …  
    358399{ TOpenGLMethod }
    359400
    360 procedure TOpenGLMethod.SetBitmap(const AValue: TBitmap);
    361 begin
    362   inherited SetBitmap(AValue);
    363 end;
    364 
    365401constructor TOpenGLMethod.Create;
    366402begin
    … …  
    370406end;
    371407
    372 procedure TOpenGLMethod.Init;
    373 begin
    374   inherited Init;
    375   //OpenGLControl.MakeCurrent;
    376 end;
    377 
    378408destructor TOpenGLMethod.Destroy;
    379409begin
    … …  
    384414var
    385415  X, Y: Integer;
    386   P: PInteger;
    387   R: PInteger;
     416  P: PCardinal;
     417  R: PCardinal;
    388418const
    389419  GL_CLAMP_TO_EDGE = $812F;
    … …  
    440470end;
    441471
     472{ TDrawMethodOpenGL }
     473
     474procedure TDrawMethodOpenGL.Init(AParent: TWinControl; Size: TPoint);
     475begin
     476  inherited Init(aParent, Size);
     477  OpenGLControl := TOpenGLControl.Create(AParent);
     478  with OpenGLControl do begin
     479    Name := 'OpenGLControl';
     480    Parent := AParent;
     481    SetBounds(0, 0, Size.X, Size.Y);
     482    InitGL;
     483    //OnPaint := OpenGLControl1Paint;
     484    OnResize := OpenGLControlResize;
     485  end;
     486  GetMem(OpenGLBitmap, OpenGLControl.Width * OpenGLControl.Height * SizeOf(Integer));
     487end;
     488
     489procedure TDrawMethodOpenGL.Done;
     490begin
     491  FreeMem(OpenGLBitmap, OpenGLControl.Width * OpenGLControl.Height);
     492  FreeAndNil(OpenGLControl);
     493  inherited;
     494end;
     495
     496procedure TDrawMethodOpenGL.OpenGLControlResize(Sender: TObject);
     497begin
     498  glViewport(0, 0, OpenGLControl.Width, OpenGLControl.Height);
     499end;
     500
     501procedure TDrawMethodOpenGL.InitGL;
     502begin
     503  glMatrixMode(GL_PROJECTION);
     504  glLoadIdentity;
     505  glOrtho(0, OpenGLControl.Width, OpenGLControl.Height, 0, 0, 1);
     506//  glOrtho(0, 1, 1, 0, 0, 1);
     507  glMatrixMode(GL_MODELVIEW);
     508  glLoadIdentity();
     509  glDisable(GL_DEPTH_TEST);
     510  glViewport(0, 0, OpenGLControl.Width, OpenGLControl.Height);
     511  //gluPerspective( 45.0, (GLfloat)(OpenGLControl1.Width)/(GLfloat)(OpenGLControl1.Height), 0.1f, 500.0 );
     512
     513    //glFrustum (-1.0, 1.0, -1.0, 1.0, 1.5, 20.0);
     514    //glTranslatef (0.0, 0.0,-3.0);
     515  //  glClearColor(0.0, 0.0, 0.0, 1.0);
     516
     517  glGenTextures(1, @TextureId);
     518  glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
     519end;
     520
    442521{$ENDIF}
    443522
    444523{ TBGRABitmapPaintBox }
    445524
    446 procedure TBGRABitmapPaintBox.SetBitmap(const AValue: TBitmap);
    447 begin
    448   inherited;
    449   BGRABitmap.SetSize(Bitmap.Width, Bitmap.Height);
     525procedure TBGRABitmapPaintBox.Paint(Sender: TObject);
     526begin
     527  //BGRABitmap.Draw(Bitmap.Canvas, 0, 0, True);
     528  BGRABitmap.Draw(PaintBox.Canvas, 0, 0, True);
     529end;
     530
     531procedure TBGRABitmapPaintBox.Init(Parent: TWinControl; Size: TPoint);
     532begin
     533  inherited Init(Parent, Size);
     534  BGRABitmap.SetSize(PaintBox.Width, PaintBox.Height);
    450535end;
    451536
    … …  
    483568  end;
    484569  BGRABitmap.InvalidateBitmap; // changed by direct access
    485   //BGRABitmap.Draw(Bitmap.Canvas, 0, 0, True);
    486   BGRABitmap.Draw(PaintBox.Canvas, 0, 0, True);
     570  PaintBox.Repaint;
    487571end;
    488572
    … …  
    494578  Caption := 'TBitmap.RawImage.Data PaintBox';
    495579  PaintObject := poPaintBox;
     580end;
     581
     582procedure TBitmapRawImageDataPaintBox.Paint(Sender: TObject);
     583var
     584  hPaint, hBmp: HDC;
     585begin
     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);
    496592end;
    497593
    … …  
    505601  BytePerPixel: Integer;
    506602  BytePerRow: Integer;
    507   hPaint, hBmp: HDC;
    508603begin
    509604  P := TempBitmap.PixelFormat;
    … …  
    526621      TempBitmap.EndUpdate(False);
    527622    end;
    528     hBmp := TempBitmap.Canvas.Handle;
    529     hPaint := PaintBox.Canvas.Handle;
    530     PaintBox.Canvas.CopyRect(Rect(0, 0, Bitmap.Width, Bitmap.Height), TempBitmap.Canvas,
    531       Rect(0, 0, TempBitmap.Width, TempBitmap.Height));
    532    // PaintBox.Canvas.Draw(0, 0, TempBitmap);
    533     //BitBlt(hPaint, 0, 0, TempBitmap.Width, TempBitmap.Height, hBmp, 0, 0, srcCopy);
     623  PaintBox.Repaint;
    534624end;
    535625
    … …  
    552642  BytePerRow: Integer;
    553643begin
    554   P := Bitmap.PixelFormat;
     644  P := Image.Picture.Bitmap.PixelFormat;
    555645    with FastBitmap do
    556646    try
    557       Bitmap.BeginUpdate(False);
    558       RawImage := Bitmap.RawImage;
     647      Image.Picture.Bitmap.BeginUpdate(False);
     648      RawImage := Image.Picture.Bitmap.RawImage;
    559649      RowPtr := PCardinal(RawImage.Data);
    560650      BytePerPixel := RawImage.Description.BitsPerPixel div 8;
    … …  
    569659      end;
    570660    finally
    571       Bitmap.EndUpdate(False);
     661      Image.Picture.Bitmap.EndUpdate(False);
    572662    end;
    573663end;
    … …  
    575665{ TLazIntfImageColorsNoCopy }
    576666
    577 procedure TLazIntfImageColorsNoCopy.SetBitmap(const AValue: TBitmap);
    578 begin
    579   inherited SetBitmap(AValue);
     667procedure TLazIntfImageColorsNoCopy.Init(Parent: TWinControl; Size: TPoint);
     668begin
     669  inherited Init(Parent, Size);
    580670  TempIntfImage.Free;
    581   TempIntfImage := Bitmap.CreateIntfImage;
     671  TempIntfImage := Image.Picture.Bitmap.CreateIntfImage;
    582672end;
    583673
    … …  
    602692      for Y := 0 to Size.Y - 1 do
    603693        TempIntfImage.Colors[X, Y] := TColorToFPColor(SwapBRComponent(Pixels[X, Y]));
    604     Bitmap.LoadFromIntfImage(TempIntfImage);
     694    Image.Picture.Bitmap.LoadFromIntfImage(TempIntfImage);
    605695  end;
    606696end;
    … …  
    626716begin
    627717  with FastBitmap do begin
    628     TempIntfImage.LoadFromBitmap(Bitmap.Handle,
    629       Bitmap.MaskHandle);
     718    TempIntfImage.LoadFromBitmap(Image.Picture.Bitmap.Handle,
     719      Image.Picture.Bitmap.MaskHandle);
    630720    for X := 0 to Size.X - 1 do
    631721      for Y := 0 to Size.Y - 1 do
    632722        TempIntfImage.Colors[X, Y] := TColorToFPColor(SwapBRComponent(Pixels[X, Y]));
    633     Bitmap.LoadFromIntfImage(TempIntfImage);
     723    Image.Picture.Bitmap.LoadFromIntfImage(TempIntfImage);
    634724  end;
    635725end;
    … …  
    649739  with FastBitmap do
    650740  try
    651     Bitmap.BeginUpdate(True);
     741    Image.Picture.Bitmap.BeginUpdate(True);
    652742    for Y := 0 to Size.Y - 1 do
    653743      for X := 0 to Size.X - 1 do
    654         Bitmap.Canvas.Pixels[X, Y] := TColor(SwapBRComponent(Pixels[X, Y]));
     744        Image.Picture.Bitmap.Canvas.Pixels[X, Y] := TColor(SwapBRComponent(Pixels[X, Y]));
    655745  finally
    656     Bitmap.EndUpdate(False);
     746    Image.Picture.Bitmap.EndUpdate(False);
    657747  end;
    658748end;
    … …  
    673763    for Y := 0 to Size.Y - 1 do
    674764      for X := 0 to Size.X - 1 do
    675         Bitmap.Canvas.Pixels[X, Y] := TColor(SwapBRComponent(Pixels[X, Y]));
     765        Image.Picture.Bitmap.Canvas.Pixels[X, Y] := TColor(SwapBRComponent(Pixels[X, Y]));
    676766  end;
    677767end;
    … …  
    679769{ TDrawMethod }
    680770
    681 procedure TDrawMethod.SetBitmap(const AValue: TBitmap);
    682 begin
    683   if FBitmap = AValue then exit;
    684   FBitmap := AValue;
    685   TempBitmap.SetSize(FBitmap.Width, FBitmap.Height);
    686 end;
    687 
    688 procedure TDrawMethod.SetPaintBox(const AValue: TPaintBox);
    689 begin
    690   if FPaintBox = AValue then Exit;
    691   FPaintBox := AValue;
    692 end;
    693 
    694 procedure TDrawMethod.Init;
     771procedure TDrawMethod.Init(Parent: TWinControl; Size: TPoint);
     772begin
     773  if (TempBitmap.Width <> Size.X) or (TempBitmap.Height <> Size.Y) then
     774    TempBitmap.SetSize(Size.X, Size.Y);
     775end;
     776
     777procedure TDrawMethod.Done;
    695778begin
    696779
    … …  
    704787destructor TDrawMethod.Destroy;
    705788begin
    706   TempBitmap.Free;
     789  FreeAndNil(TempBitmap);
    707790  inherited Destroy;
    708791end;

  • GraphicTest/UMainForm.lfm

    r338 r443  
    11object MainForm: TMainForm
    22  Left = 187
    3   Height = 421
    4   Top = 68
    5   Width = 735
     3  Height = 440
     4  Top = 107
     5  Width = 549
    66  Caption = 'Graphic test'
    7   ClientHeight = 421
    8   ClientWidth = 735
     7  ClientHeight = 440
     8  ClientWidth = 549
    99  OnClose = FormClose
    1010  OnCreate = FormCreate
    1111  OnDestroy = FormDestroy
    1212  OnShow = FormShow
    13   LCLVersion = '0.9.31'
    14   object PageControl1: TPageControl
    15     Left = 384
    16     Height = 401
    17     Top = 16
    18     Width = 348
    19     ActivePage = TabSheet1
    20     Anchors = [akTop, akRight, akBottom]
    21     TabIndex = 0
    22     TabOrder = 0
    23     object TabSheet1: TTabSheet
    24       Caption = 'TImage'
    25       ClientHeight = 368
    26       ClientWidth = 342
    27       object Image1: TImage
    28         Left = 6
    29         Height = 300
    30         Top = 7
    31         Width = 332
    32         Anchors = [akTop, akLeft, akRight, akBottom]
    33       end
    34     end
    35     object TabSheet2: TTabSheet
    36       Caption = 'TPaintBox'
    37       ClientHeight = 368
    38       ClientWidth = 342
    39       object PaintBox1: TPaintBox
    40         Left = 6
    41         Height = 279
    42         Top = 7
    43         Width = 350
    44         Anchors = [akTop, akLeft, akRight, akBottom]
    45       end
    46     end
    47     object TabSheet3: TTabSheet
    48       Caption = 'OpenGL'
    49     end
    50   end
     13  LCLVersion = '1.1'
    5114  object ListViewMethods: TListView
    5215    Left = 8
    53     Height = 345
     16    Height = 364
    5417    Top = 8
    55     Width = 368
     18    Width = 537
    5619    Anchors = [akTop, akLeft, akRight, akBottom]
    5720    Columns = <   
    … …  
    7942    ReadOnly = True
    8043    RowSelect = True
    81     TabOrder = 1
     44    TabOrder = 0
    8245    ViewStyle = vsReport
    8346    OnData = ListViewMethodsData
    … …  
    8750    Left = 8
    8851    Height = 25
    89     Top = 360
     52    Top = 379
    9053    Width = 115
    9154    Anchors = [akLeft, akBottom]
    9255    Caption = 'Test one method'
    9356    OnClick = ButtonSingleTestClick
    94     TabOrder = 2
     57    TabOrder = 1
    9558  end
    9659  object ButtonBenchmark: TButton
    9760    Left = 136
    9861    Height = 25
    99     Top = 360
     62    Top = 379
    10063    Width = 112
    10164    Anchors = [akLeft, akBottom]
    10265    Caption = 'Test all methods'
    10366    OnClick = ButtonBenchmarkClick
    104     TabOrder = 3
     67    TabOrder = 2
    10568  end
    10669  object FloatSpinEdit1: TFloatSpinEdit
    10770    Left = 88
    108     Height = 25
    109     Top = 388
     71    Height = 21
     72    Top = 411
    11073    Width = 58
    11174    Anchors = [akLeft, akBottom]
    … …  
    11376    MaxValue = 100
    11477    MinValue = 0
    115     TabOrder = 4
     78    TabOrder = 3
    11679    Value = 1
    11780  end
    … …  
    11982    Left = 256
    12083    Height = 25
    121     Top = 360
     84    Top = 379
    12285    Width = 75
    12386    Anchors = [akLeft, akBottom]
    12487    Caption = 'Stop'
    12588    OnClick = ButtonStopClick
    126     TabOrder = 5
     89    TabOrder = 4
    12790  end
    12891  object Label1: TLabel
    12992    Left = 8
    130     Height = 16
    131     Top = 393
    132     Width = 92
     93    Height = 13
     94    Top = 415
     95    Width = 69
    13396    Anchors = [akLeft, akBottom]
    13497    Caption = 'Step duration:'
    … …  
    137100  object Label2: TLabel
    138101    Left = 152
    139     Height = 16
    140     Top = 393
    141     Width = 8
     102    Height = 13
     103    Top = 415
     104    Width = 5
    142105    Anchors = [akLeft, akBottom]
    143106    Caption = 's'

  • GraphicTest/UMainForm.pas

    r442 r443  
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    99  ExtCtrls, StdCtrls, DateUtils, UPlatform, LCLType, IntfGraphics, fpImage,
    10   Math, GraphType, Contnrs, LclIntf, Spin, UFastBitmap, UDrawMethod
    11   {$IFDEF opengl}, GL, OpenGLContext{$ENDIF};
     10  Math, GraphType, Contnrs, LclIntf, Spin, UFastBitmap, UDrawMethod;
    1211
    1312const
    … …  
    2423    ButtonSingleTest: TButton;
    2524    FloatSpinEdit1: TFloatSpinEdit;
    26     Image1: TImage;
    2725    Label1: TLabel;
    2826    Label2: TLabel;
    2927    ListViewMethods: TListView;
    30     PageControl1: TPageControl;
    31     PaintBox1: TPaintBox;
    32     TabSheet1: TTabSheet;
    33     TabSheet2: TTabSheet;
    34     TabSheet3: TTabSheet;
    3528    Timer1: TTimer;
    3629    procedure ButtonBenchmarkClick(Sender: TObject);
    3730    procedure ButtonSingleTestClick(Sender: TObject);
    3831    procedure ButtonStopClick(Sender: TObject);
    39     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    4032    procedure FormCreate(Sender: TObject);
    4133    procedure FormDestroy(Sender: TObject);
    4234    procedure FormShow(Sender: TObject);
     35    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    4336    procedure ListViewMethodsData(Sender: TObject; Item: TListItem);
    4437    procedure ListViewMethodsSelectItem(Sender: TObject; Item: TListItem;
    … …  
    4639    procedure Timer1Timer(Sender: TObject);
    4740  private
    48     {$IFDEF opengl}
    49     OpenGLControl1: TOpenGLControl;
    50     TextureId: GLuint;
    51     TextureData: Pointer;
    52     {$ENDIF}
    5341    MethodIndex: Integer;
    5442    SingleTestActive: Boolean;
    5543    AllTestActive: Boolean;
    56     procedure OpenGLControl1Resize(Sender: TObject);
    57     {$IFDEF opengl}
    58     procedure InitGL;
    59     {$ENDIF}
    6044    procedure UpdateMethodList;
    6145    procedure UpdateInterface;
    6246  public
     47    FrameSize: TPoint;
    6348    DrawMethods: TObjectList; // TObjectList<TDrawMethod>
    64     Bitmap: TBitmap;
    6549    Scenes: TObjectList; // TObjectList<TFastBitmap>
    6650    SceneIndex: Integer;
    … …  
    7357
    7458{$R *.lfm}
     59
     60uses
     61  UDrawForm;
     62
    7563
    7664{ TMainForm }
    … …  
    8270  I: Integer;
    8371begin
    84   TabSheet1.DoubleBuffered := True;
     72  FrameSize := Point(320, 240);
    8573  Randomize;
    8674  Scenes := TObjectList.Create;
    8775  for I := 0 to SceneFrameCount - 1 do begin
    8876    NewScene := TFastBitmap.Create;
    89     NewScene.Size := Point(320, 240);
     77    NewScene.Size := FrameSize;
    9078    NewScene.RandomImage;
    9179    Scenes.Add(NewScene);
    9280  end;
    93   Bitmap := TBitmap.Create;
    94   Bitmap.PixelFormat := pf24bit;
    95   Image1.Picture.Bitmap.SetSize(TFastBitmap(Scenes[0]).Size.X, TFastBitmap(Scenes[0]).Size.Y);
    96   Image1.Picture.Bitmap.PixelFormat := pf24bit;
    97   Bitmap.SetSize(TFastBitmap(Scenes[0]).Size.X, TFastBitmap(Scenes[0]).Size.Y);
    98 
    99   {$IFDEF opengl}
    100   OpenGLControl1 := TOpenGLControl.Create(Self);
    101   with OpenGLControl1 do begin
    102     Name := 'OpenGLControl1';
    103     Parent := TabSheet3;
    104     SetBounds(0, 0, 320, 240);
    105     InitGL;
    106     //OnPaint := OpenGLControl1Paint;
    107     OnResize := OpenGLControl1Resize;
    108   end;
    109   GetMem(TextureData, OpenGLControl1.Width * OpenGLControl1.Height * SizeOf(Integer));
    110   {$ENDIF}
    11181
    11282  DrawMethods := TObjectList.Create;
    11383  for I := 0 to High(DrawMethodClasses) do begin
    11484    NewDrawMethod := DrawMethodClasses[I].Create;
    115     NewDrawMethod.Bitmap := Image1.Picture.Bitmap;
    116     NewDrawMethod.PaintBox := PaintBox1;
    117     {$IFDEF opengl}
    118     NewDrawMethod.OpenGLBitmap := TextureData;
    119     NewDrawMethod.OpenGLControl := OpenGLControl1;
    120     {$ENDIF}
    121     NewDrawMethod.Init;
    12285    DrawMethods.Add(NewDrawMethod);
    12386  end;
    … …  
    13699    if MethodIndex >= 0 then
    137100    with TDrawMethod(DrawMethods[MethodIndex]) do begin
    138       PageControl1.TabIndex := Integer(PaintObject);
     101      Init(DrawForm, FrameSize);
    139102      Application.ProcessMessages;
    140103      repeat
    … …  
    145108        StepDuration := NowPrecise - StepStartTime;
    146109      until not SingleTestActive;
     110      Done;
    147111    end;
    148112  finally
    … …  
    156120var
    157121  I: Integer;
    158   C: Integer;
    159122  StartTime: TDateTime;
    160123  StepStartTime: TDateTime;
    … …  
    167130    for I := 0 to DrawMethods.Count - 1 do
    168131    with TDrawMethod(DrawMethods[I]) do begin
     132      Init(DrawForm, FrameSize);
    169133      MethodIndex := I;
    170       PageControl1.TabIndex := Integer(PaintObject);
    171134      StartTime := NowPrecise;
    172135      repeat
    … …  
    177140        StepDuration := NowPrecise - StepStartTime;
    178141      until ((NowPrecise - StartTime) > OneSecond * FloatSpinEdit1.Value) or not AllTestActive;
     142      Done;
    179143    end;
    180144  finally
    … …  
    199163begin
    200164  ListViewMethods.Clear;
    201   {$IFDEF opengl}FreeMem(TextureData, OpenGLControl1.Width * OpenGLControl1.Height);{$ENDIF}
    202165  FreeAndNil(DrawMethods);
    203166  FreeAndNil(Scenes);
    204   FreeAndNil(Bitmap);
    205167end;
    206168
    … …  
    209171  UpdateMethodList;
    210172  UpdateInterface;
     173  DrawForm.Show;
    211174end;
    212175
    … …  
    238201end;
    239202
    240 procedure TMainForm.OpenGLControl1Resize(Sender: TObject);
    241 begin
    242   {$IFDEF opengl}
    243   glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);
    244   {$ENDIF}
    245 end;
    246 
    247 {$IFDEF opengl}
    248 procedure TMainForm.InitGL;
    249 begin
    250   glMatrixMode(GL_PROJECTION);
    251   glLoadIdentity;
    252   glOrtho(0, OpenGLControl1.Width, OpenGLControl1.Height, 0, 0, 1);
    253 //  glOrtho(0, 1, 1, 0, 0, 1);
    254   glMatrixMode(GL_MODELVIEW);
    255   glLoadIdentity();
    256   glDisable(GL_DEPTH_TEST);
    257   glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);
    258   //gluPerspective( 45.0, (GLfloat)(OpenGLControl1.Width)/(GLfloat)(OpenGLControl1.Height), 0.1f, 500.0 );
    259 
    260     //glFrustum (-1.0, 1.0, -1.0, 1.0, 1.5, 20.0);
    261     //glTranslatef (0.0, 0.0,-3.0);
    262   //  glClearColor(0.0, 0.0, 0.0, 1.0);
    263 
    264   glGenTextures(1, @TextureId);
    265   glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
    266 end;
    267 {$ENDIF}
    268 
    269203procedure TMainForm.UpdateMethodList;
    270204begin
Note: See TracChangeset for help on using the changeset viewer.