Ignore:
Timestamp:
Dec 22, 2016, 8:49:19 PM (8 years ago)
Author:
chronos
Message:
  • Modified: Updated BGRABitmap package.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/Packages/bgrabitmap/bgracolorquantization.pas

    r472 r494  
    3333  { TBGRAColorQuantizer }
    3434
    35   TBGRAColorQuantizer = class
     35  TBGRAColorQuantizer = class(TBGRACustomColorQuantizer)
    3636  private
    3737    FColors: ArrayOfWeightedColor;
    … …  
    4040    FReductionKeepContrast: boolean;
    4141    FSeparateAlphaChannel: boolean;
    42     function GetPalette: TBGRAApproxPalette;
    43     function GetSourceColor(AIndex: integer): TBGRAPixel;
    44     function GetSourceColorCount: Integer;
    4542    procedure Init(ABox: TBGRAColorBox);
    46     procedure SetReductionColorCount(AValue: Integer);
    4743    procedure NormalizeArrayOfColors(AColors: ArrayOfTBGRAPixel; ARedBounds, AGreenBounds, ABlueBounds, AAlphaBounds: TDimensionMinMax; AUniform: boolean);
    4844    procedure NormalizeArrayOfColors(AColors: ArrayOfTBGRAPixel; AColorBounds, AAlphaBounds: TDimensionMinMax);
     45  protected
     46    function GetPalette: TBGRACustomApproxPalette; override;
     47    function GetSourceColor(AIndex: integer): TBGRAPixel; override;
     48    function GetSourceColorCount: Integer; override;
     49    function GetReductionColorCount: integer; override;
     50    procedure SetReductionColorCount(AValue: Integer); override;
    4951  public
    50     constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean); overload;
    51     constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); overload;
    52     constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean; AReductionColorCount: integer); overload;
    53     constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption; AReductionColorCount: integer); overload;
     52    constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean); override;
     53    constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); override;
     54    constructor Create(APalette: TBGRACustomPalette; ASeparateAlphaChannel: boolean; AReductionColorCount: integer); override;
     55    constructor Create(ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption; AReductionColorCount: integer); override;
    5456    destructor Destroy; override;
    55     procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect);
    56     procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap);
    57     function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap;
    58     function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap): TBGRACustomBitmap;
    59     procedure SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AFilenameUTF8: string);
    60     procedure SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AFilenameUTF8: string; AFormat: TBGRAImageFormat);
    61     procedure SaveBitmapToStream(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; AStream: TStream; AFormat: TBGRAImageFormat);
    62     property SourceColorCount: Integer read GetSourceColorCount;
    63     property SourceColor[AIndex: integer]: TBGRAPixel read GetSourceColor;
    64     property ReductionColorCount: Integer read FReductionColorCount write SetReductionColorCount;
    65     property ReducedPalette: TBGRAApproxPalette read GetPalette;
     57    procedure ApplyDitheringInplace(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect); override;
     58    function GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap; override;
     59    function GetDitheredBitmapIndexedData(ABitDepth: integer; AByteOrder: TRawImageByteOrder; AAlgorithm: TDitheringAlgorithm;
     60      ABitmap: TBGRACustomBitmap; out AScanlineSize: PtrInt): Pointer; override;
     61    procedure SaveBitmapToStream(AAlgorithm: TDitheringAlgorithm;
     62      ABitmap: TBGRACustomBitmap; AStream: TStream; AFormat: TBGRAImageFormat); override;
    6663  end;
    6764
    … …  
    7168  private
    7269    FTree: TBGRAColorTree;
    73     FColors: ArrayOfTBGRAPixel;
     70    FColors: ArrayOfWeightedColor;
    7471  protected
    7572    function GetCount: integer; override;
    7673    function GetColorByIndex(AIndex: integer): TBGRAPixel; override;
     74    function GetWeightByIndex(AIndex: Integer): UInt32; override;
    7775    procedure Init(const AColors: ArrayOfTBGRAPixel);
    7876  public
    … …  
    9997    end;
    10098    FLargerOwned: boolean;
     99    FTransparentColorIndex: integer;
    101100  protected
    102101    function FindNearestLargerColorIndex(AValue: TBGRAPixel): integer; virtual;
    … …  
    107106    function FindNearestColor(AValue: TBGRAPixel): TBGRAPixel; override;
    108107    function FindNearestColorIndex(AValue: TBGRAPixel): integer; override;
    109   end;
    110 
    111   TIsChannelStrictlyGreaterFunc = function (p1,p2 : PBGRAPixel): boolean;
     108    function GetAsArrayOfWeightedColor: ArrayOfWeightedColor; override;
     109  end;
     110
     111  TIsChannelStrictlyGreaterFunc = TBGRAPixelComparer;
    112112  TIsChannelGreaterThanOrEqualToValueFunc = function (p : PBGRAPixel; v: UInt32): boolean;
    113113
    … …  
    122122    FColors: ArrayOfWeightedColor;
    123123    FDimensions: TColorDimensions;
    124     FHasPureTransparentColor: boolean;
     124    FPureTransparentColorCount: integer;
    125125    function GetApparentInterval(ADimension: TColorDimension): UInt32;
    126126    function GetAverageColor: TBGRAPixel;
    … …  
    128128    function GetBounds(ADimension: TColorDimension): TDimensionMinMax;
    129129    function GetColorCount(ACountPureTransparent: boolean): integer;
     130    function GetHasPureTransparentColor: boolean;
    130131    function GetInferiorColor: TBGRAPixel;
    131132    function GetLargestApparentDimension: TColorDimension;
    … …  
    135136    procedure Init(AColors: ArrayOfWeightedColor; AOwner: boolean);
    136137    procedure SortBy(ADimension: TColorDimension);
    137     procedure InsertionSort(AComparer: TIsChannelStrictlyGreaterFunc; AMinIndex, AMaxIndex: NativeInt);
    138     procedure QuickSort(AComparer: TIsChannelStrictlyGreaterFunc; AMinIndex, AMaxIndex: NativeInt);
    139138    function GetMedianIndex(ADimension : TColorDimension; AMinValue, AMaxValue: UInt32): integer;
    140139  public
    141140    constructor Create(ADimensions: TColorDimensions; AColors: ArrayOfWeightedColor; AOwner: boolean); overload;
    142     constructor Create(ADimensions: TColorDimensions; AColors: ArrayOfTBGRAPixel); overload;
     141    constructor Create(ADimensions: TColorDimensions; const AColors: ArrayOfTBGRAPixel; AAlpha: TAlphaChannelPaletteOption = acFullChannelInPalette); overload;
    143142    constructor Create(ADimensions: TColorDimensions; ABounds: TColorBoxBounds); overload;
    144143    constructor Create(ADimensions: TColorDimensions; APalette: TBGRACustomPalette); overload;
    145144    constructor Create(ADimensions: TColorDimensions; ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption); overload;
     145    constructor Create(ADimensions: TColorDimensions; AColors: PBGRAPixel; ANbPixels: integer; AAlpha: TAlphaChannelPaletteOption); overload;
    146146    function BoundsContain(AColor: TBGRAPixel): boolean;
    147147    function MedianCut(ADimension: TColorDimension; out SuperiorMiddle: UInt32): TBGRAColorBox;
    … …  
    159159    property TotalWeight: UInt32 read FTotalWeight;
    160160    property ColorCount[ACountPureTransparent: boolean]: integer read GetColorCount;
    161     property HasPureTransparentColor: boolean read FHasPureTransparentColor;
     161    property HasPureTransparentColor: boolean read GetHasPureTransparentColor;
     162    property PureTransparentColorCount: integer read FPureTransparentColorCount;
    162163  end;
    163164
    … …  
    180181    FAverageColor: TBGRAPixel;
    181182
    182     FHasPureTransparentColor: boolean;
     183    FPureTransparentColorCount: integer;
    183184    FPureTransparentColorIndex: integer;
    184185    FDimension: TColorDimension;
    … …  
    187188    FInferiorBranch, FSuperiorBranch: TBGRAColorTree;
    188189    function GetApproximatedColorCount: integer;
     190    function GetHasPureTransparentColor: boolean;
    189191    function GetLeafCount: integer;
    190192    procedure Init(ALeaf: TBGRAColorBox; AOwned: boolean);
    … …  
    206208    function ApproximateColorIndex(AColor: TBGRAPixel): integer;
    207209    function GetAsArrayOfApproximatedColors: ArrayOfTBGRAPixel;
     210    function GetAsArrayOfWeightedColors: ArrayOfWeightedColor;
    208211    procedure SplitIntoPalette(ACount: integer; AMethod: TBiggestLeafMethod;
    209212      ALeafColor: TBGRALeafColorMode);
    … …  
    212215    property LeafCount: integer read GetLeafCount;
    213216    property ApproximatedColorCount: integer read GetApproximatedColorCount;
    214     property HasPureTransparentColor: boolean read FHasPureTransparentColor;
     217    property HasPureTransparentColor: boolean read GetHasPureTransparentColor;
     218    property PureTransparentColorCount: integer read FPureTransparentColorCount;
    215219  end;
    216220
    … …  
    224228implementation
    225229
    226 uses BGRADithering, lazutf8classes, FPimage, FPWriteBMP, FPWritePNG;
     230uses BGRADithering, FPimage, FPWriteBMP, BGRAWritePNG;
    227231
    228232const MedianMinPercentage = 0.2;
    … …  
    533537
    534538const
    535   InsertionSortLimit = 10;
    536539  ApproxPaletteDimensions = [cdAlpha,cdRInvG,cdGInvB,cdRInvB,cdRInvGB,cdGInvRB,cdBInvRG,cdRGB];
    537540
    … …  
    551554  if AValue.alpha = 0 then
    552555  begin
    553     result := -1;
     556    result := FTransparentColorIndex;
    554557    exit;
    555558  end;
    556   diff := BGRAWordDiff(AValue, FColors[0]);
     559  diff := BGRAWordDiff(AValue, FColors[0].Color);
    557560  result := 0;
    558561  for i := 0 to high(FColors) do
    559562  begin
    560     curDiff := BGRAWordDiff(AValue, FColors[i]);
     563    curDiff := BGRAWordDiff(AValue, FColors[i].Color);
    561564    if curDiff < diff then
    562565    begin
    … …  
    570573  const AColors: ArrayOfTBGRAPixel; ALarger: TBGRACustomApproxPalette; ALargerOwned: boolean);
    571574var i: integer;
     575  largeWeighted: ArrayOfWeightedColor;
    572576begin
    573577  inherited Create(AColors);
     578  FTransparentColorIndex:= -1;
     579  for i := 0 to high(FColors) do
     580  begin
     581    FColors[i].Weight := 0;
     582    if FColors[i].Color.alpha = 0 then FTransparentColorIndex:= i;
     583  end;
    574584  FLarger := ALarger;
    575585  FLargerOwned := ALargerOwned;
    576   setlength(FLargerColors, FLarger.Count);
     586  largeWeighted := FLarger.GetAsArrayOfWeightedColor;
     587  setlength(FLargerColors, length(largeWeighted));
    577588  for i := 0 to high(FLargerColors) do
    578589  with FLargerColors[i] do
    579590  begin
    580     approxColorIndex := SlowFindNearestColorIndex(FLarger.Color[i]);
     591    approxColorIndex := SlowFindNearestColorIndex(largeWeighted[i].Color);
    581592    if approxColorIndex = -1 then
    582593      approxColor := BGRAPixelTransparent
    583594    else
    584       approxColor := FColors[approxColorIndex];
     595    begin
     596      approxColor := FColors[approxColorIndex].Color;
     597      inc(FColors[approxColorIndex].Weight, largeWeighted[i].Weight);
     598    end;
    585599  end;
    586600end;
    … …  
    614628end;
    615629
     630function TBGRAApproxPaletteViaLargerPalette.GetAsArrayOfWeightedColor: ArrayOfWeightedColor;
     631var
     632  i: Integer;
     633begin
     634  setlength(result, length(FColors));
     635  for i := 0 to high(FColors) do
     636    result[i] := FColors[i];
     637end;
     638
    616639{ TBGRAApproxPalette }
    617640
    … …  
    625648  if (AIndex < 0) or (AIndex >= length(FColors)) then
    626649    raise ERangeError.Create('Index out of bounds');
    627   result := FColors[AIndex];
     650  result := FColors[AIndex].Color;
     651end;
     652
     653function TBGRAApproxPalette.GetWeightByIndex(AIndex: Integer): UInt32;
     654begin
     655  if (AIndex < 0) or (AIndex >= length(FColors)) then
     656    raise ERangeError.Create('Index out of bounds');
     657  result := FColors[AIndex].Weight;
    628658end;
    629659
    … …  
    643673  FTree.SplitIntoPalette(length(AColors),blApparentInterval,lcAverage);
    644674
    645   FColors := FTree.GetAsArrayOfApproximatedColors;
     675  FColors := FTree.GetAsArrayOfWeightedColors;
    646676end;
    647677
    … …  
    656686  FTree.SplitIntoPalette(length(AColors),blApparentInterval,lcAverage);
    657687
    658   FColors := FTree.GetAsArrayOfApproximatedColors;
     688  FColors := FTree.GetAsArrayOfWeightedColors;
    659689end;
    660690
    … …  
    662692begin
    663693  FTree := AOwnedSplitTree;
    664   FColors := FTree.GetAsArrayOfApproximatedColors;
     694  FColors := FTree.GetAsArrayOfWeightedColors;
    665695end;
    666696
    … …  
    679709begin
    680710  result := FTree.ApproximateColorIndex(AValue);
    681   if (result <> -1) and not (DWord(FColors[result]) = DWord(AValue)) then result := -1;
     711  if (result <> -1) and not (DWord(FColors[result].Color) = DWord(AValue)) then result := -1;
    682712end;
    683713
    … …  
    698728  setlength(result, length(FColors));
    699729  for i := 0 to high(result) do
    700     result[i] := FColors[i];
     730    result[i] := FColors[i].Color;
    701731end;
    702732
    … …  
    705735  i: NativeInt;
    706736begin
    707   setlength(result, length(FColors));
    708   for i := 0 to high(result) do
    709   with result[i] do
    710   begin
    711     Color := FColors[i];
    712     Weight:= 1;
     737  if Assigned(FTree) then
     738    result := FTree.GetAsArrayOfWeightedColors
     739  else
     740  begin
     741    setlength(result, length(FColors));
     742    for i := 0 to high(result) do
     743      result[i] := FColors[i];
    713744  end;
    714745end;
    … …  
    719750begin
    720751  FColors := ABox.FColors;
    721   if ABox.FHasPureTransparentColor then
     752  if ABox.HasPureTransparentColor then
    722753  begin
    723754    setlength(FColors,length(FColors)+1);
    … …  
    725756    begin
    726757      Color := BGRAPixelTransparent;
    727       Weight:= 1;
     758      Weight:= ABox.PureTransparentColorCount;
    728759    end;
    729760  end;
    … …  
    853884end;
    854885
    855 function TBGRAColorQuantizer.GetPalette: TBGRAApproxPalette;
     886function TBGRAColorQuantizer.GetReductionColorCount: integer;
     887begin
     888  result := FReductionColorCount;
     889end;
     890
     891function TBGRAColorQuantizer.GetPalette: TBGRACustomApproxPalette;
    856892var
    857893  tree: TBGRAColorTree;
    858894
    859895  procedure MakeTreeErrorDiffusionFriendly;
    860   var moreColors: ArrayOfTBGRAPixel;
     896  var moreColors: ArrayOfWeightedColor;
    861897    box: TBGRAColorBox;
    862898  begin
    863     moreColors := tree.GetAsArrayOfApproximatedColors;
     899    moreColors := tree.GetAsArrayOfWeightedColors;
    864900    tree.free;
    865     box := TBGRAColorBox.Create([cdRed,cdGreen,cdBlue,cdAlpha],moreColors);
     901    box := TBGRAColorBox.Create([cdRed,cdGreen,cdBlue,cdAlpha],moreColors,True);
    866902    tree := TBGRAColorTree.Create(box,True);
    867903    tree.SplitIntoPalette(box.ColorCount[true], blApparentInterval, lcAverage);
    … …  
    889925    bounds[cdBlue] := originalBox.Bounds[cdBlue];
    890926    bounds[cdAlpha] := originalBox.Bounds[cdAlpha];
    891     if originalBox.FHasPureTransparentColor then bounds[cdAlpha].Minimum := 0;
     927    if originalBox.HasPureTransparentColor then bounds[cdAlpha].Minimum := 0;
    892928    if FReductionColorCount = 1 then
    893929    begin
    … …  
    9711007end;
    9721008
    973 procedure TBGRAColorQuantizer.ApplyDitheringInplace(
    974   AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap);
    975 begin
    976   ApplyDitheringInplace(AAlgorithm, ABitmap, rect(0,0,ABitmap.Width,ABitmap.Height));
    977 end;
    978 
    9791009function TBGRAColorQuantizer.GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm;
    9801010  ABitmap: TBGRACustomBitmap; ABounds: TRect): TBGRACustomBitmap;
    … …  
    9861016end;
    9871017
    988 function TBGRAColorQuantizer.GetDitheredBitmap(AAlgorithm: TDitheringAlgorithm;
    989   ABitmap: TBGRACustomBitmap): TBGRACustomBitmap;
    990 var task: TDitheringTask;
    991 begin
    992   task := CreateDitheringTask(AAlgorithm, ABitmap, ReducedPalette, FSeparateAlphaChannel);
    993   result := task.Execute;
    994   task.Free;
    995 end;
    996 
    997 procedure TBGRAColorQuantizer.SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap;
    998   AFilenameUTF8: string);
    999 begin
    1000   SaveBitmapToFile(AAlgorithm, ABitmap, AFilenameUTF8, SuggestImageFormat(AFilenameUTF8));
    1001 end;
    1002 
    1003 procedure TBGRAColorQuantizer.SaveBitmapToFile(AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap;
    1004   AFilenameUTF8: string; AFormat: TBGRAImageFormat);
     1018function TBGRAColorQuantizer.GetDitheredBitmapIndexedData(
     1019  ABitDepth: integer; AByteOrder: TRawImageByteOrder; AAlgorithm: TDitheringAlgorithm; ABitmap: TBGRACustomBitmap;
     1020  out AScanlineSize: PtrInt): Pointer;
    10051021var
    1006   stream: TFileStreamUTF8;
    1007 begin
    1008    stream := TFileStreamUTF8.Create(AFilenameUTF8,fmCreate);
    1009    try
    1010      SaveBitmapToStream(AAlgorithm, ABitmap, stream, AFormat);
    1011    finally
    1012      stream.Free;
    1013    end;
     1022  indexer: TDitheringToIndexedImage;
     1023begin
     1024  indexer := TDitheringToIndexedImage.Create(ReducedPalette, FSeparateAlphaChannel, ABitDepth, AByteOrder);
     1025  indexer.DefaultTransparentColorIndex := ReducedPalette.IndexOfColor(BGRAPixelTransparent);
     1026  AScanlineSize:= indexer.ComputeMinimumScanlineSize(ABitmap.Width);
     1027  result := indexer.DitherImage(AAlgorithm, ABitmap, AScanlineSize);
     1028  indexer.Free;
    10141029end;
    10151030
    … …  
    10281043    writer := CreateBGRAImageWriter(AFormat, hasTransp);
    10291044    try
    1030       if writer is TFPWriterPNG then TFPWriterPNG(writer).Indexed := true else
     1045      if writer is TBGRAWriterPNG then TBGRAWriterPNG(writer).Indexed := true else
    10311046      if writer is TFPWriterBMP then
    10321047      begin
    … …  
    10921107begin
    10931108  index := 0;
    1094   if FHasPureTransparentColor then
     1109  if HasPureTransparentColor then
    10951110  begin
    10961111    FPureTransparentColorIndex:= index;
    … …  
    12291244  begin
    12301245    CheckColorComputed;
    1231     setlength(result,1+byte(FHasPureTransparentColor));
     1246    setlength(result,1+byte(HasPureTransparentColor));
    12321247    idx := 0;
    1233     if FHasPureTransparentColor then
     1248    if HasPureTransparentColor then
    12341249    begin
    12351250      result[idx] := BGRAPixelTransparent;
    … …  
    12411256    a := FInferiorBranch.GetAsArrayOfApproximatedColors;
    12421257    b := FSuperiorBranch.GetAsArrayOfApproximatedColors;
    1243     setlength(result, length(a)+length(b)+byte(FHasPureTransparentColor));
     1258    setlength(result, length(a)+length(b)+byte(HasPureTransparentColor));
    12441259    idx := 0;
    1245     if FHasPureTransparentColor then
     1260    if HasPureTransparentColor then
    12461261    begin
    12471262      result[idx] := BGRAPixelTransparent;
     1263      inc(idx);
     1264    end;
     1265    for i := 0 to high(a) do
     1266    begin
     1267      result[idx] := a[i];
     1268      inc(idx);
     1269    end;
     1270    for i := 0 to high(b) do
     1271    begin
     1272      result[idx] := b[i];
     1273      inc(idx);
     1274    end;
     1275  end;
     1276end;
     1277
     1278function TBGRAColorTree.GetAsArrayOfWeightedColors: ArrayOfWeightedColor;
     1279var a,b: ArrayOfWeightedColor;
     1280  idx,i: integer;
     1281begin
     1282  if IsLeaf then
     1283  begin
     1284    CheckColorComputed;
     1285    setlength(result,1+byte(HasPureTransparentColor));
     1286    idx := 0;
     1287    if HasPureTransparentColor then
     1288    begin
     1289      result[idx].Color := BGRAPixelTransparent;
     1290      result[idx].Weight := PureTransparentColorCount;
     1291      inc(idx);
     1292    end;
     1293    result[idx].Color := FLeafColor;
     1294    result[idx].Weight := Weight;
     1295  end else
     1296  begin
     1297    a := FInferiorBranch.GetAsArrayOfWeightedColors;
     1298    b := FSuperiorBranch.GetAsArrayOfWeightedColors;
     1299    setlength(result, length(a)+length(b)+byte(HasPureTransparentColor));
     1300    idx := 0;
     1301    if HasPureTransparentColor then
     1302    begin
     1303      result[idx].Color := BGRAPixelTransparent;
     1304      result[idx].Weight := PureTransparentColorCount;
    12481305      inc(idx);
    12491306    end;
    … …  
    13281385    if Assigned(FSuperiorBranch) then result += FSuperiorBranch.ApproximatedColorCount;
    13291386  end;
    1330   if FHasPureTransparentColor then inc(result);
     1387  if HasPureTransparentColor then inc(result);
     1388end;
     1389
     1390function TBGRAColorTree.GetHasPureTransparentColor: boolean;
     1391begin
     1392  result := FPureTransparentColorCount > 0;
    13311393end;
    13321394
    … …  
    13471409    FMaxBorder[c] := true;
    13481410  end;
    1349   FHasPureTransparentColor:= FLeaf.HasPureTransparentColor;
     1411  FPureTransparentColorCount:= FLeaf.PureTransparentColorCount;
    13501412  FPureTransparentColorIndex:= -1;
    13511413end;
    … …  
    14061468      else
    14071469        result := supLeaf;
    1408     blMix:
     1470    else{blMix:}
    14091471      if (sqrt(infLeaf.Weight/FWeight)*(infLeaf.LargestApparentInterval/LargestApparentInterval) >=
    14101472          sqrt(supLeaf.Weight/FWeight)*(supLeaf.LargestApparentInterval/LargestApparentInterval) ) then
    … …  
    15331595begin
    15341596  result := length(FColors);
    1535   if ACountPureTransparent and FHasPureTransparentColor then inc(result);
     1597  if ACountPureTransparent and HasPureTransparentColor then inc(result);
     1598end;
     1599
     1600function TBGRAColorBox.GetHasPureTransparentColor: boolean;
     1601begin
     1602  result := FPureTransparentColorCount > 0;
    15361603end;
    15371604
    … …  
    16671734  c: TColorDimension;
    16681735begin
    1669   FHasPureTransparentColor:= false;
     1736  FPureTransparentColorCount:= 0;
    16701737  FTotalWeight:= 0;
    16711738  for c := low(TColorDimension) to high(TColorDimension) do
    … …  
    16971764      inc(idx);
    16981765    end else
    1699       FHasPureTransparentColor:= true;
     1766      inc(FPureTransparentColorCount, Weight);
    17001767  end;
    17011768  setlength(FColors,idx);
    … …  
    17071774  comparer := GetPixelStrictComparer(ADimension);
    17081775  if comparer = nil then exit;
    1709   if Length(FColors) > InsertionSortLimit then
    1710     QuickSort(comparer,0,high(FColors))
    1711   else
    1712     InsertionSort(comparer,0,high(FColors));
    1713 end;
    1714 
    1715 procedure TBGRAColorBox.InsertionSort(AComparer: TIsChannelStrictlyGreaterFunc; AMinIndex,
    1716   AMaxIndex: NativeInt);
    1717 var i,j,insertPos: NativeInt;
    1718   compared: TBGRAWeightedPaletteEntry;
    1719 begin
    1720   for i := AMinIndex+1 to AMaxIndex do
    1721   begin
    1722     insertPos := i;
    1723     compared := FColors[i];
    1724     while (insertPos > AMinIndex) and AComparer(@FColors[insertPos-1].Color,@compared.Color) do
    1725       dec(insertPos);
    1726     if insertPos <> i then
    1727     begin
    1728       for j := i downto insertPos+1 do
    1729         FColors[j] := FColors[j-1];
    1730       FColors[insertPos] := compared;
    1731     end;
    1732   end;
    1733 end;
    1734 
    1735 procedure TBGRAColorBox.QuickSort(AComparer: TIsChannelStrictlyGreaterFunc; AMinIndex,
    1736   AMaxIndex: NativeInt);
    1737 var Pivot: TBGRAPixel;
    1738   CurMin,CurMax,i : NativeInt;
    1739 
    1740   procedure Swap(a,b: NativeInt);
    1741   var Temp: TBGRAWeightedPaletteEntry;
    1742   begin
    1743     if a = b then exit;
    1744     Temp := FColors[a];
    1745     FColors[a] := FColors[b];
    1746     FColors[b] := Temp;
    1747   end;
    1748 begin
    1749   if AMaxIndex-AMinIndex+1 <= InsertionSortLimit then
    1750   begin
    1751     InsertionSort(AComparer,AMinIndex,AMaxIndex);
    1752     exit;
    1753   end;
    1754   Pivot := FColors[(AMinIndex+AMaxIndex) shr 1].Color;
    1755   CurMin := AMinIndex;
    1756   CurMax := AMaxIndex;
    1757   i := CurMin;
    1758   while i < CurMax do
    1759   begin
    1760     if AComparer(@FColors[i].Color, @Pivot) then
    1761     begin
    1762       Swap(i, CurMax);
    1763       dec(CurMax);
    1764     end else
    1765     begin
    1766       if AComparer(@Pivot, @FColors[i].Color) then
    1767       begin
    1768         Swap(i, CurMin);
    1769         inc(CurMin);
    1770       end;
    1771       inc(i);
    1772     end;
    1773   end;
    1774   if AComparer(@Pivot, @FColors[i].Color) then
    1775   begin
    1776     Swap(i, CurMin);
    1777     inc(CurMin);
    1778   end;
    1779   if CurMin > AMinIndex then QuickSort(AComparer,AMinIndex,CurMin);
    1780   if CurMax < AMaxIndex then QuickSort(AComparer,CurMax,AMaxIndex);
     1776  ArrayOfWeightedColor_QuickSort(FColors,0,high(FColors),comparer)
    17811777end;
    17821778
    … …  
    18421838
    18431839constructor TBGRAColorBox.Create(ADimensions: TColorDimensions;
    1844   AColors: ArrayOfTBGRAPixel);
     1840  const AColors: ArrayOfTBGRAPixel; AAlpha: TAlphaChannelPaletteOption = acFullChannelInPalette);
    18451841var weightedColors: ArrayOfWeightedColor;
    18461842  i: Integer;
    18471843begin
    1848   FDimensions:= ADimensions;
    1849   setlength(weightedColors, length(AColors));
    1850   for i := 0 to high(weightedColors) do
    1851   with weightedColors[i] do
    1852   begin
    1853     color := AColors[i];
    1854     Weight:= 1;
    1855   end;
    1856   Init(weightedColors,True);
     1844  if AAlpha = acFullChannelInPalette then
     1845  begin
     1846    FDimensions:= ADimensions;
     1847    setlength(weightedColors, length(AColors));
     1848    for i := 0 to high(weightedColors) do
     1849    with weightedColors[i] do
     1850    begin
     1851      color := AColors[i];
     1852      Weight:= 1;
     1853    end;
     1854    Init(weightedColors,True);
     1855  end else
     1856    Create(ADimensions, @AColors[0], length(AColors), AAlpha);
    18571857end;
    18581858
    … …  
    18621862  FBounds := ABounds;
    18631863  FTotalWeight:= 0;
    1864   FHasPureTransparentColor:= false;
     1864  FPureTransparentColorCount:= 0;
    18651865end;
    18661866
    … …  
    18711871end;
    18721872
    1873 constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption);
     1873constructor TBGRAColorBox.Create(ADimensions: TColorDimensions;
     1874  ABitmap: TBGRACustomBitmap; AAlpha: TAlphaChannelPaletteOption);
     1875begin
     1876  Create(ADimensions, ABitmap.Data, ABitmap.NbPixels, AAlpha);
     1877end;
     1878
     1879constructor TBGRAColorBox.Create(ADimensions: TColorDimensions; AColors: PBGRAPixel; ANbPixels: integer; AAlpha: TAlphaChannelPaletteOption);
    18741880var i,j,prev,idx: integer;
    18751881  p: PBGRAPixel;
    18761882  skip: boolean;
    18771883  alphaMask: DWord;
    1878   transp: boolean;
     1884  transpIndex: integer;
    18791885begin
    18801886  if AAlpha <> acFullChannelInPalette then
    … …  
    18831889    alphaMask := 0;
    18841890  FDimensions:= ADimensions;
    1885   transp := false;
    1886   SetLength(FColors,ABitmap.NbPixels);
     1891  transpIndex := -1;
     1892  SetLength(FColors,ANbPixels);
    18871893  if length(FColors)>0 then
    18881894  begin
    1889     p := ABitmap.Data;
     1895    p := AColors;
    18901896    idx := 0;
    1891     for i := 0 to ABitmap.NbPixels-1 do
     1897    for i := 0 to ANbPixels-1 do
    18921898    begin
    18931899      if (p^.alpha = 0) or ((AAlpha = acTransparentEntry) and (p^.alpha < 128)) then
    18941900      begin
    18951901        skip := true;
    1896         if not transp and not (AAlpha = acIgnore) then
     1902        if not (AAlpha = acIgnore) then
    18971903        begin
    1898           with FColors[idx] do
     1904          if (transpIndex=-1) then
    18991905          begin
    1900             Color := BGRAPixelTransparent;
    1901             Weight:= 1;
    1902           end;
    1903           transp := true;
    1904           inc(idx);
     1906            transpIndex := idx;
     1907            with FColors[idx] do
     1908            begin
     1909              Color := BGRAPixelTransparent;
     1910              Weight:= 1;
     1911            end;
     1912            inc(idx);
     1913          end else
     1914            inc(FColors[transpIndex].Weight);
    19051915        end;
    19061916        if (p^.alpha = 0) then
    … …  
    19381948    setLength(FColors, idx);
    19391949
    1940     QuickSort(@IsDWordGreater,0,high(FColors));
     1950    ArrayOfWeightedColor_QuickSort(FColors,0,high(FColors),@IsDWordGreater);
    19411951    prev := 0;
    19421952    for i := 1 to high(FColors) do
    … …  
    20062016var i,idx: integer;
    20072017begin
    2008   if AIncludePureTransparent and FHasPureTransparentColor then
     2018  if AIncludePureTransparent and HasPureTransparentColor then
    20092019  begin
    20102020    setlength(result, length(FColors)+1);
Note: See TracChangeset for help on using the changeset viewer.