Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 23.03.2016, 14:34   #1
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
Вопрос Сохранение текста в файл PNG.

Братва, чот то ли лыжи не едут, то ли ручник заклинило.
Никак не соображу.

Никогда до этого не создавал png с альфаканалом (не нужно было), вот теперь столкнулся. Если есть у кого кусок кода, дайте скопипастить, плизЪ.

Короче надо смастырить вот такую функцию:
Код:
function TextToPngFile(const AText, AFileName: string; const AInfo: TTextOutInfo): Boolean;
TTextOutInfo - это параметры изображения:
Код:
type
  TTextOutInfo = class
  private
    FFont: TFont;
    FBackground: TColor;
    FMargins: TMargins;
    FTransparent: Boolean;
  protected
    procedure SetFont(ANew: TFont);
  public
    constructor Create; virtual;
    destructor Destroy; override;
    property Font: TFont read FFont write SetFont;
    property Margins: TMargins read FMargins;
    property Background: TColor read FBackground write FBackground;
    property Transparent: Boolean read FTransparent write FTransparent;
  end;
При AInfo.Transparent = true нужно создать PNG с текстом на прозрачном фоне, иначе - с заливкой цвета AInfo.Background. B сохранить PNG в файл AFileName.

Получиться должно типа вот:
Код:
info:= {конструктор};
info.Font.Name:= 'Arial Black';
info.Font.Color:= {...};
info.Font.Size:= 24;
info.Transparent:= true;
TextToPngFile(TimeToStr(Time()), 'd:\temp\time.png' info);

Займитесь, плиз, кому не влом и/или интересно.
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 23.03.2016, 15:03   #2
TaLadno
Форумчанин
 
Регистрация: 03.06.2015
Сообщений: 393
По умолчанию

Ну наверное как-то так
Код:
var
  png: TPngImage;
begin
  png := TPngImage.CreateBlank(COLOR_RGB, 8, 200, 100);
  try
    png.TransparentColor := clwhite;

    png.Canvas.Brush.Color := png.TransparentColor;
    png.Canvas.FillRect(Rect(0, 0, png.Width, png.Height));

    png.Canvas.TextOut(50, 50, 'SomeText');
    png.SaveToFile('1.png');

  finally
    png.Free;
  end;
end;
Мож можно и как-то иначе, но у мну сработало
Изображения
Тип файла: png 1.png (698 байт, 142 просмотров)
Вы там держитесь.

Последний раз редактировалось TaLadno; 23.03.2016 в 15:16.
TaLadno вне форума Ответить с цитированием
Старый 23.03.2016, 15:31   #3
min@y™
Цифровой кот
Старожил
 
Аватар для min@y™
 
Регистрация: 29.08.2014
Сообщений: 7,656
По умолчанию

Цитата:
у мну сработало
и у мну. пасиб.
Код:
unit uGraphUtils;

interface

uses
  //============================== Модули проекта ==============================
  uStrUtils,
  //========================= Модули проекта с формами =========================
  //=============================== Левые модули ===============================
  //=================== Системные модули, добавленные вручную ==================
  Windows, Types, Graphics, SysUtils, Classes, Controls, StdCtrls, PNGImage;

type
  TTextOutInfo = class
  private
    FFont: TFont;
    FBackground: TColor;
    FMargins: TMargins;
    FTransparent: Boolean;
  protected
    procedure SetFont(ANew: TFont);
  public
    constructor Create; virtual;
    destructor Destroy; override;
    property Font: TFont read FFont write SetFont;
    property Margins: TMargins read FMargins;
    property Background: TColor read FBackground write FBackground;
    property Transparent: Boolean read FTransparent write FTransparent;
  end;

function GetTextPosition(const Text: string;                 // текст
                         const Canvas: TCanvas;              // канва
                         const Rect: TRect;                  // прямоугольник отрисовки
                         const TextMargins: TMargins;        // размеры полей
                         const Alignment: TAlignment;        // гориз. выравнивание
                         const Layout: TTextLayout): TPoint; // верт. выравнивание

procedure TextToPicture(const AText: string; const APng: TPngImage; const AInfo: TTextOutInfo);
function TextToPngFile(const AText, AFileName: string; const AInfo: TTextOutInfo): Boolean;

implementation


{ TTextOutInfo }

constructor TTextOutInfo.Create;
begin
  inherited;

  FFont:= TFont.Create();
  FFont.Name:= 'Tahoma';
  FFont.Size:= 8;

  FMargins:= TMargins.Create(nil);
  FBackground:= clWhite;
  FTransparent:= True;
end;

destructor TTextOutInfo.Destroy;
begin
  FFont.Free();
  FMargins.Free();
  inherited;
end;

procedure TTextOutInfo.SetFont(ANew: TFont);
begin
  FFont.Assign(ANew);
end;

// Начальная точка вывода текста на канве внутри прямоугольника Rect
// с выравниванием горизонтальным и вертикальным
// для вывода предельных величин графика функции (по углам)
function GetTextPosition(const Text: string;                 // текст
                         const Canvas: TCanvas;              // канва
                         const Rect: TRect;                  // прямоугольник отрисовки
                         const TextMargins: TMargins;        // размеры полей
                         const Alignment: TAlignment;        // гориз. выравнивание
                         const Layout: TTextLayout): TPoint; // верт. выравнивание
var
  th, tw: Integer;
begin
  tw:= Canvas.TextWidth(Text);
  th:= Canvas.TextHeight(Text);

  case Alignment of
    taLeftJustify  : Result.x:= TextMargins.Left;
    taCenter       : Result.x:= ((Rect.Right - Rect.Left) div 2) - (tw div 2);
    taRightJustify : Result.x:= (Rect.Right - Rect.Left) - tw - TextMargins.Right;
  end; //case

  case Layout of
    tlTop:    Result.y:= TextMargins.Top;
    tlCenter: Result.y:= ((Rect.Bottom - Rect.Top) div 2) - (th div 2);
    tlBottom: Result.y:= (Rect.Bottom - Rect.Top) - th - TextMargins.Bottom;
  end; // case
end;

procedure TextToPicture(const AText: string; const APng: TPngImage; const AInfo: TTextOutInfo);
var
  r: TRect;
  tp: TPoint;
  w, h: Integer;
begin
  with APng do
    begin
      if Assigned(AInfo.Font)
        then Canvas.Font.Assign(AInfo.Font);

      w:= AInfo.Margins.Left + Canvas.TextWidth(AText) + AInfo.Margins.Right;
      h:= AInfo.Margins.Top + Canvas.TextHeight(AText) + AInfo.Margins.Bottom;
      SetSize(w, h);
      r:= Rect(0, 0, w, h);
      tp:= GetTextPosition(AText, Canvas, r,
                           AInfo.Margins, taCenter, tlCenter);
      TransparentColor:= clWhite;
      Transparent:= AInfo.Transparent;
      if Transparent
        then Canvas.Brush.Color:= TransparentColor
        else Canvas.Brush.Color:= AInfo.Background;
      Canvas.FillRect(r);
      Canvas.TextOut(tp.X, tp.Y, AText);
    end;

end;

function TextToPngFile(const AText, AFileName: string; const AInfo: TTextOutInfo): Boolean;
var
  png: TPngImage;
begin
  Result:= False;
  try
    png:= TPngImage.CreateBlank(COLOR_RGB, 8, 32, 32);

    try
      TextToPicture(AText, png, AInfo);
      png.SaveToFile(AFileName);
    finally
      png.Free();
    end;

    Result:= True;
  except on E: Exception do
    ShowErrorDlg('Ошибка сохранения PNG.'#13#10 + E.Message);
  end;
end;

end.
Расскажу я вам, дружочки, как выращивать грибочки: нужно в поле утром рано сдвинуть два куска урана...
min@y™ вне форума Ответить с цитированием
Старый 24.03.2016, 13:43   #4
x128
Форумчанин
 
Регистрация: 03.02.2010
Сообщений: 178
По умолчанию

Прозрачность по ключу не самый удачный выбор, такое изображение будет хорошо выглядеть только на фоне близком к ключевому цвету, в остальных случаях это будет вырвиглазное зрелище. Как по мне, логичней было бы использовать альфа-канал для текста, в таком случае текст будет выглядеть нормально на любом фоне, а в качестве бонуса будет более гибкое управление цветом текста.

немного костыльный пример:
Код:
uses PNGImage, GraphUtil;
...
function CreatePNGFromText(const FText: string; const FName: TFontName; const FSize: integer; const c1,c2: TColor):TPNGObject;
var
  i: integer;
begin
  with TBitmap.Create do begin
    PixelFormat:=pf24bit;
    with Canvas do begin
      Font.Size:=FSize;
      Font.Name:=FName;
      Font.Color:=clWhite;
      SetSize(TextWidth(FText), TextHeight(FText));
      Brush.Color:=clBlack;
      FillRect(ClipRect);
      TextOut(0, 0, FText);
    end;
    PixelFormat:=pf8bit;
    Result:=TPNGObject.CreateBlank(COLOR_RGBALPHA, 8, Width, Height);
    GradientFillCanvas(Result.Canvas, c1, c2, Result.Canvas.ClipRect, gdVertical);
    for i:=0 to Result.Height-1 do Move(ScanLine[i]^, Result.AlphaScanline[i]^, Width);
    Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  png: TPNGObject;
begin
  png:=CreatePNGFromText(TimeToStr(Time()), 'Arial Black', 24, clBlue, clRed);
  png.SaveToFile('text.png');
  png.Free;
end;
результат:
x128 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сохранение схемы графа в формат PNG (JPG) А здесь смотрели? LENA_M WPF, UWP, WinRT, XAML 0 03.04.2014 22:13
Шифрование текста в PNG картинку ! fucil Общие вопросы Delphi 2 20.10.2011 13:45
Сохранение текста в txt файл на UCOZe maksim1995 JavaScript, Ajax 8 12.02.2011 23:39
сохранение текста в файл!!! AK BULLETS Общие вопросы Delphi 2 19.03.2010 13:23
Загрузить png файл MAcK Мультимедиа в Delphi 1 22.12.2008 22:23