Форум по 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
Ответить с цитированием
 


Delphi Sources

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

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

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

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


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


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

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