/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 435
от 06.04.2006, 06:35

Вопрос № 39.032

На кнопку поставил обработчик, который меняет значение "HKEY_CURRENT_USERSoftwareMicrosoftInternet ExplorerMainyesno" c "yes" на "no" и обратно (отключение/выключение картинок в IE). Допустим значение сначала - "no"... запускаю IE, картинок нет. В программе нажимаю кнопку, значение становится "yes", в IE открываю какой-нибудь сайт - а картинки по прежнему не отображаются. Если запустить новое окно Internet Explorer-a, то в нем картинки уже отображаются. Почему такое происходит и как это исправить?

Отправлен: 31.03.2006, 11:09 Вопрос задал: Rusland (статус: Специалист) Всего ответов: 5 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Полховский Александр Владимирович Здравствуйте, Rusland! Очевидно. IE грузит настройки при запуске. Запускает - грузит. НЕ запускает - НЕ грузит. Реестр ведь задумывался как замена ini-файлам (то есть настроечным, инициализирующим). Не будет же он на каждом шаге проверять, не наклацал ли кто-нибудь там чего-нибудь. Вот посмотрите Вы на расписание, скажем, телепередач, увидите любимый фильм в 21:00. И до 21:00 будете планировать всё так, чтобы успеть. И не будете заглядывать каждую минуту, скажем, на WEB-сайт, проверяя, не изменилось ли чего. Так и тут. Исправить... хмм... да, пожалуй, только переоткрыв IE с теми же параметрами. --------- Спасём нашу хрупкую планету !

Ответ отправил: Полховский Александр Владимирович (статус: Практикант) Ответ отправлен: 31.03.2006, 12:27

Отвечает: Kazakh Здравствуйте, Rusland! Попробуйте после закрытия ключа (RegCloseKey) оповестить систему о смене значения в реестре, используя функцию PostMessage( HWND hWnd, // handle of destination window UINT Msg, // message to post WPARAM wParam, // first message parameter LPARAM lParam // second message parameter ); Оповестить можно только Броузер (указав хэндл броузера), но лучше оповестить все окна, задав первый параметр равным HWND_BROADCAST. К сожалению не помню, какое сообщение надо отправлять :-( Но может уважаевмые эксперты дополнят меня. --------- Если собеседник затрудняется ответить, значит, вопрос поставлен правильно.

Ответ отправил: Kazakh (статус: 5-ый класс) Ответ отправлен: 31.03.2006, 13:07 Оценка за ответ: 5 Комментарий оценки: Спасибо, попробую.

Отвечает: Ataman N. N. Здравствуйте, Rusland! Посылайте Internet Explorer-у сообщение WM_WININICHANGE. Должно работать.

Ответ отправил: Ataman N. N. (статус: 10-ый класс) Ответ отправлен: 31.03.2006, 17:04 Оценка за ответ: 5 Комментарий оценки: Спасибо.

Отвечает: Tamashev Denis M Здравствуйте, Rusland! А F5 нажимать не пробовал ? 8) Можно эмулировать нажатие на F5 при нажатии на кнопку !!! Удачи ! А в остальном тебе всё сказали !

Ответ отправил: Tamashev Denis M (статус: 2-ой класс) Ответ отправлен: 31.03.2006, 17:50 Оценка за ответ: 3 Комментарий оценки: Ух ты, и как это я не догадался F5 нажать... без комментариев ;)

Отвечает: Данилевич Игорь Владимирович Здравствуйте, Rusland! После исследования Internet Explorer'а 6.0 выяснилось, что при своей работе каждый его экземпляр создает также невидимое окно класса "Internet Explorer_Hidden". Так вот этому невидимому окну нужно послать сообщение WM_SETTINGCHANGE и обновить по F5 видимое окно. Пример обновления всех окон Internet Explorer в приложении. P.S. Обновление содержимого по F5 лучше делать по-другому, а не посылкой WM_KeyDown / WM_KeyUp, поскольку это срабатывает только тогда, когда фокус ввода в конкретном окне имеет дочерний элемент управления (например строка ввода URL). В других версиях эксплорера названия классов может отличаться. Приложение: //посылаем извещение всем невидимым окнам эксплорера. function EnumProc(hWin:HWND; lp:LParam):BOOL; stdcall; var buffer:array[0..255] of char; len:integer; begin len := GetClassName(hWin, buffer, sizeof(buffer)); if (len>0) and (lstrcmpi(buffer, 'Internet Explorer_Hidden')=0) then SendMessage(hWin, WM_SETTINGCHANGE, 0, 0); Result := True; end; //обновляем все видимые окна эксплорера. function EnumProcUpdate(hWin:HWND; lp:LParam):BOOL; stdcall; var buffer:array[0..255] of char; len:integer; begin len := GetClassName(hWin, buffer, sizeof(buffer)); if (len>0) and (lstrcmpi(buffer, 'IEFrame')=0) then begin PostMessage(hWin, WM_KEYDOWN, VK_F5, 0); PostMessage(hWin, WM_KEYUP, VK_F5, 0); end; Result := True; end; procedure TForm1.Button1Click(Sender: TObject); var i:integer; begin EnumWindows(@EnumProc, 0); EnumWindows(@EnumProcUpdate, 0); end;

Ответ отправил: Данилевич Игорь Владимирович (статус: 1-ый класс) Ответ отправлен: 01.04.2006, 19:17 Оценка за ответ: 5 Комментарий оценки: Огромное спасибо. PS. Осталось только перевести код на CBuilder...

Вопрос № 39.059

Добрый день! У меня выскакивает ошибка при обработки такой строки, в чем ошибка? idhttp1.post('http://localhost/bla.txt',log); где log-string переменная! Заранее спасибо!

Отправлен: 31.03.2006, 15:51 Вопрос задал: Грицай Алексей Юрьевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Samum Здравствуйте, Грицай Алексей Юрьевич! >'this is no overloaded version of 'post' that can be called with this arguments' вот текст ошибки! Это означает, что вы передаете неправильные параметры процедуре! Второй аргумент не может быть типа String, это должен быть тип TSrtings или TStream. --------- Если бы программистам за их ошибки отрывали части тела, то в конце концов им пришлось бы использовать голову!

Ответ отправил: Samum (статус: Специалист) Ответ отправлен: 01.04.2006, 10:24 Оценка за ответ: 5

Вопрос № 39.068

Всем добрый день ! Вопрос: Как эмулировать нажатие на Mouse1 и на Mouse2 ?

Отправлен: 31.03.2006, 18:02 Вопрос задал: Tamashev Denis M (статус: 2-ой класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Ерёмин Андрей Здравствуйте, Tamashev Denis M! Вот пример. "Отпускать" кнопку обязательно, если нужно совершить нажатие. Если не отпускать - то можно что-нибудь "таскать" или выделять. { Эмуляция нажатия левой кнопки мыши в текущем месте курсора } mouse_event(MOUSEEVENTF_LEFTDOWN,MOUSEEVENTF_ABSOLUTE,MOUSEEVENTF_ABSOLUTE,0,0); mouse_event(MOUSEEVENTF_LEFTUP,MOUSEEVENTF_ABSOLUTE,MOUSEEVENTF_ABSOLUTE,0,0); { Правая кнопка } mouse_event(MOUSEEVENTF_RIGHTDOWN,MOUSEEVENTF_ABSOLUTE,MOUSEEVENTF_ABSOLUTE,0,0); mouse_event(MOUSEEVENTF_RIGHTUP,MOUSEEVENTF_ABSOLUTE,MOUSEEVENTF_ABSOLUTE,0,0); --------- Нет правила без исключений. Правило без исключений - исключение из правил.

Ответ отправил: Ерёмин Андрей (статус: Профессор) Россия, Тула WWW: Программирование на DELPHI: Всё для программиста. ICQ: 286837644 ---- Ответ отправлен: 31.03.2006, 18:37 Оценка за ответ: 5

Вопрос № 39.089

Здраствуйте уважаемые эксперты Как Можно програмно узнать какие порты открыты на компютере в данный момент, а именно открыт ли сейчас 80 и 21 порты? Поделитесь пожалуйста исходником. Заранее Спасибо.

Отправлен: 31.03.2006, 21:56 Вопрос задал: Станислав (статус: 1-ый класс) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: [TiER] Здравствуйте, Станислав! Для начала подключите модуль Registry в области uses. Затем на форму нужно будет вынести кнопку и многострочное текстовое поле класса TMemo. Ну и по нажатию на кнопку написать следующий код: procedure TForm1.Button1Click(Sender: TObject); var reg: TRegistry; st: TStrings; i: integer; begin reg := TRegistry.Create; reg.RootKey := HKEY_LOCAL_MACHINE; reg.OpenKey('hardwaredevicemapserialcomm', false); st := TStringList.Create; reg.GetValueNames(st); for i := 0 to st.Count - 1 do Memo1.Lines.Add(reg.ReadString(st.Strings[i])); st.Free; reg.CloseKey; reg.free; end;

Ответ отправил: [TiER] (статус: 1-ый класс) Ответ отправлен: 31.03.2006, 22:28

Отвечает: Артём Шегеда Здравствуйте, Станислав! Подозреваю, что простейшим способом проверки открытых портов на локальном компьютере будет создание серверных сокетов с перебором номеров портов. Вопрос, скорее, не по Delphi, а по Win32 API, но программа будет выглядеть примерно так: Приложение: const PortList : array [0..6] of integer = ( 21, 80, 800, 1080, 3128, 8000, 8080); var wsaData : WinSock.TWSAData; s : WinSock.TSocket; addr : WinSock.TSockAddr; i : integer; res : integer; begin if WSAStartup(MAKEWORD(2,0), wsaData)<>0 then exit; for i:=Low(PortList) to High(PortList) do begin s := socket(AF_INET, SOCK_STREAM, IPPROTO_IP); FillChar(addr,sizeof(addr),0); addr.sin_family := PF_INET; addr.sin_port := htons(PortList[i]); addr.sin_addr.S_addr := INADDR_ANY; bind(s,addr,sizeof(addr)); res := listen(s,SOMAXCONN); if res<>0 then ListBox1.Items.Add(IntToStr(PortList[i])); closesocket(s); end; WSACleanup;

Ответ отправил: Артём Шегеда (статус: 4-ый класс) Ответ отправлен: 31.03.2006, 23:49

Отвечает: Malysh Здравствуйте, Станислав! Вот готовый код, можно посмотреть любой диапазон портов: procedure TForm1.Button1Click(Sender: TObject); var i: Integer; ipstr: String; begin ipstr:= '127.0.0.1'; Memo1.Clear; if not InputQuery('Внимание', 'введите IP-адрес', ipstr) then exit; for i:=StrToInt(Edit1.Text) to StrToInt(Edit2.Text) do begin TcpClient1.RemotePort:=IntToStr(i); TcpClient1.Open; if TcpClient1.Connected then Memo1.Lines.Add(IntToStr(i)+' открыт') else Memo1.Lines.Add(IntToStr(i)+' закрыт'); Memo1.Update; TcpClient1.Close; end; end;

Ответ отправил: Malysh (статус: Студент) Ответ отправлен: 01.04.2006, 01:49

Вопрос № 39.094

Здравствуйте господа прогаммисты! У меня такая проблема: при использовании поиска по базе данных с дочерней формы-Locate опции не устанавливаются-при попытке скомпилировать проект обе опции выходят как не объявленные переменные, а если Locate вызывается с главной формы - все работает? Заранее спасибо!

Отправлен: 31.03.2006, 23:23 Вопрос задал: Leshiy2006 (статус: 6-ой класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Артём Шегеда Здравствуйте, Leshiy2006! Для того, чтобы можно было использовать необходимые типы и константы, следует подключить к дочерней формы после implementation модуль DB ... implementation uses   WinSock; ...

Ответ отправил: Артём Шегеда (статус: 4-ый класс) Ответ отправлен: 31.03.2006, 23:56 Оценка за ответ: 5 Комментарий оценки: Большое спасибо!

Вопрос № 39.097

Здравствуйте уважаемые эксперты! Помогите решить следующую проблему. В программе на событие FormCloseQuery отрабатывает такой код: (см прил.). Т.е. при выходе из проги, она спрашивает подтверждение на выход. Все работает отлично, но при выключении (перезагрузке) компа прога "выплёвывает" это сообщение, с виндой то всё в порядке она нормально выключается, но вот сам факт... :( Как можно, оставив прежний функционал, избавиться от проблемы, т.к. очень важно чтобы программу не закрыли случайно. Еще пробовал убирать кнопки из заголовка окна, и "делал свою кнопочку для закрытия": Style: Longint; ... Style:=GetWindowLong(Handle, GWL_STYLE); SetWindowLong(Handle, GWL_STYLE, Style And Not WS_SYSMENU); Но это помогало лишь частично, т.к. еще оставался заголовок окна на панели, и можно было там "без проблем" закрыть прогу. Ну, вроде все рассказал, как быть дальше?? Приложение: procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if Application.MessageBox('Вы действительно хотите выйти?', 'Подтверждение выхода', MB_OKCANCEL+MB_DEFBUTTON1+MB_ICONINFORMATION)=IDOK then begin //некоторые действия CanClose:=True; end else CanClose:=False; end;

Отправлен: 31.03.2006, 23:54 Вопрос задал: AnD1 (статус: 4-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Артём Шегеда Здравствуйте, And1! Используй обработчик сообщения WM_ENDSESSION. Подробнее - в "Win32 Programmer's reference", раздел "System Shutdown" Приложение: type TForm1 = class(TForm) procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); private { Private declarations } ENDSESSION_flag : boolean; procedure WMEndSession(var Msg: TMessage); message WM_ENDSESSION; public { Public declarations } end; implementation {$R *.dfm} procedure TForm1.WMEndSession(var Msg: TMessage); begin ENDSESSION_flag := true; end; procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if ENDSESSION_flag then exit; Application.MessageBox('Завершаемся вручную','Инфо',MB_OK); end;

Ответ отправил: Артём Шегеда (статус: 4-ый класс) Ответ отправлен: 01.04.2006, 00:11 Оценка за ответ: 5

Вопрос № 39.107

Здравствуйте, Уважаемые эксперты! 1. Как определить попадает ли точка с заданными координатами (например, (2R,0) см. приложение) в область прямоугольника (за исключением области прямоугольника ограниченной дугой) и треугольника, результат вывести в виде сообщения. Необходимо, чтобы координаты точки можно было вводить, например, через Edit. 2. Как закрасить каким-нибудь цветом вышеуказанные области (область ограниченная дугой не должна быть закрашена). Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls; type TForm1 = class(TForm) PaintBox1: TPaintBox; Panel1: TPanel; procedure FormPaint(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormPaint(Sender: TObject); var x0, y0: integer; // координаты начала координатных осей x, y: integer; lx, ly: real; // метки (оцифровка) линий сетки по X и Y const dXY = 50; // Шаг координатной сетки dlx: Real = 1.0 ; // шаг меток оси X dly: Real = 1.0; // шаг меток оси Y begin x0:= paintBox1.ClientWidth shr 1; // оси начинаются в центре y0:= paintBox1.ClientHeight shr 1; with PaintBox1.Canvas do begin pen.Color:= clblack; Pen.Style:= psSolid; Pen.Width:= 2; MoveTo(x0, y0); LineTo(x0, 0); // ось Y+ MoveTo(x0, y0); LineTo(x0, PaintBox1.Height); // ось Y- MoveTo(x0, y0); LineTo(PaintBox1.Width, y0); // ось X+ MoveTo(x0, y0); LineTo(0, y0); // ось X- Pen.Width:= 1; TextOut(x0 - 12, y0 + 4, '0'); // выводим 0 в точке пересечения осей // засечки, сетка и оцифровка по оси X+ x:= x0 + dXY; // переходим на место 1-й засечки на оси X+ lx:= dlx; // 1-я метка - единица repeat MoveTo(x, y0 - 3); LineTo(x, y0 + 3); // засечка TextOut(x - 8, y0 + 5, floattostr(lx) + 'R'); // оцифровка Pen.Style:= psDot; // линия - штрихпунктирная MoveTo(x, 0); LineTo(x, PaintBox1.Height); // линия сетки lx:= lx + dlx; // увеличиваем метку на шаг x:= x + dXY; // переходим к следующей засечке until (x > PaintBox1.Width); // засечки, сетка и оцифровка по оси X- lx:= 0; // обнуляем метку lx:= lx - dlx; // теперь метки отрицательные x:= x0 - dXY; // переходим на место 1-й засечки на оси X- repeat MoveTo(x, y0 - 3); LineTo(x, y0 + 3); TextOut(x - 8, y0 + 5, floattostr(lx) + 'R') ; // оцифровка MoveTo(x, 0); LineTo(x, PaintBox1.Height); // линия сетки lx:= lx - dlx; // уменьшаем метку на шаг, т. к. ось X- x:= x - dXY; // переходим к следующей засечке until (x < 0); // засечки, сетка и оцифровка по оси Y+ ly:=dly; // 1-я метка - единица y:=y0-dXY; // переходим на место 1-й засечки на оси Y+ repeat MoveTo(x0 - 3, y); LineTo(x0 + 3, y); // засечка TextOut(x0 - 12, y, FloatToStr(ly)+'R'); // оцифровка MoveTo(x0 + PaintBox1.Width, y); LineTo(0, y); // линия сетки ly:= ly + dly; // увеличиваем мету на шаг y:= y - dXY; // переходим к следующей засечке until (y < 0); // засечки, сетка и оцифровка по оси Y- ly:= 0; // обнуляем метку ly:= ly - dly; // отрицательные метки для оси Y- y:= y0 + dXY; // переходим на место 1-й засечки на оси Y- repeat MoveTo(x0 - 3, y);LineTo(x0 + 3, y); // засечка TextOut(x0 - 15, y, FloatToStr(ly)+'R'); // оцифровка MoveTo(x0 + PaintBox1.Width, y); LineTo(0, y); // линия сетки y:= y + dXY; // переходим к следующей засечке ly:= ly - dly; // уменьшаем метку на шаг т. к. Ось Y- until (y > PaintBox1.Height); pen.Style:=psSolid; pen.Width:=2; rectangle(x0,y0-2*dXY,x0+2*dXY,y0); arc(x0-dXY,y0-dXY,x0+dXY,y0+dXY,x0+dXY,y0,x0,y0-dXY); moveto(x0-2*dXY,y0); lineto(x0,y0+2*dXY); end; end; end.

Отправлен: 01.04.2006, 04:05 Вопрос задал: Solovej (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Полховский Александр Владимирович Здравствуйте, Solovej! С прямоугольником всё просто. Необходимо выполнение следующих условий: координата X правее левой стороны прямоугольника; координата X левее правой стороны прямоугольника; координата Y ниже верхней стороны прямоугольника; координата Y выше нижней стороны прямоугольника; Что касается дуги, то тут несколько сложнее. Для начала общее уравнение для эллипса: (x-x0)²/a²+(y-y0)²/b²=1; x0, y0 - координаты центра эллипса; a, b - горизонтальная и вертикальная полуоси. В зависимости от того, в какой части прямоугольника Вам "позволено" разместить точку (внутри или за эллипсом), сравниваете вышенаписанное выражение с 1. Если оно больше 1, то точка находится за пределами эллипса, если меньше - внутри. Если равно - на линии эллипса. В итоге: вводите координаты в какие-нибудь, скажем, Edit1 и Edit2. Преобразуете их из строки в число функцией StrToInt (ну или StrToFloat, если проверяете нецелые координаты). Подставляем координаты в выражение (x-x0)²/a²+(y-y0)²/b², сравниваем полученное число с 1 и выводим сообщение. Вот Вам пример для прямоугольника, левая верхняя вершина которого находится в точке (20, 20), а правая нижняя - (80, 40), и эллипса с параметрами x0=70; y0=35; a=50; b=30. xp1:=20; yp1:=20; xp2:=80; yp2:=40;//координаты вершин прямоугольника x0:=70; y0:=35; a:=50; b:=30;//параметры эллипса x1:=StrToInt(Edit1.Text); y1:=StrToInt(Edit2.Text);//проверяемые координаты Number1:=sqr(x1-x0)/sqr(a)+sqr(y1-y0)/sqr(b); if x1>xp1 and x1yp1 and y1 and Number1<1//находится внутри эллипса then application.MessageBox('Точка попадает в нужную область', 'Результат') else application.MessageBox('Точка НЕ попадает в нужную область', 'Результат'); Добавлю только, что раз Вы рисуете это в стандартной координатной сетке, то не забывайте, что ось Y в Delphi направлена вниз, а не вверх. Немного о треугольнике. Здесь, в отличие от прямоугольника, сравнивать координаты точки с координатами вершин не получится. Вместо этого надо выявить положение точки относительно всех трёх сторон треугольника. Для этого будем руководствоваться некоторыми очевидными принципами: Из всех трёх вершин должна быть хотя бы одна, находящаяся выше заданной точки, иначе точка не лежит в треугольнике. Из всех трёх вершин должна быть хотя бы одна, находящаяся ниже заданной точки, иначе точка не лежит в треугольнике. Оставшаяся вершина должна находиться по ту же сторону от прямой, соединяющей первые две вершины (о которых говорилось в пунктах I и II), что и проверяемая точка, иначе точка не лежит в пределах треугольника. Точка должна находиться ниже прямой, соединяющей верхнюю вершину (из пункта I) и третью вершину треугольника, иначе точка лежит за пределами треугольника. Точка должна находиться выше прямой, соединяющей нижнюю вершину (из пункта II) и третью вершину треугольника, иначе точка лежит за пределами треугольника. Чтобы определить, находится ли вершина в той же полуплоскости от стороны треугольника (с той же стороны от неё), что и точка, проще всего сравнить пару координат: обе координаты x должны одинаково лежать относительно коорддинат x точек, отмечаемых горизонтальными прямыми на стороне треугольника, проведёнными через заданную точку и через третью вершину; обе координаты y должны одинаково лежать относительно коорддинат y точек, отмечаемых вертикальными прямыми на стороне треугольника, проведёнными через заданную точку и через третью вершину. Чтобы решить, каким условием пользоваться (достаточно совпадение хотя бы одного из них), нужно проверить, не является ли сторона треугольника (из пункта III) горизонтальной или вертикальной. Если она вертикальна, то проверяем условие из пункта 1, ели горизонтальна - из пункта 2. Если ни то, ни другое - можно использовать любое условие. Вот так ищутся координаты x точек, отмечаемых горизонтальными прямыми на стороне треугольника: XX=x1+[(x2-x1)/(y2-y1)]*(Y-y1); XX - искомая координата; x1, y1 - координаты одной из вершин, которые соединяет исследуемая сторона треугольника; x2, y2 - координаты другой вершини, которую соединяет с первой исследуемая сторона треугольника; Y - координата y заданной точки. А вот так ищутся координаты y точек, отмечаемых горизонтальными прямыми на стороне треугольника: YY=y1+[(y2-y1)/(x2-x1)]*(X-x1); YY - искомая координата; x1, y1 - координаты одной из вершин, которые соединяет исследуемая сторона треугольника; x2, y2 - координаты другой вершини, которую соединяет с первой исследуемая сторона треугольника; X - координата x заданной точки. Теперь сядьте на стул, возьмите кружечку чая (миллилитров так на 500), аккуратненько нарисуйте всё, о чём я выше сказал, пораскиньте мозгами (только не раскидайте все), и всё получится. --------- Спасём нашу хрупкую планету !

Ответ отправил: Полховский Александр Владимирович (статус: Практикант) Ответ отправлен: 01.04.2006, 08:53 Оценка за ответ: 5

Отвечает: Артём Шегеда Здравствуйте, Solovej! Если использовать функции Win32 API для работы с регионами, то можно описать правило проверки любой экранной координаты на предмет попадания в заданную область (реализация поставленной задачи в приложении). Если же необходимо проверять не экранные координаты, а координаты, задаваемые вещественым числом, то лучше использовать уравнения кривых, ограничивающих заданную область. Например, принадлежность точки треугольнику проверяется следующим образом: точка лежит в треугольнике, если хотя бы одна сторона находится левее точки, хотя бы одна сторона находится правее точки, хотя бы одна сторона находится выше точки и хотя бы одна сторона находится ниже точки. Приложение: type TForm1 = class(TForm) PaintBox1: TPaintBox; Button1: TButton; Edit1: TEdit; Edit2: TEdit; Edit3: TEdit; procedure FormPaint(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } rgn : THandle; x0, y0: integer; // координаты начала координатных осей public { Public declarations } end; var Form1: TForm1; implementation const dXY = 50; // Шаг координатной сетки dlx: Real = 1.0 ; // шаг меток оси X dly: Real = 1.0; // шаг меток оси Y {$R *.dfm} procedure TForm1.FormPaint(Sender: TObject); var x, y: integer; lx, ly: real; // метки (оцифровка) линий сетки по X и Y tmp_rgn1 : THandle; Points : array [0..2] of TPoint; begin x0:= paintBox1.ClientWidth shr 1; // îñè íà÷èíàþòñÿ â öåíòðå y0:= paintBox1.ClientHeight shr 1; with PaintBox1.Canvas do begin pen.Color:= clblack; Pen.Style:= psSolid; Pen.Width:= 2; brush.Color := PaintBox1.Color; /// .... здесь код не менялся if rgn<>0 then // если область ранее создавалась, то удалим её DeleteObject(rgn); rgn := CreateRectRgn(x0,y0-2*dXY,x0+2*dXY,y0); // создадим прямоугольную область tmp_rgn1 := CreateEllipticRgn(x0-dXY,y0-dXY,x0+dXY,y0+dXY); // создадим эллиптическую область CombineRgn(rgn, rgn, tmp_rgn1, RGN_DIFF); // вычтем из прямоугольной эллиптическую DeleteObject(tmp_rgn1); // уничтожим эллиптическую Points[0] := Point(x0-2*dXY,y0); Points[1] := Point(x0,y0+2*dXY); Points[2] := Point(x0,y0); // создали массив углов треугольника tmp_rgn1 := CreatePolygonRgn(Points, 3, WINDING); // создали треугольную область CombineRgn(rgn, rgn, tmp_rgn1, RGN_OR); // объединили треугольную и сложную области DeleteObject(tmp_rgn1); // уничтожим треугольную brush.Color := clWhite; PaintRgn(Handle,rgn); // закрасили сложную область pen.Style:=psSolid; pen.Width:=2; rectangle(x0,y0-2*dXY,x0+2*dXY,y0); arc(x0-dXY,y0-dXY,x0+dXY,y0+dXY,x0+dXY,y0,x0,y0-dXY); moveto(x0-2*dXY,y0); lineto(x0,y0+2*dXY); end;

Ответ отправил: Артём Шегеда (статус: 4-ый класс) Ответ отправлен: 01.04.2006, 09:27 Оценка за ответ: 5

© 2001-2006, Портал RusFAQ.ru, Россия, Москва. Идея, дизайн, программирование: Калашников О.А. Email: adm@rusfaq.ru, Тел.: +7 (926) 535-23-31 Авторские права | Реклама на портале Версия системы: 4.21 от 03.04.2006