[Lazarus] Fuzzy translations ignored

Bart bartjunk64 at gmail.com
Thu Sep 18 22:12:10 CEST 2014


I've got thiscode now (from your example).
It creates a bitmap.

After that I add the bitmap to an imagelist that is set as the
largeIcons properties of a TListView.

function TForm1.CreateBitmap2(AStat: TStat): TBitmap;
const
  FullCircle = 16 * 360;
var
  Bmp: TBitmap;
  Translated16Angle, UnTranslated16Angle, Fuzzy16Angle: Integer;
  PieRect: TRect;
begin
  Bmp := TBitmap.Create;
  Bmp.SetSize(BmpWH,BmpWH);
  //Bmp.Width := BmpWH;
  //Bmp.Height := BmpWH;
  //PieRect := Rect(1,1,BmpWH-1, BmpWH-1);
  PieRect := Rect(0,0,BmpWH, BmpWH);
  with Bmp do
  begin
    //Draw background
    Canvas.Brush.Color := clBack;
    //Canvas.FillRect(0,0,BmpWH,BmpWH);
    Canvas.FillRect(PieRect);
    Canvas.Pen.Color := clBack;
    //All angles in 16th of a degree
    Translated16Angle     := Round(AStat.FracTranslated *
FullCircle);// div Total;
    UnTranslated16Angle   := Round(AStat.FracUntranslated *
FullCircle);// div Total;
    Fuzzy16Angle          := Round(AStat.FracFuzzy * FullCircle);// div Total;

    //writeln('TranslatedAngle   = ',Translated16Angle:3,'
[',Translated16Angle div 16,']');
    //writeln('UnTranslatedAngle = ',UnTranslated16Angle:3,'
[',UnTranslated16Angle div 16,']');
    //writeln('FuzzyAngle        = ',Fuzzy16Angle:3,' [',Fuzzy16Angle
div 16,']');
    //writeln('TotalAngle        =
',Translated16Angle+UnTranslated16Angle+Fuzzy16Angle:3, '
[',(Translated16Angle+UnTranslated16Angle+Fuzzy16Angle) div 16,']');
    //writeln('FullCircle        = ',FullCircle,' [',FullCircle div 16,']');


    if Translated16Angle > 0 then
    begin
      Canvas.Brush.Color:= clTrans;
      if Translated16Angle = FullCircle then
        Canvas.Ellipse(PieRect)
      else
        Canvas.RadialPie(PieRect.Left,PieRect.Top,PieRect.Right,PieRect.Bottom,0,Translated16Angle);;
    end;

    if UnTranslated16Angle > 0 then
    begin
      Canvas.Brush.Color:= clUnTrans;
      if UnTranslated16Angle = FullCircle then
        Canvas.Ellipse(PieRect)
      else
        Canvas.RadialPie(PieRect.Left,PieRect.Top,PieRect.Right,PieRect.Bottom,Translated16Angle,UnTranslated16Angle);;
    end;

    if Fuzzy16Angle > 0 then
    begin
      Canvas.Brush.Color:= clFuzzy;
      if Fuzzy16Angle = FullCircle then
        Canvas.Ellipse(PieRect)
      else
        Canvas.RadialPie(PieRect.Left,PieRect.Top,PieRect.Right,PieRect.Bottom,Translated16Angle+UnTranslated16Angle,Fuzzy16Angle);
    end;
  end;
  Result := Bmp;
end;

I attached one of the resulting images.

Some antialiassing code would be very nice though!

Bart
-------------- next part --------------
A non-text attachment was scrubbed...
Name: Test2.1.po.bmp
Type: image/bmp
Size: 10854 bytes
Desc: not available
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20140918/15b8fe2c/attachment-0003.bin>


More information about the Lazarus mailing list