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.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • 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;
Note: See TracChangeset for help on using the changeset viewer.