Changeset 450 for GraphicTest


Ignore:
Timestamp:
Nov 23, 2012, 1:11:03 PM (12 years ago)
Author:
chronos
Message:
  • Added: Test using Graphics32 package TGR32Image class.
  • Modified: Used packages are now located uncompressed in Packages subfolder.
Location:
GraphicTest
Files:
364 added
1 deleted
6 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/GraphicTest.lpi

    r447 r450  
    6666      </local>
    6767    </RunParams>
    68     <RequiredPackages Count="4">
     68    <RequiredPackages Count="5">
    6969      <Item1>
    70         <PackageName Value="SynEdit"/>
     70        <PackageName Value="GR32_L"/>
     71        <DefaultFilename Value="Packages/Graphics32/Packages/GR32_L.lpk" Prefer="True"/>
    7172      </Item1>
    7273      <Item2>
    73         <PackageName Value="bgrabitmappack"/>
     74        <PackageName Value="SynEdit"/>
    7475      </Item2>
    7576      <Item3>
    76         <PackageName Value="lazopenglcontext"/>
     77        <PackageName Value="bgrabitmappack"/>
     78        <DefaultFilename Value="Packages/BGRABitmap/bgrabitmappack.lpk" Prefer="True"/>
    7779      </Item3>
    7880      <Item4>
     81        <PackageName Value="lazopenglcontext"/>
     82      </Item4>
     83      <Item5>
    7984        <PackageName Value="LCL"/>
    80       </Item4>
     85      </Item5>
    8186    </RequiredPackages>
    82     <Units Count="17">
     87    <Units Count="18">
    8388      <Unit0>
    8489        <Filename Value="GraphicTest.lpr"/>
    … …  
    171176        <UnitName Value="UOpenGLPBOMethod"/>
    172177      </Unit16>
     178      <Unit17>
     179        <Filename Value="Methods/UGraphics32Method.pas"/>
     180        <IsPartOfProject Value="True"/>
     181        <UnitName Value="UGraphics32Method"/>
     182      </Unit17>
    173183    </Units>
    174184  </ProjectOptions>

  • GraphicTest/GraphicTest.lpr

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

  • GraphicTest/Methods/UBitmapRawImageDataPaintBox.pas

    r449 r450  
    77uses
    88  Classes, SysUtils, UDrawMethod, UFastBitmap, Graphics, LCLType,
    9   FPimage, IntfGraphics, GraphType;
     9  FPimage, IntfGraphics, GraphType{$IFDEF windows}, Windows{$ENDIF};
    1010
    1111type
    … …  
    3838  //PaintBox.Canvas.CopyRect(Rect(0, 0, PaintBox.Width, PaintBox.Height), TempBitmap.Canvas,
    3939  //  Rect(0, 0, TempBitmap.Width, TempBitmap.Height));
    40   PaintBox.Canvas.Draw(0, 0, TempBitmap);
    41   //BitBlt(hPaint, 0, 0, TempBitmap.Width, TempBitmap.Height, hBmp, 0, 0, srcCopy);
     40  //PaintBox.Canvas.Draw(0, 0, TempBitmap);
     41  BitBlt(hPaint, 0, 0, TempBitmap.Width, TempBitmap.Height, hBmp, 0, 0, srcCopy);
    4242end;
    4343

  • GraphicTest/UFastBitmap.pas

    r442 r450  
    3838    constructor Create;
    3939    destructor Destroy; override;
    40     procedure RandomImage;
     40    procedure RandomImage(Index, Count: Integer);
    4141    property Size: TPoint read FSize write SetSize;
    4242    property Pixels[X, Y: Integer]: TFastBitmapPixel read GetPixel write SetPixel;
    … …  
    204204end;
    205205
    206 procedure TFastBitmap.RandomImage;
     206procedure TFastBitmap.RandomImage(Index, Count: Integer);
    207207var
    208208  I, X, Y: Integer;
    209209begin
     210  // Main three color blocks
    210211  for I := 0 to 2 do
    211     for Y := 0 to (Size.Y div 2) - 1 do
     212    for Y := 0 to (Size.Y div 3) - 1 do
    212213      for X := 0 to (Size.X div 3) - 1 do
    213214        Pixels[X + (I * (Size.X div 3)), Y] := (255 shl (I * 8)) and $ffffff;
    214215
    215   for Y := (Size.Y div 2) to Size.Y - 1 do
     216  // Random noise
     217  for Y := (Size.Y div 3) to (Size.Y * 2 div 3) - 1 do
    216218    for X := 0 to Size.X - 1 do
    217219      Pixels[X, Y] := (Random(256) or (Random(256) shl 16) or (Random(256) shl 8)) and $ffffff;
     220
     221  // Color gradient
     222  for Y := (Size.Y * 2 div 3) to (Size.Y - 1) do begin
     223    for X := 0 to Size.X - 1 do
     224      Pixels[X, Y] := (Trunc(Sin((X + Trunc(Index / Count * Size.X)) mod Size.X
     225        / Size.X * pi) * 255) * $010101) and $ffffff;
     226  end;
    218227end;
    219228

  • GraphicTest/UMainForm.lfm

    r448 r450  
    33  Height = 411
    44  Top = 117
    5   Width = 846
     5  Width = 857
    66  Caption = 'Graphic test'
    77  ClientHeight = 411
    8   ClientWidth = 846
     8  ClientWidth = 857
    99  OnClose = FormClose
    1010  OnCreate = FormCreate
    … …  
    1313  LCLVersion = '1.1'
    1414  object PageControl1: TPageControl
    15     Left = 544
     15    Left = 555
    1616    Height = 411
    1717    Top = 0
    … …  
    526526    Height = 411
    527527    Top = 0
    528     Width = 539
     528    Width = 550
    529529    Align = alClient
    530530    BevelOuter = bvNone
    531531    ClientHeight = 411
    532     ClientWidth = 539
     532    ClientWidth = 550
    533533    TabOrder = 1
    534534    object ListViewMethods: TListView
    … …  
    536536      Height = 335
    537537      Top = 8
    538       Width = 528
     538      Width = 539
    539539      Anchors = [akTop, akLeft, akRight, akBottom]
    540540      Columns = <     
    … …  
    690690      TabOrder = 8
    691691    end
     692    object CheckBox1: TCheckBox
     693      Left = 408
     694      Height = 17
     695      Top = 387
     696      Width = 58
     697      Anchors = [akLeft, akBottom]
     698      Caption = 'Opaque'
     699      OnChange = CheckBox1Change
     700      TabOrder = 9
     701    end
    692702  end
    693703  object Splitter1: TSplitter
    694     Left = 539
     704    Left = 550
    695705    Height = 411
    696706    Top = 0

  • GraphicTest/UMainForm.pas

    r449 r450  
    2222    ButtonSingleTest: TButton;
    2323    ButtonStop: TButton;
     24    CheckBox1: TCheckBox;
    2425    CheckBoxDoubleBuffered: TCheckBox;
    2526    CheckBoxEraseBackground: TCheckBox;
    … …  
    4445    procedure ButtonSingleTestClick(Sender: TObject);
    4546    procedure ButtonStopClick(Sender: TObject);
     47    procedure CheckBox1Change(Sender: TObject);
    4648    procedure CheckBoxDoubleBufferedChange(Sender: TObject);
    4749    procedure CheckBoxEraseBackgroundChange(Sender: TObject);
    … …  
    8587  UCanvasPixelsUpdateLock, UBGRABitmapPaintBox, UBitmapRawImageDataPaintBox,
    8688  UBitmapRawImageData, UBitmapRawImageDataMove, UDummyMethod, UOpenGLMethod,
    87   UOpenGLPBOMethod;
     89  UOpenGLPBOMethod, UGraphics32Method;
    8890
    8991const
    90   DrawMethodClasses: array[0..{$IFDEF opengl}10{$ELSE}8{$ENDIF}] of TDrawMethodClass = (
     92  DrawMethodClasses: array[0..9{$IFDEF opengl}+2{$ENDIF}] of TDrawMethodClass = (
    9193    TCanvasPixels, TCanvasPixelsUpdateLock, TLazIntfImageColorsCopy,
    9294    TLazIntfImageColorsNoCopy, TBitmapRawImageData, TBitmapRawImageDataPaintBox,
    93     TBitmapRawImageDataMove, TBGRABitmapPaintBox{$IFDEF opengl}, TOpenGLMethod, TOpenGLPBOMethod{$ENDIF}
     95    TBitmapRawImageDataMove, TBGRABitmapPaintBox, TGraphics32Method{$IFDEF opengl}, TOpenGLMethod, TOpenGLPBOMethod{$ENDIF}
    9496    ,TDummyMethod);
    9597
    … …  
    190192end;
    191193
     194procedure TMainForm.CheckBox1Change(Sender: TObject);
     195begin
     196  if CheckBox1.Checked then
     197    DrawForm.ControlStyle := DrawForm.ControlStyle + [csOpaque]
     198    else DrawForm.ControlStyle := DrawForm.ControlStyle - [csOpaque];
     199end;
     200
    192201procedure TMainForm.CheckBoxDoubleBufferedChange(Sender: TObject);
    193202begin
    … …  
    280289    NewScene := TFastBitmap.Create;
    281290    NewScene.Size := FrameSize;
    282     NewScene.RandomImage;
     291    NewScene.RandomImage(I, SceneFrameCount);
    283292    Scenes.Add(NewScene);
    284293  end;
    … …  
    300309  CheckBoxDoubleBuffered.Checked := DrawForm.DoubleBuffered;
    301310  CheckBoxEraseBackground.Checked := DrawForm.EraseBackgroundEnabled;
     311  CheckBox1.Checked := csOpaque in DrawForm.ControlStyle;
    302312end;
    303313
Note: See TracChangeset for help on using the changeset viewer.