Нарисовать TLabel с указанным Font на TImage и вывести на TPrinter

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

Доброго времени суток!

Стоит задача, разработать некий дизайнер визитки, пока что требуется:
- Установка надписей в любую точку изображения

Собственно с самим дизайнером проблем надеюсь не предвидеться, пара таймеров, un-time'мные TLabel со свойствами загруженными из шаблона. Все.

Проблема в другом:
Как вывести на изображение, мой текст TLabel, со всеми параметрами Font, установленными у него?

И как это изображение отправить на печать в тот-же TPrinter?

[обн]

Торможу..
Свойства шрифта нужно не у TLabel ставить а у канвы на которой рисовать надо, и тогда TextOut просто шикарен
Вторая проблема решена.

Допустим я сделал изображение с надписями и .т.д. и т.п. Изображение цветное, как передать его TPrinter? Будет ли он печатать его цветным если к нему подсоединен цветной принтер?



Знающие подскажите!

[Аватар]

BitBlt переносит с одной канвас на другую, в том числе и принтера. По идее почему цветной принтер не будет в цвете печатать, если таким образом передать ему изображение? Могу вечерком дома проверить.

Нормально на моем струйном Epson-е съело цветную картинку

procedure TForm1.Button1Click(Sender: TObject);
var xJPEGImage: TJPEGImage;
begin
  xJPEGImage:=TJPEGImage.Create;
  xJPEGImage.LoadFromFile('e:\Обои1.jpg');
  Image1.Picture.Bitmap.Assign(xJPEGImage);
  xJPEGImage.Free;
  Printer.Copies:=1;
  Printer.Orientation:=poPortrait;
  Printer.BeginDoc;
  BitBlt(Printer.Canvas.Handle,0,0,Image1.Picture.Bitmap.Width,Image1.Picture.Bitmap.Height,Image1.Picture.Bitmap.Canvas.Handle,0,0,SRCCOPY);
  Printer.EndDoc;
end;

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

Собственное мне не 1 картинку надо печатать, а много, и не по одной штуке.

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

Моя задача обеспечить ему возможность самому создавать шаблон печати, например на лист бумаги наложить сетку изображений 6x10 с толщиной пера X и цветом C.

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

вот 2 варианта рисования сетки:
Первый:

  var
  iVertLine, i, iHorLine, iCols, iRows, iColsRows: integer;
  z: integer;
begin
  Img.Canvas.Pen.Color := clWhite;
  Img.Canvas.FillRect(Img.BoundsRect);
  z := 25; // Площадь?
  iRows := 4;
  iCols := 4;
  iColsRows := 2;
  Img.Canvas.Pen.Width := 1;
  Img.Canvas.Pen.Color := clBlack;

  for i := 0 to iColsRows do
  begin
    Img.Canvas.MoveTo(0, i * z);
    Img.Canvas.LineTo(iColsRows * z, i * z);
    Img.Canvas.MoveTo(i * z, 0);
    Img.Canvas.LineTo(i * z, iColsRows * z);
  end;

Вместе рисуются и вертикальные и горизонтальные линии, думаю как бы в эту клетку изображение вставить, вот только как?

При таком алгоритме рисование сетки 4x6 невозможно..

А вот так можно рисовать хоть 2x400:

var
  iVertLine, i, iHorLine, iCols, iRows, iColsRows: integer;
  z: integer;
begin
  Img.Canvas.Pen.Color := clWhite;
  Img.Canvas.FillRect(Img.BoundsRect);
  z := 25; // Площадь?
  iRows := 4;
  iCols := 4;
  iColsRows := 2;
  Img.Canvas.Pen.Width := 1;
  Img.Canvas.Pen.Color := clBlack;

    for iHorLine := 0 to iRows do
    begin
    Img.Canvas.MoveTo(0, iHorLine * z);
    Img.Canvas.LineTo(iCols * z, iHorLine * z);
    end;

    // вертикальные
    for iVertLine := 0 to iCols do
    begin
    Img.Canvas.MoveTo(iVertLine * z, 0);
    Img.Canvas.LineTo(iVertLine * z, iRows * z);
    end;

Но я понятия не имею как тут изображение и каким боком вставить....

Разные принтеры по разному распечатают моё изображение в итоге? Это моя головная боль или конечного пользователя?

Надо проверить влезает ли желание в рамки действительности, например: печать 1500x1240 картинок в сетке 4x5 на бумаге A4.
(Кол-во колонок * ширина изображения)+(Кол-во колонок*толщина карандаша канвы) <> ширина листа?

Ещё надуло припахать к этому делу RTF и MS Word т.е., я открываю файл и просто на места вставляю картинки а потом печатаю. Тут 2 сомнения:
1. Это бред
2. Зачем на конечной машине целый MS Word ради 1 программы

В общем прошу помощи...

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

Собственно проблему решил так:

procedure TForm1.DrawBtnClick(Sender: TObject);
var
  iRow, iCol, // Счетчики
  iBorderSize, // Размер отступа отступа от края
  iImgDistance, // Дистанция между картинками
  iRows, // Кол-во строк
  iColumns, // Кол-во изображений в строке
  iLeft, iTop: Integer; // Для удобства расчетов
  bmp: TBitmap;
begin
  iBorderSize := StrToInt(BorderSizeEdit.Text);
  iImgDistance := StrToInt(ImgsDistanceEdit.Text);
  iRows := StrToInt(RowsCountEdit.Text);
  iColumns := StrToInt(ColCountEdit.Text);
  iRow := 0;
  iCol := 0;
  // Начальные значения координат рисования
  iLeft := iBorderSize;
  iTop := iBorderSize;
  bmp := TBitmap.Create;
  try
    bmp.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Source.bmp');
    with Img.Canvas do
    begin
      // Чищу Canvas
      Brush.Color := clWhite;
      FillRect(Img.BoundsRect);

      for iRow := 1 to iRows do
      begin
        // Кальк. позицию строки
        if (iRow = 1) then
          iTop := iBorderSize
        else
          iTop := iBorderSize + (iImgDistance * (iRow - 1)) +
            (bmp.Height * (iRow - 1));

        // Кальк. позиции картинок в строке
        for iCol := 1 to iColumns do
        begin
          if (iCol = 1) then
            iLeft := iBorderSize
          else
            iLeft := iBorderSize + (iImgDistance * (iCol - 1)) +
              (bmp.Width * (iCol - 1));
          Draw(iLeft, iTop, bmp);
        end;
      end;
    end;
  finally
    FreeAndNil(bmp);
  end;
end;

Теперь вопрос в другом:
Мне нужно исходя из размеров листа, блокировать ввод значения больше чем это возможно, т.е. исходя из: размеров листа в принтере, размеров 1 изображения, ширины линии сетки, размера отступа от левого и верхнего краев листа, узнать сколько поместиться изображений по горизонтали и по вертикали.

Я придумал такое:

procedure TForm1.Button1Click(Sender: TObject);
var
  iRow, iCol, // Счетчики
  iBorderSize, // Размер отступа отступа от края
  iImgDistance: Integer; // Дистанция между картинками
  bmp: TBitmap;
  ImgPos: TPoint;
  R: TRect;
begin
  iBorderSize := StrToInt(BorderSizeEdit.Text);
  iImgDistance := StrToInt(ImgsDistanceEdit.Text);
  iRow := 0;
  iCol := 0;

  // Начальные значения координат рисования
  ImgPos.X := iBorderSize; // X
  ImgPos.Y := iBorderSize; // Y
  bmp := TBitmap.Create;
  try
    R.Width := bmp.Width;
    R.Height := bmp.Height;
    bmp.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Source.bmp');

    iRow := 1;
    while PtInRect(R, ImgPos) do
    begin
      // Кальк. позицию строки
      if (iRow = 1) then
        ImgPos.Y := iBorderSize
      else
        ImgPos.Y := iBorderSize + (iImgDistance * (iRow - 1)) +
          (bmp.Height * (iRow - 1));

      Inc(iRow);
    end;

    iCol := 1;
    while PtInRect(R, ImgPos) do
    begin
      if (iCol = 1) then
        ImgPos.X := iBorderSize
      else
        ImgPos.X := iBorderSize + (iImgDistance * (iCol - 1)) +
          (bmp.Width * (iCol - 1));

      Inc(iCol);
    end;
    ShowMessage('Max. cols: ' + IntToStr(iCol) + ' Max. rows: ' +
      IntToStr(igiRotate));
  finally
    FreeAndNil(bmp);
  end;
end;

Как-то это не правильно, циклами считать.
Да и считает не правильно, почему - непонятно.

Может кто-нибудь подскажет как найти макс. строк и столбцов?