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/bgrapen.pas

    r452 r472  
    2020  TBGRAPolyLineOption = (plRoundCapOpen, //specifies that the line ending is opened
    2121                         plCycle,        //specifies that it is a polygon
    22                          plAutoCycle);   //specifies that a cycle must be used if the last point is the first point
     22                         plAutoCycle,    //specifies that a cycle must be used if the last point is the first point
     23                         plNoStartCap,
     24                         plNoEndCap);
    2325  TBGRAPolyLineOptions = set of TBGRAPolyLineOption;
     26  TComputeArrowHeadProc = function(const APosition: TPointF; const ADirection: TPointF; const AWidth: single; const ACurrentPos: single): ArrayOfTPointF of object;
    2427
    2528{ Draw a polyline with specified parameters. If a scanner is specified, it is used as a texture.
    … …  
    2730procedure BGRAPolyLine(bmp: TBGRACustomBitmap; const linepts: array of TPointF;
    2831     width: single; pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
    29      options: TBGRAPolyLineOptions; scan: IBGRAScanner = nil; miterLimit: single = 2);
     32     options: TBGRAPolyLineOptions; scan: IBGRAScanner = nil; miterLimit: single = 2; arrowStart: TComputeArrowHeadProc = nil; arrowStartPos: single = 0; arrowEnd: TComputeArrowHeadProc = nil; arrowEndPos: single = 0);
    3033
    3134{ Compute the path for a polyline }
    3235function ComputeWidePolylinePoints(const linepts: array of TPointF; width: single;
    3336          pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
    34           options: TBGRAPolyLineOptions; miterLimit: single = 2): ArrayOfTPointF;
     37          options: TBGRAPolyLineOptions; miterLimit: single = 2; arrowStart: TComputeArrowHeadProc = nil; wantedStartArrowPos: single = 0; arrowEnd: TComputeArrowHeadProc = nil; WantedEndArrowPos: single = 0): ArrayOfTPointF;
    3538
    3639{ Compute the path for a poly-polyline }
    3740function ComputeWidePolyPolylinePoints(const linepts: array of TPointF; width: single;
    3841          pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
    39           options: TBGRAPolyLineOptions; miterLimit: single = 2): ArrayOfTPointF;
     42          options: TBGRAPolyLineOptions; miterLimit: single = 2; arrowStart: TComputeArrowHeadProc = nil; arrowStartPos: single = 0; arrowEnd: TComputeArrowHeadProc = nil; arrowEndPos: single = 0): ArrayOfTPointF;
    4043
    4144{--------------------- Pixel line procedures --------------------------}
    … …  
    4447
    4548//aliased version
    46 procedure BGRADrawLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean);
     49procedure BGRADrawLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode = dmDrawWithTransparency);
    4750procedure BGRAEraseLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer; alpha: byte; DrawLastPixel: boolean);
    4851
    4952//antialiased version
    50 procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
    51   c: TBGRAPixel; DrawLastPixel: boolean);
     53procedure BGRADrawLineAntialias({%H-}dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
     54  c: TBGRAPixel; DrawLastPixel: boolean; LinearBlend : boolean = false);
    5255procedure BGRAEraseLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
    5356  calpha: byte; DrawLastPixel: boolean);
    … …  
    5558//antialiased version with bicolor dashes (to draw a frame)
    5659procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
    57   c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer);
     60  c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer; LinearBlend : boolean = false);
    5861
    5962//length added to ensure accepable alpha join (using TBGRAMultishapeFiller is still better)
    … …  
    7477
    7578procedure BGRADrawLineAliased(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
    76   c: TBGRAPixel; DrawLastPixel: boolean);
     79  c: TBGRAPixel; DrawLastPixel: boolean; ADrawMode: TDrawMode);
     80var
     81  Y, X: integer;
     82  DX, DY, SX, SY, E: integer;
     83  PixelProc: procedure (x, y: int32or64; c: TBGRAPixel) of object;
     84begin
     85  if (Y1 = Y2) then
     86  begin
     87    if (X1 = X2) then
     88    begin
     89      if DrawLastPixel then
     90        dest.DrawPixel(X1, Y1, c, ADrawMode);
     91    end else
     92    begin
     93      if not DrawLastPixel then
     94      begin
     95        if X2 > X1 then dec(X2) else inc(X2);
     96      end;
     97      dest.HorizLine(X1,Y1,X2,c, ADrawMode);
     98    end;
     99    Exit;
     100  end else
     101  if (X1 = X2) then
     102  begin
     103    if not DrawLastPixel then
     104    begin
     105      if Y2 > Y1 then dec(Y2) else inc(Y2);
     106    end;
     107    dest.VertLine(X1,Y1,Y2,c, ADrawMode);
     108  end;
     109
     110  DX := X2 - X1;
     111  DY := Y2 - Y1;
     112
     113  if (ADrawMode = dmSetExceptTransparent) and (c.alpha <> 255) then exit else
     114  if c.alpha = 0 then
     115  begin
     116    if ADrawMode in[dmDrawWithTransparency,dmLinearBlend] then exit;
     117    if (ADrawMode = dmXor) and (DWord(c)=0) then exit;
     118  end;
     119  case ADrawMode of
     120  dmDrawWithTransparency: PixelProc := @dest.DrawPixel;
     121  dmXor: PixelProc := @dest.XorPixel;
     122  dmLinearBlend: PixelProc := @dest.FastBlendPixel;
     123  else
     124    PixelProc := @dest.SetPixel;
     125  end;
     126
     127  if DX < 0 then
     128  begin
     129    SX := -1;
     130    DX := -DX;
     131  end
     132  else
     133    SX := 1;
     134
     135  if DY < 0 then
     136  begin
     137    SY := -1;
     138    DY := -DY;
     139  end
     140  else
     141    SY := 1;
     142
     143  DX := DX shl 1;
     144  DY := DY shl 1;
     145
     146  X := X1;
     147  Y := Y1;
     148  if DX > DY then
     149  begin
     150    E := DY - DX shr 1;
     151
     152    while X <> X2 do
     153    begin
     154      PixelProc(X, Y, c);
     155      if E >= 0 then
     156      begin
     157        Inc(Y, SY);
     158        Dec(E, DX);
     159      end;
     160      Inc(X, SX);
     161      Inc(E, DY);
     162    end;
     163  end
     164  else
     165  begin
     166    E := DX - DY shr 1;
     167
     168    while Y <> Y2 do
     169    begin
     170      PixelProc(X, Y, c);
     171      if E >= 0 then
     172      begin
     173        Inc(X, SX);
     174        Dec(E, DY);
     175      end;
     176      Inc(Y, SY);
     177      Inc(E, DX);
     178    end;
     179  end;
     180
     181  if DrawLastPixel then
     182    PixelProc(X2, Y2, c);
     183end;
     184
     185procedure BGRAEraseLineAliased(dest: TBGRACustomBitmap; x1, y1, x2,
     186  y2: integer; alpha: byte; DrawLastPixel: boolean);
    77187var
    78188  Y, X: integer;
    … …  
    83193  begin
    84194    if DrawLastPixel then
    85       dest.DrawPixel(X1, Y1, c);
     195      dest.ErasePixel(X1, Y1, alpha);
    86196    Exit;
    87197  end;
    … …  
    117227    while X <> X2 do
    118228    begin
    119       dest.DrawPixel(X, Y, c);
     229      dest.ErasePixel(X, Y, alpha);
    120230      if E >= 0 then
    121231      begin
    … …  
    133243    while Y <> Y2 do
    134244    begin
    135       dest.DrawPixel(X, Y, c);
     245      dest.ErasePixel(X, Y, alpha);
    136246      if E >= 0 then
    137247      begin
    … …  
    145255
    146256  if DrawLastPixel then
    147     dest.DrawPixel(X2, Y2, c);
     257    dest.ErasePixel(X2, Y2, alpha);
    148258end;
    149259
    150 procedure BGRAEraseLineAliased(dest: TBGRACustomBitmap; x1, y1, x2,
    151   y2: integer; alpha: byte; DrawLastPixel: boolean);
    152 var
    153   Y, X: integer;
     260procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
     261  c: TBGRAPixel; DrawLastPixel: boolean; LinearBlend : boolean);
     262var
     263  Y, X:  integer;
    154264  DX, DY, SX, SY, E: integer;
     265  alpha: NativeUInt;
     266  pixelproc: procedure(x,y: int32or64; c: TBGRAPixel) of object;
    155267begin
     268  if LinearBlend then
     269    pixelproc := @dest.FastBlendPixel
     270  else
     271    pixelproc := @dest.DrawPixel;
    156272
    157273  if (Y1 = Y2) and (X1 = X2) then
    158274  begin
    159275    if DrawLastPixel then
    160       dest.ErasePixel(X1, Y1, alpha);
     276      pixelproc(X1, Y1, c);
    161277    Exit;
    162278  end;
    … …  
    186302  X := X1;
    187303  Y := Y1;
     304
    188305  if DX > DY then
    189306  begin
    190     E := DY - DX shr 1;
     307    E := 0;
    191308
    192309    while X <> X2 do
    193310    begin
    194       dest.ErasePixel(X, Y, alpha);
    195       if E >= 0 then
     311      alpha := c.alpha * E div DX;
     312      pixelproc(X, Y, BGRA(c.red, c.green, c.blue, c.alpha - alpha));
     313      pixelproc(X, Y + SY, BGRA(c.red, c.green, c.blue, alpha));
     314      Inc(E, DY);
     315      if E >= DX then
    196316      begin
    197317        Inc(Y, SY);
    … …  
    199319      end;
    200320      Inc(X, SX);
    201       Inc(E, DY);
    202321    end;
    203322  end
    204323  else
    205324  begin
    206     E := DX - DY shr 1;
     325    E := 0;
    207326
    208327    while Y <> Y2 do
    209328    begin
    210       dest.ErasePixel(X, Y, alpha);
    211       if E >= 0 then
     329      alpha := c.alpha * E div DY;
     330      pixelproc(X, Y, BGRA(c.red, c.green, c.blue, c.alpha - alpha));
     331      pixelproc(X + SX, Y, BGRA(c.red, c.green, c.blue, alpha));
     332      Inc(E, DX);
     333      if E >= DY then
    212334      begin
    213335        Inc(X, SX);
    … …  
    215337      end;
    216338      Inc(Y, SY);
    217       Inc(E, DX);
    218     end;
    219   end;
    220 
     339    end;
     340  end;
    221341  if DrawLastPixel then
    222     dest.ErasePixel(X2, Y2, alpha);
     342    pixelproc(X2, Y2, c);
    223343end;
    224344
    225 procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
    226   c: TBGRAPixel; DrawLastPixel: boolean);
     345procedure BGRAEraseLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2,
     346  y2: integer; calpha: byte; DrawLastPixel: boolean);
    227347var
    228348  Y, X:  integer;
    229349  DX, DY, SX, SY, E: integer;
    230   alpha: single;
     350  alpha: NativeUInt;
    231351begin
    232352
    … …  
    234354  begin
    235355    if DrawLastPixel then
    236       dest.DrawPixel(X1, Y1, c);
     356      dest.ErasePixel(X1, Y1, calpha);
    237357    Exit;
    238358  end;
    … …  
    269389    while X <> X2 do
    270390    begin
    271       alpha := 1 - E / DX;
    272       dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
    273       dest.DrawPixel(X, Y + SY, BGRA(c.red, c.green, c.blue,
    274         round(c.alpha * sqrt(1 - alpha))));
     391      alpha := calpha * E div DX;
     392      dest.ErasePixel(X, Y, calpha - alpha);
     393      dest.ErasePixel(X, Y + SY, alpha);
    275394      Inc(E, DY);
    276395      if E >= DX then
    … …  
    288407    while Y <> Y2 do
    289408    begin
    290       alpha := 1 - E / DY;
    291       dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
    292       dest.DrawPixel(X + SX, Y, BGRA(c.red, c.green, c.blue,
    293         round(c.alpha * sqrt(1 - alpha))));
    294       Inc(E, DX);
    295       if E >= DY then
    296       begin
    297         Inc(X, SX);
    298         Dec(E, DY);
    299       end;
    300       Inc(Y, SY);
    301     end;
    302   end;
    303   if DrawLastPixel then
    304     dest.DrawPixel(X2, Y2, c);
    305 end;
    306 
    307 procedure BGRAEraseLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2,
    308   y2: integer; calpha: byte; DrawLastPixel: boolean);
    309 var
    310   Y, X:  integer;
    311   DX, DY, SX, SY, E: integer;
    312   alpha: single;
    313 begin
    314 
    315   if (Y1 = Y2) and (X1 = X2) then
    316   begin
    317     if DrawLastPixel then
    318       dest.ErasePixel(X1, Y1, calpha);
    319     Exit;
    320   end;
    321 
    322   DX := X2 - X1;
    323   DY := Y2 - Y1;
    324 
    325   if DX < 0 then
    326   begin
    327     SX := -1;
    328     DX := -DX;
    329   end
    330   else
    331     SX := 1;
    332 
    333   if DY < 0 then
    334   begin
    335     SY := -1;
    336     DY := -DY;
    337   end
    338   else
    339     SY := 1;
    340 
    341   DX := DX shl 1;
    342   DY := DY shl 1;
    343 
    344   X := X1;
    345   Y := Y1;
    346 
    347   if DX > DY then
    348   begin
    349     E := 0;
    350 
    351     while X <> X2 do
    352     begin
    353       alpha := 1 - E / DX;
    354       dest.ErasePixel(X, Y, round(calpha * sqrt(alpha)));
    355       dest.ErasePixel(X, Y + SY, round(calpha * sqrt(1 - alpha)));
    356       Inc(E, DY);
    357       if E >= DX then
    358       begin
    359         Inc(Y, SY);
    360         Dec(E, DX);
    361       end;
    362       Inc(X, SX);
    363     end;
    364   end
    365   else
    366   begin
    367     E := 0;
    368 
    369     while Y <> Y2 do
    370     begin
    371       alpha := 1 - E / DY;
    372       dest.ErasePixel(X, Y, round(calpha * sqrt(alpha)));
    373       dest.ErasePixel(X + SX, Y, round(calpha * sqrt(1 - alpha)));
     409      alpha := calpha * E div DY;
     410      dest.ErasePixel(X, Y, calpha - alpha);
     411      dest.ErasePixel(X + SX, Y, alpha);
    374412      Inc(E, DX);
    375413      if E >= DY then
    … …  
    386424
    387425procedure BGRADrawLineAntialias(dest: TBGRACustomBitmap; x1, y1, x2, y2: integer;
    388   c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer);
     426  c1, c2: TBGRAPixel; dashLen: integer; DrawLastPixel: boolean; var DashPos: integer; LinearBlend : boolean);
    389427var
    390428  Y, X:  integer;
    391429  DX, DY, SX, SY, E: integer;
    392   alpha: single;
     430  alpha: NativeUInt;
    393431  c:     TBGRAPixel;
    394432begin
    … …  
    396434  if DashLen <= 0 then
    397435  begin
    398     BGRADrawLineAntialias(dest,x1,y1,x2,y2,MergeBGRA(c1,c2),DrawLastPixel);
     436    BGRADrawLineAntialias(dest,x1,y1,x2,y2,MergeBGRA(c1,c2),DrawLastPixel,LinearBlend);
    399437    exit;
    400438  end;
    … …  
    441479    while X <> X2 do
    442480    begin
    443       alpha := 1 - E / DX;
    444       dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
    445       dest.DrawPixel(X, Y + SY, BGRA(c.red, c.green, c.blue,
    446         round(c.alpha * sqrt(1 - alpha))));
     481      alpha := c.alpha * E div DX;
     482      dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, c.alpha - alpha));
     483      dest.DrawPixel(X, Y + SY, BGRA(c.red, c.green, c.blue, alpha));
    447484      Inc(E, DY);
    448485      if E >= DX then
    … …  
    470507    while Y <> Y2 do
    471508    begin
    472       alpha := 1 - E / DY;
    473       dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, round(c.alpha * sqrt(alpha))));
    474       dest.DrawPixel(X + SX, Y, BGRA(c.red, c.green, c.blue,
    475         round(c.alpha * sqrt(1 - alpha))));
     509      alpha := c.alpha * E div DY;
     510      dest.DrawPixel(X, Y, BGRA(c.red, c.green, c.blue, c.alpha - alpha));
     511      dest.DrawPixel(X + SX, Y, BGRA(c.red, c.green, c.blue, alpha));
    476512      Inc(E, DX);
    477513      if E >= DY then
    … …  
    592628  procedure AddPt(pt: TPointF);
    593629  begin
    594     if nbStyled = length(styledPts) then
    595       setlength(styledPts,nbStyled*2+4);
    596     styledPts[nbStyled] := pt;
    597     inc(nbStyled);
     630    if (nbStyled = 0) or (pt <> styledPts[nbStyled-1]) then
     631    begin
     632      if nbStyled = length(styledPts) then
     633        setlength(styledPts,nbStyled*2+4);
     634      styledPts[nbStyled] := pt;
     635      inc(nbStyled);
     636    end;
    598637  end;
    599638
    … …  
    708747procedure BGRAPolyLine(bmp: TBGRACustomBitmap; const linepts: array of TPointF; width: single;
    709748          pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
    710           options: TBGRAPolyLineOptions; scan: IBGRAScanner; miterLimit: single);
     749          options: TBGRAPolyLineOptions; scan: IBGRAScanner; miterLimit: single; arrowStart: TComputeArrowHeadProc; arrowStartPos: single; arrowEnd: TComputeArrowHeadProc; arrowEndPos: single);
    711750var
    712751  widePolylinePoints: ArrayOfTPointF;
    713752begin
    714   widePolylinePoints := ComputeWidePolylinePoints(linepts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit);
     753  widePolylinePoints := ComputeWidePolylinePoints(linepts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrowStart,arrowStartPos,arrowEnd,arrowEndPos);
    715754  if scan <> nil then
    716755    bmp.FillPolyAntialias(widePolylinePoints,scan)
    … …  
    721760function ComputeWidePolylinePoints(const linepts: array of TPointF; width: single;
    722761          pencolor: TBGRAPixel; linecap: TPenEndCap; joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
    723           options: TBGRAPolyLineOptions; miterLimit: single): ArrayOfTPointF;
    724 var
     762          options: TBGRAPolyLineOptions; miterLimit: single; arrowStart: TComputeArrowHeadProc; wantedStartArrowPos: single; arrowEnd: TComputeArrowHeadProc; wantedEndArrowPos: single): ArrayOfTPointF;
     763var
     764  startArrowPos, startArrowDir, endArrowPos, endArrowDir: TPointF;
     765  startArrowLinePos, endArrowLinePos: single;
    725766  borders : array of record
    726767              leftSide,rightSide: TLineDef;
    … …  
    883924              pts[lastPointIndex] - borders[lastPointIndex-1].leftDir);
    884925
    885     if (lastPointIndex = high(pts)) and (linecap = pecRound) then
     926    if (lastPointIndex = high(pts)) and (linecap = pecRound) and not (plNoEndCap in options) then
    886927    begin
    887928      if not (plRoundCapOpen in options) then
    … …  
    937978      end;
    938979      FlushLine(-1);
     980    end;
     981  end;
     982
     983  procedure FinalizeArray;
     984  var arrowStartData, arrowEndData: ArrayOfTPointF;
     985    finalNb,i,delta: integer;
     986    hasStart,hasEnd: boolean;
     987  begin
     988    if assigned(arrowStart) and not isEmptyPointF(startArrowPos) then
     989      arrowStartData := arrowStart(startArrowPos, startArrowDir, width, startArrowLinePos)
     990    else
     991      arrowStartData := nil;
     992    if assigned(arrowEnd) and not isEmptyPointF(endArrowPos) then
     993      arrowEndData := arrowEnd(endArrowPos, endArrowDir, width, endArrowLinePos)
     994    else
     995      arrowEndData := nil;
     996    hasStart := length(arrowStartData)>0;
     997    hasEnd := length(arrowEndData)>0;
     998    finalNb := NbPolyAcc;
     999    if hasStart then
     1000    begin
     1001      delta := length(arrowStartData)+1;
     1002      finalNb += delta;
     1003    end else delta := 0;
     1004    if hasEnd then finalNb += length(arrowEndData)+1;
     1005    SetLength(Result, finalNb);
     1006    if hasStart then
     1007    begin
     1008      for i := NbPolyAcc-1 downto 0 do
     1009        result[i+delta] := result[i];
     1010      result[delta-1] := EmptyPointF;
     1011      for i := 0 to high(arrowStartData) do
     1012        result[i] := arrowStartData[i];
     1013    end;
     1014    if hasEnd then
     1015    begin
     1016      delta += NbPolyAcc+1;
     1017      result[delta-1] := EmptyPointF;
     1018      for i := 0 to high(arrowEndData) do
     1019        result[i+delta] := arrowEndData[i];
    9391020    end;
    9401021  end;
    … …  
    9501031  ShouldFlushLine, HasLittleBorder, NormalRestart: Boolean;
    9511032  pt1,pt2,pt3,pt4: TPointF;
     1033  linePos: single;
     1034  startArrowDone,endArrowDone: boolean;
    9521035
    9531036begin
    9541037  Result := nil;
    9551038
    956   if length(linepts)=0 then exit;
     1039  if (length(linepts)=0) or (width = 0) then exit;
    9571040  if IsClearPenStyle(penstyle) then exit;
    9581041  for i := 0 to high(linepts) do
    … …  
    9651048  if (plAutoCycle in options) and (length(linepts) >= 2) and (linepts[0]=linepts[high(linepts)]) then
    9661049    options := options + [plCycle];
     1050  if plNoEndCap in options then options := options - [plRoundCapOpen];
    9671051
    9681052  hw := width / 2;
    … …  
    10061090    exit;
    10071091  end;
     1092
     1093  startArrowDir := EmptyPointF;
     1094  startArrowPos := EmptyPointF;
     1095  endArrowDir := EmptyPointF;
     1096  endArrowPos := EmptyPointF;
     1097  startArrowDone := @arrowStart = nil;
     1098  endArrowDone := @arrowEnd = nil;
    10081099
    10091100  //init computed points arrays
    … …  
    10141105  NbPolyAcc := 0;
    10151106
     1107  if not endArrowDone then
     1108  begin
     1109    wantedEndArrowPos:= -wantedEndArrowPos*width;
     1110    linePos := 0;
     1111    for i := high(pts) downto 1 do
     1112    begin
     1113      dir := pts[i-1]-pts[i];
     1114      len := sqrt(dir*dir);
     1115      dir *= 1/len;
     1116      if not endArrowDone and (linePos+len >= wantedEndArrowPos) then
     1117      begin
     1118        endArrowPos := pts[i];
     1119        endArrowDir := -dir;
     1120        endArrowLinePos := -linePos/width;
     1121        endArrowDone := true;
     1122        break;
     1123      end;
     1124      linePos += len;
     1125    end;
     1126  end;
     1127
     1128  wantedStartArrowPos:= -wantedStartArrowPos*width;
     1129  linePos := 0;
    10161130  //compute borders
    10171131  setlength(borders, length(pts)-1);
    … …  
    10211135    len := sqrt(dir*dir);
    10221136    dir *= 1/len;
    1023 
    1024     if (linecap = pecSquare) and ((i=0) or (i=high(pts)-1)) then //for square cap, just start and end further
     1137    if not startArrowDone and (linePos+len >= wantedStartArrowPos) then
     1138    begin
     1139      startArrowPos := pts[i];
     1140      startArrowDir := -dir;
     1141      startArrowLinePos := -linePos/width;
     1142      startArrowDone := true;
     1143    end;
     1144    if (linecap = pecSquare) and ((not (plNoStartCap in options) and (i=0)) or
     1145      (not (plNoEndCap in options) and (i=high(pts)-1))) then //for square cap, just start and end further
    10251146    begin
    10261147      if i=0 then
    … …  
    10351156      dir *= 1/len;
    10361157    end else
    1037     if (linecap = pecRound) and (i=0) and not (plCycle in options) then
     1158    if not (plNoStartCap in options) and (linecap = pecRound) and (i=0) and not (plCycle in options) then
    10381159      AddRoundCap(pts[0], -dir ,true);
    10391160
    … …  
    10441165    borders[i].rightSide.origin := pts[i] - borders[i].leftDir;
    10451166    borders[i].rightSide.dir := dir;
     1167    linePos += len;
    10461168  end;
    10471169
    … …  
    12831405    FlushLine(high(pts));
    12841406
    1285   SetLength(Result, NbPolyAcc);
     1407  FinalizeArray;
    12861408end;
    12871409
    … …  
    12891411  width: single; pencolor: TBGRAPixel; linecap: TPenEndCap;
    12901412  joinstyle: TPenJoinStyle; const penstyle: TBGRAPenStyle;
    1291   options: TBGRAPolyLineOptions; miterLimit: single): ArrayOfTPointF;
     1413  options: TBGRAPolyLineOptions; miterLimit: single; arrowStart: TComputeArrowHeadProc; arrowStartPos: single; arrowEnd: TComputeArrowHeadProc; arrowEndPos: single): ArrayOfTPointF;
    12921414
    12931415var
    … …  
    13061428      for j := startIndex to endIndexP1-1 do
    13071429        subPts[j-startIndex] := linepts[j];
    1308       tempWidePolyline := ComputeWidePolylinePoints(subPts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit);
     1430      tempWidePolyline := ComputeWidePolylinePoints(subPts,width,pencolor,linecap,joinstyle,penstyle,options,miterLimit,arrowStart,arrowStartPos,arrowEnd,arrowEndPos);
    13091431      if length(results) = nbresults then
    13101432        setlength(results,(nbresults+1)*2);
Note: See TracChangeset for help on using the changeset viewer.