|
Вопрос # 2 319/ вопрос открыт / |
|
Здравствуйте, уважаемые эксперты!
Пишу программу для построения графиков функции. В связи с чем у меня возникли вопросы.
1. Как составить процедуру для разметки осей?
2. Необходимо реализовать возможность вывода на одно координатное поле нескольких графиков. Не знаю как. У меня получается только каждый график выводить отдельно.
3. Необходимо реализовать масштабирование, настройки цвета и типа линии графиков.
(Настройки цвета линий графиков я реализовала, а вот масштабирование и тип линии не получается).
В приложении код построения линий координат и код выбора цвета линии.
Буду очень благодарна за помощь и объяснение.
Приложение: Переключить в обычный режим-
-
-
- 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);
-
-
- 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;
-
-
-
-
-
- name plPen
- Width = 24
- Height = 22
- BevelOuter = bvNone
- Color = clBlack
-
-
-
- name = ColorDialog
-
- if ColorDialog.execute then
- begin
- imWork.Canvas.pen.color:=ColorDialog.color;
- plPen.color:=ColorDialog.color;
- end;
 |
Вопрос задала: Brigina (статус: Посетитель)
Вопрос отправлен: 20 января 2009, 04:27
Состояние вопроса: открыт, ответов: 0.
|
Мини-форум вопроса
Всего сообщений: 27; последнее сообщение — 22 января 2009, 13:55; участников в обсуждении: 3.
Страницы: [1] [2] [Следующая »]
|
min@y™ (статус: Доктор наук), 20 января 2009, 08:19 [#1]:
Зачем изобретать велосипед, если всё вышеописанное (и ещё много чего) уже отлично реализовано в компоненте TChart?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
Вадим К (статус: Академик), 20 января 2009, 11:07 [#2]:
Абослютно не понимаю, в чем проблема. Если можете нарисовать один график, то кто мешает нарисовать два. Если не получается, то что как именно не получается.
Разметку осей.... нарисовать полоски и подписать циферки? или не знаем о функции TextOut ?
Масштабирование... ну тут чистая геометрия, где то 9-10 класс. Пишите, где проблемы, иначе помочь не сможем.
А собственно кода рисования графика я собственно и не увидел. Например я ожидал увидеть массив точек (или хоть какаю то их генерацию...)
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
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™ (статус: Доктор наук), 20 января 2009, 14:21 [#5]:
Ну чем TChart-то не устраивает, а?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Brigina (статус: Посетитель), 20 января 2009, 14:22 [#6]:
Спасибо что взялись мне помочь! Для меня это очень важно.
Что-то сильно сложного мне и не нужно. Я делаю эту программу по книжке,а там было так. Вот, а теперь мне нужно ее усовершенствовать.
Я ведь еще только учусь.
Архив с программой разместила по адресу http://webfile.ru/2567611
|
|
|
Вадим К (статус: Академик), 20 января 2009, 14:23 [#7]:
Ну хочет человек научиться строить графики, что тут плохого? Иногда, что бы использовать чужие велосипеды и уметь гнуть их до нужной кондиции, надо уметь написать свой, хотя бы с квадратными колёсами и двигателем с боинга. Другое дело, если пишеться продакшн код...
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
Brigina (статус: Посетитель), 20 января 2009, 14:24 [#8]:
А чем TChart лучше?
|
|
|
Вадим К (статус: Академик), 20 января 2009, 14:28 [#9]:
Он просто умеет строить разные графики, масштабировать и прочие прелести. Даже вертеть графики
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
Brigina (статус: Посетитель), 20 января 2009, 15:02 [#10]:
Попробую потом и им тоже сделать.
|
|
|
min@y™ (статус: Доктор наук), 20 января 2009, 15:26 [#11]:
Посмотри сначала его возможности. Может после этого и не понадобится велосипед с квадратными колёсами и двигателем с боинга (© Вадим К).
Скомпили и запусти демо-проект, который в файле <Каталог Delphi >\Demos\TeeChart\teedemo.dpr, и посмотри, что можно наворотить с помощью этого компонента. Даже прислать могу готоый EXE, если не сможешь найти.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
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 (статус: Посетитель), 21 января 2009, 15:05 [#14]:
Не работает все равно почему-то  хоть и толщина 1.
|
|
|
Вадим К (статус: Академик), 21 января 2009, 15:16 [#15]:
показывайте код, который вызывает эту процедуру.
Галочка "подтверждения прочтения" - вселенское зло.
|
|
|
min@y™ (статус: Доктор наук), 21 января 2009, 15:27 [#16]:
DashPen, DotPen, DashDotPen и т.п. - это, как я понял, TRadioButton'ы. Проверь, вполняется ли этот обработчик их собития OnClick. Может он не вызывается, потому что банально не назначен в инспекторе?
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
|
|
Brigina (статус: Посетитель), 21 января 2009, 16:13 [#18]:
Задала толщину рисования координат Pen.Width:=2, чтобы они оставались сплошными. Но наверное есть другой способ?
Я пока тренируюсь на другом графике, чтобы не испортить свою программу.
|
|
|
Brigina (статус: Посетитель), 21 января 2009, 16:21 [#19]:
DashPen, DotPen, DashDotPen и т.п - TSpeedButton
|
|
|
min@y™ (статус: Доктор наук), 21 января 2009, 16:57 [#20]:
Ну, а выполнение доходит до этого обработчика? Поставь там брейкпойнт на строке "if Sender = SolidPen then..." и потыкай на кнопки. Остановится там выполнение или нет? Если нет, то чначи этот обработчик не назначен собитиям OnClick кнопок.
Делаю лабы и курсачи по Delphi и Turbo Pascal. За ПИВО! Пишите в личку, а лучше в аську. А ещё лучше - звоните в скайп!
|
Страницы: [1] [2] [Следующая »]
Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
|
.