Ignore:
Timestamp:
Apr 9, 2015, 9:58:36 PM (10 years ago)
Author:
chronos
Message:
  • Fixed: Use csOpaque control style also to Image, PaintBox and OpenGLControl.
  • Modified: Change size of test frame with SpinEdits as delayed using timer.
  • Updated: BRGABitmap package to version 8.1.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest/Packages/bgrabitmap/bgrapolygonaliased.pas

    r452 r472  
    22
    33{$mode objfpc}{$H+}
     4
     5{$i bgrasse.inc}
    46
    57interface
    … …  
    1214
    1315uses
    14   Classes, SysUtils, BGRABitmapTypes, BGRAFillInfo, BGRAPolygon, BGRASSE;
     16  Classes, SysUtils, BGRABitmapTypes, BGRAFillInfo, BGRASSE;
    1517
    1618type
    … …  
    2931  { TPolygonLinearColorGradientInfo }
    3032
    31   TPolygonLinearColorGradientInfo = class(TFillPolyInfo)
     33  TPolygonLinearColorGradientInfo = class(TOnePassFillPolyInfo)
    3234  protected
    3335    FColors: array of TColorF;
     36    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
     37      ANumSegment: integer; dy: single; AData: pointer); override;
    3438  public
    3539    constructor Create(const points: array of TPointF; const Colors: array of TBGRAPixel);
    3640    function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
    3741    function CreateIntersectionInfo: TIntersectionInfo; override;
    38     procedure ComputeIntersection(cury: single;
    39       var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
    4042  end;
    4143
    … …  
    6163  { TPolygonPerspectiveColorGradientInfo }
    6264
    63   TPolygonPerspectiveColorGradientInfo = class(TFillPolyInfo)
     65  TPolygonPerspectiveColorGradientInfo = class(TOnePassFillPolyInfo)
    6466  protected
    6567    FColors: array of TColorF;
    6668    FPointsZ: array of single;
     69    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
     70      ANumSegment: integer; dy: single; AData: pointer); override;
    6771  public
    6872    constructor Create(const points: array of TPointF; const pointsZ: array of single; const Colors: array of TBGRAPixel);
    6973    function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
    7074    function CreateIntersectionInfo: TIntersectionInfo; override;
    71     procedure ComputeIntersection(cury: single;
    72       var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
    7375  end;
    7476
    … …  
    9698  { TPolygonLinearTextureMappingInfo }
    9799
    98   TPolygonLinearTextureMappingInfo = class(TFillPolyInfo)
     100  TPolygonLinearTextureMappingInfo = class(TOnePassFillPolyInfo)
    99101  protected
    100102    FTexCoords: array of TPointF;
    101103    FLightnesses: array of Word;
     104    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
     105      ANumSegment: integer; dy: single; AData: pointer); override;
    102106  public
    103107    constructor Create(const points: array of TPointF; const texCoords: array of TPointF);
    … …  
    105109    function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
    106110    function CreateIntersectionInfo: TIntersectionInfo; override;
    107     procedure ComputeIntersection(cury: single;
    108       var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
    109111  end;
    110112
    … …  
    140142  { TPolygonPerspectiveTextureMappingInfo }
    141143
    142   TPolygonPerspectiveTextureMappingInfo = class(TFillPolyInfo)
     144  TPolygonPerspectiveTextureMappingInfo = class(TOnePassFillPolyInfo)
    143145  protected
    144146    FTexCoords: array of TPointF;
    145147    FPointsZ: array of single;
    146148    FLightnesses: array of Word;
     149    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
     150      ANumSegment: integer; dy: single; AData: pointer); override;
    147151  public
    148152    constructor Create(const points: array of TPointF; const pointsZ: array of single; const texCoords: array of TPointF);
    … …  
    150154    function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
    151155    function CreateIntersectionInfo: TIntersectionInfo; override;
    152     procedure ComputeIntersection(cury: single;
    153       var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
    154156  end;
    155157
    156158  { TPolygonPerspectiveMappingShaderInfo }
    157159
    158   TPolygonPerspectiveMappingShaderInfo = class(TFillPolyInfo)
     160  TPolygonPerspectiveMappingShaderInfo = class(TOnePassFillPolyInfo)
    159161  protected
    160162    FTexCoords: array of TPointF;
    161163    FPositions3D, FNormals3D: array of TPoint3D_128;
     164    procedure SetIntersectionValues(AInter: TIntersectionInfo; AInterX: Single; AWinding,
     165      ANumSegment: integer; dy: single; AData: pointer); override;
    162166  public
    163167    constructor Create(const points: array of TPointF; const points3D: array of TPoint3D; const normals: array of TPoint3D; const texCoords: array of TPointF);
    … …  
    165169    function CreateSegmentData(numPt,nextPt: integer; x,y: single): pointer; override;
    166170    function CreateIntersectionInfo: TIntersectionInfo; override;
    167     procedure ComputeIntersection(cury: single;
    168       var inter: ArrayOfTIntersectionInfo; var nbInter: integer); override;
    169171  end;
    170172
    … …  
    192194{ Aliased round rectangle }
    193195procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer;
    194   DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil);
     196  DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency;
     197  skipFill: boolean = false);
    195198
    196199implementation
    … …  
    199202
    200203{ TPolygonPerspectiveColorGradientInfo }
     204
     205procedure TPolygonPerspectiveColorGradientInfo.SetIntersectionValues(
     206  AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
     207  dy: single; AData: pointer);
     208var
     209  info: PPerspectiveColorInfo;
     210begin
     211  AInter.SetValues(AInterX,AWinding,ANumSegment);
     212  info := PPerspectiveColorInfo(AData);
     213  TPerspectiveColorGradientIntersectionInfo(AInter).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
     214  TPerspectiveColorGradientIntersectionInfo(AInter).ColorDivZ := info^.ColorDivZ + info^.ColorSlopesDivZ*dy;
     215end;
    201216
    202217constructor TPolygonPerspectiveColorGradientInfo.Create(
    … …  
    266281end;
    267282
    268 procedure TPolygonPerspectiveColorGradientInfo.ComputeIntersection(
    269   cury: single; var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
    270 var
    271   j: integer;
    272   dy: single;
    273   info: PPerspectiveColorInfo;
    274 begin
    275   if length(FSlices)=0 then exit;
    276 
    277   while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice);
    278   while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice);
    279   with FSlices[FCurSlice] do
    280   if (cury >= y1) and (cury <= y2) then
    281   begin
    282     for j := 0 to nbSegments-1 do
    283     begin
    284       dy := cury - segments[j].y1;
    285       inter[nbinter].interX := dy * segments[j].slope + segments[j].x1;
    286       inter[nbinter].winding := segments[j].winding;
    287       info := PPerspectiveColorInfo(segments[j].data);
    288       TPerspectiveColorGradientIntersectionInfo(inter[nbinter]).coordInvZ := dy*info^.InvZSlope + info^.InvZ;
    289       TPerspectiveColorGradientIntersectionInfo(inter[nbinter]).ColorDivZ := info^.ColorDivZ + info^.ColorSlopesDivZ*dy;
    290       Inc(nbinter);
    291     end;
    292   end;
    293 end;
    294 
    295283{ TPolygonLinearColorGradientInfo }
     284
     285procedure TPolygonLinearColorGradientInfo.SetIntersectionValues(
     286  AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
     287  dy: single; AData: pointer);
     288var
     289  info: PLinearColorInfo;
     290begin
     291  AInter.SetValues(AInterX,AWinding,ANumSegment);
     292  info := PLinearColorInfo(AData);
     293  TLinearColorGradientIntersectionInfo(AInter).color := info^.Color + info^.ColorSlopes*dy;
     294end;
    296295
    297296constructor TPolygonLinearColorGradientInfo.Create(
    … …  
    343342begin
    344343  Result:= TLinearColorGradientIntersectionInfo.Create;
    345 end;
    346 
    347 procedure TPolygonLinearColorGradientInfo.ComputeIntersection(cury: single;
    348       var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
    349 var
    350   j: integer;
    351   dy: single;
    352   info: PLinearColorInfo;
    353 begin
    354   if length(FSlices)=0 then exit;
    355 
    356   while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice);
    357   while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice);
    358   with FSlices[FCurSlice] do
    359   if (cury >= y1) and (cury <= y2) then
    360   begin
    361     for j := 0 to nbSegments-1 do
    362     begin
    363       dy := cury - segments[j].y1;
    364       inter[nbinter].interX := dy * segments[j].slope + segments[j].x1;
    365       inter[nbinter].winding := segments[j].winding;
    366       info := PLinearColorInfo(segments[j].data);
    367       TLinearColorGradientIntersectionInfo(inter[nbinter]).color := info^.Color + info^.ColorSlopes*dy;
    368       Inc(nbinter);
    369     end;
    370   end;
    371344end;
    372345
    … …  
    389362        r,g,b,a: integer;
    390363       end;
    391     {$IFDEF CPUI386} c: TBGRAPixel; {$ENDIF}
     364    {$IFDEF BGRASSE_AVAILABLE} c: TBGRAPixel; {$ENDIF}
    392365  begin
    393366    t := ((ix1+0.5)-x1)/(x2-x1);
    … …  
    396369    pdest := bmp.ScanLine[yb]+ix1;
    397370
    398     {$IFDEF CPUI386} {$asmmode intel}
     371    {$IFDEF BGRASSE_AVAILABLE} {$asmmode intel}
    399372    If UseSSE then
    400373    begin
    … …  
    499472{ TPolygonLinearTextureMappingInfo }
    500473
     474procedure TPolygonLinearTextureMappingInfo.SetIntersectionValues(
     475  AInter: TIntersectionInfo; AInterX: Single; AWinding, ANumSegment: integer;
     476  dy: single; AData: pointer);
     477var
     478  info: PLinearTextureInfo;
     479begin
     480  AInter.SetValues(AInterX,AWinding,ANumSegment);
     481  info := PLinearTextureInfo(AData);
     482  TLinearTextureMappingIntersectionInfo(AInter).texCoord := info^.TexCoord + info^.TexCoordSlopes*dy;
     483  if FLightnesses<>nil then
     484    TLinearTextureMappingIntersectionInfo(AInter).lightness := round(info^.lightness + info^.lightnessSlope*dy)
     485  else
     486    TLinearTextureMappingIntersectionInfo(AInter).lightness := 32768;
     487end;
     488
    501489constructor TPolygonLinearTextureMappingInfo.Create(const points: array of TPointF;
    502490  const texCoords: array of TPointF);
    … …  
    585573begin
    586574  result := TLinearTextureMappingIntersectionInfo.Create;
    587 end;
    588 
    589 procedure TPolygonLinearTextureMappingInfo.ComputeIntersection(cury: single;
    590       var inter: ArrayOfTIntersectionInfo; var nbInter: integer);
    591 var
    592   j: integer;
    593   dy: single;
    594   info: PLinearTextureInfo;
    595 begin
    596   if length(FSlices)=0 then exit;
    597 
    598   while (cury < FSlices[FCurSlice].y1) and (FCurSlice > 0) do dec(FCurSlice);
    599   while (cury > FSlices[FCurSlice].y2) and (FCurSlice < high(FSlices)) do inc(FCurSlice);
    600   with FSlices[FCurSlice] do
    601   if (cury >= y1) and (cury <= y2) then
    602   begin
    603     for j := 0 to nbSegments-1 do
    604     begin
    605       dy := cury - segments[j].y1;
    606       inter[nbinter].interX := dy * segments[j].slope + segments[j].x1;
    607       inter[nbinter].winding := segments[j].winding;
    608       info := PLinearTextureInfo(segments[j].data);
    609       TLinearTextureMappingIntersectionInfo(inter[nbinter]).texCoord := info^.TexCoord + info^.TexCoordSlopes*dy;
    610       if FLightnesses<>nil then
    611         TLinearTextureMappingIntersectionInfo(inter[nbinter]).lightness := round(info^.lightness + info^.lightnessSlope*dy)
    612       else
    613         TLinearTextureMappingIntersectionInfo(inter[nbinter]).lightness := 32768;
    614       Inc(nbinter);
    615     end;
    616   end;
    617575end;
    618576
    … …  
    637595    z,invZ,InvZStep: single;
    638596    r,g,b,a: integer;
    639     {$IFDEF CPUI386}minVal,maxVal: single;
     597    {$IFDEF BGRASSE_AVAILABLE}minVal,maxVal: single;
    640598    cInt: packed record
    641599      r,g,b,a: integer;
    … …  
    657615    {$DEFINE PARAM_USEZBUFFER}
    658616      zbufferpos := zbuffer + yb*bmp.Width + ix1;
    659       {$IFDEF CPUI386}
     617      {$IFDEF BGRASSE_AVAILABLE}
    660618      If UseSSE then
    661619      begin
    … …  
    679637    end else
    680638    begin
    681       {$IFDEF CPUI386}
     639      {$IFDEF BGRASSE_AVAILABLE}
    682640      If UseSSE then
    683641      begin
    … …  
    846804{From LazRGBGraphics}
    847805procedure BGRARoundRectAliased(dest: TBGRACustomBitmap; X1, Y1, X2, Y2: integer;
    848   DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil);
     806  DX, DY: integer; BorderColor, FillColor: TBGRAPixel; FillTexture: IBGRAScanner = nil; ADrawMode: TDrawMode = dmDrawWithTransparency;
     807  skipFill: boolean = false);
    849808var
    850809  CX, CY, CX1, CY1, A, B, NX, NY: single;
    … …  
    858817  LX, LY: integer;
    859818  RowStart,RowEnd: integer;
    860   eBorderColor,eFillColor: TExpandedPixel;
     819  PixelProc: procedure (x, y: int32or64; c: TBGRAPixel) of object;
     820  skipBorder: boolean;
    861821
    862822  procedure AddEdge(X, Y: integer);
    … …  
    891851  Dec(y2);
    892852
    893   eBorderColor := GammaExpansion(BorderColor);
    894   eFillColor := GammaExpansion(FillColor);
    895 
    896853  if (X1 = X2) and (Y1 = Y2) then
    897854  begin
    898     dest.DrawPixel(X1, Y1, eBorderColor);
     855    dest.DrawPixel(X1, Y1, BorderColor, ADrawMode);
    899856    Exit;
    900857  end;
    … …  
    902859  if (X2 - X1 = 1) or (Y2 - Y1 = 1) then
    903860  begin
    904     dest.FillRect(X1, Y1, X2 + 1, Y2 + 1, BorderColor, dmDrawWithTransparency);
     861    dest.FillRect(X1, Y1, X2 + 1, Y2 + 1, BorderColor, ADrawMode);
    905862    Exit;
    906863  end;
    … …  
    908865  if (LX > X2 - X1) or (LY > Y2 - Y1) then
    909866  begin
    910     dest.Rectangle(X1, Y1, X2 + 1, Y2 + 1, BorderColor, dmDrawWithTransparency);
    911     if FillTexture <> nil then
    912       dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillTexture, dmDrawWithTransparency) else
    913       dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillColor, dmDrawWithTransparency);
     867    dest.Rectangle(X1, Y1, X2 + 1, Y2 + 1, BorderColor, ADrawMode);
     868    if not skipFill then
     869      if FillTexture <> nil then
     870        dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillTexture, ADrawMode) else
     871        dest.FillRect(X1 + 1, Y1 + 1, X2, Y2, FillColor, ADrawMode);
    914872    Exit;
    915873  end;
    … …  
    977935  end;
    978936
     937  case ADrawMode of
     938  dmSetExceptTransparent: begin PixelProc := @dest.SetPixel; skipBorder:= BorderColor.alpha <> 255; end;  dmDrawWithTransparency: begin PixelProc := @dest.DrawPixel; skipBorder:= BorderColor.alpha = 0; end;
     939  dmXor: begin PixelProc := @dest.XorPixel; skipBorder:= DWord(BorderColor) = 0; end;
     940  dmLinearBlend: begin PixelProc := @dest.FastBlendPixel; skipBorder:= BorderColor.alpha = 0; end;
     941  else
     942  begin PixelProc := @dest.SetPixel; skipBorder := false; end;
     943  end;
     944
    979945  J := 0;
    980946  while J < Length(EdgeList) do
    … …  
    982948    if (J = 0) and (Frac(CY) > 0) then
    983949    begin
     950      if not skipBorder then
    984951      for I := EdgeList[J].X to EdgeList[J].Y do
    985952      begin
    986         dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, eBorderColor);
    987         dest.DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, eBorderColor);
     953        PixelProc(Floor(CX) + I, Floor(CY) + J, BorderColor);
     954        PixelProc(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor);
    988955      end;
    989956
    990       if FillTexture <> nil then
    991         dest.DrawHorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
    992           Pred(EdgeList[J].X), FillTexture) else
    993         dest.DrawHorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
    994           Pred(EdgeList[J].X), eFillColor);
     957      if not SkipFill then
     958        if FillTexture <> nil then
     959          dest.HorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
     960            Pred(EdgeList[J].X), FillTexture, ADrawMode) else
     961          dest.HorizLine(Ceil(CX) - EdgeList[J].X, Floor(CY) + J, Floor(CX) +
     962            Pred(EdgeList[J].X), FillColor, ADrawMode);
    995963    end
    996964    else
    … …  
    1002970        S := -Succ(EdgeList[J].Y);
    1003971
     972      if not skipBorder then
    1004973      for I := S to EdgeList[J].Y do
    1005974      begin
    1006         dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, eBorderColor);
    1007         dest.DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), eBorderColor);
     975        PixelProc(Floor(CX) + I, Floor(CY) + J, BorderColor);
     976        PixelProc(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor);
    1008977      end;
    1009978    end
    1010979    else
    1011980    begin
     981      if not skipBorder then
    1012982      for I := EdgeList[J].X to EdgeList[J].Y do
    1013983      begin
    1014         dest.DrawPixel(Floor(CX) + I, Floor(CY) + J, eBorderColor);
    1015         dest.DrawPixel(Floor(CX) + I, Ceil(CY) - Succ(J), eBorderColor);
     984        PixelProc(Floor(CX) + I, Floor(CY) + J, BorderColor);
     985        PixelProc(Floor(CX) + I, Ceil(CY) - Succ(J), BorderColor);
    1016986        if Floor(CX) + I <> Ceil(CX) - Succ(I) then
    1017987        begin
    1018           dest.DrawPixel(Ceil(CX) - Succ(I), Floor(CY) + J, eBorderColor);
    1019           dest.DrawPixel(Ceil(CX) - Succ(I), Ceil(CY) - Succ(J), eBorderColor);
     988          PixelProc(Ceil(CX) - Succ(I), Floor(CY) + J, BorderColor);
     989          PixelProc(Ceil(CX) - Succ(I), Ceil(CY) - Succ(J), BorderColor);
    1020990        end;
    1021991      end;
    1022992
    1023       RowStart := Ceil(CX) - EdgeList[J].X;
    1024       RowEnd := Floor(CX) + Pred(EdgeList[J].X);
    1025       if RowEnd >= RowStart then
    1026       begin
    1027         if FillTexture <> nil then
     993      if not SkipFill then
     994      begin
     995        RowStart := Ceil(CX) - EdgeList[J].X;
     996        RowEnd := Floor(CX) + Pred(EdgeList[J].X);
     997        if RowEnd >= RowStart then
    1028998        begin
    1029           dest.DrawHorizLine(RowStart, Floor(CY) + J,
    1030             RowEnd, FillTexture);
    1031           dest.DrawHorizLine(RowStart, Ceil(CY) - Succ(J),
    1032             RowEnd, FillTexture);
    1033         end else
    1034         begin
    1035           dest.DrawHorizLine(RowStart, Floor(CY) + J,
    1036             RowEnd, eFillColor);
    1037           dest.DrawHorizLine(RowStart, Ceil(CY) - Succ(J),
    1038             RowEnd, eFillColor);
     999          if FillTexture <> nil then
     1000          begin
     1001            dest.HorizLine(RowStart, Floor(CY) + J,
     1002              RowEnd, FillTexture, ADrawMode);
     1003            dest.HorizLine(RowStart, Ceil(CY) - Succ(J),
     1004              RowEnd, FillTexture, ADrawMode);
     1005          end else
     1006          begin
     1007            dest.HorizLine(RowStart, Floor(CY) + J,
     1008              RowEnd, FillColor, ADrawMode);
     1009            dest.HorizLine(RowStart, Ceil(CY) - Succ(J),
     1010              RowEnd, FillColor, ADrawMode);
     1011          end;
    10391012        end;
    10401013      end;
     1014
    10411015    end;
    10421016    Inc(J);
Note: See TracChangeset for help on using the changeset viewer.