Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 15.02.2013, 07:44
Exnefus Exnefus вне форума
Прохожий
 
Регистрация: 14.02.2013
Сообщения: 3
Репутация: 10
По умолчанию Программа для построения линейных графиков по точкам

Здравствуйте.
Давно не программировал, можно сказать вообще забыл, но вот пришлось написать прогу, которая может составлять график по данным из файла. Взял исходник на этом сайте, т.к. без исходника я вообще не написал бы ничего
В самом же файле храниться как бы архив значений, вида:
Код:
12.02.2013 10:24:36:965 ; -0.720767676830292
12.02.2013 10:24:48:387 ; -0.733323454856873
12.02.2013 10:27:49:355 ; -0.722337126731873
График нужно строить по последнему стобцу, открываю файл и переношу в StringGrid, далее была проблема с дробным разделителем точки и запятой, решил это виндовым способом. А теперь не могу понять в чем ошибка. Есть в этом исходнике условие на то, что дескать "Количество точек графика не может быть меньше двух" и вот она и выскакивает.
Вот исходник программы:

Код:
unit grafik01;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    CheckBox1: TCheckBox;
    dlgOpen1: TOpenDialog;
    btn1: TBitBtn;
    strngrd1: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var

  Form1: TForm1;


// Процедуру gr вызывает процедура обработки
// события onPaint для формы Form2, на поверхности
// которой вычерчивается график и которая
// находится в другом модуле. Поэтому объявление
// функции надо поместить в раздел Interface.
procedure gr; // чтобы процедуру можно было вызвать
              // из другого модуля

implementation

uses grafik02;

{$R *.dfm}

{ Во время создания формы установить
  свойства компонента StringGrid:
  FixedRows := 0;
  RowCount := 2;
  Options.goEditing := True;
  Options.goTab := True;
}

const
    COLCOUNT = 15;
var
    // аргументы и значения функции
    x: array[1..COLCOUNT] of real;

// строит график по содержимому массивов x,y
procedure gr;
var
    i: integer;
    x1,x2:real;    // границы изменения аргумента функции
    l,b:integer;   // левый нижний угол области вывода графика
    w,h:integer;   // ширина и высота области вывода графика
    mx,my:real;    // масштаб по осям X и Y
    x0,y0:integer; // точка пересечения координатных осей
    px,py: integer;// координаты точки графика на поверхности формы
    np: integer;   // кол-во точек графика

begin
 Form2.Canvas.Rectangle(0,0,Form2.ClientWidth,Form2.ClientHeight);
 // область вывода графика
 l:=10;                     // X - координата левого верхнего угла
 b:=Form2.ClientHeight-20;  // Y - координата левого нижнего угла
 h:=Form2.ClientHeight-40;  // высота
 w:=Form2.Width-40;         // ширина

 // определим границы изменения аргумента
 // и количество точек (элементы массива X
 // должны образовывать возрастающую последовательность)
 x1:=x[1];
 i:=1;
 while (x[i+1] > x[i]) and (i < COLCOUNT) do
          i:= i+1;

 x2:= x[i]; //x[COLCOUNT-1];
 np:=i; // количество точек

 if np < 2 then begin
    ShowMessage('Количество точек графика не может быть меньше двух');
    exit;
 end;

 // найдем максимальное и минимальное значения функции



 // вычислим масштаб
 mx:=w/abs(x2-x1);  // масштаб по оси X

 // точка пересечения координатных осей
 x0:=l+Abs(Round(x1*mx));

 with form2.Canvas do
 begin
   MoveTo(x0,b);LineTo(x0,b-h); // ось Y
   MoveTo(l,y0);LineTo(l+w,y0); // ось X

   // построить график
   for i:=1 to np do
   begin
      px := x0+Round(x[i]*mx);

      Form2.Canvas.Pen.Color := clRed;
      Rectangle(px-2,py-2,px+2,py+2); // маркер

      if Form1.CheckBox1.Checked then
        // соединительная линия
        if i = 1
          then MoveTo(px,py)
          else LineTo(px,py);

      Form2.Canvas.Pen.Color := clBlack;

      // значение функции и аргумент
      TextOut(px-5,y0+2, FloatToStr(x[i]));
      MoveTo(px,py); // вернуть перо в точку px,py
                     // т.к. TextOut меняет положение пера
   end;
 end;
end;

// щелчок на кнопке Построить
procedure TForm1.Button1Click(Sender: TObject);
var
    i: integer;
    s: string;
begin
    // перепишем содержимое таблицы в массивы
    // аргументов и значений функции
    for i:=1 to COLCOUNT-1 do
    begin
        x[i] := StrToFloat(Form1.strngrd1.Cells[3,i]);
    end;

    // функцию вывода графика вызывает процедура
    // обработки события OnPaint для Form2
    if not Form2.Showing
        then Form2.Show     // отобразить окно Form2
        else Form2.Repaint;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  sl:TStringList;
  i,j,p,rem:integer;
  temp,s,t:string;
begin
  dlgOpen1.Execute;
  sl:=TStringList.Create;
  sl.LoadFromFile(dlgOpen1.FileName);
  delete(t,pos(';',t),2);
  for i:=0 to sl.Count-1 do begin
    temp:=sl.Strings[i];
    for j:=0 to strngrd1.ColCount-1 do begin
      p:=pos(' ',temp);
      if p>0 then begin
        s:=Copy(temp,1,p-1);
        delete(temp,1,p);
        strngrd1.Cells[j,i]:=s;
      end else
        if j=strngrd1.ColCount-1 then strngrd1.Cells[j,i]:=temp;
    end;
  strngrd1.Cells[0,0] := '  Дата';
  strngrd1.Cells[1,0] := '  Время';
  strngrd1.Cells[2,0] := '  Разделитель';
  strngrd1.Cells[3,0] := '  Значение переменной';
  end;
  sl.Destroy;
end;

end.
Исходник + файл с данными
graphic.rar
Ответить с цитированием
  #2  
Старый 15.02.2013, 10:53
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Почему в этой строке удаляется только 2 символа?
Код:
 delete(t,pos(';',t),2); 
к тому же на момент удаления, переменная t неинициализирована - в ней "мусор".
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #3  
Старый 15.02.2013, 11:49
Exnefus Exnefus вне форума
Прохожий
 
Регистрация: 14.02.2013
Сообщения: 3
Репутация: 10
По умолчанию

angvelem
Это кусок старого кода, который я забыл удалить) можете не смотреть на это.
Ответить с цитированием
  #4  
Старый 16.02.2013, 05:37
Аватар для Alegun
Alegun Alegun вне форума
LMD-DML
 
Регистрация: 12.07.2009
Адрес: Богородское
Сообщения: 3,025
Версия Delphi: D7E
Репутация: 1834
По умолчанию

Проблему точки/запятой (в смысле decimalseparator) можно ещё решить во время заполнения стрингрида:
Код:
...
if j=strngrd1.ColCount-1 then
        begin
        temp[pos('.',temp)]:=',';
        strngrd1.Cells[j,i]:=temp;
        end;
...
Вроде не должна работать procedure gr, уж больно в ней косяков много наблюдается, остаются переменные (напр. py, y0) без явного заполнения, получается что ей рисовать нечего, только по оси Х, да и while, судя по всему, не выполняется - глубже голова отказывается в дебри залазить, болит Вот эту процедуру наверное лопатить и надо.
Ответить с цитированием
Этот пользователь сказал Спасибо Alegun за это полезное сообщение:
Exnefus (16.02.2013)
  #5  
Старый 16.02.2013, 14:30
Exnefus Exnefus вне форума
Прохожий
 
Регистрация: 14.02.2013
Сообщения: 3
Репутация: 10
По умолчанию

Alegun Cпасибо за решение проблемы дробного делителя.
Переменные с y остались с исходника, которые нужно будет подчистить, хотя я затупил, надо было привязать эти переменные к графику для построения по оси Y к времени в файле данных. Спасибо, Вы мне очень помогли.
Ответить с цитированием
Ответ


Delphi Sources

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

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 12:43.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter