Ignore:
Timestamp:
Dec 20, 2016, 6:02:51 PM (8 years ago)
Author:
chronos
Message:
  • Added: Define specialized classes for various usual pixmaxs.
Location:
branches/gbitmap
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • branches/gbitmap

    • Property svn:ignore

      •  

        old new  
        33project1.lps
        44project1.res
         5project1.exe

  • branches/gbitmap/UFormMain.pas

    r18 r19  
    77uses
    88  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
    9   ExtCtrls, StdCtrls, GPixmap;
     9  ExtCtrls, StdCtrls, GPixmap, UPixmapSpecialized, GImage;
    1010
    1111type
    12   TRGB8 = record
    13     R: Byte;
    14     B: Byte;
    15     G: Byte;
    16     function Create(R, G, B: Byte): TRGB8;
    17   end;
    18 
    19   { TRGB16 }
    20 
    21   TRGB16 = record
    22     R: Word;
    23     B: Word;
    24     G: Word;
    25     function Create(R, G, B: Word): TRGB16;
    26   end;
    27 
    28   { TGrayVar }
    29 
    30   TGrayVar = PByte;
    3112
    3213  { TForm1 }
    … …  
    3920    procedure ListBox1SelectionChange(Sender: TObject; User: boolean);
    4021  private
    41     function Gray8ToColor(Value: Byte): TColor;
    42     function Gray32ToColor(Value: Cardinal): TColor;
    43     function Gray16Random(Position: TPoint): Word;
    44     function Gray16ToColor(Value: Word): TColor;
    45     function Gray32Random(Position: TPoint): Cardinal;
    46     function Gray4Random(Position: TPoint): Byte;
    47     function Gray1Random(Position: TPoint): Byte;
    48     function Gray2Random(Position: TPoint): Byte;
    49     function Gray8Random(Position: TPoint): Byte;
    50     function RGB16Random(Position: TPoint): TRGB16;
    51     function RGB16ToColor(Value: TRGB16): TColor;
    52     function RGB8Random(Position: TPoint): TRGB8;
    53     function RGB8ToColor(Value: TRGB8): TColor;
    54     function Gray1ToColor(Value: Byte): TColor;
    55     function Gray2ToColor(Value: Byte): TColor;
    56     function Gray4ToColor(Value: Byte): TColor;
    57     function GrayVarToColor(Value: TGrayVar): TColor;
    58     function GrayVarCreate(Value: QWord): TGrayVar;
    59     procedure TestGray16;
     22    function Gray1Random(Position: TPoint): TColorGray1;
     23    function Gray2Random(Position: TPoint): TColorGray2;
     24    function Gray4Random(Position: TPoint): TColorGray4;
     25    function Gray8Random(Position: TPoint): TColorGray8;
     26    function Gray16Random(Position: TPoint): TColorGray16;
     27    function Gray32Random(Position: TPoint): TColorGray32;
     28    function RGB8Random(Position: TPoint): TColorRGB8;
     29    function RGB16Random(Position: TPoint): TColorRGB16;
     30  public
     31    procedure TestGray1;
    6032    procedure TestGray2;
    6133    procedure TestGray4;
    62   public
    63     procedure TestGray1;
    6434    procedure TestGray8;
     35    procedure TestGray16;
    6536    procedure TestGray32;
    6637    procedure TestRGB8;
    6738    procedure TestRGB16;
    6839    procedure TestGrayVar;
     40    procedure TestImage;
    6941  end;
    7042
    … …  
    7244  Form1: TForm1;
    7345
     46
    7447implementation
    7548
    7649{$R *.lfm}
    7750
    78 { TRGB16 }
    79 
    80 function TRGB16.Create(R, G, B: Word): TRGB16;
    81 begin
    82   Result.R := R;
    83   Result.G := G;
    84   Result.B := B;
    85 end;
    86 
    87 { TRGB8 }
    88 
    89 function TRGB8.Create(R, G, B: Byte): TRGB8;
    90 begin
    91   Result.R := R;
    92   Result.G := G;
    93   Result.B := B;
    94 end;
    95 
    9651{ TForm1 }
    9752
    98 function TForm1.Gray1ToColor(Value: Byte): TColor;
    99 begin
    100   Value := (Value and $1) * $ff;
    101   Result := (Value shl 16) or (Value shl 8) or (Value shl 0);
    102 end;
    103 
    104 function TForm1.Gray2ToColor(Value: Byte): TColor;
    105 begin
    106   Value := (Value and $3) * (255 div (4 - 1));
    107   Result := (Value shl 16) or (Value shl 8) or (Value shl 0);
    108 end;
    109 
    110 function TForm1.Gray4ToColor(Value: Byte): TColor;
    111 begin
    112   Value := (Value and $f) * (255 div (16 - 1));
    113   Result := (Value shl 16) or (Value shl 8) or (Value shl 0);
    114 end;
    115 
    116 function TForm1.Gray8ToColor(Value: Byte): TColor;
    117 begin
    118   Result := (Value shl 16) or (Value shl 8) or (Value shl 0);
    119 end;
    120 
    121 function TForm1.Gray16ToColor(Value: Word): TColor;
    122 begin
    123   Value := (Value shr 8) and $ff;
    124   Result := (Value shl 16) or (Value shl 8) or (Value shl 0);
    125 end;
    126 
    127 function TForm1.Gray32ToColor(Value: Cardinal): TColor;
    128 begin
    129   Value := (Value shr 24) and $ff;
    130   Result := (Value shl 16) or (Value shl 8) or (Value shl 0);
    131 end;
    132 
    133 function TForm1.RGB8ToColor(Value: TRGB8): TColor;
    134 begin
    135   Result := (Value.R shl 16) or (Value.G shl 8) or (Value.B shl 0);
    136 end;
    137 
    138 function TForm1.RGB16ToColor(Value: TRGB16): TColor;
    139 begin
    140   Result := ((Value.R shr 8) shl 16) or ((Value.G shr 8) shl 8) or
    141     ((Value.B shr 8) shl 0);
    142 end;
    143 
    144 function TForm1.GrayVarToColor(Value: TGrayVar): TColor;
    145 var
    146   ValuePart: Byte;
    147 begin
    148   if Assigned(Value) then begin
    149     ValuePart := PByte(Value + MemSize(Value) - 1)^;
    150     Result := (ValuePart shl 16) or (ValuePart shl 8) or (ValuePart shl 0);
    151   end else Result := clBlack;
    152 end;
    153 
    154 function TForm1.GrayVarCreate(Value: QWord): TGrayVar;
    155 begin
    156   Result := GetMem(SizeOf(Value));
    157   Move(Value, Result^, SizeOf(Value));
    158 end;
    159 
    160 function TForm1.Gray1Random(Position: TPoint): Byte;
     53
     54function TForm1.Gray1Random(Position: TPoint): TColorGray1;
    16155begin
    16256  Result := Random(2);
    16357end;
    16458
    165 function TForm1.Gray2Random(Position: TPoint): Byte;
     59function TForm1.Gray2Random(Position: TPoint): TColorGray2;
    16660begin
    16761  Result := Random(4);
    16862end;
    16963
    170 function TForm1.Gray4Random(Position: TPoint): Byte;
     64function TForm1.Gray4Random(Position: TPoint): TColorGray4;
    17165begin
    17266  Result := Random($10);
    17367end;
    17468
    175 function TForm1.Gray8Random(Position: TPoint): Byte;
     69function TForm1.Gray8Random(Position: TPoint): TColorGray8;
    17670begin
    17771  Result := Random($100);
    17872end;
    17973
    180 function TForm1.Gray16Random(Position: TPoint): Word;
     74function TForm1.Gray16Random(Position: TPoint): TColorGray16;
    18175begin
    18276  Result := Random($10000);
    18377end;
    18478
    185 function TForm1.Gray32Random(Position: TPoint): Cardinal;
     79function TForm1.Gray32Random(Position: TPoint): TColorGray32;
    18680begin
    18781  Result := Random($ffffffff);
    18882end;
    18983
    190 function TForm1.RGB8Random(Position: TPoint): TRGB8;
     84function TForm1.RGB8Random(Position: TPoint): TColorRGB8;
    19185begin
    19286  Result.R := Random($100);
    … …  
    19589end;
    19690
    197 function TForm1.RGB16Random(Position: TPoint): TRGB16;
     91function TForm1.RGB16Random(Position: TPoint): TColorRGB16;
    19892begin
    19993  Result.R := Random($10000);
    … …  
    20498procedure TForm1.TestGray1;
    20599var
    206   Bitmap: TGPixmapBit<Byte>;
    207 begin
    208   Bitmap := TGPixmapBit<Byte>.Create;
     100  Bitmap: TPixmapGray1;
     101begin
     102  Bitmap := TPixmapGray1.Create;
    209103  with Bitmap do begin
    210104    BitsPerPixel := 1;
    … …  
    223117procedure TForm1.TestGray2;
    224118var
    225   Bitmap: TGPixmapBit<Byte>;
    226 begin
    227   Bitmap := TGPixmapBit<Byte>.Create;
     119  Bitmap: TPixmapGray2;
     120begin
     121  Bitmap := TPixmapGray2.Create;
    228122  with Bitmap do begin
    229123    BitsPerPixel := 2;
    … …  
    242136procedure TForm1.TestGray4;
    243137var
    244   Bitmap: TGPixmapBit<Byte>;
    245 begin
    246   Bitmap := TGPixmapBit<Byte>.Create;
     138  Bitmap: TPixmapGray4;
     139begin
     140  Bitmap := TPixmapGray4.Create;
    247141  with Bitmap do begin
    248142    BitsPerPixel := 4;
    … …  
    261155procedure TForm1.TestGray8;
    262156var
    263   Bitmap: TGPixmap<Byte>;
    264 begin
    265   Bitmap := TGPixmap<Byte>.Create;
     157  Bitmap: TPixmapGray8;
     158begin
     159  Bitmap := TPixmapGray8.Create;
    266160  with Bitmap do begin
    267161    Size := Point(100, 100);
    … …  
    279173procedure TForm1.TestGray16;
    280174var
    281   Bitmap: TGPixmap<Word>;
    282 begin
    283   Bitmap := TGPixmap<Word>.Create;
     175  Bitmap: TPixmapGray16;
     176begin
     177  Bitmap := TPixmapGray16.Create;
    284178  with Bitmap do begin
    285179    Size := Point(100, 100);
    … …  
    297191procedure TForm1.TestGray32;
    298192var
    299   Bitmap: TGPixmap<Cardinal>;
    300 begin
    301   Bitmap := TGPixmap<Cardinal>.Create;
     193  Bitmap: TPixmapGray32;
     194begin
     195  Bitmap := TPixmapGray32.Create;
    302196  with Bitmap do begin
    303197    Size := Point(100, 100);
    … …  
    315209procedure TForm1.TestRGB8;
    316210var
    317   Bitmap: TGPixmap<TRGB8>;
    318 begin
    319   Bitmap := TGPixmap<TRGB8>.Create;
    320   with Bitmap do begin
    321     Size := Point(100, 100);
    322     Fill(TRGB8.Create(255, 0, 0));
     211  Bitmap: TPixmapRGB8;
     212begin
     213  Bitmap := TPixmapRGB8.Create;
     214  with Bitmap do begin
     215    Size := Point(100, 100);
     216    Fill(TColorRGB8.Create(255, 0, 0));
    323217    Fill(RGB8Random);
    324     Pixels[0, 0] := TRGB8.Create(1, 1, 1);
     218    Pixels[0, 0] := TColorRGB8.Create(1, 1, 1);
    325219    Canvas.Pen.LineTo(Point(60, 40));
    326220    Image1.Picture.Bitmap.SetSize(Size.X, Size.Y);
    … …  
    333227procedure TForm1.TestRGB16;
    334228var
    335   Bitmap: TGPixmap<TRGB16>;
    336 begin
    337   Bitmap := TGPixmap<TRGB16>.Create;
    338   with Bitmap do begin
    339     Size := Point(100, 100);
    340     Fill(TRGB16.Create($ffff, 0, 0));
     229  Bitmap: TPixmapRGB16;
     230begin
     231  Bitmap := TPixmapRGB16.Create;
     232  with Bitmap do begin
     233    Size := Point(100, 100);
     234    Fill(TColorRGB16.Create($ffff, 0, 0));
    341235    Fill(RGB16Random);
    342     Pixels[0, 0] := TRGB16.Create(1, 1, 1);
     236    Pixels[0, 0] := TColorRGB16.Create(1, 1, 1);
    343237    Canvas.Pen.LineTo(Point(60, 40));
    344238    Image1.Picture.Bitmap.SetSize(Size.X, Size.Y);
    … …  
    351245procedure TForm1.TestGrayVar;
    352246var
    353   Bitmap: TGPixmap<TGrayVar>;
    354 begin
    355   Bitmap := TGPixmap<TGrayVar>.Create;
     247  Bitmap: TPixmapGrayVar;
     248begin
     249  Bitmap := TPixmapGrayVar.Create;
    356250  with Bitmap do begin
    357251    Size := Point(100, 100);
    … …  
    362256    PaintToCanvas(Image1.Picture.Bitmap.Canvas, GrayVarToColor);
    363257    Label1.Caption := IntToStr(GetDataSize);
     258    Free;
     259  end;
     260end;
     261
     262procedure TForm1.TestImage;
     263var
     264  Image: TGImage;
     265  Color: TBColorGray1;
     266begin
     267  Image := TGImage.Create;
     268  with Image do begin
     269    Size := Point(100, 100);
     270    ColorFormat := cfGray1;
     271    Color := TBColorGray1.Create;
     272    Color.Value := 1;
     273    Fill(Color);
     274    Random;
     275    PaintToCanvas(Image1.Picture.Bitmap.Canvas);
    364276    Free;
    365277  end;
    … …  
    384296    7: TestRGB16;
    385297    8: TestGrayVar;
     298    9: TestImage;
    386299  end;
    387300end;
Note: See TracChangeset for help on using the changeset viewer.