Ignore:
Timestamp:
Mar 17, 2011, 7:40:35 AM (14 years ago)
Author:
george
Message:
  • Modified: TFastBitmap class moved to separated unit.
  • Modified: Draw method transformed to individual classes in separated unit.
Location:
GraphicTest
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest

    • Property svn:ignore

      •  

        old new  
        11lib
        22GraphicTest
         3GraphicTest.exe

  • GraphicTest/UMainForm.pas

    r200 r201  
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
    99  ExtCtrls, StdCtrls, DateUtils, UPlatform, LCLType, IntfGraphics, fpImage,
    10   Math, GraphType, Contnrs, LclIntf;
     10  Math, GraphType, Contnrs, LclIntf, UFastBitmap, UDrawMethod;
    1111
    1212const
    13   SceneFrameCount = 20;
     13  SceneFrameCount = 100;
    1414
    1515type
    1616
    17   { TScene }
    18 
    19   TScene = class
    20   private
    21     function GetSize: TPoint;
    22     procedure SetSize(const AValue: TPoint);
    23   public
    24     Pixels: array of array of Byte;
    25     procedure RandomImage;
    26     property Size: TPoint read GetSize write SetSize;
    27   end;
    2817
    2918  { TMainForm }
    3019
    3120  TMainForm = class(TForm)
    32     Button1: TButton;
     21    ButtonBenchmark: TButton;
    3322    ButtonStart: TButton;
    3423    ButtonStop: TButton;
    … …  
    4635    TabSheet2: TTabSheet;
    4736    Timer1: TTimer;
    48     procedure Button1Click(Sender: TObject);
     37    procedure ButtonBenchmarkClick(Sender: TObject);
    4938    procedure ButtonStartClick(Sender: TObject);
    5039    procedure ButtonStopClick(Sender: TObject);
     40    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    5141    procedure FormCreate(Sender: TObject);
    5242    procedure FormDestroy(Sender: TObject);
    5343    procedure Timer1Timer(Sender: TObject);
    5444  private
    55     procedure Draw1;
    56     procedure Draw2;
    57     procedure Draw3;
    58     procedure Draw4;
    59     procedure Draw5;
    60     procedure Draw6;
    61     { private declarations }
    6245  public
     46    DrawMethod: TDrawMethod;
    6347    Bitmap: TBitmap;
    64     Frames: Integer;
    65     Scenes: TObjectList; // TObjectList<TScene>
     48    Scenes: TObjectList; // TObjectList<TFastBitmap>
    6649    SceneIndex: Integer;
    67     StartTime: TDateTime;
    68     FrameDuration: TDateTime;
    6950  end;
    7051
    … …  
    7455implementation
    7556
    76 { TScene }
    77 
    78 function TScene.GetSize: TPoint;
    79 begin
    80   Result.X := Length(Pixels);
    81   if Result.X > 0 then Result.Y := Length(Pixels[0])
    82     else Result.Y := 0;
    83 end;
    84 
    85 procedure TScene.SetSize(const AValue: TPoint);
    86 begin
    87   SetLength(Pixels, AValue.X, AValue.Y);
    88 end;
    89 
    90 procedure TScene.RandomImage;
    91 var
    92   X, Y: Integer;
    93 begin
    94   for Y := 0 to Size.Y - 1 do
    95     for X := 0 to Size.X - 1 do
    96       Pixels[X, Y] := Random(256);
    97 end;
    98 
    9957{$R *.lfm}
    10058
    … …  
    10361procedure TMainForm.FormCreate(Sender: TObject);
    10462var
    105   NewScene: TScene;
     63  NewScene: TFastBitmap;
    10664  I: Integer;
    10765begin
     66  TabSheet1.DoubleBuffered := True;
    10867  Randomize;
    10968  Scenes := TObjectList.Create;
    11069  for I := 0 to SceneFrameCount - 1 do begin
    111     NewScene := TScene.Create;
     70    NewScene := TFastBitmap.Create;
    11271    NewScene.Size := Point(320, 240);
    11372    NewScene.RandomImage;
    … …  
    11675  Bitmap := TBitmap.Create;
    11776  Bitmap.PixelFormat := pf24bit;
    118   Image1.Picture.Bitmap.SetSize(TScene(Scenes[0]).Size.X, TScene(Scenes[0]).Size.Y);
    119   Bitmap.SetSize(TScene(Scenes[0]).Size.X, TScene(Scenes[0]).Size.Y);
     77  Image1.Picture.Bitmap.SetSize(TFastBitmap(Scenes[0]).Size.X, TFastBitmap(Scenes[0]).Size.Y);
     78  Bitmap.SetSize(TFastBitmap(Scenes[0]).Size.X, TFastBitmap(Scenes[0]).Size.Y);
     79  ComboBox1.ItemIndex := 0;
    12080end;
    12181
    … …  
    12585  ButtonStart.Enabled := False;
    12686  Timer1.Enabled := True;
    127   Frames := 0;
    128   if ComboBox1.ItemIndex = 0 then Draw1;
    129   if ComboBox1.ItemIndex = 1 then Draw3;
    130   if ComboBox1.ItemIndex = 2 then Draw2;
    131   if ComboBox1.ItemIndex = 3 then Draw4;
    132   if ComboBox1.ItemIndex = 4 then Draw5;
    133   if ComboBox1.ItemIndex = 5 then Draw6;
     87  DrawMethod.Free;
     88  if ComboBox1.ItemIndex >= 0 then begin
     89    DrawMethod := DrawMethodClasses[ComboBox1.ItemIndex].Create;
     90    DrawMethod.Bitmap := Image1.Picture.Bitmap;
     91    DrawMethod.Bitmap.SetSize(Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);
     92    repeat
     93      DrawMethod.DrawFrameTiming(TFastBitmap(Scenes[SceneIndex]));
     94      SceneIndex := (SceneIndex + 1) mod Scenes.Count;
     95      Application.ProcessMessages;
     96    until not ButtonStop.Enabled;
     97  end;
     98  ButtonStopClick(Self);
    13499end;
    135100
    136 procedure TMainForm.Button1Click(Sender: TObject);
     101procedure TMainForm.ButtonBenchmarkClick(Sender: TObject);
    137102var
    138103  NewItem: TListItem;
     104  I: Integer;
    139105begin
    140106  with ListView1, Items do
    … …  
    142108    BeginUpdate;
    143109    Clear;
    144     Draw1;
    145     NewItem := Add;
    146     NewItem.Caption := ComboBox1.Items[0];
    147     NewItem.SubItems.Add(FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)));
    148     Draw3;
    149     NewItem := Add;
    150     NewItem.Caption := ComboBox1.Items[1];
    151     NewItem.SubItems.Add(FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)));
    152     Draw2;
    153     NewItem := Add;
    154     NewItem.Caption := ComboBox1.Items[2];
    155     NewItem.SubItems.Add(FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)));
    156     Draw4;
    157     NewItem := Add;
    158     NewItem.Caption := ComboBox1.Items[3];
    159     NewItem.SubItems.Add(FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)));
    160     Draw5;
    161     NewItem := Add;
    162     NewItem.Caption := ComboBox1.Items[4];
    163     NewItem.SubItems.Add(FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)));
    164     Draw6;
    165     NewItem := Add;
    166     NewItem.Caption := ComboBox1.Items[5];
    167     NewItem.SubItems.Add(FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3)));
     110    for I := 0 to High(DrawMethodClasses) do begin
     111      DrawMethod.Free;
     112      DrawMethod := DrawMethodClasses[I].Create;
     113      DrawMethod.Bitmap := Image1.Picture.Bitmap;
     114      DrawMethod.Bitmap.SetSize(Image1.Picture.Bitmap.Width, Image1.Picture.Bitmap.Height);
     115      DrawMethod.DrawFrameTiming(TFastBitmap(Scenes[0]));
     116      NewItem := Add;
     117      NewItem.Caption := DrawMethod.Caption;
     118      NewItem.SubItems.Add(FloatToStr(RoundTo(DrawMethod.FrameDuration / OneMillisecond, -3)));
     119      NewItem.SubItems.Add(FloatToStr(RoundTo(1 / (DrawMethod.FrameDuration / OneSecond), -3)));
     120    end;
    168121  finally
    169122    EndUpdate;
    … …  
    177130end;
    178131
     132procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
     133begin
     134  ButtonStopClick(Self);
     135end;
     136
    179137procedure TMainForm.FormDestroy(Sender: TObject);
    180138begin
    … …  
    185143procedure TMainForm.Timer1Timer(Sender: TObject);
    186144begin
    187   Label2.Caption := IntToStr(Frames);
    188   Label4.Caption := FloatToStr(RoundTo(FrameDuration / OneMillisecond, -3));
    189   Frames := 0;
    190 end;
    191 
    192 procedure TMainForm.Draw1;
    193 var
    194   Y, X: Integer;
    195 begin
    196   repeat
    197     StartTime := NowPrecise;
    198     Inc(Frames);
    199     with TScene(Scenes[SceneIndex]) do begin
    200       for X := 0 to Size.X - 1 do
    201         for Y := 0 to Size.Y - 1 do
    202           Image1.Picture.Bitmap.Canvas.Pixels[X, Y] := Pixels[X, Y] * $010101;
    203       FrameDuration := NowPrecise - StartTime;
    204     end;
    205     SceneIndex := (SceneIndex + 1) mod Scenes.Count;
    206     Application.ProcessMessages;
    207   until ButtonStart.Enabled;
    208 end;
    209 
    210 procedure TMainForm.Draw2;
    211 var
    212   Y, X: Integer;
    213   TempIntfImage: TLazIntfImage;
    214 begin
    215   try
    216   TempIntfImage := TLazIntfImage.Create(0, 0);
    217   repeat
    218     StartTime := NowPrecise;
    219     Inc(Frames);
    220     with TScene(Scenes[SceneIndex]) do begin
    221       TempIntfImage.LoadFromBitmap(Image1.Picture.Bitmap.Handle,
    222         Image1.Picture.Bitmap.MaskHandle);
    223       for X := 0 to Size.X - 1 do
    224         for Y := 0 to Size.Y - 1 do
    225           TempIntfImage.Colors[X, Y] := TColorToFPColor(Pixels[X, Y] * $010101);
    226       Image1.Picture.Bitmap.LoadFromIntfImage(TempIntfImage);
    227       FrameDuration := NowPrecise - StartTime;
    228     end;
    229     SceneIndex := (SceneIndex + 1) mod Scenes.Count;
    230     Application.ProcessMessages;
    231   until ButtonStart.Enabled;
    232   finally
    233     TempIntfImage.Free;
     145  if Assigned(DrawMethod) then begin
     146    if (DrawMethod.FrameDuration > 0) then
     147      Label2.Caption := FloatToStr(RoundTo(1 / (DrawMethod.FrameDuration / OneSecond), -3))
     148      else Label2.Caption := '0';
     149    Label4.Caption := FloatToStr(RoundTo(DrawMethod.FrameDuration / OneMillisecond, -3)) + ' ms';
    234150  end;
    235 end;
    236 
    237 procedure TMainForm.Draw3;
    238 var
    239   Y, X: Integer;
    240 begin
    241   repeat
    242     StartTime := NowPrecise;
    243     Inc(Frames);
    244     with TScene(Scenes[SceneIndex]) do
    245     try
    246       Image1.Picture.Bitmap.BeginUpdate(True);
    247       for X := 0 to Size.X - 1 do
    248         for Y := 0 to Size.Y - 1 do
    249           Image1.Picture.Bitmap.Canvas.Pixels[X, Y] := Pixels[X, Y] * $010101;
    250     finally
    251       Image1.Picture.Bitmap.EndUpdate(False);
    252     end;
    253     FrameDuration := NowPrecise - StartTime;
    254     SceneIndex := (SceneIndex + 1) mod Scenes.Count;
    255     Application.ProcessMessages;
    256   until ButtonStart.Enabled;
    257 end;
    258 
    259 procedure TMainForm.Draw4;
    260 var
    261   Y, X: Integer;
    262   TempIntfImage: TLazIntfImage;
    263   C: TFPColor;
    264 begin
    265   try
    266   TempIntfImage := Image1.Picture.Bitmap.CreateIntfImage;
    267   repeat
    268     StartTime := NowPrecise;
    269     Inc(Frames);
    270 
    271     with TScene(Scenes[SceneIndex]) do begin
    272       for X := 0 to Size.X - 1 do
    273         for Y := 0 to Size.Y - 1 do begin
    274           C := TColorToFPColor(Pixels[X, Y] * $010101);
    275           TempIntfImage.Colors[X, Y] := C;
    276         end;
    277       Image1.Picture.Bitmap.LoadFromIntfImage(TempIntfImage);
    278     end;
    279     FrameDuration := NowPrecise - StartTime;
    280     SceneIndex := (SceneIndex + 1) mod Scenes.Count;
    281     Application.ProcessMessages;
    282   until ButtonStart.Enabled;
    283   finally
    284     TempIntfImage.Free;
    285   end;
    286 end;
    287 
    288 procedure TMainForm.Draw5;
    289 var
    290   Y, X: Integer;
    291   PixelPtr: PInteger;
    292   P: TPixelFormat;
    293   RawImage: TRawImage;
    294   BytePerPixel: Integer;
    295 begin
    296   P := Image1.Picture.Bitmap.PixelFormat;
    297   repeat
    298     StartTime := NowPrecise;
    299     Inc(Frames);
    300     with TScene(Scenes[SceneIndex]) do
    301     try
    302       Image1.Picture.Bitmap.BeginUpdate(False);
    303       RawImage := Image1.Picture.Bitmap.RawImage;
    304       PixelPtr := PInteger(RawImage.Data);
    305       BytePerPixel := RawImage.Description.BitsPerPixel div 8;
    306       for X := 0 to Size.X - 1 do
    307         for Y := 0 to Size.Y - 1 do begin
    308           PixelPtr^ := Pixels[X, Y] * $010101;
    309           Inc(PByte(PixelPtr), BytePerPixel);
    310         end;
    311     finally
    312       Image1.Picture.Bitmap.EndUpdate(False);
    313     end;
    314     FrameDuration := NowPrecise - StartTime;
    315     SceneIndex := (SceneIndex + 1) mod Scenes.Count;
    316     Application.ProcessMessages;
    317   until ButtonStart.Enabled;
    318 end;
    319 
    320 procedure TMainForm.Draw6;
    321 var
    322   Y, X: Integer;
    323   PixelPtr: PInteger;
    324   P: TPixelFormat;
    325   RawImage: TRawImage;
    326   BytePerPixel: Integer;
    327   hPaint, hBmp: HDC;
    328 begin
    329   P := Image1.Picture.Bitmap.PixelFormat;
    330   repeat
    331     StartTime := NowPrecise;
    332     Inc(Frames);
    333     with TScene(Scenes[SceneIndex]) do
    334     try
    335       Bitmap.BeginUpdate(False);
    336       RawImage := Bitmap.RawImage;
    337       PixelPtr := PInteger(RawImage.Data);
    338       BytePerPixel := RawImage.Description.BitsPerPixel div 8;
    339       for X := 0 to Size.X - 1 do
    340         for Y := 0 to Size.Y - 1 do begin
    341           PixelPtr^ := Pixels[X, Y] * $010101;
    342           Inc(PByte(PixelPtr), BytePerPixel);
    343         end;
    344     finally
    345       Bitmap.EndUpdate(False);
    346     end;
    347     hBmp := Bitmap.Canvas.Handle;
    348     hPaint := PaintBox1.Canvas.Handle;
    349     BitBlt(hPaint, 0, 0, Bitmap.Width, Bitmap.Height, hBmp, 0, 0, srcCopy);
    350 
    351     FrameDuration := NowPrecise - StartTime;
    352     SceneIndex := (SceneIndex + 1) mod Scenes.Count;
    353     Application.ProcessMessages;
    354   until ButtonStart.Enabled;
    355151end;
    356152
Note: See TracChangeset for help on using the changeset viewer.