Lazarus 2.2.2 (2022.05.19.)
Letöltés

  • Oldal:
  • 1

TÉMA:

TrueType font körvonalak kinyerése és poligonizálása 2022 aug. 05 09:03 #2599

  • Stella_209
  • Stella_209 profilkép Témaindító
  • Új tag
  • Új tag
  • Hozzászólások: 8
  • Köszönetek: 1
Érdekes feladatot kaptam. Olyan cross-platform programot kell írnom ami képes egy ttf fontfájlból egy karakter körvonalát kinyerni és azt poligonná alakítani egy CNC program számára.
Windows alatt ez nem ördöngősség, mert a win API kész függvényekkel és eljárásokkal szolgál. Természetesen ez nem megy Linux és MAC-OS rendszereken.
Tehát egy univerzális rutin kellene, ami kinyeri a karfakter körvonalakat a ttf fájlból (ezek általában spline-ok) és poligonná (sokszöggé) alakítaná.
Nagyon megköszönnék minden segítséget!

windows alatt:

procedure DrawTTF(text: string; ID: integer; hFont: integer);
begin
    BeginPath(GrayBmp.Canvas.Handle);
    SetBkMode(GrayBmp.Canvas.Handle, TRANSPARENT);
    GrayBmp.Canvas.TextOut(0, hFont, text);
    EndPath(GrayBmp.Canvas.Handle);
    FlattenPath(GrayBmp.Canvas.Handle);

    FNumber := GetPath(GrayBmp.Canvas.Handle, Pointer(nil^), Pointer(nil^), 0);

  if FNumber>0 then begin
  SetLength(FPathPoints, FNumber);
  SetLength(FPathTypes, FNumber);
  FNumber := GetPath(GrayBmp.Canvas.Handle, FPathPoints[0], FPathTypes[0], FNumber);
  StatusBar1.Panels[1].Text := Inttostr(FNumber);

  PointIdx := 0; i:=1;

    while PointIdx < FNumber do begin

    case FPathTypes[PointIdx] of
        PT_MOVETO:
        begin
            h:=Paper.MakeCurve(Text,i,dmPolygon,True,True,False);
            FCurve := Paper.FCurveList.Items[h];
            GrayBmp.Canvas.MoveTo(FPathPoints[PointIdx].X, FPathPoints[PointIdx].Y);
            LastMove := FPathPoints[PointIdx];
            Paper.AddPoint(h,FPathPoints[PointIdx].x,
                           GrayBmp.Height-FPathPoints[PointIdx].y);
            inc(PointIdx, 1);
            inc(i);
        end;
        PT_LINETO:
        begin
            GrayBmp.Canvas.LineTo(FPathPoints[PointIdx].X, FPathPoints[PointIdx].Y);
            Paper.AddPoint(h,FPathPoints[PointIdx].x,
                           GrayBmp.Height-FPathPoints[PointIdx].y);
            inc(PointIdx, 1);
        end;
        PT_BEZIERTO:
        begin
            PolyBezierTo(GrayBmp.Canvas.Handle, FPathPoints[PointIdx], 3);
            Paper.AddPoint(h,FPathPoints[PointIdx].x,
                           GrayBmp.Height-FPathPoints[PointIdx].y);
            Paper.AddPoint(h,FPathPoints[PointIdx+1].x,
                           GrayBmp.Height-FPathPoints[PointIdx+1].y);
            Paper.AddPoint(h,FPathPoints[PointIdx+2].x,
                           GrayBmp.Height-FPathPoints[PointIdx+2].y);
            inc(PointIdx, 3);
        end;
        PT_LINETO or PT_CLOSEFIGURE:
        begin
            FCurve.Closed := True;
            GrayBmp.Canvas.LineTo(FPathPoints[PointIdx].X, FPathPoints[PointIdx].y);
            GrayBmp.Canvas.LineTo(LastMove.x, LastMove.y);
            Paper.AddPoint(h,FPathPoints[PointIdx].x,
                           GrayBmp.Height-FPathPoints[PointIdx].y);
            inc(PointIdx, 1);
        end;
    END;
    end;

  PointIdx := 0;
    while PointIdx < FNumber do begin
    case FPathTypes[PointIdx] of
        PT_MOVETO:
        begin
        GrayBmp.Canvas.Pen.Color := clRed;
        GrayBmp.Canvas.Brush.Color := clRed;
        GrayBmp.Canvas.Ellipse(FPathPoints[PointIdx].X-4, FPathPoints[PointIdx].y-4,
                             FPathPoints[PointIdx].X+4, FPathPoints[PointIdx].y+4);
        end;
    else
        GrayBmp.Canvas.Pen.Color := clBlue;
        GrayBmp.Canvas.Brush.Color := clBlue;
    end;
    if FPathTypes[PointIdx]<>;(PT_LINETO or PT_CLOSEFIGURE) then

       GrayBmp.Canvas.Ellipse(FPathPoints[PointIdx].X-2, FPathPoints[PointIdx].y-2,
                             FPathPoints[PointIdx].X+2, FPathPoints[PointIdx].y+2);
      inc(PointIdx, 1);
    end;
  end;
end;

begin
  SetLength(FPathPoints, 0);
  SetLength(FPathTypes, 0);

  Paper.Clear;
  cls(GrayBmp.canvas,clWhite);
  GrayBmp.canvas.Brush.Style := bsClear;
  GrayBmp.canvas.Font.Style := ;
  if BoldCheck.Checked then
     GrayBmp.canvas.Font.Style := [fsBold];
  if ItalicCheck.Checked then
     GrayBmp.canvas.Font.Style := GrayBmp.canvas.Font.Style+[fsItalic];

  hF := Abs(GrayBmp.canvas.Font.Size);

  Try
     nLines:=sText.Count;
  except
     nLines:=1;
  end;
  For sor:=0 to nLines-1 do
      DrawTTF(sText[sor],Paper.FCurveList.Count,sor*(hF+LineSpacing));
  StatusBar1.Panels[0].Text := Inttostr(Paper.FCurveList.Count);
end;

 
Mellékletek:

  • Oldal:
  • 1