|
|
Регистрация Восстановить пароль |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
17.04.2008, 13:01 | #1 |
Пользователь
Регистрация: 17.04.2008
Сообщений: 16
|
на координатной плоскости, координаты в ручную
Здрасьте народ,
у мну к вам такой вопрос как сделать на дельфи что бы на координатной плоскости мы сами выставляли координаты в ручную...? Последний раз редактировалось Proskurin; 17.04.2008 в 13:18. |
17.04.2008, 13:32 | #2 |
Участник клуба
Регистрация: 12.10.2007
Сообщений: 1,204
|
Что-то не нравится мне идея вручную проставлять координаты.
До редактирования сообщения там было что-то про фотографию. Зря вы убрали подробности. Теперь непонятно о чем речь. Наверное ось, на которой координаты неравномерны, направлена от фотографа вглубь к линии горизонта. Координаты неравномерны из-за перспективы. Эту зависимость можно просчитать. Получим что-то вроде этого: |.......|......|.....|....|..|..|.| | Для задания координат достаточно будет движка, которым будем регулировать грубину перспективы. Для реализации этой идеи нужно почитать о перспективных проекциях и подобрать формулу. Если особой точности не требуется, можно использовать логарифмическую зависимость. Последний раз редактировалось alexBlack; 17.04.2008 в 13:39. |
17.04.2008, 13:48 | #3 |
*
Старожил
Регистрация: 22.11.2006
Сообщений: 9,201
|
Возможно, автор хочет по нажатию мышкой фиксировать и отображать координаты точки, где было произведено нажатие?
|
17.04.2008, 16:26 | #4 | |
Пользователь
Регистрация: 17.04.2008
Сообщений: 16
|
Цитата:
-------------------------------------------------------------------- Ладно будущие коллеги))) спасибо дома покумекаю и сделаю... код проги убрал потому что он большой был )) спасибо за реагирование! |
|
18.04.2008, 10:06 | #5 |
Пользователь
Регистрация: 17.04.2008
Сообщений: 16
|
Сделано :-)
Все народ сделал) думаю наверное надобно быть выложить код сюда) вдруг кому нить понадобиться такая тема) чуть позже выложу код... ща вот только курсовую до конца доделаю и выложу)
|
18.04.2008, 13:31 | #6 |
Пользователь
Регистрация: 17.04.2008
Сообщений: 16
|
unit Unit1;
interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Buttons, jpeg, Mask, ExtDlgs; type TForm1 = class(TForm) Panel1: TPanel; Edit1: TEdit; Label1: TLabel; Edit2: TEdit; Image1: TImage; Y: TBevel; X: TLabel; OpenPictureDialog1: TOpenPictureDialog; Button1: TButton; CheckBox1: TCheckBox; Memo1: TMemo; CheckBox2: TCheckBox; CheckBox3: TCheckBox; Procedure XY(Sender: TObject); procedure Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Button1Click(Sender: TObject); procedure CheckBox3Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; Ms : Array[1..1000,1..2] of integer; Max : Integer; implementation {$R *.DFM} Procedure TForm1.XY(Sender: TObject); var Mem,i:integer; begin if CheckBox2.Checked then begin Mem:=Memo1.Width+10; Memo1.Visible:=true; end else begin Memo1.Visible:=false; Mem:=0; end; image1.Width:=form1.width-20-Mem; image1.Height:=form1.Height-95; form1.Refresh; for i:=0 to form1.Height-100 do begin Canvas.Pen.Color := clblack; if i/10=round(i/10) then form1.Canvas.Rectangle(10,panel1.to p-10-i,15,panel1.top-11-i); if i>10 then begin if i/100=round(i/100) then begin Canvas.Pen.Color := clblack; if CheckBox1.Checked then form1.Canvas.Rectangle(10,panel1.to p-10-i,form1.Width-11,panel1.top-11-i); Canvas.Pen.Color := clRed; form1.Canvas.Rectangle(10,panel1.to p-10-i,20,panel1.top-12-i); end; end end; for i:=0 to form1.Width-30-Mem do begin Canvas.Pen.Color := clBlack; if i/10=round(i/10) then form1.Canvas.Rectangle(10+i,panel1. top-10,11+i,panel1.top-15); if i>10 then begin if i/100=round(i/100) then begin Canvas.Pen.Color := clblack; if CheckBox1.Checked then form1.Canvas.Rectangle(10+i,panel1. top-10,11+i,10); Canvas.Pen.Color := clRed; form1.Canvas.Rectangle(10+i,panel1. top-10,12+i,panel1.top-20); end; end; end; end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Var Sx:String; i,j,My:integer; begin Sx:=''; Y:=Image1.Height-y; if CheckBox3.Checked then begin Sx:=InputBox('Ввод пользовательского значения', 'Введите число', '0'); Max:=Max+1; Ms[Max,1]:=y; Ms[Max,2]:=StrToInt(Sx); end; if not CheckBox3.Checked then begin if Max=0 then begin memo1.lines.add('Точки не заданы'); exit; end; if Max<2 then begin memo1.lines.add('Задано мало точек'); exit; end; if Ms[1,1]>y Then begin memo1.lines.add('Точка за пределами задданого диапазона'); exit; end; if Ms[Max,1]<y Then begin memo1.lines.add('Точка за пределами задданого диапазона'); exit; end; i:=Max; While Ms[i,1]>y do i:=i-1; My:=Ms[i,2]+Round(((Ms[i+1,2]-Ms[i,2])/(Ms[i+1,1]-Ms[i,1]))*(y-Ms[i,1])); Sx:=IntToStr(My); end; memo1.Lines.Add('Y:'+IntToStr(y)+'; R:'+Sx); Edit1.text:=Sx; Edit2.text:=IntToStr((y)); end; procedure TForm1.Button1Click(Sender: TObject); var fn:String; begin OpenPictureDialog1.Execute; fn:=OpenPictureDialog1.FileName; if fn<>'' then Image1.Picture.LoadFromFile(fn); end; procedure TForm1.CheckBox3Click(Sender: TObject); var j,i,a,b:Integer; begin if CheckBox3.Checked then begin memo1.Lines.clear; Max:=0; end else begin for i:=Max-1 downto 1 do for J:=1 to i do if Ms[j,1]>Ms[j+1,1] then begin a:=Ms[j,1]; b:=Ms[j,2]; Ms[j,1]:=Ms[j+1,1]; Ms[j,2]:=Ms[j+1,2]; Ms[j+1,1]:=a; Ms[j+1,2]:=b; end; Memo1.Lines.Clear; for i:=1 to Max do begin memo1.Lines.Add('Y:'+IntToStr(Ms[i,1])+';R:'+IntToStr(Ms[i,2])); end; end; end; end. |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
точки плоскости, заданные своими координатами, попадают в круг с радиусом R | Jondeer | Общие вопросы C/C++ | 6 | 16.06.2008 00:06 |
Создание координатной сетки на компоненте Image | Thasraney | Общие вопросы Delphi | 5 | 03.06.2008 14:16 |
Нарисовать на координатной площади линию a*x+b*y+c=0 | НУБ!!! | Общие вопросы Delphi | 4 | 13.05.2008 22:48 |
Написать класс - прямые на плоскости. | Red Devel | Помощь студентам | 7 | 22.01.2008 15:23 |