Граф. редактор, редактируемое изображение и канва

[Аватар]

Почему (Font = nil) когда parent у Label = nil?

С чего? Вот в примере фонт существует независимо от наличия парента

procedure TForm1.Button1Click(Sender: TObject);
var xLabel: TLabel;
begin
  xLabel:=TLabel.Create(nil);
  xLabel.ParentFont:=False;
  Label1.Caption:=xLabel.Font.Name;
  xLabel.Parent:=Self;
  Label2.Caption:=xLabel.Font.Name;
  xLabel.Parent:=nil;
  Label3.Caption:=xLabel.Font.Name;
  xLabel.Free;
end;

[Человек_Борща]

Да, действительно надо было parent:=nil выставить.

[Человек_Борща]

Собственно как считать шрифт обратно в TLabel.Font?

Пробую так:

function TNativeXMLHelper.ReadFont(aName: UTF8String): TFont;
  function Str2FontStyles(aStylesStr: string): TFontStyles;
  begin
    Result := [];
    if Pos('B', aStylesStr) > 0 then
      Result := Result + [fsBold];
    if Pos('I', aStylesStr) > 0 then
      Result := Result + [fsItalic];
    if Pos('U', aStylesStr) > 0 then
      Result := Result + [fsUnderline];
    if Pos('S', aStylesStr) > 0 then
      Result := Result + [fsStrikeOut];
  end;

var
  Node: TXmlNode;
  Font: TFont;
begin
  Font := TFont.Create;
  try
    Font.Assign(Result); //Получаю то, что имеется в Result ТУТ AV ОШИБКА
    if NodeExists(aName, Node) then
    begin
      with Node do
      begin
        Font.Name := ReadAttributeUnicodeString('Name'); //Ошибка ещё здесь, тоже AV
        Font.Size := ReadAttributeInteger('Size');
        Font.Style := Str2FontStyles(ReadAttributeUnicodeString('Styles'));
        Font.Pitch := TFontPitch(Byte(ReadAttributeInteger('Pitch')));
        Font.Color := StringToColor(ReadAttributeUnicodeString('Color'));
        Font.Charset := ReadAttributeInteger('Charset');
      end;
    end;
    Result.Assign(Font); //Возвращаю в результат изменения из моего Font, или же самого себя, если NodeExists = False
  finally
    FreeAndNil(Font);
  end;
end;

Как правильно шрифт из файла обратно прочитать?

TLabel создаю таким:

  fLabel := TLabel.Create(nil);
  fLabel.Tag := fID;
  fLabel.ParentColor := False;
  fLabel.ParentFont := False;
  fLabel.Visible := False;

Читаю в него так:

        Text := TPrintCardText.Create;
         ....
        with Nodes[t] do
        begin
        ....
        //Text.Text, где 2й Text - это property Text:TLabel read fLabel ...
          Text.Text.BoundsRect := ReadRect('BoundsRect');
          Text.Text.Font := ReadFont('Font');
         ....
        end;

[Аватар]

Font.Assign(Result); //Получаю то, что имеется в Result ТУТ AV ОШИБКА

Result-а то еще нет

или

Font := TFont.Create;
// здесь работа только с Font
Result:=Font;
// убивать Font не надо, об этом должна позаботиться вызывающая программа

или

Result:=TFont.Create;
// здесь работа только с Result
// убивать аналогично не надо

и

 Font:=ReadFont('Font');
 Text.Text.Font.Assign(Font);
 Font.Free;

[Человек_Борща]

Так сделал:

function TNativeXMLHelper.ReadFont(aName: UTF8String): TFont;
  function Str2FontStyles(aStylesStr: string): TFontStyles;
  begin
    Result := [];
    if Pos('B', aStylesStr) > 0 then
      Result := Result + [fsBold];
    if Pos('I', aStylesStr) > 0 then
      Result := Result + [fsItalic];
    if Pos('U', aStylesStr) > 0 then
      Result := Result + [fsUnderline];
    if Pos('S', aStylesStr) > 0 then
      Result := Result + [fsStrikeOut];
  end;

var
  Node: TXmlNode;
  Font: TFont;
begin
  Result := nil;
  if NodeExists(aName, Node) then
  begin
    with Node do
    begin
      Font := TFont.Create;
      Font.Name := ReadAttributeUnicodeString('Name');
      Font.Size := ReadAttributeInteger('Size');
      Font.Style := Str2FontStyles(ReadAttributeUnicodeString('Styles'));
      Font.Pitch := TFontPitch(Byte(ReadAttributeInteger('Pitch')));
      Font.Color := StringToColor(ReadAttributeUnicodeString('Color'));
      Font.Charset := ReadAttributeInteger('Charset');
      Result := Font;
    end;
  end;
end;

Работает. Но кто отвечает за освобождение Font? Сам TLabel теперь?

[Аватар]

Так как в конце #24, то явное удаление. Если Text.Text.Font:=ReadFont('Font'); и это работает, то проверить нет ли утечек. Так никогда не пользовался

ADD

procedure TControl.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

При втором варианте все равно нужно явное удаление

[Человек_Борща]

Разобрался... Теперь формирую картинку-результат:
Вот так Label'ы лежат в редакторе:


А вот так в изображении для пред. просмотра:


Изображение для пред. просмотра строится так:

var
  Img: TBitmap;
  i: Integer;
begin
  Img := TBitmap.Create;
  try
    Img.Assign(fSrcBitmap);
    for i := 0 to Count - 1 do
    begin
      Img.Canvas.Font := Items[i].Text.Font;
      Img.Canvas.TextOut(Items[i].Text.BoundsRect.TopLeft.X,
        Items[i].Text.BoundsRect.TopLeft.Y - Items[i].Text.Height,
        Items[i].Text.Caption);
    end;
    aSsignTo.Picture.Assign(Img);
  finally
    FreeAndNil(Img);
  end;
end;

Как позиционировать на Label'ы на картинку так же как они лежат в редакторе?
Вроде бы правильно все.. но в итоге Label рисуется ниже, чем он лежит в редакторе.

--Разобрался--

var
  Img: TBitmap;
  i: Integer;
begin
  Img := TBitmap.Create;
  try
    Img.Assign(fSrcBitmap);
    for i := 0 to Count - 1 do
    begin
      Img.Canvas.Font := Items[i].Text.Font;
      Img.Canvas.TextOut(Items[i].Text.BoundsRect.TopLeft.X -
        Items[i].Text.Font.Size, Items[i].Text.BoundsRect.TopLeft.Y -
        Items[i].Text.Height - Items[i].Text.Font.Size, Items[i].Text.Caption);
    end;
    aSsignTo.Picture.Assign(Img);
  finally
    FreeAndNil(Img);
  end;
end;

Надо просто учитывать размер шрифта, а из высоты вычитывать высоту Label'а.
На белом фоне работает..

--НОВОЕ--
А если рисовать на черном или на любом другом, то вокруг текста рисуется странная белая рамка... как лечить?