Версия для печати темы

Автор: SeregaR1Val 21.01.2011 21:30

Добрый день! Необходимо написать графический редактор следующего вида:
Окно разбито на 2 части, в левой вводятся параметры фигуры, в правой она отрисовывается. Например: для начала задан прямоугольник высотой 50 и шириной 100. Указываем высоту - 25, на ней ширина 50 и фигура должна преобразоваться, приняв форму песочных часов и далее в этом духе. Надеюсь нормально объяснил...

Программу еще не начал, код писать не прошу, необходима консультация в том, какие элементы выбрать для разработки, TPaintBox или TImage и т.д. и как лучше всё это отрисовывать, может кто может дать совет?

Автор: TarasBer 21.01.2011 22:30

Что-то я пока не очень понял.
Если мы можем только менять ширину на конкретной высоте.
То есть фигура может иметь только такой вид?



Эскизы прикрепленных изображений

Автор: Гость 21.01.2011 23:51

Да, только такой, возможно надо будет сругленные углы добавить, но пока только такой вид! Может есть у кого какие соображения? Опыт подсказывает, что первое попавшееся решение потом приходится переделывать, хотелось бы узнать мнение знающих людей и приступить к работе!

Автор: TarasBer 22.01.2011 0:38

То есть все инструкции определяются только двумя параметрами - высота и ширина?
Ну так и храни массив пар (высота, ширина)
Изначально массив состоит из 2 пар: (25, 100) и (-25, 100)
Каждая команда добавляет пару к массиву.
Потом отсортируй по высоте.
Потом просто выведи ломаную линию (стандартная функция, передай в неё массив пар (ширина пополам плюс середина экрана, высота)), отрази её (передай пары (середина экрана минус ширина пополам, высота)).
Потом нарисуй верхнюю и нижнюю грани (длину линии определи по ширине на максимальной и минимальной высоте).

Автор: RussoTuristo 4.02.2011 14:51

Извините, придется заходить не под собой, мой профиль исчез куда-то))))
Навоял что-то, но работает оно совсем не так... Отрисовывается что-то непонятное, а из-за того, что изображение строю в буфере, отследить по шагам не удается... Может я что не так делаю? Подскажите, пожалуйста...
Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Grids, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    PaintBox1: TPaintBox;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    StringGrid1: TStringGrid;
    BitBtn1: TBitBtn;
    Label3: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  img, buffer: TBitmap;
  pol:array[1..100] of TPoint;
  ar1,ar2: array[1..2,1..100] of real;
  l,h:integer;

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin
  StringGrid1.Cells[0,0]:='Ширина';
  StringGrid1.Cells[1,0]:='Высота';
  StringGrid1.Cells[0,1]:='70';
  StringGrid1.Cells[1,1]:='200';
  StringGrid1.Cells[0,2]:='120';
  StringGrid1.Cells[1,2]:='300';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Img:=TBitmap.Create;
  buffer:=TBitmap.Create;
  img.Width:=PaintBox1.ClientWidth;
  buffer.Width:=PaintBox1.ClientWidth;
  img.Height:=PaintBox1.ClientHeight;
  buffer.Height:=PaintBox1.ClientHeight;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
i:integer;
a1,a2:real;
begin
//ar1 и ar2-содержат точки аттриума(1-левая грань,2-правая)
  img.Canvas.Pen.Color:=clBlack;
  l:=StrtoInt(edit1.text);
  h:=StrtoInt(edit2.text);
//Начальная фигура -прямоугольник(зададим углы)
  ar1[1,1]:=10;   ar1[2,1]:=10;
  ar1[1,100]:=10; ar1[2,100]:=10+h;
  ar2[1,1]:=10+l;   ar2[2,1]:=10;
  ar2[1,100]:=10+l; ar2[2,100]:=10+h;
//заполним массивы точками из таблицы
  for i:=2 to 100 do
  begin
  if (StringGrid1.Cells[1, i]<>'') and (StringGrid1.Cells[2, i]<>'') then begin
    a1:=StrToInt(StringGrid1.Cells[1, i]);
    a2:=StrToInt(StringGrid1.Cells[2, i]);
    ar1[1,i]:=10+Round((h-a1)/2);
    ar1[2,i]:=10+a2;
    ar2[1,i]:=10+Round((h-a1)/2)+a1;
    ar2[2,i]:=10+a2;
  end;
  end;
//Тут надо отсортировать массивы ar1 и ar2 по высоте

//Печать того, что получилось
  img.Canvas.MoveTo(10,10);
  for i:=1 to 100 do begin
  if (ar1[1, i]<>0) and (ar1[2, i]<>0) then begin
  img.Canvas.LineTo(Round(ar1[1,i]),Round(ar1[2,i]));
  end;
  end;
  img.Canvas.MoveTo(10,10+l);
  for i:=1 to 100 do begin
  if (ar2[1, i]<>0) and (ar2[2, i]<>0) then begin
  img.Canvas.LineTo(Round(ar2[1,i]),Round(ar2[2,i]));
  end;
  end;

//Отрисовка верхней и нижней граней
  img.Canvas.MoveTo(10,10);
  img.Canvas.LineTo(10+l,10);
  img.Canvas.MoveTo(10,10+l);
  img.Canvas.LineTo(10+h,10+l);
//Перевод изображения из буфера
  paintbox1.Canvas.CopyRect(bounds(0,0,img.Width,img.Height),
                    img.Canvas,bounds(0,0,img.Width,img.Height));
end;

end.

Автор: TarasBer 4.02.2011 15:17

> StringGrid1.Cells[0,0]:='Ширина';
> StringGrid1.Cells[1,0]:='Высота';
> StringGrid1.Cells[0,1]:='70';
> StringGrid1.Cells[1,1]:='200';
> StringGrid1.Cells[0,2]:='120';
> StringGrid1.Cells[1,2]:='300';

> 0 1



> img.Canvas.MoveTo(10,10);
> for i:=1 to 100 do begin
> if (ar1[1, i]<>0) and (ar1[2, i]<>0) then begin
> img.Canvas.LineTo(Round(ar1[1,i]),Round(ar1[2,i]));
> end;
> end;
> img.Canvas.MoveTo(10,10+l);
> for i:=1 to 100 do begin
> if (ar2[1, i]<>0) and (ar2[2, i]<>0) then begin
> img.Canvas.LineTo(Round(ar2[1,i]),Round(ar2[2,i]));
> end;
> end;

> 1 2

У тебя нумерация сбилась.

Автор: RussoTuristo 4.02.2011 15:25

Что-то до меня не доходит... В строке 0 - заголовочная часть, её пропускаем, часть StringGrida заполнена, она начинается со строки 1 и считываем для отрисовки соответственно со строки 1... Не понимаю, где ошибся. Объясните, пожалуйста, еще немного...

Автор: TarasBer 4.02.2011 15:30

Я тебе привёл 2 фрагмента.
В одном ты берёшь 1й индекс 0 и 1
В другом ты берёшь 1й индекс 1 и 2.

Кстати, 1й индекс - это точно номер столбца?

Автор: RussoTuristo 4.02.2011 15:52

В одном ты берёшь 1й индекс 0 и 1
В другом ты берёшь 1й индекс 1 и 2.
Структуры-то разные по сути, StringGrid и массивы ar1. ar2, если ошибаюсь и здесь ошибка - извините заранее...

А насчет индекса навёл много сомнений, только с массивами я работал не так основательно, что-то сам вникнуть не могу, по моей какой-то логике и примеру из учебника вроде так, но буду благодарен, если вы меня разубедите ...

Автор: TarasBer 4.02.2011 16:03

Ещё раз.
Вот тебе два куска твоего кода:

StringGrid1.Cells[0,0]:='Ширина';
StringGrid1.Cells[1,0]:='Высота';

a1:=StrToInt(StringGrid1.Cells[1, i]);
a2:=StrToInt(StringGrid1.Cells[2, i]);

Что, не настораживает?

Ещё раз:

StringGrid1.Cells[0,0]:='Ширина';
StringGrid1.Cells[1,0]:='Высота';

a1:=StrToInt(StringGrid1.Cells[1, i]);
a2:=StrToInt(StringGrid1.Cells[2, i]);

> Структуры-то разные по сути, StringGrid и массивы ar1. ar2

Нет, ты и там и там обращаешься к "массиву" StringGrid.Cells.

Автор: RussoTuristo 4.02.2011 16:11

Спасибо, понял, что с индексами не так!

Автор: volvo 4.02.2011 16:36

Автор: RussoTuristo 4.02.2011 16:46

Цитата(volvo @ 4.02.2011 12:36)

Автор: TarasBer 4.02.2011 17:00

Просто пишешь BitBtn1Click(Sender);

Автор: RussoTuristo 4.02.2011 17:40

Помогите, пожалуйста, еще с одной вещью: как правильно отсортировать двумерный массив по одному из индексов. Мне нужно расположить значения массивов ar1 и ar2 в порядке возрастания по высоте (2-й столбец). Но это оказывается непросто:

for i:=1 to 100 do
    for j:=1 to 100 do
    if ar1[2,i]<ar1[2,j] then begin
      buf1:=ar1[1,i];
      buf2:=ar1[2,i];
      ar1[1,j]:=ar1[1,i];
      ar1[2,j]:=ar1[2,i];
      ar1[1,i]:=buf1;
      ar1[2,i]:=buf2;
    end;

Автор: TarasBer 4.02.2011 17:48

Надо так:

buf1:=ar1[1,j];
buf2:=ar1[2,j];
ar1[1,j]:=ar1[1,i];
ar1[2,j]:=ar1[2,i];
ar1[1,i]:=buf1;
ar1[2,i]:=buf2;


да что же у тебя так хреново с индексами-то...

Автор: RussoTuristo 4.02.2011 18:32

Спасибо! Невнимательность моя... вроде могу сообразить принцип, а мелочи, даже очень значительные, пропускаю...

Можно узнать, а есть ли в Delphi возмоожность подогнать изображение под холст, то есть, например: на форме есть место под PaintBox размером 200 на 400 пикселей, а изображение может быть очень большим, можно ли как-нибудь "подогнать" его, чтобы оно оставшись своих размеров, отображалось в уменьшенном виде?

Автор: TarasBer 4.02.2011 18:37

PaintBox1.Canvas.StretchDraw(какие-то параметры, не помню, дельфи сама подскажет)

Автор: RussoTuristo 7.02.2011 12:45

StretchDraw не подойдет на сколько я понимаю....
Paintbox не имеет свойства Graphic...
Paintbox1.Canvas.StretchDraw(MyRect,Paintbox1.Graphic); выдает ошибку...
Может есть другие способы, или необходимо Painbox менять на что-то?

И еще вопросик... Изображение получается недолговечным... перетаскиваешь какое-нибудь окно или просто сворачиваешь и нету ничего.... как сделать чтобы изображение не стиралось?

Автор: volvo 7.02.2011 13:11

У тебя какой-то "неправильный мёд" (С)

В PaintBox-е всегда был Canvas: http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/ExtCtrls_TPaintBox_Canvas.html

А чтобы изображение было "долговечным", и его не надо было перерисовывать каждый раз по OnPaint, используй TImage, он "хранит" свое содержимое...

Автор: RussoTuristo 7.02.2011 13:26

Извините за Canvas, действительно пропустил, но Paintbox1.Canvas.Graphic тоже не работает....

То есть чтобы оно "хранилось" вместо Paintbox необходимо использовать Image? Еще раз извините за глупый вопрос, просто не хочется из-за недопонимания переписывать всё...

Автор: volvo 7.02.2011 13:49

TPaintBox так устроен, что не хранит изображение, которое в нем нарисовано. Ему просто негде его хранить. Это обычная канва. Чем-то напоминает "узоры на песке", их тоже видно, пока ветер не подует или пока дождь не пойдет. Пока твое окно не перекрыто другими окнами - все видно. Как только окно перекроется - все, что было тобой нарисовано в PaintBox-е сотрется. Чтобы восстановить изображение, тебе придется перерисовать его. Поэтому заполняют TPaintBox обычно в событии OnPaint, то есть, полностью перерисовывают содержимое каждый раз, когда приходит сообщение WM_PAINT.

TImage снимает с тебя заботу о перерисовке своего содержимого. Допустим, по нажатию TButton ты нарисовал линию, свернул программу на таскбар, развернул - линия ровно в том же месте, где и была. PaintBox в аналогичном случае будет пуст.

Автор: RussoTuristo 7.02.2011 13:56

Спасибо за разъяснение, запомню и переделаю, в принципе не так много работы прибавится.

Автор: TarasBer 7.02.2011 14:29

> Извините за Canvas, действительно пропустил, но Paintbox1.Canvas.Graphic тоже не работает....

Просто Canvas, блин, без .Graphic!

Автор: RussoTuristo 7.02.2011 20:37

Вместо Paintbox взял Image, всё отрисовывается хорошо, не исчезает никуда, но StretchDraw упрямится - ошибок не выдает но и не сжимает ничего, когда изображение больше, чем Image, видна лишь часть изображения...

MyRect := Rect(0,0,250,450);
  Image1.Canvas.StretchDraw(MyRect, Image1.Picture.Graphic);

Автор: TarasBer 7.02.2011 20:57

А ты задай MyRect побольше (или поменьше) раз в 10, узнаешь, напутал, или нет. А лучше задавай MyRect в зависимости от максимального и минимального из вводимых значений.

Автор: RussoTuristo 7.02.2011 21:19

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

procedure TForm1.BitBtn1Click(Sender: TObject);
var
i,j:integer;
a1,a2,buf1,buf2:real;
MyRect:TRect;
begin
//ar1 и ar2-содержат точки фигуры(1-левая грань,2-правая)
  img.Canvas.Pen.Color:=clBlack;
  l:=StrtoInt(edit1.text);
  h:=StrtoInt(edit2.text);
//Начальная фигура -прямоугольник(зададим углы)
  ar1[1,1]:=10;   ar1[2,1]:=10;
  ar1[1,100]:=10; ar1[2,100]:=10+h;
  ar2[1,1]:=10+l;   ar2[2,1]:=10;
  ar2[1,100]:=10+l; ar2[2,100]:=10+h;
//заполним массивы точками из таблицы
  for i:=1 to 100 do
  begin
  if (StringGrid1.Cells[0, i]<>'') and (StringGrid1.Cells[1, i]<>'') then begin
    a1:=StrToInt(StringGrid1.Cells[0, i]);
    a2:=StrToInt(StringGrid1.Cells[1, i]);
    ar1[1,i+1]:=10+Round((l-a1)/2);
    ar1[2,i+1]:=10+a2;
    ar2[1,i+1]:=10+Round((l-a1)/2)+a1;
    ar2[2,i+1]:=10+a2;
  end;
  end;
//Сортируем массивы по высоте
  for i:=1 to 100 do
    for j:=1 to 100 do
    if ar1[2,i]<ar1[2,j] then begin
      buf1:=ar1[1,j];
      buf2:=ar1[2,j];
      ar1[1,j]:=ar1[1,i];
      ar1[2,j]:=ar1[2,i];
      ar1[1,i]:=buf1;
      ar1[2,i]:=buf2;
    end;
   for i:=1 to 100 do
    for j:=1 to 100 do
    if ar2[2,i]<ar2[2,j] then begin
      buf1:=ar2[1,j];
      buf2:=ar2[2,j];
      ar2[1,j]:=ar2[1,i];
      ar2[2,j]:=ar2[2,i];
      ar2[1,i]:=buf1;
      ar2[2,i]:=buf2;
    end;
//Печать того, что получилось
  img.Canvas.MoveTo(10,10);
  for i:=1 to 100 do begin
  if (ar1[1, i]<>0) and (ar1[2, i]<>0) then begin
  img.Canvas.LineTo(Round(ar1[1,i]),Round(ar1[2,i]));
  end;
  end;
  img.Canvas.MoveTo(10+l,10);
  for i:=1 to 100 do begin
  if (ar2[1, i]<>0) and (ar2[2, i]<>0) then begin
  img.Canvas.LineTo(Round(ar2[1,i]),Round(ar2[2,i]));
  end;
  end;
//Отрисовка верхней и нижней граней
  img.Canvas.MoveTo(10,10);
  img.Canvas.LineTo(10+l,10);
  img.Canvas.MoveTo(10,10+h);
  img.Canvas.LineTo(10+l,10+h);
//Перевод изображения из буфера
  MyRect := Rect(0,0,Image1.ClientWidth,Image1.ClientHeight);
  Image1.Canvas.StretchDraw(MyRect, Image1.Picture.Graphic);
  Image1.Canvas.CopyRect(bounds(0,0,img.Width,img.Height),
                    img.Canvas,bounds(0,0,img.Width,img.Height));
end;

Автор: TarasBer 7.02.2011 21:46

Кто так сортировку пишет? У тебя она неправильно сортирует вообще.
Видимо, ты откуда-то переписал, причём очень небрежно и не глядя, что там происходит.

for i:=1 to 100 do
for j:=i+1 to 100 do

Дальше, а с чего StretchBlt будет работать, если у тебя и буфер, и область вывода, и прямоугольник, который ты выводишь - одного размера? Чему там и куда сжиматься?
И зачем ты копируешь из себя в себя?

> Image1.Canvas.StretchDraw(MyRect, Image1.Picture.Graphic);

Ты сам понимаешь, что ты написал?

Почему так нельзя?

MyRect := Rect(0,0,Image1.ClientWidth,Image1.ClientHeight);
Image1.Canvas.StretchDraw(MyRect, img);

Почему фигура у тебя выводится от 10, если должна рисоваться от середины буфера (от img.Width div 2)?

ar1[1,1]:=img.Width div 2; и так далее надо

Автор: RussoTuristo 7.02.2011 22:00

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

А по поводу цикла - это эксперимент был и он удался, если сделать как ты говоришь, то появляются какие-то левые 2 линии по бокам, даже не знаю откуда, но тоже попробую привести к человеческому виду. Еще раз спасибо, будем работать!

Автор: RussoTuristo 8.02.2011 12:54

Помогите, пожалуйста, с удалением изображения, Img.Destroy напрочь отказывается работать, всё та же ошибка - Invalid Pointer Operation. По идее Create - Destroy, но что-то не так тут...

Автор: TarasBer 8.02.2011 14:27

Create-Free, а не Create-Destroy.

Опять невнимательность!

Автор: RussoTuristo 8.02.2011 14:51

Free тоже самое выдает, я пробовал....

Автор: TarasBer 8.02.2011 15:13

Покажи, как ты этот Free вызываешь?

Автор: RussoTuristo 8.02.2011 15:32

img.free; первым делом при нажатии кнопки...
Пробовал одновременно с этим буфер очищать, но тогда вообще ошибка сразу с нулями вылетает.

Автор: TarasBer 8.02.2011 15:38

Ты создаёшь img при создании формы, а уничтожаешь при нажатии кнопки.
Где логика.
В OnDestroy деструкторы перенеси.

Автор: RussoTuristo 9.02.2011 14:06

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

procedure TForm1.FormDestroy(Sender: TObject);
begin
  buffer.Free;
  img.Free;
end;

img.Width:=l+50;
buffer.Width:=l+50;
img.Height:=h+50;
buffer.Height:=h+50;

MyRect := Rect(0,0,250,450);

Image1.Canvas.StretchDraw(MyRect, Image1.Picture.Graphic);
Image1.Canvas.CopyRect(bounds(0,0,img.Width,img.Height),
                    img.Canvas,bounds(0,0,img.Width,img.Height));

Автор: TarasBer 9.02.2011 15:02

> Без ошибок и без результатов.

Какой результат тебе нужен?
Создаются они у тебя при создании формы, то есть 1 раз.
Значит, и удалять их надо 1 раз. То есть при уничтожении формы.

> Подскажите, пожалуйста, что делаю не так?

Ты всё делаешь не так.

> Image1.Canvas.StretchDraw(MyRect, Image1.Picture.Graphic);

Покажи мне в этой строчке слово img или buffer.

> Image1.Canvas.CopyRect(bounds(0,0,img.Width,img.Height),
img.Canvas,bounds(0,0,img.Width,img.Height));

Это что, это зачем? Зачем копировать ещё раз?
Ты сначала зачем-то вывел содержимое Image1 на себя со сжатием, а потом без сжатия туда же скопировал буфер.

Я же тебе сказал, как правильно выводить. А ты забил и сделал свою хрень неправильно.
У тебя полное непонимание того, что ты делаешь.

Автор: RussoTuristo 11.02.2011 15:37

Автор: TarasBer 11.02.2011 15:44

> Чтобы при нажатии кнопки BitBtn1 старое изображение уничтожалось, а не при уничтожении формы

Хорошо. А создавать новое изображение тогда надо когда?

> Stretchdraw ожидает в качестве параметра тип .Graphic, img.Canvas такого свойства не имеет

Тебе нужен тип или свойство?
Я же тебе написал, как надо использовать StretchDraw! Ищи сам в этой теме.

Автор: RussoTuristo 11.02.2011 15:50

Автор: TarasBer 11.02.2011 16:08

> Я так понимаю, речь идёт об этой строке, но изображение всё равно не сжимается, а часть его остается где-то за пределами....

Да, об этой.
Она именно выводит то, что было в Img на форму. То, что там что-то за пределами - ну так что было в Img, то и вывелось. Можешь написать для контроля Img.SvaeToFile() и сравнить.

> При нажатии кнопки первым делом удаляем старое, и строим новое.

Что-то я не увидел, чтобы ты создавал новое при нажатии кнопки.
У тебя, видимо полное непонимание происходящего.

TBitmap.Create - это создание изображения для работы, если этого не сделать, то с ним ничего делать нельзя. Эта процедура соответствует доставанию нового листа бумаги из стола.
TBitmap.Free - это не стереть изображение ластиком с листа! Это выкинуть лист в мусорку, потому что тебе он больше не нужен. После Free делать с изображением ничего нельзя, поэтому его лучше пропиши в OnDestroy.

Всякие там рисования - это не создание нового листа, это рисование на текущем.
А для того, чтобы стереть изображение ластиком, делай так:

with Img.Canvas do begin
  Brush.Style := bsSolid; // стиль заливки - заливать по полной
  Brush.Color := clWhite; // цвет заливки - белый
  Pen.Style := psClear;  // линии не рисовать
  Rectangle(0, 0, Width, Height); // нарисовать прямоугольник на всю область
end;

Автор: RussoTuristo 12.02.2011 21:08

Вроде доработал все, изображение строится, сжимается/растягивается, но как-то иногда очень криво, что-то не прорисовывается, когда изображение большое - иногда целые линии не видны. Увеличил размер кисти, стало лучше, даже нормально, но это, наверное, не правильный способ.... Можно как-то по-другому это реализовать - улучшить качество?

И еще вопрос, добавил панель для расчетов, поместил Editы, туда ввожу значения, но при расчете вылетает ошибка: "EConverError with message "" is not a vali floating point value". Незаполненных Editов нету, странно...
Хотя типы должны совпадать:

Qn, Vlin,r:real;
tau:integer;

Procedure Init;
begin
Qn:=StrToFloat(Edit3.text);
Vlin:=StrToFloat(Edit4.Text);
tau:=StrToInt(Edit7.Text);
r:=Vlin*tau;
Edit8.text:=FloatToStr®;
end;

Автор: -TarasBer- 12.02.2011 21:25

> о при расчете вылетает ошибка: "EConverError with message "" is not a vali floating point value".

Это не значит, что он не заполнен. Это значит, что его содержимое - не число. Кстати, в качестве разделителя нужна именно запятая (кажется).

> что-то не прорисовывается, когда изображение большое - иногда целые линии не видны

Функцию сжатия писал Микрософт. Видать, хреново написал. У меня тоже при сжатии вместо оттенков серого просто пропадают линии, даже если принудительно задать режим сжатия halftone .

> Можно как-то по-другому это реализовать - улучшить качество?

Да.
Изначально задать размер буфера, совпадающий с размером выводимого участко и при рисовании в буфер использовать только относительные координаты, никаких точных чисел.
То есть делать так:
w := Img.Width;
h := Img.Height;
...
LineTo(round(w * 0.1), round(h * 0.34));

(для первой координаты через w, для второй через h).

Автор: RussoTuristo 12.02.2011 21:51

В поля text у Edit3, Edit4 и Edit7 введены значения 1380, 10 и 10 соответственно без запятых и без пробелов, поле для вывода - пустое.
Вообще когда добавил 2-ю панель она как не родная))) С первой панели из такого же Edita считывается, а эта панель вообще мёртвая почему-то.... Хотя они по сути идентичные.

Автор: -TarasBer- 12.02.2011 22:24

> В поля text у Edit3, Edit4 и Edit7

Ты хоть сам помнишь, что они означают?
Возьми редактор свойств объектов и исправь им значение поля Name на нормальное.

Да, пустое поле тоже вызывает ошибку при попытке перевести в число.
Кстати, я в таких случаях делаю примерно так:

function ToFloat(E: TEdit): extended;
var
   c: integer;
begin
  val(E.Caption, Result, c);// пытаемся перевести чесло в строку
  if c <> 0 then begin // если код ошибки не равен нулю
    ShowMessage(E.Caption + " не число!!!");
    E.SelectText(1, Length(E.Caption)); // как-то так, не помню, там вроде два свойства надо менять для выделения текста
  end;
end;

Автор: RussoTuristo 12.02.2011 23:02

http://delphi-manual.ru/edit.php А что с text не так? Я всегда так делал, да и в учебниках так написано.

Спасибо за функцию, думаю пригодится в будущем, только прибавить к ней немного кода на запрет значений, кроме числовых и ","... и вместо caption, наверное, text, а-то что-то не сходится....

Procedure Init;
begin
Edit3.text:='13800';
Edit4.text:='19';
Edit5.text:='0,015';
Edit6.text:='100';
Edit7.text:='10';
Qn:=StrToFloat(Edit3.text);
Vlin:=StrToFloat(Edit4.Text);
tau:=StrToInt(Edit7.Text);
r:=Vlin*tau;
Fn:=Pi*Vlin*Vlin*tau*tau;
Edit8.text:=FloatToStr®;
Edit9.text:=FloatToStr(Fn);
end;

Автор: volvo 13.02.2011 0:16

Значит, где-то в обработчиках чего-то лишнего понавешал. На пустом проекте прекрасно отработала процедура Init. Прикрепляй свой проект целиком (только не надо EXE-шники и все временные файлы пихать, ладно? Скомпилировать я и сам могу, меня исходники интересуют)

Автор: RussoTuristo 13.02.2011 0:37

Вот проект без ЕХЕшников:
Заранее спасибо.




Прикрепленные файлы
 2.rar ( 12.51 килобайт ) Кол-во скачиваний: 254

Автор: volvo 13.02.2011 0:49

OMG...

А ничего, что Edit3 и Form1.Edit3 (и так далее) - это разные вещи? Убери напрочь этот свой "страшный Var" (у тебя ж сейчас все переменные, описанные там - NIL-ы, не инициализированные они), и сделай Init методом TForm1, тогда все будут всё видеть...

  TForm1 = class(TForm)
    // тут ничего не меняй
  private
    { Private declarations }
  public
    { Public declarations }

    procedure Init; // <--- Добавляешь прототип
  end;

procedure TForm1.Init; // <--- Добавляешь Tform1.
begin
end;

Автор: RussoTuristo 13.02.2011 11:52

Спасибо, уверен был, что там косяк, но не знал куда пихнуть метод Init в заголовочную часть....

Автор: RussoTuristo 20.02.2011 16:36

Снова здравствуйте, в процессе работы программы мне необходимо вычислить производную функции, наткнулся на форуме на "Процедурные типы и переменные". Возник вопрос: Для вычисления производной не обязательно писать объёмного кода, есть встроенные решения или я не так понял эту статью?

Автор: RussoTuristo 21.02.2011 22:11

Помогите, пожалуйста с кое-чем:
Рассматривается определенный физический процесс, с течением времени изменяются 2 величины, в упрощенном виде выглядит так:
G=a(y+b)
-dy/dt=G/c+d;
a,b,c,d известны, G и y - искомые величины.
Я с математикой дружу плохо, поэтому хотелось бы услышать совет знающих людей... Необходимо ли вообще вычислять производную или нет? Глупый вопрос, но серьёзно меня тормозит...
С первым уравнением всё понятно, а вот втором - dy/dt и даже не знаю как к этому подступиться...

Мои рассуждения:
1)Подставляем первое уравнение во второе и получаем:
-dy/dt=a(y+b)/c+d
2)Вычисляем по формуле производную и получаем: y=a/c
3)Подставляем у в первую формулу

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

Автор: -TarasBer- 21.02.2011 22:54

> 2)Вычисляем по формуле производную и получаем: y=a/c

Как ты это сделал?

Автор: RussoTuristo 21.02.2011 23:01

По формуле производной, хотя уже сомнения закрались:
-dy/dt=2(y+3)/5+7
-dy/dt=2y/5+(2/5+7)
-dy/dt=2y/5
По формуле получаем -2/5
Или выражение -dy/dt=2y/5 не равно -(2y/5)'?

Автор: -TarasBer- 22.02.2011 0:03

> -dy/dt=2y/5+(2/5+7)
> -dy/dt=2y/5

А чё, 2/5+7 уже считается нулевым?

> -dy/dt=2y/5
> По формуле получаем -2/5

По какой формуле?!
Как можно из левой части сократить d/dt, а из правой y?

Ты в каком классе учишься? Если у вас не было курса дифуров, то я тебе это решу, если был, то читай конспекты.

Автор: RussoTuristo 22.02.2011 15:56

Школу давно закончил, но с математикой всегда были проблемы...
Пытаюсь разобраться, но чёто везде примеры легкие и без этих примудростей с d/dt, окунаюсь в тёмный лес...
Если это плёвое дело - помоги, пожалуйста...

Автор: TarasBer 22.02.2011 16:29

> Пытаюсь разобраться, но чёто везде примеры легкие и без этих примудростей с d/dt

ДИФУР без этих "прИмудростей"? Такие вообще бывают?
Ты примеры из какой главы смотрел? Надо по дифурам смотреть, а не просто по алгебраическим уравнениям.

Автор: RussoTuristo 2.05.2011 0:16

Добрый вечер! Снова нужна помощь форума, помогите, пожалуйста:
У меня есть форма, на которой расположены StringGrid, куча Editов и еще компоненты.
Как можно сделать сохранение введенных значений, чтобы одновременно, в один файл сохранялись StringGrid и Editы? Наткнулся в интернете на чьи-то комментарии, попытался переделать, но что-то у меня ничего путного не выходит...

Procedure TF_main.Save(Sender: TObject);
var j:Byte;
    f:TextFile;
begin
  AssignFile(f, 'Save.txt');
  Rewrite(f);
  for j := 0 to ComponentCount - 1 do
    if Components[j] is TEdit then
        WriteLn(f, (Components[j] as TEdit).Text);
  CloseFile(f);
  SaveGrid('grid.dat',GridRoom);
end;

Procedure TF_main.SaveGrid(Const S: String; Const Grid: TStringGrid);  // Сохранение данных таблицы
Var ff: TextFile;
    t: Integer;
Begin
 AssignFile(ff, S);
 ReWrite(ff);
 try
  With Grid Do For t:=1 to RowCount - 1 Do
   WriteLn(ff, StringReplace(Rows[t].Text, #13#10, #9, [rfReplaceAll]));
 finally
  CloseFile(ff);
 end;  
End;

procedure TF_main.ClearGrid(Const Grid : TStringGrid);
var
  i : Integer;
begin
  //Очистка строк. Этот шаг необходим из-за "плавающего" бага
  //компонента TStringGrid. - Строки, удалённые через уменьшение значения
  //TStringGrid.RowCount на самом деле не всегда удаляются. - TStringGrid
  //их прячет и при последующем увеличении TStringGrid.RowCount в таблице опять
  //могут появиться ранее "удалённые" строки. Именно поэтому необходима очистка
  //перед удалением.
  for i := Grid.FixedRows to Grid.RowCount - 1 do begin
    Grid.Rows[i].Clear;
  end;
  //Удаление строк.
  //Здесь +1 - для того, чтобы после фиксированной строки осталась одна нефиксированная
  //строка - это необходимо для правильного функционирования таблицы.
  Grid.RowCount := Grid.FixedRows + 1;
end;

Procedure TF_main.LoadGrid(Const S: String; Const Grid: TStringGrid); //Загрузка таблицы из файла
Var ff: TextFile;
    St: String;
  //Индекс очередной строки в которую мы намереваемся записать данные из файла.
  RowNum : Integer;
Begin
 //Файловая переменная связывается с именем файла.
 AssignFile(ff, S);
 //Открытие файла в режиме "только чтение".
 Reset(ff);
 try
  //Очистка таблицы.
  ClearGrid(Grid);
  //Индекс самой верхней нефиксированной строки.
  RowNum := Grid.FixedRows;
  //Цикл до тех пор пока не достигнут конец файла.
  While not Eof(ff) Do
   Begin
    //Читаем очередную строку из файла.
    ReadLn(ff, St);
    With Grid Do
     Begin
      //Если требуется, добавляем строку вниз таблицы.
      if RowNum = RowCount then begin
        RowCount := RowCount + 1;
      end;
      //Распределяем данные по ячейкам, ориентируюясь на знаки табуляции.
      Rows[RowNum].Text:=StringReplace(St, #9, #13#10, [rfReplaceAll]);
     End;
   End;
 finally
  //Закрываем файл.
  CloseFile(ff);
 end;
End;

procedure Tf_main.N4Click(Sender: TObject);
begin
  Save(Edit1);
end;

Автор: IUnknown 2.05.2011 1:33

Проходи в одной процедуре по всем компонентам, и пиши все в один файл:

procedure TForm1.SaveToFile(const FileName: TFileName);
var
  f : TextFile;
  j, R: Integer;
begin
  AssignFile(f, FileName);
  Rewrite(f);

  for j := 0 to ComponentCount - 1 do
    if Components[j] is TEdit then
      with Components[j] as TEdit do
      begin // Saving Edits
        WriteLn(f, 'TEdit' + #13#10 + Name + #13#10 + Text);
      end
    else
      if Components[j] is TStringGrid then
        with Components[j] as TStringGrid do
        begin // Saving Grigs
          WriteLn(f, 'TGrid' + #13#10 + Name + #13#10 + IntToStr(RowCount));
          for R := 0 to RowCount - 1 do
            WriteLn(f, StringReplace(Rows[R].Text, #13#10, #9, [rfReplaceAll]));
        end;
  CloseFile(f);
end;

procedure TForm1.LoadFromFile(const FileName: TFileName);
var
  f : TextFile;
  i, R: Integer;
  TheClassName, TheComponentName, s : string;
begin
  AssignFile(f, FileName);
  Reset(f);
  while not Eof(f) do
  begin
    ReadLn(f, TheClassName);
    ReadLn(f, TheComponentName);
    if TheClassName = 'TEdit' then
    begin
      ReadLn(f, s);
      (FindComponent(TheComponentName) as TEdit).Text := s;
    end
    else
      if TheClassName = 'TGrid' then
        with FindComponent(TheComponentName) as TStringGrid do
        begin
          ReadLn(f, R);
          RowCount := R;
          for i := 0 to R - 1 do
          begin
            ReadLn(f, s);
            Rows[i].Text := StringReplace(s, #9, #13#10, [rfReplaceAll]);
          end;
        end;
  end;

  CloseFile(f);
end;

Автор: RussoTuristo 2.05.2011 15:10

Спасибо. сохранение и загрузка происходит, только вот программа содержит очень много сложных расчетов с большой точностью и числами, после нескольки расчетов вылетает ошибка о нехватке памяти.
Знаю, что переменные можно очищать с помощью dispose(); Но переменных в памяти очень много, можно ли каким-либо образом очистить всю память, занимаемую программой?

И еще, подскажите, пожалуйста, что делаю не так:
Есть TChart1, содержащий Series1, есть StringGrid, в который выводятся данные расчета, мне необходимо сделать график зависимости между несколькими величинами из таблицы:

procedure Tf_main.Grafiki;
var
i:integer;
a1,a2:real;
begin
Series1.Clear;
for i:=1 to 5 do begin
if (GridResult.Cells[1, i]<>'') and (GridRoom.Cells[5, i]<>'') then begin
    a1:=StrToFloat(GridRoom.Cells[1, i]);
    a2:=StrToFloat(GridRoom.Cells[5, i]);
  end;
Series1.AddXY(a1, a2, '', clRed);
end;
//Edit для проверки значения, которое записывается в a1
Edit16.Text:=FloatToStr(a1);
end;

Автор: IUnknown 2.05.2011 17:16

procedure Tf_main.Grafiki;
var
   i:integer;
   a1,a2:real;
begin
   Series1.Clear;
   for i:=1 to 5 do
      if (GridResult.Cells[1, i]<>'') and (GridRoom.Cells[5, i]<>'') then
      begin
         a1:=StrToFloat(GridRoom.Cells[1, i]);
         a2:=StrToFloat(GridRoom.Cells[5, i]);
         Series1.AddXY(a1, a2, '', clRed); // Добавлять в грид только тогда, когда A1 и A2 изменяются
      end;
   // Edit16.Text:=FloatToStr(a1);
end;

Автор: TarasBer 2.05.2011 19:22

> если выделял конструктором какого-то класса - то вызывай его деструктор

Деструктор, который надо вызывать руками... Ни в одном другом языке такого бреда нету - везде либо ГЦ либо РАИИ, либо вообще понятие деструктора отсутствует.
Позор ботланда, вечный костыль дельфи...

Автор: IUnknown 2.05.2011 19:30

Ну, что есть - то есть... По мне - так лучше я руками соберу там, где это надо, чем GC будет решать за меня, когда и где память освобождать.

Кстати, что в современном Дельфи (2009 и выше) есть возможность написать аналоги С++-ных auto_ptr, тогда будет чуть проще с освобождением памяти... Но это только на новых версиях...

Автор: TarasBer 2.05.2011 20:21

> По мне - так лучше я руками соберу там, где это надо, чем GC будет решать за меня, когда и где память освобождать.

А ещё лучше нормальный RAII.

> Кстати, что в современном Дельфи (2009 и выше) есть возможность написать аналоги С++-ных auto_ptr, тогда будет чуть проще с освобождением памяти... Но это только на новых версиях...

Видел я эти аналоги - только не auto_ptr, а shared_ptr. Я и в Д7 умею делать приведение к интерфейсу. Только это, во-первых, обязательно через счётчик ссылок работает (а если мне нужно другое поведение?), а во-вторых, это дико тормозить будет. Проверяли - делали большой массив, загоняли в него 1000 раз по 10 ссылок на один объект, сортировали. В Д7 большую часть времени занимала работа интерфейсов, С++-ники ржали долго. Адский же код с контролируемыми объектами показал себя на нормальном уровне, правда я не знаю, вызовы деструкторов там виртуальные или статические, надеюсь, что компилятор догадался.

Автор: IUnknown 2.05.2011 20:30

Автор: RussoTuristo 2.05.2011 20:45

Извините, код громоздкий, но всё же выложу, не понимаю почему не строятся графики, помогите, пожалуйста, может и про память что-то дельное сказать можно?

Код удален

Автор: IUnknown 2.05.2011 21:06

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

Автор: RussoTuristo 2.05.2011 21:10

Код программы прикрепил, удалить то длинное сообщение?


Прикрепленные файлы
 ______.rar ( 24.96 килобайт ) Кол-во скачиваний: 207

Автор: IUnknown 2.05.2011 21:24

Автор: RussoTuristo 2.05.2011 21:36

У меня такое сообщение вылетает, когда я раза 3-4 подряд вызываю функцию расчет, я не очищаю память вообще нигде, что больше всего ест памяти? Изображения, что строятся и где-то хранятся или множественные расчеты величин с 5 знаками после запятой? Можно в принципе сократить до 2-х знаков...

Автор: IUnknown 2.05.2011 21:57

Так... Во-первых, Buffer типа TImage, можно убрать, он не используется. Только жрет место. И много жрет, ты резервируешь для него достаточно большой размер памяти (увеличением Width и Height). Итого: процедура Tf_main.BitBtn1Click

// ...

  Img:=TBitmap.Create;
//  buffer:=TBitmap.Create;
  img.Width:=l+400;
//  buffer.Width:=l+400;
  img.Height:=h+400;
//  buffer.Height:=h+400;

// ...

if (GridResult.Cells[1, i]<>'') and (GridRoom.Cells[5, i]<>'') then

Автор: RussoTuristo 2.05.2011 22:30

Спасибо большое, понял в чем ошибка с графиками, 2 дня с ними мучался и не заметил, что название StringGrida во втором условии перепутал, поправил, только вот теперь он ругается: EConvertError "" is not a valid floating point value.
А по поводу памяти можно еще вопросик: bufferы можно убрать, а изображение при многократном вызове расчета каждый раз ведь память занимает? Значит по идее перед каждым новым вызовым его тоже можно почистить?

Автор: -TarasBer- 2.05.2011 22:57

Нет. Буферу надо выделять память только один раз.
А в обработчике кнопки надо стирать содержимое буфера.

Понимаешь разницу между уничтожением буфера и стиранием его содержимого?

Автор: IUnknown 2.05.2011 22:58

      if (GridResult.Cells[1, i]<>'') and (GridResult.Cells[5, i]<>'') then
      begin
         a1:=StrToFloat(GridResult.Cells[1, i]); // <--- Здесь тоже надо менять ...
         a2:=StrToFloat(GridResult.Cells[5, i]); // <--- И здесь ...
         Series1.AddXY(a1, a2, '', clRed);
      end;

Автор: RussoTuristo 2.05.2011 23:09

Спасибо большое, графики отображаются, сейчас займусь чисткой буфера.
Удивляюсь как вы умудряетесь замечать всё. Вот что значит мастера своего дела! Еще раз спасибо большое за помощь!

Автор: IUnknown 3.05.2011 15:02

RussoTuristo, ты не думал никогда над тем, что чем меньше строк в программе - тем лучше? Вот тебе 2 хинта, как можно безо всяких проблем убрать по десятку строк в каждом случае, без изменения функционала программы.

Первый - касается вот этого ужаса (из процедуры TzoneMath.ShowOnTable):

  for i:=1 to steps do begin
    grid.Cells[0,i]:=FloatToStr(RoundTo(rooms[room].iParams[i-1].tau,-5));
    grid.Cells[1,i]:=FloatToStr(RoundTo(rooms[room].iParams[i-1].Fp,-5));
    grid.Cells[2,i]:=FloatToStr(RoundTo(rooms[room].iParams[i-1].Gk,-5));
    grid.Cells[3,i]:=FloatToStr(RoundTo(rooms[room].iParams[i-1].y,-5));
    grid.Cells[4,i]:=FloatToStr(RoundTo(rooms[room].iParams[i-1].Qpozh,-5));
    grid.Cells[5,i]:=FloatToStr(RoundTo(rooms[room].iParams[i-1].Ro2,-5));
    grid.Cells[6,i]:=FloatToStr(RoundTo(rooms[room].iParams[i-1].T2,-5));
    grid.Cells[7,i]:=FloatToStr(RoundTo(rooms[room].iParams[i-1].Gm,-5));
  end;

  for i:=1 to steps do
  begin
    for j := 0 to 7 do grid.Cells[j, i] := FloatToStr(RoundTo(rooms[room].iParams[i-1].Values[j], -5));
  end;

function TzoneMath.fGm(iter,CurrentRoom:integer; woll:TWoll; forroom:integer):extended;

  function TrapezeSt1(a, b: extended; eps: extended): extended;
    function func(h: extended): extended;
    begin
     curroom:=CurrentRoom;
     Result:=Woll.Proem[0].Width * Rooms[CurrentRoom].iParams[iter].Ro2P *
        sqrt((2 * TrapezeInt(Rooms[CurrentRoom].Height-Rooms[CurrentRoom].iParams[iter].yP, woll.Proem[0].Height, 0.01, fdP_1))/Rooms[CurrentRoom].iParams[iter].Ro2P);
    end;
  var
    xx1,xx2,xx3:extended;
    c:integer;
  begin
    result:=0;
    for c:=1 to round(abs(b-a)/eps) do begin
      xx1:=func(a+c*eps);
      xx2:=func(a+c*eps+eps);
      if xx2>xx1 then begin
        xx3:=xx1
      end else begin
        xx3:=xx2;
      end;
      result:=result+abs(xx2-xx1)*eps+abs(xx3)*eps;
    end;
  end;

begin
  if (Rooms[CurrentRoom].Height-Rooms[CurrentRoom].iParams[iter_buf].YP)<woll.Proem[0].Height then begin
    result:= TrapezeSt1(Rooms[CurrentRoom].Height-Rooms[CurrentRoom].iParams[iter].yP, Woll.Proem[0].Height, 0.01);
  end else begin
    result:=0;
  end;
end;

function fdP_1(h: extended): extended; // Эта функция у тебя была...
begin
  result:=9.81*(zoneMath.Rooms[curroom].iParams[0].Ro2P-zoneMath.Rooms[curroom].iParams[iter_buf].Ro2P)
end;

// После нее добавляешь еще одну, небольшую, функцию:
var
  currWoll : TWoll;
  iteration : Integer;

function SecondFunc(h: extended): extended;
begin
  with zoneMath.Rooms[curroom] do
    Result:=CurrWoll.Proem[0].Width * iParams[iteration].Ro2P * sqrt(
      (2 * TrapezeInt(Height-iParams[iteration].yP, currwoll.Proem[0].Height, 0.01,fdP_1)) / iParams[iteration].Ro2P
    );
end;

function TzoneMath.fGm(iter,CurrentRoom:integer; woll:TWoll; forroom:integer):extended;
begin
  curroom:=CurrentRoom;
  currWoll := woll;
  iteration := iter;

  if (Rooms[CurrentRoom].Height-Rooms[CurrentRoom].iParams[iter_buf].YP)<woll.Proem[0].Height then
  begin
    result:= TrapezeInt(Rooms[CurrentRoom].Height-Rooms[CurrentRoom].iParams[iter].yP,
                                 Woll.Proem[0].Height, 0.01, SecondFunc);
  end else begin
    result:=0;
  end;
end;

Автор: RussoTuristo 4.05.2011 17:32

Дельные замечания, поработаю над исправлением, в будущем пригодится....
И вопросик:
Подскажите, пожалуйста, использую для сохранения и загрузки выше указанный код, но после загрузки при попытке Расчета вылетает ошибка: "" is not a valid integer value
С чем это может быть связано? Визуально пустых строчек и эдитов нигде нет, ошибка отправляет в строчку:

procedure Tf_main.Button1Click(Sender: TObject);//Функция расчета
var i:integer;
begin
  F_main.BitBtn1Click(Sender);
  widthXX:=StrToFloat(edit15.text);
  widthYX:=StrToFloat(edit13.text);

Автор: TarasBer 4.05.2011 18:01

edit15...
Хм, что бы это могло быть...
Наверное, это пятнадцатый компонент типа TEdit, добавленный на форму, и в нём нет текста.

А потому что, блин, нельзя использовать компоненты с именами, даваемыми по умолчанию.

Автор: IUnknown 4.05.2011 18:05

То, что Дельфи останавливается на строке с edit15.text - ни разу не значит, что ошибка именно в нем. Может быть и раньше по ходу программы.

if (GridRoom.Cells[2, i]<>'') and (GridRoom.Cells[3, i]<>'') then

    a1:=10*StrToInt(GridRoom.Cells[2, i]);
    a2:=10*StrToInt(GridRoom.Cells[3, i]);

if (Trim(GridRoom.Cells[2, i])<>'') and (Trim(GridRoom.Cells[3, i])<>'') then

      if TheClassName = 'TGrid' then
        with FindComponent(TheComponentName) as TStringGrid do
        begin
          ReadLn(f, R);
          RowCount := R;
          for i := 0 to R - 1 do
          begin
            ReadLn(f, s);
            if s <> '' then // <--- Вот эту строку добавь, чтоб лишнюю работу не делать
               Rows[i].Text := StringReplace(s, #9, #13#10, [rfReplaceAll]);
          end;
        end;

Автор: RussoTuristo 4.05.2011 18:11

Спасибо, исправил, теперь сохраняется и загружается.

Автор: RussoTuristo 4.05.2011 19:46

Пишу функцию, чтобы в поля нельзя было вводить недопустимые значения, решил по уму сделать, чтобы сразу всё обрабатывалось, но с синтаксисом проблемки:

function Tf_main.Vvod_dannih:boolean;
var
i,j:integer;
begin
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TEdit then
      with Components[i] as TEdit do
      begin
        for j := 0 to Length(Components[i].text) do//Здесь ошибочка с обращением к свойству text
           if (Components[i].Text[j] not in['0'..'9', ',']) then //not in тоже не пашет, хотя вроде когда-то писал так
              begin
                 ShowMessage('В поле введено неправильное значение');
                 Result:=false;
                 Break;
              end else
              Result:=true;
      end;
end;

Автор: TarasBer 4.05.2011 19:59

Нафига ты используешь with, если внутри него всё равно обращаешься через Components[i]?
Внимательнее пиши же!

function Tf_main.Vvod_dannih:boolean;
var
i,j:integer;
begin
  for i := 0 to ComponentCount - 1 do
    if Components[i] is TEdit then
      with TEdit(Components[i]) do begin  // можно без as, так как проверку ты уже сделал строчку назад
        for j := 1 to Length(text) do// убрать нафиг Components[i]. и индексировать строки надо от 1
           if not (Text[j] in['0'..'9', ',']) then //not in тоже не пашет, хотя вроде когда-то писал так
              begin
                 ShowMessage('В поле введено неправильное значение');
                 Result:=false;
                 Break;
              end else
              Result:=true;
      end;
end;

Автор: IUnknown 4.05.2011 20:02

function Tf_main.Vvod_dannih : boolean;
var
   i, j: integer;
begin
   Result := False;
   for i := 0 to ComponentCount - 1 do
      if Components[ i ] is TEdit then
         with Components[ i ] as TEdit do
         begin
            for j := 0 to Length({(Components[ i ] as TEdit).}Text) do
               if not ({(Components[ i ] as TEdit).}Text[j] {not} in['0'..'9', ',']) then
               begin
                  ShowMessage('В поле введено неправильное значение'); Exit;
               end;
         end;
   Result := True;
end;

Автор: RussoTuristo 4.05.2011 20:04

Спасибо, DecimalSeparator видел в интернете, но честно говоря не знал, что это значит.
А если использовать такой синтаксис, то установить фокус уже никак не получится в этот Edit, так как работа идет уже непосредственно с текстом?
IUnknown, С днём Рождения, кстати!

Автор: IUnknown 4.05.2011 20:25

С чего бы? Ты хочешь оставить фокус в том Edit-е, который некорректно заполнен, что-ли? Вот так попробуй:

function Tf_main.Vvod_dannih : boolean;
var
   i, j: integer;
   Edit : TEdit;
begin
   Result := False;
   for i := 0 to ComponentCount - 1 do
      if Components[i] is TEdit then
      begin
         Edit := Components[i] as TEdit;
         for j := 1 to Length(Edit.Text) do
            if not (Edit.Text[j] in['0'..'9', ',']) then
            begin
               Edit.SelStart := 1; Edit.SelLength := Length(Edit.Text);
               Edit.SetFocus;
               ShowMessage('В поле введено неправильное значение'); Exit;
            end;
      end;
   Result := True;
end;

Автор: RussoTuristo 4.05.2011 20:31

Первая понял в чем - я не все Editы просматривал, нумерация-то с нуля идет, а вот вторая связана с длиной текста в Editе походу, но что-то сразу не доходит, в чем её серьёзность...

Автор: IUnknown 4.05.2011 20:55

Не совсем. Первая - это то, что у тебя есть другое свойство Text в контексте этой процедуры. То есть, вставь строку:

   Result := False;
   ShowMessage(Text); // <--- Вот эту, еще до того, как начинаешь проверять компоненты
   for i := 0 to ComponentCount - 1 do

Автор: TarasBer 4.05.2011 20:56

Я бы делал проверку на корректность содержимого не перебором символов, а через Val. Мне кажется, логичнее проверять, можно ли строку сделать числом, при помощи функции, делающей строку числом.

> а вот вторая связана с длиной текста в Editе походу, но что-то сразу не доходит, в чем её серьёзность...

А ты прочитай мой пост (82), который IUnknown перебил с ошибкой в индексации строки.

Автор: IUnknown 4.05.2011 21:02

Автор: RussoTuristo 8.05.2011 16:00

Добрый день! Подскажите, пожалуйста, а можно ли в текстовый файл вместе с таблицами и Эдитами вывести графики из TChart и рисунок? Есть такая необходимость, про THcart что-то нашел в интернете, попытался наваять, но вместо графиков выводятся названия TChartов, а изображение вообще вызывает сомнения -можно ли ехо сохранить в текстовый файл или только в bmp/jpeg?

procedure Tf_main.N7Click(Sender: TObject);
var
  f : TextFile;
  j, R: Integer;
  BM: TBitmap;
begin
if SaveDialog1.Execute then
  begin
  AssignFile(f, SaveDialog1.FileName);
  Rewrite(f);

  for j := 0 to ComponentCount - 1 do
    if Components[j] is TEdit then
      with Components[j] as TEdit do
      begin // Saving Edits
        WriteLn(f, 'TEdit' + #13#10 + Name + #13#10 + Text);
      end
    else
      if Components[j] is TStringGrid then
        with Components[j] as TStringGrid do
        begin // Saving Grigs
          WriteLn(f, 'TGrid' + #13#10 + Name + #13#10 + IntToStr(RowCount));
          for R := 0 to RowCount - 1 do
            WriteLn(f, StringReplace(Rows[R].Text, #13#10, #9, [rfReplaceAll]));
        end
    else
      if Components[j] is TChart then
        with Components[j] as TChart do
        begin // Saving Grigs
          BM:=TBitmap.Create;
          try
             BM.PixelFormat:=pf24bit;
             BM.Width:=Chart1.ClientWidth;
             BM.Height:=Chart1.ClientHeight;
             Chart1.PrintPartialCanvas(bm.canvas, Chart1.ClientRect);
             BM.SaveToFile('f');
         finally
             BM.Free;
        end;
        end;
  CloseFile(f);
  end;
end;

Автор: -TarasBer- 8.05.2011 16:12

В тестовый? Нет. На то он и текстовый.
Можно в вордовый.
Можно сохранить картинку в файл, а потом сгенерировать html, в который включена эта картинка.

Только лучше не в bmp сохранять, а в png. Правда, как это делать - я не знаю, но вроде есть какое-то стандартное решение.

Автор: IUnknown 8.05.2011 16:44

Автор: RussoTuristo 8.05.2011 19:49

А как сохранить Chart и Image в вордовский фал, может кто-нибудь подсказать? А-то что-то ничего в интернете нашарить не могу похожего...

Автор: IUnknown 8.05.2011 20:22

У приложения Word есть коллекция http://msdn.microsoft.com/en-us/library/microsoft.office.interop.word.inlineshapes_members%28v=office.11%29.aspx, к которой и надо добавлять изображение, чтобы оно добавилось в документ. Поскольку и метод AddPicture и метод AddOLEObject этой коллекции требуют имя файла (т.е., файл с изображением уже должен быть на диске), то надо записать картинку во временный файл, оттуда - добавить к документу, а потом - удалить:

   fn := ExtractFilePath(Application.ExeName) + 'tmp.bmp'; // Тут будет временная картинка
   Chart1.SaveToBitmapFile(fn);

   WordApp := CreateOleObject('Word.Application'); // А вот с эти приложением работаем
   WordApp.Visible := True; // Это можно отключить, я включил, чтоб наблюдать за происходящим
   WordApp.Documents.Add; // Новый документ

   // Добавляем картинку из файла
   WordApp.Selection.InlineShapes.AddOLEObject(ClassType:='Paint.Picture',
      FileName:=fn, LinkToFile:=False, DisplayAsIcon:=False);

   DeleteFile(fn); // Все, картинка больше не нужна, удаляем

Автор: IUnknown 8.05.2011 20:49

Хотя... Что тебе надо делать с этим изображением? Сохранить, а потом восстановить? Или просто для просмотре? Если сохранение/восстановление - то можно изображение закодировать в строку (EncodeBase64), а потом, когда нужно - раскодировать назад: DecodeBase64. На форуме embarcadero было решение подобной задачи.

Автор: RussoTuristo 10.05.2011 10:22

Мне надо вывести отчет о задымленности в файл, то есть исходные данные, рассчитанные данные, желательно рисунок(не обязательно, чувствую с ним много проблем будет) и графики зависимостей(TChart)....
Кстати, в связи с этим возникает вопрос, а график TChart наверняка выводится по похожим с Image алгоритмам?(То естьTChart нельзя вывести в один файл с Эдитами и таблицами, используя, например не word, а какой-либо более легкий метод вывода)

Автор: TarasBer 10.05.2011 14:13

> AddOLEObject(ClassType:='Paint.Picture',
FileName:=fn, LinkToFile:=False, DisplayAsIcon:=False);

Кстати, интересно было, что означает эта конструкция в Дельфи?
(хахаха, это спецкостыль для OLE)

> WordApp := CreateOleObject('Word.Application');

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

И ещё, почему у меня не получалось сделать так, чтобы одновременно работала подобная программа и я мог что-то набирать в другом документе (при выборе другого документа моя программа тоже переключалась на него)?

Автор: IUnknown 10.05.2011 15:16

Автор: TarasBer 10.05.2011 15:22

> Или удалить надо было до сохранения? Или надо было написать полный код, чтоб ТС только скопировал и добавил к себе?

Надо было написать "потом сохранить и обязательно удалить не забудь".

> Если надо одновременно работать вручную - с одним документом, а автоматически - с другим, то нужно переписывать код по-другому.

А насколько именно по-другому?

> Ты еще работу с OLE в Билдере не видел.

Да, не видел...

Автор: IUnknown 10.05.2011 16:00

// во-первых, создаем OLE-объект только тогда, когда он еще не создан,
// иначе подключаемся уже к работающему:
try
   WordApp := GetActiveOleObject('Word.Application');
except
   WordApp := CreateOleObject('Word.Application');
end;

// во-вторых, при создании нового документа надо получить на него ссылку:
new_doc := wordapp.Documents.Add; // var new_doc : variant
// и потом добавлять объект именно к новому документу
new_doc.{selection.}InlineShapes.AddOLEObject(...)

Автор: TarasBer 10.05.2011 16:09

> Ну, как-то вот так (набираю прямо здесь, так что где-то могу и накосячить) :

И тогда можно будет параллельно несколько таких программзапускать и они не будут друг другу мешать?

> Посмотри: С++ Builder6 & Excel

Там как раз всё по-честному сделано.

Автор: IUnknown 10.05.2011 16:30

Автор: RussoTuristo 10.05.2011 16:35

С кодом выходят проблемки, файл создается, открывается, но дальше ничего проверить не могу, пара косячков с синтаксисом, не знаю как поправить:

procedure Tf_main.N7Click(Sender: TObject);
var
  i1, i2, j, R: Integer;
  WordApp, Table: Variant;
  fn:string;
begin
if SaveDialog1.Execute then
  begin
  WordApp := CreateOleObject('Word.Application'); // А вот с эти приложением работаем
  WordApp.Visible := True; // Это можно отключить, я включил, чтоб наблюдать за происходящим
  WordApp.Documents.Add; // Новый документ
  WordApp.Selection.Font.Size := 8;
  for j := 0 to ComponentCount - 1 do
    if Components[j] is TEdit then
      with Components[j] as TEdit do
      begin // Saving Edits
     {  WordApp.Selection.TypeText(Edit1.text);
       WordApp.Selection.TypeText(#13#10'new');}
      end
    else
      if Components[j] is TStringGrid then
        with Components[j] as TStringGrid do
        begin // Saving Grigs
          WordApp.ActiveDocument.Tables.Add(WordApp.ActiveDocument.Range,
          RowCount, ColCount);//Ошибка: не удаётся удалить диапазон
          Table := WordApp.ActiveDocument.Tables.Item(1);
          Table.Style := 'Сетка таблицы';
          for i1:=0 to RowCount-1 do
             for i2:=0 to ColCount-1 do
               begin
                Table.Cell(i1+1, i2+1).Range.Text:=Cells[i2, i1];
                WordApp.Visible:=True;
               end;
          WordApp.Selection.TypeText(#13#10'new');
        end
    else
      if Components[j] is TChart then
        with Components[j] as TChart do
        begin // Saving Grigs
         { fn := ExtractFilePath(Application.ExeName) + 'tmp.bmp'; // Тут будет временная картинка
          Chart.SaveToBitmapFile(fn);//Delphi говорит, что нет такого свойства у TChart
          WordApp.Selection.InlineShapes.AddOLEObject(ClassType:='Paint.Picture',
          FileName:=fn, LinkToFile:=False, DisplayAsIcon:=False);
          DeleteFile(fn);
          WordApp.Selection.TypeText(#13#10'new');
        end;   }
        end;
  WordApp.ActiveDocument.SaveAs(SaveDialog1.FileName+'.doc');
  end;
end;

Автор: IUnknown 10.05.2011 20:14

Не знаю, с чем у тебя там проблема, вот этот код работает прекрасно:

procedure Tf_main.N7Click(Sender: TObject);

var
   WordApp, Table : Variant;

   procedure CommentTable(numRows : integer; const s : string);
   begin
      wordapp.selection.MoveDown(wdLine, numRows, EmptyParam);
      wordapp.selection.TypeParagraph;
      wordapp.selection.InsertAfter(Name);
      // снимаем выделение с выведенного текста,
      // чтобы вывод следующей таблицы не затер этот текст
      wordapp.selection.MoveDown(wdLine, 1, EmptyParam);
      wordapp.selection.TypeParagraph;
   end;

var
  i1, i2, j, R: Integer;
  new_doc : Variant;
  fn:string;
  numCols, numRows : Integer;
  s : string;
begin
   if SaveDialog1.Execute then
   begin
      WordApp := CreateOleObject('Word.Application'); // С этим приложением работаем
      WordApp.Visible := True; // Это НЕЛЬЗЯ отключать на Word до 2002, вставка будет работать неправильно!!!
      new_doc := WordApp.Documents.Add; // Новый документ

      for j := 0 to ComponentCount - 1 do
      begin
         if Components[j] is TEdit then
            with Components[j] as TEdit do
            begin // Saving Edits
            (*
               WordApp.Selection.TypeText(Edit1.text);
                  WordApp.Selection.TypeText(#13#10'new');
            *)
            end
         else
            if Components[j] is TStringGrid then
               with Components[j] as TStringGrid do
               begin // Saving Grigs
                  numCols := ColCount;
                  numRows := RowCount;
                  table := new_doc.Tables.Add(WordApp.Selection.Range, numRows, numCols);

                  for i1:=0 to RowCount-1 do
                     for i2:=0 to ColCount-1 do
                     begin
                        Table.Cell(i1+1, i2+1).Range.Text:=Cells[i2, i1];
                     end;

                  Table.Cell(0, 0).Select;
                  // Выводим снизу от таблицы имя компонента.
                  // В принципе, можешь выводить любую информацию.
                  CommentTable(numRows + 1, Name);
               end
            else
               if Components[j] is TChart then
                  begin // Saving Charts
                     fn := ExtractFilePath(Application.ExeName) + 'tmp.bmp';
                     (Components[j] as TChart).SaveToBitmapFile(fn);
                     WordApp.Selection.TypeParagraph;
                     WordApp.Selection.InlineShapes.AddPicture(FileName:=fn,
                        LinkToFile:=False, SaveWithDocument:=True);
                     DeleteFile(fn);
                     wordapp.selection.InsertAfter('Chart : ' + Name);
                     wordapp.selection.MoveDown(wdLine, 1, EmptyParam);
                     WordApp.Selection.TypeParagraph;
                  end;
      end;
      WordApp.ActiveDocument.SaveAs(SaveDialog1.FileName+'.doc');
      WordApp.Quit;
      WordApp := Unassigned;
   end;
end;

Автор: RussoTuristo 10.05.2011 20:26

Спасибо большое, только вот там одна переменная не объявлена: wdLine
Насколько я понял wdLine - значение по умолчанию, но не работает, может для его работы нужно что-нибудь включать в Uses?

Автор: IUnknown 10.05.2011 22:19

Это константа:

const
   wdline = 5;

Автор: RussoTuristo 12.05.2011 10:44

while not TStringGrid.Eof do - не работает, пробовал сделать так, чтобы новая строчка в таблице появлялась после заполнения предыдущей, но тоже что-то так и не нашел нужного свойства.
Помогите, пожалуйста: как сделать чтобы в отчет выводились только заполненные поля?

Автор: IUnknown 12.05.2011 12:48

            if Components[j] is TStringGrid then
               with Components[j] as TStringGrid do
               begin // Saving Grigs
                  numCols := ColCount;
                  numRows := 0;

                  while Trim(StringReplace(Rows[numRows].Text, #13#10, '', [rfReplaceAll])) <> '' do
                  begin
                     inc(numRows);
                  end;

                  if numRows > 0 then // Пустая таблица? Пропускаем...
                  begin
                     table := new_doc.Tables.Add(WordApp.Selection.Range, numRows, numCols);

                     for i1:=0 to numRows - 1 do
                        for i2:=0 to ColCount-1 do
                        begin
                           Table.Cell(i1+1, i2+1).Range.Text:=Cells[i2, i1];
                        end;

                     Table.Cell(0, 0).Select;
                     // Выводим снизу от таблицы имя компонента.
                     // В принципе, можешь выводить любую информацию.
                     CommentTable(numRows + 1, Name);
                  end
               end

Автор: RussoTuristo 12.05.2011 21:44

Спасибо, огромное!