Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом

Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »



Вопрос # 2 319

/ вопрос открыт /

Здравствуйте, уважаемые эксперты!
Пишу программу для построения графиков функции. В связи с чем у меня возникли вопросы.
1. Как составить процедуру для разметки осей?
2. Необходимо реализовать возможность вывода на одно координатное поле нескольких графиков. Не знаю как. У меня получается только каждый график выводить отдельно.
3. Необходимо реализовать масштабирование, настройки цвета и типа линии графиков.
(Настройки цвета линий графиков я реализовала, а вот масштабирование и тип линии не получается).
В приложении код построения линий координат и код выбора цвета линии.
Буду очень благодарна за помощь и объяснение.

Приложение:
  1.  
  2.  
  3.  
  4. cx,cy:longint;
  5. procedure MyLine(x1,y1,x2,y2:real);
  6. procedure GetCxCy(var cx,cy:integer);
  7. Procedure CoordLines(cx,cy:integer);
  8. Procedure MyPixel(x,y:real;color:Tcolor);
  9.  
  10.  
  11. Procedure TfmAll.MyPixel(x,y:Real;color:Tcolor);
  12. begin
  13. imWork.canvas.pixels[Round(cx+x),round(cy-y)]:=Color;
  14. end;
  15.  
  16. Procedure TfmAll.CoordLines(cx,cy:Integer);
  17. begin
  18. myline(-cx,0,cx,0);
  19. myline(0,-cy,0,cy);
  20. end;
  21.  
  22. procedure TfmAll.GetCxCy(var cx,cy:integer);
  23. begin
  24. cx:=imWork.Width div 2;
  25. cy:=imWork.Height div 2;
  26. end;
  27.  
  28. procedure TfmAll.MyLine(x1,y1,x2,y2:real);
  29.  
  30. begin
  31. imWork.Canvas.MoveTo(round(cx+x1),round(cy-y1));
  32. imWork.Canvas.lineTo(round(cx+x2),round(cy-y2));
  33. end;
  34.  
  35.  
  36.  
  37.  
  38.  
  39. name plPen
  40. Width = 24
  41. Height = 22
  42. BevelOuter = bvNone
  43. Color = clBlack
  44.  
  45.  
  46.  
  47. name = ColorDialog
  48.  
  49. if ColorDialog.execute then
  50. begin
  51. imWork.Canvas.pen.color:=ColorDialog.color;
  52. plPen.color:=ColorDialog.color;
  53. end;


Brigina Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задала: Brigina (статус: Посетитель)
Вопрос отправлен: 20 января 2009, 04:27
Состояние вопроса: открыт, ответов: 0.


Мини-форум вопроса

Всего сообщений: 27; последнее сообщение — 22 января 2009, 13:55; участников в обсуждении: 3.

Страницы: [1] [2] [Следующая »]

min@y™

min@y™ (статус: Доктор наук), 20 января 2009, 08:19 [#1]:

Зачем изобретать велосипед, если всё вышеописанное (и ещё много чего) уже отлично реализовано в компоненте TChart?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
Вадим К

Вадим К (статус: Академик), 20 января 2009, 11:07 [#2]:

Абослютно не понимаю, в чем проблема. Если можете нарисовать один график, то кто мешает нарисовать два. Если не получается, то что как именно не получается.
Разметку осей.... нарисовать полоски и подписать циферки? или не знаем о функции TextOut ?
Масштабирование... ну тут чистая геометрия, где то 9-10 класс. Пишите, где проблемы, иначе помочь не сможем.

А собственно кода рисования графика я собственно и не увидел. Например я ожидал увидеть массив точек (или хоть какаю то их генерацию...)
Галочка "подтверждения прочтения" - вселенское зло.
Brigina

Brigina (статус: Посетитель), 20 января 2009, 13:36 [#3]:

Каждый график строится в своем окне. Когда я нажимаю на кнопку "Построить" у меня пропадает предыдушее изображение. А еще почему не меняется цвет заливки, хотя цвет графика меняется? Где-то у меня ошибка? Но заодно меняется цвет осей, а мне бы хотелось, чтобы они были черными. И не получается сделать кнопки для выбора типа линии графиков. Я их пробовала добавить на панель инструментов, они не срабатывают. Как применить для разметки функцию TextOut я не знаю. Маштабирование я имею ввиду, добавить кнопку на панель инструментов, чтобы нажав на нее, картинка увеличивалась.
Привожу коды модулей. Извините, если что не так.



unit Uall;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ExtDlgs, ImgList, ComCtrls, ToolWin;

type
TfmAll = class(TForm)
Panel1: TPanel;
ToolBar1: TToolBar;
plBrush: TPanel;
plPen: TPanel;
tbClear: TToolButton;
tbSave: TToolButton;
imWork: TImage;
ImageList1: TImageList;
ColorDialog: TColorDialog;
SavePictureDialog: TSavePictureDialog;
procedure plBrushClick(Sender: TObject);
procedure plPenClick(Sender: TObject);
procedure tbClearClick(Sender: TObject);
procedure tbSaveClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
cx,cy:longint;
procedure MyLine(x1,y1,x2,y2:real);
procedure GetCxCy(var cx,cy:integer);
procedure CoordLines(cx,cy:integer);
procedure MyPixel(x,y:real;color:Tcolor);

end;

var
fmAll: TfmAll;

implementation

{$R *.dfm}

{}
procedure TfmAll.MyPixel(x,y:Real;color:Tcolor);
begin
imWork.canvas.pixels[Round(cx+x),round(cy-y)]:=Color;
end;

{построение осей}
procedure TfmAll.CoordLines(cx,cy:Integer);
begin
myline(-cx,0,cx,0);
myline(0,-cy,0,cy);
end;

{начало координат}
procedure TfmAll.GetCxCy(var cx,cy:integer);
begin
cx:=imWork.Width div 2;
cy:=imWork.Height div 2;
end;

{границы изменения аргумента функции,
границы изменения значения функции}
procedure TfmAll.MyLine(x1,y1,x2,y2:real);
begin
imWork.Canvas.MoveTo(round(cx+x1),round(cy-y1));
imWork.Canvas.LineTo(round(cx+x2),round(cy-y2));
end;

{цвет кисти}
procedure TfmAll.plBrushClick(Sender: TObject);
begin
if ColorDialog.execute then
begin
imWork.Canvas.brush.color:=ColorDialog.color;
plBrush.color:=ColorDialog.color;
end;
end;

{цвет карандаша}
procedure TfmAll.plPenClick(Sender: TObject);
begin
if ColorDialog.execute then
begin
imWork.Canvas.pen.color:=ColorDialog.color;
plPen.color:=ColorDialog.color;
end;
end;

{очистить}
procedure TfmAll.tbClearClick(Sender: TObject);
begin
imWork.Picture:=nil;
imWork.Canvas.Pen.Color:=plPen.color;
imWork.Canvas.Brush.Color:=plBrush.color;
end;

{сохранить рисунок}
procedure TfmAll.tbSaveClick(Sender: TObject);
begin
if SavePictureDialog.Execute then
imWork.Picture.bitmap.SaveToFile(SavePictureDialog.filename);
end;

procedure TfmAll.FormClose(Sender: TObject; var Action: TCloseAction);
begin
cleanupinstance;
release;
end;

procedure TfmAll.FormCreate(Sender: TObject);
begin
imWork.Picture:=nil;
color:=clWhite;
imWork.Canvas.brush.Color:=clWhite;
imWork.Canvas.pen.Color:=clBlack;
GetCxCy(cx,cy);
end;

end.

unit Umain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus;

type
TfmMain = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
miWindow: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
procedure N2Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmMain: TfmMain;

implementation
uses Unit1, Unit2, Unit3;
{$R *.dfm}

procedure TfmMain.N2Click(Sender: TObject);
begin
Close; {Файл\Выход - выход из программы}
end;

procedure TfmMain.N8Click(Sender: TObject);
begin
Tile; {Окна плиткой}
end;

procedure TfmMain.N9Click(Sender: TObject);
begin
Cascade; {Окна каскадом}
end;

{Построение графика функции в явном виде}
procedure TfmMain.N4Click(Sender: TObject);
begin
application.CreateForm(TfmFun1,fmFun1);
fmFun1.show;
end;

{Построение графика функции в параметрическом виде}
procedure TfmMain.N5Click(Sender: TObject);
begin
application.CreateForm(TfmFun2,fmFun2);
fmFun2.show;
end;

{Построение графика функции в полярных координатах}
procedure TfmMain.N6Click(Sender: TObject);
begin
application.CreateForm(TfmFun3,fmFun3);
fmFun3.show;
end;

end.

{График 1}
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Uall, ExtDlgs, ImgList, ComCtrls, ToolWin, ExtCtrls, StdCtrls;

type
TfmFun1 = class(TfmAll)
Label1: TLabel;
edMinX: TEdit;
Label2: TLabel;
edMaxX: TEdit;
Label3: TLabel;
edD: TEdit;
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmFun1: TfmFun1;

implementation

{$R *.dfm}

procedure TfmFun1.Button1Click(Sender: TObject);
var
kx,ky:real;
x,y,minX,maxX:real;
d,dx,dy:real;
function f(x:real):real;
var
temp:real;
begin
temp:=x*cos(x);
f:=temp;
end;
begin
tbClearClick(sender);
GetCxCy(cx,cy);
CoordLines(cx,cy);
maxX:=strtofloat(edMaxX.text);
minX:=strtofloat(edMinX.text);
dx:=MaxX-MinX;
dy:=dx;
kx:=(2*cx)/dx;
ky:=(2*cy)/dy;
d:=dx/strtoint(edD.text);
x:=MinX;
y:=f(x);
while x<=maxX do
begin
myline(kx*x,ky*y,kx*(x+d),ky*f(x+d));
x:=x+d;
y:=f(x);
Application.ProcessMessages;
end;
end;



end.

{График 2}
unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Uall, ExtDlgs, ImgList, ComCtrls, ToolWin, ExtCtrls, StdCtrls;

type
TfmFun2 = class(TfmAll)
Label1: TLabel;
edA: TEdit;
Label2: TLabel;
edB: TEdit;
Label3: TLabel;
edD: TEdit;
Button1: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmFun2: TfmFun2;

implementation

{$R *.dfm}

procedure TfmFun2.Button1Click(Sender: TObject);
var t,x,y,d,maxT:real;
a,b:integer;
function fx(t:real):real;
var temp:real;
begin
temp:=(a+b)*cos(t)-a*cos((a+b)*t/a);
fx:=temp;
end;
function fy(t:real):real;
var temp:real;
begin
temp:=(a+b)*sin(t)-a*sin((a+b)*t/a);
fy:=temp;
end;
function nod(a,b:integer):integer;
begin
if (a=0)or(b=0) then nod:=a+b
else
begin
if a>b then nod:=nod(b,a mod b)
else nod:=nod(a,b mod a);
end;
end;
begin
tbClearClick(sender);
GetCxCy(cx,cy);
coordlines(cx,cy);
a:=strtoint(edA.text);
b:=strtoint(edB.text);
d:=strtofloat(edD.text);
t:=0;
x:=fx(t);
y:=fy(t);
if (b mod a)=0 then maxT:=2*pi
else maxT:=2*pi*(a/nod(a,b));
while t<=maxT do
begin
myline(x,y,fx(t+d),fy(t+d));
x:=fx(t+d);
y:=fy(t+d);
t:=t+d;
application.processMessages;
end;
end;


end.

{График 3}
unit Unit3;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Uall, ExtDlgs, ImgList, ComCtrls, ToolWin, ExtCtrls, StdCtrls;

type
TfmFun3 = class(TfmAll)
Label1: TLabel;
edA: TEdit;
Label2: TLabel;
edK: TEdit;
Label3: TLabel;
edD: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
fmFun3: TfmFun3;

implementation

{$R *.dfm}

procedure TfmFun3.Button1Click(Sender: TObject);
var t,x,y,d,k,maxT:real;
a:integer;
function fx(t:real):real;
var temp:real;
begin
temp:=a*sin(k*t)*cos(t);
fx:=temp;
end;

function fy(t:real):real;
var temp:real;
begin
temp:=a*sin(k*t)*sin(t);
fy:=temp;
end;

begin
tbClearClick(sender);
GetCxCy(cx,cy);
coordlines(cx,cy);
a:=strtoint(edA.text);
k:=strtofloat(edK.text);
d:=strtofloat(edD.text);
t:=0;
x:=fx(t);
y:=fy(t);
if frac(k)=0 then maxT:=2*pi
else if k>1 then maxT:=4*pi*k
else maxT:=4*pi/k;
while t<=maxT do
begin
myline(x,y,fx(t+d),fy(t+d));
x:=fx(t+d);
y:=fy(t+d);
t:=t+d;
application.processMessages;
end;
end;

end.
Вадим К

Вадим К (статус: Академик), 20 января 2009, 13:59 [#4]:

А можно это оформить в виде архивчика и выложить где нибудь? только exe не надо туда добавлять.
Но даже так могу сказать, что код ужасный, для каждой функции оформлена своя форма.... с почти идентичным кодом...
Галочка "подтверждения прочтения" - вселенское зло.
min@y™

min@y™ (статус: Доктор наук), 20 января 2009, 14:21 [#5]:

Ну чем TChart-то не устраивает, а?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
Brigina

Brigina (статус: Посетитель), 20 января 2009, 14:22 [#6]:

Спасибо что взялись мне помочь! Для меня это очень важно.
Что-то сильно сложного мне и не нужно. Я делаю эту программу по книжке,а там было так. Вот, а теперь мне нужно ее усовершенствовать.
Я ведь еще только учусь.
Архив с программой разместила по адресу http://webfile.ru/2567611
Вадим К

Вадим К (статус: Академик), 20 января 2009, 14:23 [#7]:

Ну хочет человек научиться строить графики, что тут плохого? Иногда, что бы использовать чужие велосипеды и уметь гнуть их до нужной кондиции, надо уметь написать свой, хотя бы с квадратными колёсами и двигателем с боинга. Другое дело, если пишеться продакшн код...
Галочка "подтверждения прочтения" - вселенское зло.
Brigina

Brigina (статус: Посетитель), 20 января 2009, 14:24 [#8]:

А чем TChart лучше?
Вадим К

Вадим К (статус: Академик), 20 января 2009, 14:28 [#9]:

Он просто умеет строить разные графики, масштабировать и прочие прелести. Даже вертеть графики:)
Галочка "подтверждения прочтения" - вселенское зло.
Brigina

Brigina (статус: Посетитель), 20 января 2009, 15:02 [#10]:

Попробую потом и им тоже сделать.
min@y™

min@y™ (статус: Доктор наук), 20 января 2009, 15:26 [#11]:

Посмотри сначала его возможности. Может после этого и не понадобится велосипед с квадратными колёсами и двигателем с боинга (© Вадим К).
Скомпили и запусти демо-проект, который в файле <Каталог Delphi >\Demos\TeeChart\teedemo.dpr, и посмотри, что можно наворотить с помощью этого компонента. Даже прислать могу готоый EXE, если не сможешь найти.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
Brigina

Brigina (статус: Посетитель), 21 января 2009, 13:39 [#12]:

>\Demos\TeeChart\teedemo.dpr посмотрела. Мне не понравилось, если честно.
И это не совсем то, что нужно. Дело ведь не в эффектах. И потом, я хочу доделать свое. Пусть с квадратными колесами, но тем не менее.
Нашла процедуру для выбора типов линий. Но у меня она не работает.
procedure TForm1.SetPenStyle(Sender: TObject);
begin
with Image.Canvas.Pen do
begin
if Sender = SolidPen then Style := psSolid
else if Sender = DashPen then Style := psDash
else if Sender = DotPen then Style := psDot
else if Sender = DashDotPen then Style := psDashDot
else if Sender = DashDotDotPen then Style := psDashDotDot
else if Sender = ClearPen then Style := psClear;
end;
end;
Вадим К

Вадим К (статус: Академик), 21 января 2009, 14:38 [#13]:

это работает только в том случае, если толщина линии один пиксель.
Галочка "подтверждения прочтения" - вселенское зло.
Brigina

Brigina (статус: Посетитель), 21 января 2009, 15:05 [#14]:

Не работает все равно почему-то :( хоть и толщина 1.
Вадим К

Вадим К (статус: Академик), 21 января 2009, 15:16 [#15]:

показывайте код, который вызывает эту процедуру.
Галочка "подтверждения прочтения" - вселенское зло.
min@y™

min@y™ (статус: Доктор наук), 21 января 2009, 15:27 [#16]:

DashPen, DotPen, DashDotPen и т.п. - это, как я понял, TRadioButton'ы. Проверь, вполняется ли этот обработчик их собития OnClick. Может он не вызывается, потому что банально не назначен в инспекторе?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
Brigina

Brigina (статус: Посетитель), 21 января 2009, 16:11 [#17]:

Я делала как написано в справке:
1 Select all six pen-style buttons and select the Object Inspector|Events|OnClick event and in the Handler column, type SetPenStyle.

The Code editor generates an empty click-event handler called SetPenStyle and attaches it to the OnClick events of all six buttons.

2 Fill in the click-event handler by setting the pen's style depending on the value of Sender, which is the control that sent the click event:

procedure TForm1.SetPenStyle(Sender: TObject);
begin
with Canvas.Pen do
begin
if Sender = SolidPen then Style := psSolid
else if Sender = DashPen then Style := psDash
else if Sender = DotPen then Style := psDot
else if Sender = DashDotPen then Style := psDashDot
else if Sender = DashDotDotPen then Style := psDashDotDot
else if Sender = ClearPen then Style := psClear;

end;
end;

(Кроме else if Sender = ClearPen then Style := psClear;).
Эффекта ноль.
При этом если делать отдельно:
procedure TForm1.DashPenClick(Sender: TObject);
begin
Image1.Canvas.Pen.Style:=psDash;
end;

procedure TForm1.DotPenClick(Sender: TObject);
begin
Image1.Canvas.Pen.Style:=psDot;
end;

то стиль лиии меняется. Правда меняется и тип линий координатных осей тоже :(.
Brigina

Brigina (статус: Посетитель), 21 января 2009, 16:13 [#18]:

Задала толщину рисования координат Pen.Width:=2, чтобы они оставались сплошными. Но наверное есть другой способ?
Я пока тренируюсь на другом графике, чтобы не испортить свою программу.
Brigina

Brigina (статус: Посетитель), 21 января 2009, 16:21 [#19]:

DashPen, DotPen, DashDotPen и т.п - TSpeedButton
min@y™

min@y™ (статус: Доктор наук), 21 января 2009, 16:57 [#20]:

Ну, а выполнение доходит до этого обработчика? Поставь там брейкпойнт на строке "if Sender = SolidPen then..." и потыкай на кнопки. Остановится там выполнение или нет? Если нет, то чначи этот обработчик не назначен собитиям OnClick кнопок.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!

Страницы: [1] [2] [Следующая »]

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.

Версия движка: 2.6+ (26.01.2011)
Текущее время: 29 февраля 2020, 11:15
Выполнено за 0.02 сек.
Рейтинг@Mail.ru