Changeset 20 for branches/gbitmap


Ignore:
Timestamp:
Dec 21, 2016, 3:49:27 PM (8 years ago)
Author:
chronos
Message:
  • Modified: For single class layer TPixmap and TColor is used. They have TBPixmap and TBColor backends pairs.
Location:
branches/gbitmap
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/gbitmap/GImage.pas

    r19 r20  
    99
    1010type
    11   TBColor = class
    12   end;
    13 
    14   TBColorGray1 = class(TBColor)
     11  TColorFormat = (cfNone, cfGray1, cfGray2, cfGray4, cfGray8, cfGray16, cfGray32,
     12    cfRGB8, cfRGB16);
     13
     14  TColorName = (cnBlack, cnWhite, cnBlue, cnRed, cnGreen, cnGray, cnSilver);
     15
     16  IBColor = interface
     17    procedure SetColorName(ColorName: TColorName);
     18    procedure SetRandom;
     19  end;
     20
     21  { TBColorNone }
     22
     23  TBColorNone = class(TInterfacedObject, IBColor)
     24    procedure SetColorName(ColorName: TColorName);
     25    procedure SetRandom;
     26  end;
     27
     28  { TBColorGray1 }
     29
     30  TBColorGray1 = class(TInterfacedObject, IBColor)
    1531    Value: TColorGray1;
    16   end;
    17 
    18   TBColorGray2 = class(TBColor)
     32    constructor Create(Color: TColorGray1);
     33    procedure SetColorName(ColorName: TColorName);
     34    procedure SetRandom;
     35  end;
     36
     37  { TBColorGray2 }
     38
     39  TBColorGray2 = class(TInterfacedObject, IBColor)
    1940    Value: TColorGray2;
    20   end;
    21 
    22   TBColorRGB8 = class(TBColor)
     41    constructor Create(Color: TColorGray2);
     42    procedure SetColorName(ColorName: TColorName);
     43    procedure SetRandom;
     44  end;
     45
     46  { TBColorRGB8 }
     47
     48  TBColorRGB8 = class(TInterfacedObject, IBColor)
    2349    Value: TColorRGB8;
     50    constructor Create(Color: TColorRGB8);
     51    procedure SetColorName(ColorName: TColorName);
     52    procedure SetRandom;
    2453  end;
    2554
     
    2958  public
    3059    type
    31       TGetColorPos = function (Position: TPoint): TBColor of object;
     60      TGetColorPos = function (Position: TPoint): IBColor of object;
    3261  private
    3362    FSize: TPoint;
     63    function GetPixel(X, Y: Integer): IBColor;  virtual;
     64    procedure SetPixel(X, Y: Integer; AValue: IBColor); virtual;
    3465  protected
    3566    procedure SetSize(AValue: TPoint); virtual;
    3667  public
    37     procedure Fill(Color: TBColor); virtual; overload;
     68    procedure Fill(Color: IBColor); virtual; overload;
    3869    procedure Fill(Func: TGetColorPos); virtual; overload;
    3970    procedure PaintToCanvas(Canvas: TCanvas); virtual;
     71    function GetDataSize: Integer; virtual;
    4072    property Size: TPoint read FSize write SetSize;
     73    property Pixels[X, Y: Integer]: IBColor read GetPixel write SetPixel;
    4174  end;
    4275
     
    4477
    4578  TBImageGray1 = class(TBImage)
     79  private
     80    FillCallBack: TGetColorPos;
     81    function FillGetColor(Position: TPoint): TColorGray1;
    4682  protected
    4783    procedure SetSize(AValue: TPoint); override;
     84    function GetPixel(X, Y: Integer): IBColor;  override;
     85    procedure SetPixel(X, Y: Integer; AValue: IBColor); override;
    4886  public
    4987    Pixmap: TPixmapGray1;
    50     procedure Fill(Color: TBColor); override;
     88    procedure Fill(Color: IBColor); override;
    5189    procedure Fill(Func: TGetColorPos); override;
    5290    procedure PaintToCanvas(Canvas: TCanvas); override;
     91    function GetDataSize: Integer; override;
    5392    constructor Create;
    5493    destructor Destroy; override;
     
    5897
    5998  TBImageGray2 = class(TBImage)
     99  private
     100    FillCallBack: TGetColorPos;
     101    function FillGetColor(Position: TPoint): TColorGray1;
    60102  protected
    61103    procedure SetSize(AValue: TPoint); override;
     104    function GetPixel(X, Y: Integer): IBColor;  override;
     105    procedure SetPixel(X, Y: Integer; AValue: IBColor); override;
    62106  public
    63107    Pixmap: TPixmapGray2;
    64     procedure Fill(Color: TBColor); override;
     108    procedure Fill(Color: IBColor); override;
     109    procedure Fill(Func: TGetColorPos); override;
    65110    procedure PaintToCanvas(Canvas: TCanvas); override;
     111    function GetDataSize: Integer; override;
    66112    constructor Create;
    67113    destructor Destroy; override;
     
    75121  public
    76122    Pixmap: TGPixmap<TColorRGB8>;
    77     procedure Fill(Color: TBColor); override;
     123    procedure Fill(Color: IBColor); override;
    78124    constructor Create;
    79125    destructor Destroy; override;
    80126  end;
    81127
    82 
    83   TColorFormat = (cfNone, cfGray1, cfGray2, cfGray4, cfGray8, cfGray16, cfGray32,
    84     cfRGB8, cfRGB16);
    85 
    86   { TGImage }
    87 
    88   TGImage = class
     128  { TColor }
     129
     130  TColor = class
     131  private
     132    FBackend: IBColor;
     133    FColorFormat: TColorFormat;
     134    procedure SetColorFormat(AValue: TColorFormat);
     135  public
     136    property Backend: IBColor read FBackend;
     137    property ColorFormat: TColorFormat read FColorFormat write SetColorFormat;
     138    procedure SetColorName(ColorName: TColorName);
     139    procedure SetRandom;
     140    constructor Create; overload;
     141    constructor Create(ColorFormat: TColorFormat; ColorName: TColorName); overload;
     142    destructor Destroy; override;
     143  end;
     144
     145  { TPixmap }
     146
     147  TPixmap = class
    89148  public
    90149    type
    91       TGetColorPos = function (Position: TPoint): TBColor of object;
     150      TGetColorPos = function (Position: TPoint; ColorFormat: TColorFormat): TColor of object;
    92151  private
    93152    FBackend: TBImage;
    94153    FColorFormat: TColorFormat;
    95154    FSize: TPoint;
     155    FillCallBack: TGetColorPos;
     156    function FillGetColor(Position: TPoint): IBColor;
     157    function GetPixel(X, Y: Integer): TColor;
    96158    procedure SetColorFormat(AValue: TColorFormat);
     159    procedure SetPixel(X, Y: Integer; AValue: TColor);
    97160    procedure SetSize(AValue: TPoint);
    98161  public
     162    procedure Fill(Color: TColor); overload;
     163    procedure Fill(Func: TGetColorPos); overload;
     164    procedure PaintToCanvas(Canvas: TCanvas);
     165    function GetDataSize: Integer;
     166    constructor Create;
     167    destructor Destroy; override;
    99168    property Backend: TBImage read FBackend;
    100169    property ColorFormat: TColorFormat read FColorFormat write SetColorFormat;
    101170    property Size: TPoint read FSize write SetSize;
    102     procedure Fill(Color: TBColor); overload;
    103     procedure Fill(Func: TGetColorPos); overload;
    104     procedure PaintToCanvas(Canvas: TCanvas);
    105     constructor Create;
    106     destructor Destroy; override;
     171    property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
    107172  end;
    108173
     
    110175implementation
    111176
     177{ TBColorNone }
     178
     179procedure TBColorNone.SetColorName(ColorName: TColorName);
     180begin
     181end;
     182
     183procedure TBColorNone.SetRandom;
     184begin
     185end;
     186
     187{ TColor }
     188
     189procedure TColor.SetColorFormat(AValue: TColorFormat);
     190begin
     191  if FColorFormat = AValue then Exit;
     192  if AValue = cfGray1 then FBackend := TBColorGray1.Create(0)
     193    else if AValue = cfGray2 then FBackend := TBColorGray2.Create(0)
     194    else if AValue = cfRGB8 then FBackend := TBColorRGB8.Create(TColorRGB8.Create(0, 0, 0))
     195    else raise Exception.Create('Missing color backend for specified color format');
     196  FColorFormat := AValue;
     197end;
     198
     199procedure TColor.SetColorName(ColorName: TColorName);
     200begin
     201  FBackend.SetColorName(ColorName);
     202end;
     203
     204procedure TColor.SetRandom;
     205begin
     206  FBackend.SetRandom;
     207end;
     208
     209constructor TColor.Create;
     210begin
     211  ColorFormat := cfNone;
     212end;
     213
     214constructor TColor.Create(ColorFormat: TColorFormat; ColorName: TColorName);
     215begin
     216  Self.ColorFormat := ColorFormat;
     217  Backend.SetColorName(ColorName);
     218end;
     219
     220destructor TColor.Destroy;
     221begin
     222  inherited Destroy;
     223end;
     224
     225{ TBColorRGB8 }
     226
     227constructor TBColorRGB8.Create(Color: TColorRGB8);
     228begin
     229  Value := Color;
     230end;
     231
     232procedure TBColorRGB8.SetColorName(ColorName: TColorName);
     233begin
     234  case ColorName of
     235    cnBlack: Value := TColorRGB8.Create(0, 0, 0);
     236    cnGray: Value := TColorRGB8.Create($80, $80, $80);
     237    cnSilver: Value := TColorRGB8.Create($C0, $C0, $C0);
     238    cnWhite: Value := TColorRGB8.Create($ff, $ff, $ff);
     239    else Value := TColorRGB8.Create(0, 0, 0);;
     240  end;
     241end;
     242
     243procedure TBColorRGB8.SetRandom;
     244begin
     245  Value := TColorRGB8.Create(Random(256), Random(256), Random(256));
     246end;
     247
     248{ TBColorGray2 }
     249
     250constructor TBColorGray2.Create(Color: TColorGray2);
     251begin
     252  Value := Color;
     253end;
     254
     255procedure TBColorGray2.SetColorName(ColorName: TColorName);
     256begin
     257  case ColorName of
     258    cnBlack: Value := 0;
     259    cnGray: Value := 1;
     260    cnSilver: Value := 2;
     261    cnWhite: Value := 3;
     262    else Value := 0;
     263  end;
     264end;
     265
     266procedure TBColorGray2.SetRandom;
     267begin
     268  Random(4);
     269end;
     270
     271{ TBColorGray1 }
     272
     273constructor TBColorGray1.Create(Color: TColorGray1);
     274begin
     275  Value := Color;
     276end;
     277
     278procedure TBColorGray1.SetColorName(ColorName: TColorName);
     279begin
     280  case ColorName of
     281    cnBlack: Value := 0;
     282    cnWhite: Value := 1;
     283    else Value := 0;
     284  end;
     285end;
     286
     287procedure TBColorGray1.SetRandom;
     288begin
     289  Value := Random(2);
     290end;
     291
    112292{ TBImageGray2 }
     293
     294function TBImageGray2.FillGetColor(Position: TPoint): TColorGray1;
     295begin
     296  Result := (FillCallBack(Position) as TBColorGray2).Value;
     297end;
    113298
    114299procedure TBImageGray2.SetSize(AValue: TPoint);
     
    118303end;
    119304
    120 procedure TBImageGray2.Fill(Color: TBColor);
     305function TBImageGray2.GetPixel(X, Y: Integer): IBColor;
     306begin
     307  Result := TBColorGray2.Create(Pixmap.Pixels[X, Y]);
     308end;
     309
     310procedure TBImageGray2.SetPixel(X, Y: Integer; AValue: IBColor);
     311begin
     312  Pixmap.Pixels[X, Y] := (AValue as TBColorGray2).Value;
     313end;
     314
     315procedure TBImageGray2.Fill(Color: IBColor);
    121316begin
    122317  if Color is TBColorGray2 then
     
    124319end;
    125320
     321procedure TBImageGray2.Fill(Func: TGetColorPos);
     322begin
     323  FillCallBack := Func;
     324  Pixmap.Fill(FillGetColor);
     325end;
     326
    126327procedure TBImageGray2.PaintToCanvas(Canvas: TCanvas);
    127328begin
     
    129330end;
    130331
     332function TBImageGray2.GetDataSize: Integer;
     333begin
     334  Result := Pixmap.GetDataSize;
     335end;
     336
    131337constructor TBImageGray2.Create;
    132338begin
    133339  Pixmap := TPixmapGray2.Create;
     340  Pixmap.BitsPerPixel := 2;
    134341end;
    135342
    136343destructor TBImageGray2.Destroy;
    137344begin
    138   Pixmap.Free;
    139   inherited Destroy;
     345  FreeAndNil(Pixmap);
     346  inherited;
    140347end;
    141348
     
    149356end;
    150357
    151 procedure TBImageRGB8.Fill(Color: TBColor);
     358procedure TBImageRGB8.Fill(Color: IBColor);
    152359begin
    153360  if Color is TBColorRGB8 then
     
    162369destructor TBImageRGB8.Destroy;
    163370begin
    164   Pixmap.Free;
     371  FreeAndNil(Pixmap);
    165372  inherited Destroy;
    166373end;
    167374
    168375{ TBImage }
     376
     377function TBImage.GetPixel(X, Y: Integer): IBColor;
     378begin
     379  Result := TBColorNone.Create;
     380end;
     381
     382procedure TBImage.SetPixel(X, Y: Integer; AValue: IBColor);
     383begin
     384end;
    169385
    170386procedure TBImage.SetSize(AValue: TPoint);
     
    174390end;
    175391
    176 procedure TBImage.Fill(Color: TBColor);
     392procedure TBImage.Fill(Color: IBColor);
    177393begin
    178394end;
     
    186402end;
    187403
     404function TBImage.GetDataSize: Integer;
     405begin
     406  Result := 0;
     407end;
     408
    188409{ TBImageGray1 }
     410
     411function TBImageGray1.FillGetColor(Position: TPoint): TColorGray1;
     412begin
     413  Result := (FillCallBack(Position) as TBColorGray1).Value;
     414end;
    189415
    190416procedure TBImageGray1.SetSize(AValue: TPoint);
     
    194420end;
    195421
    196 procedure TBImageGray1.Fill(Color: TBColor);
     422function TBImageGray1.GetPixel(X, Y: Integer): IBColor;
     423begin
     424  Result := TBColorGray1.Create(Pixmap.Pixels[X, Y]);
     425end;
     426
     427procedure TBImageGray1.SetPixel(X, Y: Integer; AValue: IBColor);
     428begin
     429  Pixmap.Pixels[X, Y] := (AValue as TBColorGray1).Value;
     430end;
     431
     432procedure TBImageGray1.Fill(Color: IBColor);
    197433begin
    198434  if Color is TBColorGray1 then
     
    202438procedure TBImageGray1.Fill(Func: TGetColorPos);
    203439begin
    204   //Pixmap.Fill();
     440  FillCallBack := Func;
     441  Pixmap.Fill(FillGetColor);
    205442end;
    206443
     
    210447end;
    211448
     449function TBImageGray1.GetDataSize: Integer;
     450begin
     451  Result := Pixmap.GetDataSize;
     452end;
     453
    212454constructor TBImageGray1.Create;
    213455begin
    214456  Pixmap := TPixmapGray1.Create;
     457  Pixmap.BitsPerPixel := 1;
    215458end;
    216459
    217460destructor TBImageGray1.Destroy;
    218461begin
    219   Pixmap.Free;
    220   inherited Destroy;
    221 end;
    222 
    223 { TGImage }
    224 
    225 procedure TGImage.SetColorFormat(AValue: TColorFormat);
     462  FreeAndNil(Pixmap);
     463  inherited;
     464end;
     465
     466{ TPixmap }
     467
     468procedure TPixmap.SetColorFormat(AValue: TColorFormat);
    226469begin
    227470  if FColorFormat = AValue then Exit;
    228471  FBackend.Free;
    229472  if AValue = cfGray1 then FBackend := TBImageGray1.Create
    230   else if AValue = cfGray2 then FBackend := TBImageGray2.Create
    231   else if AValue = cfRGB8 then FBackend := TBImageRGB8.Create
    232   else FBackend := nil;
    233   if Assigned(FBackend) then FBackend.Size := FSize;
     473    else if AValue = cfGray2 then FBackend := TBImageGray2.Create
     474    else if AValue = cfRGB8 then FBackend := TBImageRGB8.Create
     475    else raise Exception.Create('Missing image backend for specified color format');
     476  FBackend.Size := FSize;
    234477  FColorFormat := AValue;
    235478end;
    236479
    237 procedure TGImage.SetSize(AValue: TPoint);
     480function TPixmap.FillGetColor(Position: TPoint): IBColor;
     481begin
     482  Result := FillCallBack(Position, ColorFormat).Backend;
     483end;
     484
     485function TPixmap.GetPixel(X, Y: Integer): TColor;
     486begin
     487  Result := TColor.Create;
     488  Result.ColorFormat := ColorFormat;
     489  Result.FBackend := FBackend.Pixels[X, Y];
     490end;
     491
     492procedure TPixmap.SetPixel(X, Y: Integer; AValue: TColor);
     493begin
     494  FBackend.Pixels[X, Y] := AValue.FBackend;
     495end;
     496
     497procedure TPixmap.SetSize(AValue: TPoint);
    238498begin
    239499  if (FSize.X = AValue.X) and (FSize.Y = AValue.Y) then Exit;
    240500  FSize := AValue;
    241   if Assigned(FBackend) then
    242     FBackend.Size := AValue;
    243 end;
    244 
    245 procedure TGImage.Fill(Color: TBColor);
    246 begin
    247   if Assigned(FBackend) then FBackend.Fill(Color);
    248 end;
    249 
    250 procedure TGImage.Fill(Func: TGetColorPos);
    251 begin
    252 //  if Assigned(FBackend) then FBackend.Fill(Func: TGetColorPos);
    253 end;
    254 
    255 procedure TGImage.PaintToCanvas(Canvas: TCanvas);
    256 begin
    257   if Assigned(FBackend) then FBackend.PaintToCanvas(Canvas);
    258 end;
    259 
    260 constructor TGImage.Create;
    261 begin
    262   FBackend := nil;
    263 end;
    264 
    265 destructor TGImage.Destroy;
    266 begin
    267   if Assigned(FBackend) then FreeAndNil(FBackend);
     501  FBackend.Size := AValue;
     502end;
     503
     504procedure TPixmap.Fill(Color: TColor);
     505begin
     506  FBackend.Fill(Color.Backend);
     507end;
     508
     509procedure TPixmap.Fill(Func: TGetColorPos);
     510begin
     511  FillCallBack := Func;
     512  FBackend.Fill(FillGetColor);
     513end;
     514
     515procedure TPixmap.PaintToCanvas(Canvas: TCanvas);
     516begin
     517  FBackend.PaintToCanvas(Canvas);
     518end;
     519
     520function TPixmap.GetDataSize: Integer;
     521begin
     522  FBackend.GetDataSize;
     523end;
     524
     525constructor TPixmap.Create;
     526begin
     527  FBackend := TBImage.Create;
     528end;
     529
     530destructor TPixmap.Destroy;
     531begin
     532  FreeAndNil(FBackend);
    268533  inherited Destroy;
    269534end;
    270535
    271536end.
    272 
     537       3
  • branches/gbitmap/GPixmap.pas

    r18 r20  
    5353    FData: PByte;
    5454    FSize: TPoint;
     55    FCanvas: TGCanvas<TGColor>;
    5556    function GetPixel(X, Y: Integer): TGColor; virtual;
    5657    function GetSize: TPoint; virtual;
     
    6061    procedure CheckLimits(X, Y: Integer);
    6162  public
    62     Canvas: TGCanvas<TGColor>;
    6363    constructor Create;
    6464    destructor Destroy; override;
     
    6767    procedure Fill(Func: TGGetColor); overload;
    6868    function GetDataSize: Int64; virtual;
     69    property Canvas: TGCanvas<TGColor> read FCanvas;
    6970    property Pixels[X, Y: Integer]: TGColor read GetPixel write SetPixel;
    7071    property Size: TPoint read GetSize write SetSize;
     
    120121constructor TGPixmap<TGColor>.Create;
    121122begin
    122   Canvas := TGCanvas<TGColor>.Create;
    123   Canvas.Bitmap := Self;
     123  FCanvas := TGCanvas<TGColor>.Create;
     124  FCanvas.Bitmap := Self;
    124125end;
    125126
     
    127128begin
    128129  Size := Point(0, 0);
     130  FreeAndNil(FCanvas);
    129131end;
    130132
  • branches/gbitmap/UFormMain.pas

    r19 r20  
    66
    77uses
    8   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
    9   ExtCtrls, StdCtrls, GPixmap, UPixmapSpecialized, GImage;
     8  GImage, Classes, SysUtils, FileUtil, Forms, Graphics, Controls, Dialogs, Menus,
     9  ExtCtrls, StdCtrls, GPixmap, UPixmapSpecialized;
    1010
    1111type
     
    2828    function RGB8Random(Position: TPoint): TColorRGB8;
    2929    function RGB16Random(Position: TPoint): TColorRGB16;
     30    function ColorRandom(Position: TPoint; ColorFormat: TColorFormat): GImage.TColor;
    3031  public
    3132    procedure TestGray1;
     
    9697end;
    9798
     99function TForm1.ColorRandom(Position: TPoint; ColorFormat: TColorFormat): GImage.TColor;
     100begin
     101  Result := GImage.TColor.Create;
     102  Result.ColorFormat := ColorFormat;
     103  Result.SetRandom;
     104end;
     105
    98106procedure TForm1.TestGray1;
    99107var
     
    262270procedure TForm1.TestImage;
    263271var
    264   Image: TGImage;
    265   Color: TBColorGray1;
    266 begin
    267   Image := TGImage.Create;
     272  Image: GImage.TPixmap;
     273begin
     274  Image := GImage.TPixmap.Create;
    268275  with Image do begin
    269276    Size := Point(100, 100);
    270     ColorFormat := cfGray1;
    271     Color := TBColorGray1.Create;
    272     Color.Value := 1;
    273     Fill(Color);
    274     Random;
     277    ColorFormat := cfGray2;
     278    Fill(GImage.TColor.Create(ColorFormat, cnWhite));
     279    Pixels[0, 0] := GImage.TColor.Create(ColorFormat, cnBlack);
     280    Fill(ColorRandom);
    275281    PaintToCanvas(Image1.Picture.Bitmap.Canvas);
     282    Label1.Caption := IntToStr(GetDataSize);
    276283    Free;
    277284  end;
  • branches/gbitmap/project1.lpi

    r19 r20  
    1818      <StringTable ProductVersion=""/>
    1919    </VersionInfo>
    20     <BuildModes Count="1">
    21       <Item1 Name="Default" Default="True"/>
     20    <BuildModes Count="2">
     21      <Item1 Name="Debug" Default="True"/>
     22      <Item2 Name="Release">
     23        <CompilerOptions>
     24          <Version Value="11"/>
     25          <PathDelim Value="\"/>
     26          <Target>
     27            <Filename Value="project1"/>
     28          </Target>
     29          <SearchPaths>
     30            <IncludeFiles Value="$(ProjOutDir)"/>
     31            <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
     32          </SearchPaths>
     33          <Parsing>
     34            <SyntaxOptions>
     35              <SyntaxMode Value="Delphi"/>
     36              <CStyleOperator Value="False"/>
     37              <AllowLabel Value="False"/>
     38              <CPPInline Value="False"/>
     39            </SyntaxOptions>
     40          </Parsing>
     41          <CodeGeneration>
     42            <SmartLinkUnit Value="True"/>
     43          </CodeGeneration>
     44          <Linking>
     45            <Debugging>
     46              <GenerateDebugInfo Value="False"/>
     47            </Debugging>
     48            <LinkSmart Value="True"/>
     49            <Options>
     50              <Win32>
     51                <GraphicApplication Value="True"/>
     52              </Win32>
     53            </Options>
     54          </Linking>
     55        </CompilerOptions>
     56      </Item2>
    2257    </BuildModes>
    2358    <PublishOptions>
     
    73108      <SyntaxOptions>
    74109        <SyntaxMode Value="Delphi"/>
     110        <CStyleOperator Value="False"/>
    75111        <IncludeAssertionCode Value="True"/>
     112        <AllowLabel Value="False"/>
     113        <CPPInline Value="False"/>
    76114      </SyntaxOptions>
    77115    </Parsing>
     
    86124    </CodeGeneration>
    87125    <Linking>
     126      <Debugging>
     127        <UseHeaptrc Value="True"/>
     128      </Debugging>
    88129      <Options>
    89130        <Win32>
     
    92133      </Options>
    93134    </Linking>
     135    <Other>
     136      <CompilerMessages>
     137        <IgnoredMessages idx5024="True"/>
     138      </CompilerMessages>
     139      <CustomOptions Value="-dDEBUG"/>
     140    </Other>
    94141  </CompilerOptions>
    95142  <Debugging>
  • branches/gbitmap/project1.lpr

    r19 r20  
    88  {$ENDIF}{$ENDIF}
    99  Interfaces, // this includes the LCL widgetset
    10   Forms, UFormMain, GPixmap, GImage, UPixmapSpecialized
     10  SysUtils, Forms, UFormMain, GPixmap, GImage, UPixmapSpecialized
    1111  { you can add units after this };
    1212
    1313{$R *.res}
    1414
     15{$IFDEF DEBUG}
     16const
     17  HeapTraceLog = 'heaptrclog.trc';
     18{$ENDIF}
     19
    1520begin
    16   RequireDerivedFormResource:=True;
     21  {$IFDEF DEBUG}
     22  // Heap trace
     23  DeleteFile(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
     24  SetHeapTraceOutput(ExtractFilePath(ParamStr(0)) + HeapTraceLog);
     25  {$ENDIF}
     26
     27  RequireDerivedFormResource := True;
    1728  Application.Initialize;
    1829  Application.CreateForm(TForm1, Form1);
Note: See TracChangeset for help on using the changeset viewer.