Changeset 9


Ignore:
Timestamp:
Sep 21, 2014, 8:11:48 PM (10 years ago)
Author:
chronos
Message:
  • Modified: Not TGBitmap and TGColor data are stored as TBitMemory to support color formats with lower bit width size then 8.
Location:
trunk
Files:
1 added
8 edited

Legend:

Unmodified
Added
Removed

  • trunk

    • Property svn:ignore

      •  

        old new  
        22LibrePaint
        33lib
         4backup

  • trunk/ColorFormats/UColorGray1.pas

    r7 r9  
    1717    function GetChannelBitPos(Channel: TGColorChannel): Integer; override;
    1818    function GetChannelBitWidth(Channel: TGColorChannel): Integer; override;
    19     function ColorToTColor(Color: TGColor): TColor; override;
    20     procedure ColorFromTColor(GColor: TGColor; Color: TColor); override;
    21     function GetColorClass: TGColorClass; override;
    2219  end;
    2320
    … …  
    5653end;
    5754
    58 function TGColorFormatGray1.ColorToTColor(Color: TGColor): TColor;
    59 begin
    60   Result := $ffffff * (PByte(Color.Data + GetChannelBitPos(ccGray))^ and 1);
    61 end;
    62 
    63 procedure TGColorFormatGray1.ColorFromTColor(GColor: TGColor; Color: TColor);
    64 begin
    65   PByte(GColor.Data + GetChannelBitPos(ccGray))^ := (((Color and $ff) +
    66   ((Color shr 8) and $ff) +
    67   ((Color shr 16) and $ff)) div 3) shr 7;
    68 end;
    69 
    70 function TGColorFormatGray1.GetColorClass: TGColorClass;
    71 begin
    72   Result := TGColor;
    73 end;
    74 
    7555
    7656end.

  • trunk/ColorFormats/UColorGray8.pas

    r7 r9  
    1717    function GetChannelBitPos(Channel: TGColorChannel): Integer; override;
    1818    function GetChannelBitWidth(Channel: TGColorChannel): Integer; override;
    19     function ColorToTColor(Color: TGColor): TColor; override;
    20     procedure ColorFromTColor(GColor: TGColor; Color: TColor); override;
    21     function GetColorClass: TGColorClass; override;
    2219  end;
    2320
    … …  
    2825function TGColorFormatGray8.GetPixelSize: Integer;
    2926begin
    30   Result := 1;
     27  Result := 8;
    3128end;
    3229
    … …  
    4542  case Channel of
    4643    ccGray: Result := 0;
    47     else raise Exception.Create('Unsupported color channel');
     44    else Result := 0;
    4845  end;
    4946end;
    … …  
    5653end;
    5754
    58 function TGColorFormatGray8.ColorToTColor(Color: TGColor): TColor;
    59 begin
    60   Result := $010101 * PByte(Color.Data + (GetChannelBitPos(ccGray) shr 3))^;
    61 end;
    62 
    63 procedure TGColorFormatGray8.ColorFromTColor(GColor: TGColor; Color: TColor);
    64 begin
    65   PByte(GColor.Data + (GetChannelBitPos(ccGray) shr 3))^ := ((Color and $ff) +
    66   ((Color shr 8) and $ff) +
    67   ((Color shr 16) and $ff)) div 3;
    68 end;
    69 
    70 function TGColorFormatGray8.GetColorClass: TGColorClass;
    71 begin
    72   Result := TGColor;
    73 end;
    74 
    7555
    7656end.

  • trunk/ColorFormats/UColorRGBA8.pas

    r7 r9  
    66
    77uses
    8   Classes, SysUtils, Graphics, UGraphic;
     8  Classes, SysUtils, Graphics, UGraphic, UMemory;
    99
    1010type
    … …  
    1717    function GetChannelBitPos(Channel: TGColorChannel): Integer; override;
    1818    function GetChannelBitWidth(Channel: TGColorChannel): Integer; override;
    19     function ColorToTColor(Color: TGColor): TColor; override;
    20     procedure ColorFromTColor(GColor: TGColor; Color: TColor); override;
    21     function GetColorClass: TGColorClass; override;
    2219  end;
    2320
    … …  
    2926function TGColorFormatRGBA8.GetPixelSize: Integer;
    3027begin
    31   Result := 4;
     28  Result := 32;
    3229end;
    3330
    … …  
    4946    ccBlue: Result := 16;
    5047    ccOpacity: Result := 24;
    51     else raise Exception.Create('Unsupported color channel');
     48    else Result := 0;
    5249  end;
    5350end;
    … …  
    6057end;
    6158
    62 function TGColorFormatRGBA8.ColorToTColor(Color: TGColor): TColor;
    63 begin
    64   Result := PByte(Color.Data + (GetChannelBitPos(ccRed) shr 3))^ or
    65     (PByte(Color.Data + (GetChannelBitPos(ccGreen) shr 3))^ shl 8) or
    66     (PByte(Color.Data + (GetChannelBitPos(ccBlue) shr 3))^ shl 16);
    67 end;
    68 
    69 procedure TGColorFormatRGBA8.ColorFromTColor(GColor: TGColor; Color: TColor);
    70 begin
    71   PByte(GColor.Data + (GetChannelBitPos(ccRed) shr 3))^ := Color and $ff;
    72   PByte(GColor.Data + (GetChannelBitPos(ccGreen) shr 3))^ := (Color shr 8) and $ff;
    73   PByte(GColor.Data + (GetChannelBitPos(ccBlue) shr 3))^ := (Color shr 16) and $ff;
    74 end;
    75 
    76 function TGColorFormatRGBA8.GetColorClass: TGColorClass;
    77 begin
    78   Result := TGColor;
    79 end;
    80 
    81 
    8259end.
    8360

  • trunk/LibrePaint.lpi

    r8 r9  
    7171      </Item1>
    7272    </RequiredPackages>
    73     <Units Count="9">
     73    <Units Count="10">
    7474      <Unit0>
    7575        <Filename Value="LibrePaint.lpr"/>
    … …  
    9999        <HasResources Value="True"/>
    100100        <ResourceBaseClass Value="Form"/>
    101         <UnitName Value="UFormNew"/>
    102101      </Unit4>
    103102      <Unit5>
    … …  
    112111        <HasResources Value="True"/>
    113112        <ResourceBaseClass Value="Form"/>
    114         <UnitName Value="UFormMain"/>
    115113      </Unit6>
    116114      <Unit7>
    … …  
    124122        <UnitName Value="UColorGray1"/>
    125123      </Unit8>
     124      <Unit9>
     125        <Filename Value="UMemory.pas"/>
     126        <IsPartOfProject Value="True"/>
     127        <UnitName Value="UMemory"/>
     128      </Unit9>
    126129    </Units>
    127130  </ProjectOptions>

  • trunk/LibrePaint.lpr

    r7 r9  
    88  {$ENDIF}{$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UCore, UGraphic, UProject, UFormNew, UFormMain, UColorRGBA8,
    11 UColorGray8, UColorGray1
     10  Forms, UCore, UGraphic, UProject, UBitStream, UMemory, UFormNew, UFormMain,
     11  UColorRGBA8, UColorGray8, UColorGray1
    1212  { you can add units after this };
    1313

  • trunk/UCore.pas

    r8 r9  
    6666
    6767  // Set default
    68   Project.Bitmap.Size := Point(800, 600);
     68  Project.Bitmap.Size := Point(200, 100);
    6969  if ColorManager.FormatCount > 0 then
    7070    Project.Bitmap.ColorFormat := ColorManager.Formats[0];
    … …  
    7979    Project.Bitmap.Size := Point(FormNew.SpinEditWidth.Value, FormNew.SpinEditHeight.Value);
    8080    Project.Bitmap.ColorFormat := ColorManager.Formats[FormNew.ComboBoxColorFormat.ItemIndex];
     81    Project.Bitmap.BackgroundColor.FromTColor(clBlack);
    8182    Project.Bitmap.DPI := FormNew.SpinEditDPI.Value;
    8283    FormMain.Redraw;
    … …  
    112113  Project.Bitmap.Canvas.Pen.Color.Format := Project.Bitmap.ColorFormat;
    113114  Project.Bitmap.Canvas.Pen.Color.FromTColor(clWhite);
    114   Project.Bitmap.Canvas.Pen.MoveTo(Point(100, 100));
    115   Project.Bitmap.Canvas.Pen.LineTo(Point(700, 500));
     115  Project.Bitmap.Canvas.Pen.MoveTo(Point(80, 80));
     116  Project.Bitmap.Canvas.Pen.LineTo(Point(50, 20));
    116117  FormMain.Redraw;
    117118end;

  • trunk/UGraphic.pas

    r8 r9  
    66
    77uses
    8   Classes, SysUtils, Graphics, Contnrs;
     8  Classes, SysUtils, Graphics, Contnrs, UMemory;
    99
    1010type
    … …  
    1313  TGColor = class;
    1414  TGCanvas = class;
    15 
    16   TGColorClass = class of TGColor;
     15  TGBitmap = class;
    1716
    1817  { TGColorFormat }
    … …  
    2423    function GetChannelBitPos(Channel: TGColorChannel): Integer; virtual;
    2524    function GetChannelBitWidth(Channel: TGColorChannel): Integer; virtual;
     25    function GetChannelStateCount(Channel: TGColorChannel): Integer; virtual;
    2626    function ChannelUsed(Channel: TGColorChannel): Boolean;
    2727    function ColorToTColor(Color: TGColor): TColor; virtual;
    2828    procedure ColorFromTColor(GColor: TGColor; Color: TColor); virtual;
    29     function GetColorClass: TGColorClass; virtual;
    3029  end;
    3130
    … …  
    3736  private
    3837    FColorFormat: TGColorFormat;
    39     FData: PByte;
     38    FData: TBitMemory;
    4039    function GetChannel(Channel: TGColorChannel): TGColor;
    4140    procedure SetColorFormat(AValue: TGColorFormat);
    42     procedure LoadData(BitmapData: Pointer); virtual;
    43     procedure SaveData(BitmapData: Pointer); virtual;
     41    procedure LoadData(Bitmap: TGBitmap; Position: Integer); virtual;
     42    procedure SaveData(Bitmap: TGBitmap; Position: Integer); virtual;
    4443  public
    4544    function ToTColor: TColor;
    … …  
    4847    constructor Create;
    4948    property Channels[Channel: TGColorChannel]: TGColor read GetChannel;
    50     property Data: PByte read FData;
     49    property Data: TBitMemory read FData;
    5150  published
    5251    property Format: TGColorFormat read FColorFormat write SetColorFormat;
    … …  
    6261    FDPI: Integer;
    6362    FSize: TPoint;
    64     FData: PByte;
     63    FData: TBitMemory;
    6564    function GetPixel(X, Y: Integer): TGColor;
    6665    function GetSize: TPoint;
    … …  
    6968    procedure SetPixel(X, Y: Integer; AValue: TGColor);
    7069    procedure SetSize(AValue: TPoint);
    71     function GetPixelDataPos(X, Y: Integer): Pointer;
     70    function GetPixelDataPos(X, Y: Integer): Integer;
     71    procedure CheckLimits(X, Y: Integer);
    7272  public
    7373    function GetDataSize: Integer;
    … …  
    7979    constructor Create; virtual;
    8080    destructor Destroy; override;
     81    property Data: TBitMemory read FData;
    8182    property BackgroundColor: TGColor read FBackgroundColor write SetBackgroundColor;
    8283    property DPI: Integer read FDPI write FDPI;
    … …  
    253254end;
    254255
     256function TGColorFormat.GetChannelStateCount(Channel: TGColorChannel): Integer;
     257begin
     258  Result := 1 shl GetChannelBitWidth(Channel);
     259end;
     260
    255261function TGColorFormat.ChannelUsed(Channel: TGColorChannel): Boolean;
    256262begin
    … …  
    259265
    260266function TGColorFormat.ColorToTColor(Color: TGColor): TColor;
    261 begin
    262   Result := clBlack;
     267var
     268  Channel: TBitMemory;
     269begin
     270  Result := 0;
     271  Channel := TBitMemory.Create;
     272
     273  if GetChannelBitWidth(ccRed) > 0 then begin
     274    Channel.Size := GetChannelBitWidth(ccRed);
     275    Color.Data.ReadBlock(Channel, GetChannelBitPos(ccRed));
     276    Result := Result or (Trunc(Channel.GetInteger * 255 / (GetChannelStateCount(ccRed) - 1)) shl 0);
     277  end;
     278
     279  if GetChannelBitWidth(ccGreen) > 0 then begin
     280    Channel.Size := GetChannelBitWidth(ccGreen);
     281    Color.Data.ReadBlock(Channel, GetChannelBitPos(ccGreen));
     282    Result := Result or (Trunc(Channel.GetInteger * 255 / (GetChannelStateCount(ccGreen) - 1)) shl 8);
     283  end;
     284
     285  if GetChannelBitWidth(ccBlue) > 0 then begin
     286    Channel.Size := GetChannelBitWidth(ccBlue);
     287    Color.Data.ReadBlock(Channel, GetChannelBitPos(ccBlue));
     288    Result := Result or (Trunc(Channel.GetInteger * 255 / (GetChannelStateCount(ccBlue) - 1)) shl 16);
     289  end;
     290
     291  if GetChannelBitWidth(ccGray) > 0 then begin
     292    Channel.Size := GetChannelBitWidth(ccGray);
     293    Color.Data.ReadBlock(Channel, GetChannelBitPos(ccGray));
     294    Result := $010101 * Trunc(Channel.GetInteger * 255 / (GetChannelStateCount(ccGray) - 1));
     295  end;
     296
     297  Channel.Free;
    263298end;
    264299
    265300procedure TGColorFormat.ColorFromTColor(GColor: TGColor; Color: TColor);
    266 begin
    267   FillChar(GColor.Data^, GetPixelSize, 0);
    268 end;
    269 
    270 function TGColorFormat.GetColorClass: TGColorClass;
    271 begin
    272   Result := TGColor;
     301var
     302  Channel: TBitMemory;
     303begin
     304  GColor.Data.Clear(0);
     305  Channel := TBitMemory.Create;
     306
     307  if GetChannelBitWidth(ccRed) > 0 then begin
     308    Channel.Size := GetChannelBitWidth(ccRed);
     309    Channel.SetInteger(((Color shr 0) and $ff) * GetChannelStateCount(ccRed) div 256);
     310    GColor.Data.WriteBlock(Channel, GetChannelBitPos(ccRed));
     311  end;
     312
     313  if GetChannelBitWidth(ccGreen) > 0 then begin
     314    Channel.Size := GetChannelBitWidth(ccGreen);
     315    Channel.SetInteger(((Color shr 8) and $ff) * GetChannelStateCount(ccGreen) div 256);
     316    GColor.Data.WriteBlock(Channel, GetChannelBitPos(ccGreen));
     317  end;
     318
     319  if GetChannelBitWidth(ccBlue) > 0 then begin
     320    Channel.Size := GetChannelBitWidth(ccBlue);
     321    Channel.SetInteger(((Color shr 16) and $ff) * GetChannelStateCount(ccBlue) div 256);
     322    GColor.Data.WriteBlock(Channel, GetChannelBitPos(ccBlue));
     323  end;
     324
     325  if GetChannelBitWidth(ccGray) > 0 then begin
     326    Channel.Size := GetChannelBitWidth(ccGray);
     327    Channel.SetInteger((((Color shr 16) and $ff) + ((Color shr 8) and $ff) + ((Color shr 0) and $ff))
     328      * GetChannelStateCount(ccGray) div (3 * 256));
     329    GColor.Data.WriteBlock(Channel, GetChannelBitPos(ccGray));
     330  end;
     331
     332  Channel.Free;
    273333end;
    274334
    … …  
    284344  if FColorFormat = AValue then Exit;
    285345  FColorFormat := AValue;
    286   ReAllocMem(FData, FColorFormat.GetPixelSize);
    287 end;
    288 
    289 procedure TGColor.LoadData(BitmapData: Pointer);
    290 begin
    291   Move(BitmapData^, FData^, FColorFormat.GetPixelSize);
    292 end;
    293 
    294 procedure TGColor.SaveData(BitmapData: Pointer);
    295 begin
    296   Move(FData^, BitmapData^, FColorFormat.GetPixelSize);
     346  FData.Size := FColorFormat.GetPixelSize;
     347end;
     348
     349procedure TGColor.LoadData(Bitmap: TGBitmap; Position: Integer);
     350begin
     351  Bitmap.Data.ReadBlock(FData, Position);
     352end;
     353
     354procedure TGColor.SaveData(Bitmap: TGBitmap; Position: Integer);
     355begin
     356  Bitmap.Data.WriteBlock(FData, Position);
    297357end;
    298358
    … …  
    313373constructor TGColor.Create;
    314374begin
     375  FData := TBitMemory.Create;
    315376  Format := TGColorFormat.Create;
    316377end;
    … …  
    320381function TGBitmap.GetPixel(X, Y: Integer): TGColor;
    321382begin
     383  CheckLimits(X, Y);
    322384  Result := TGColor.Create;
    323385  Result.Format := ColorFormat;
    324   Result.LoadData(GetPixelDataPos(X, Y));
     386  Result.LoadData(Self, GetPixelDataPos(X, Y));
    325387end;
    326388
    … …  
    340402  if FColorFormat = AValue then Exit;
    341403  FColorFormat := AValue;
    342   ReAllocMem(FData, GetDataSize);
     404  FData.Size := GetDataSize;
    343405  FBackgroundColor.Format := ColorFormat;
    344406end;
    … …  
    346408procedure TGBitmap.SetPixel(X, Y: Integer; AValue: TGColor);
    347409begin
    348   AValue.SaveData(GetPixelDataPos(X, Y));
     410  CheckLimits(X, Y);
     411  FData.WriteBlock(AValue.Data, GetPixelDataPos(X, Y));
    349412end;
    350413
    … …  
    353416  if (FSize.X = AValue.X) and (FSize.Y = AValue.Y) then Exit;
    354417  FSize := AValue;
    355   ReAllocMem(FData, GetDataSize);
    356 end;
    357 
    358 function TGBitmap.GetPixelDataPos(X, Y: Integer): Pointer;
    359 begin
    360   Result := FData + X * FColorFormat.GetPixelSize + Y * FColorFormat.GetPixelSize * FSize.X;
     418  FData.Size := GetDataSize;
     419end;
     420
     421function TGBitmap.GetPixelDataPos(X, Y: Integer): Integer;
     422begin
     423  Result := X * FColorFormat.GetPixelSize + Y * FColorFormat.GetPixelSize * FSize.X;
     424end;
     425
     426procedure TGBitmap.CheckLimits(X, Y: Integer);
     427begin
     428  if (X < 0) or (Y < 0) or (X >= Size.X) or (Y >= Size.Y) then
     429    raise Exception.Create('Out of range');
    361430end;
    362431
    … …  
    399468  X, Y: Integer;
    400469  Color: TGColor;
     470  F: Cardinal;
    401471begin
    402472  Color := TGColor.Create;
    … …  
    405475    for X := 0 to Size.X - 1 do begin
    406476      Color.FromTColor(System.Random($ffffff));
     477      F := Cardinal(Color.Data.GetInteger);
     478
    407479      Pixels[X, Y] := Color;
    408480    end;
    … …  
    440512constructor TGBitmap.Create;
    441513begin
    442   FData := GetMem(0);
     514  FData := TBitMemory.Create;
    443515  FBackgroundColor := TGColor.Create;
    444516  ColorFormat := TGColorFormat.Create;
    … …  
    451523destructor TGBitmap.Destroy;
    452524begin
     525  Size := Point(0, 0);
     526  FData.Free;
    453527  inherited Destroy;
    454   Size := Point(0, 0);
    455528end;
    456529
Note: See TracChangeset for help on using the changeset viewer.