Отрисовка текста в цикле

[artemavd]

Stilet, ладно, это я переделаю щас. Возьму например PaintBox. А как мне на нем расстянуть изображение по ширине компонента, чтобы оно полностью поместилось? А то оно довольно таки большое. Это важно.

[Stilet]

Я люблю функцию StretchBlt.
Тебе обязательно делать отображение? Ты в курсе что в цикле ты просто глазом не сможешь увидеть, оно же будет меняться быстрее ветра.

[artemavd]

Ну, можно и не грузить картинку. Мне важно, чтобы алгоритм правильно работал

[Sibedir]

А что в СтрингГриде хранится. Я так понимаю там не номера по порядку. Или...

[Stilet]

Например у тебя есть куча файлов в одной папке.
Тогда код

procedure TForm1.BitBtn1Click(Sender: TObject);
var x,y,i:integer;b:TBitmap; sr:TSearchRec;  s:string;
begin
 b:=TBitmap.Create;
 FindFirst('C:\temp\*',faAnyFile,sr);
  FindNext(sr);
  FindNext(sr);
 with StringGrid1 do
  for i:=1 to RowCount-1 do begin
   b.LoadFromFile('C:\temp\'+sr.Name);
   x:=b.Width-b.Canvas.TextWidth(Cells[1,i]);
   y:=b.Height-b.Canvas.TextHeight('W');
   b.Canvas.TextOut(x,y,Cells[1,i]);
   b.SaveToFile('C:\temp\_'+sr.Name);
   if FindNext(sr)<>0 then break;
  end;
 b.Free;
 FindClose(sr);
end;

промаркирует графику в этих файлах как ты указал.
Идею понял?
Только учти что это для BMP

[artemavd]

Хм...применил код. Немного переделал его:

procedure TForm1.BtnRecordClick(Sender: TObject);
var
 x,y,i:integer;
 b:TBitmap;
 sr:TSearchRec;
 s:string;
begin
 b:=TBitmap.Create;
 FindFirst('C:\Users\Àðòåì Ãëàâàöêèé\Desktop\Äèëåðû\*',faAnyFile,sr);
 FindNext(sr);
 FindNext(sr);
 with StringGrid1 do
  for i:=1 to RowCount-1 do begin
   b.LoadFromFile('C:\Users\Àðòåì Ãëàâàöêèé\Desktop\Äèëåðû\'+sr.Name);
   b.Canvas.Rectangle(550,200,1000,90);
   b.Canvas.Font.Color:=clBlack;
   b.Canvas.Font.Size:=50;
   b.Canvas.Font.Name:='Verdana';
   b.Canvas.TextOut(600,100,Cells[0,i]);
   b.SaveToFile('C:\Users\Àðòåì Ãëàâàöêèé\Desktop\Äèëåðû\_'+sr.Name);
   if FindNext(sr)<>0 then break;
  end;
 b.Free;
 FindClose(sr);
end;

Вот, разобрался почему не было текста. Не добавил просто:

   b.Canvas.Font.Color:=clBlack;
   b.Canvas.Font.Size:=50;
   b.Canvas.Font.Name:='Verdana';

Теперь рамка рисуется, текст тоже. Но, осталось имена файлов сохраненным задать, почему-то не задаются. Ну, в принципе это не было принципиально. Всем большое спасибо! . Если что, то спрошу что-нибудь у вас.

[Stilet]

но надписи я не вижу.

Она там мелкая. Шрифт для канвы Битмапа увеличь.

[artemavd]

Че-т у меня непонятно как код работает. Рисует начиная со второго или третьего файла. Вроде код впринципе правильный. Не работает он начиная с первого файла в папке:

procedure TForm1.BtnRecordClick(Sender: TObject);
var
 x,y,i:integer;
 b:TBitmap;
 sr:TSearchRec;
 s:string;
begin
 b:=TBitmap.Create;
 FindFirst(Form1.StatusBar3.Panels[1].Text +'*.bmp',faAnyFile,sr);
 FindNext(sr);
 FindNext(sr);
 with StringGrid1 do
  for i:=0 to RowCount-1 do begin
   b.LoadFromFile(Form1.StatusBar3.Panels[1].Text + sr.Name);
   b.Canvas.Rectangle(90,200,600,90);
   b.Canvas.Font.Color:=clBlack;
   b.Canvas.Font.Size:=50;
   b.Canvas.Font.Name:='Verdana';
   b.Canvas.TextOut(120,100,Cells[0,i]);
   b.SaveToFile(Form1.StatusBar3.Panels[1].Text + sr.Name + '.tiff');
   if FindNext(sr)<>0 then break;
  end;
 b.Free;
 FindClose(sr);
 ShowMessage('             Выполнено!             ');
end;

[Serge_Bliznykov]

вот из за этого:

FindFirst(Form1.StatusBar3.Panels[1].Text +'*.bmp',faAnyFile,sr);
 FindNext(sr);
 FindNext(sr);

и я не понял смысла пропускать два файла!..

[Sibedir]

и я не понял смысла пропускать два файла!..

Это видимо

.
..

2 FindNext(sr) можно вроде пропустить, если:

FindFirst(Form1.StatusBar3.Panels[1].Text +'*.bmp',faAnyFile-faDirectory,sr);