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

Выпуск № 913
от 02.09.2007, 21:35

Вопрос № 99.916

Здравствуйте, Уважаемые эксперты!!! Помогите, пожалуйста, найти, в чем ошибка. Программа подсчитывает сумму и произведение чисел, которые вводит пользователь с клавиатуры, после того как будет введен ноль, ввод чисел заканчивается и выводится вычисление. Но почему-то сумма чисел выводится, а вот произведение чисел все-время равно нулю. Подскажите в чем дело? Заранее ОГРОМНОЕ СПАСИБО!!!:-) Приложение: Var x:integer; Summa: integer; Proizv:integer; Begin Summa:=0; Proizv:=1; Repeat Writeln ('Введите число'); Readln (x); If x<0 then Continue; Proizv:=Proizv*x; Summa:=Summa + x; Until x=0; Writeln ('Сумма чисел = ', Summa); Writeln ('Произведение чисел = ', Proizv); Readln; end.

Отправлен: 27.08.2007, 22:53 Вопрос задала: Алена (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Gh0stik Здравствуйте, Алена! Все достаточно просто, Вы же при вводе числа НОЛЬ автоматически в цикле умножаете произведение на это число, следовательно оно и становиться нулевым. ;) Вот пример переработанного кода: Var x:integer; Summa: integer; Proizv:integer; Begin Summa:=0; Proizv:=1; Writeln ('Введите число'); Readln (x); while x<>0 do begin if x<0 then Continue; {По-моему так будет более правильно :) } Эксперт sir henry Proizv:=Proizv*x; Summa:=Summa + x; Writeln ('Введите число'); Readln (x); end; Writeln ('Сумма чисел = ', Summa); Writeln ('Произведение чисел = ', Proizv); Readln; end. Good Luck!!! --------- Господь Бог - это всего лишь сверхмощный генератор случайных чисел, в соответствии с которыми сочетаются события на Земле. Генератор случайных чисел - и только.

Ответ отправил: Gh0stik (статус: Профессор) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) ICQ: 289363162 ---- Ответ отправлен: 27.08.2007, 23:10 Оценка за ответ: 5 Комментарий оценки: Спасибо!:-) И Вам удачи!!!

Отвечает: Vlad Cepesh Здравствуйте, Алена! В данном примере условием выхода из цикла явлется х=0, и по этому произведение всегда будет равно 0. Если необходимо, чтобы сумма и произведение выводились после каждого ввода числа, то необходимо Writeln ('Сумма чисел = ', Summa); Writeln ('Произведение чисел = ', Proizv); Поставить перед Until x=0;

Ответ отправил: Vlad Cepesh (статус: 3-ий класс) Ответ отправлен: 28.08.2007, 08:02 Оценка за ответ: 5

Отвечает: Дмитрий С. Здравствуйте, Алена! немного подрихтовал Ваш листинг. Должно работать. P.S. Пишу без компилятора Приложение: Var x:integer; Summa: integer; Proizv:integer; Begin Summa:=0; Proizv:=1; Repeat Writeln ('Введите число'); Readln (x); If x<0 then begin Proizv:=Proizv*x; Summa:=Summa + x; end; Until x=0; Writeln ('Сумма чисел = ', Summa); Writeln ('Произведение чисел = ', Proizv); Readln; end. --------- Наши программисты самые программистые программисты!..

Ответ отправил: Дмитрий С. (статус: 4-ый класс) Ответ отправлен: 31.08.2007, 15:44 Оценка за ответ: 5

Вопрос № 100.010

Здравствуйте, уважаемые эксперты! Пожалуйста, помогите мне разобраться с задачей. Дано N точек на плоскости. Выбрать из них три такие, чтобы различались наименьшим образом число точек, лежащих внутри и вне окружности, проходящей через эти три точки. Решение задачи оформить в виде проекта на Delphi и представить результат расчета на графике. Я разбирала похожий пример на визуализацию решения алгоритмической задачи. Он был тоже про три точки на плоскости, но там надо было определить, принадлежит ли начало координат (0,0) треугольнику, образованному этими точками. То есть попроще. А вот эту про окружность... чего-то не получается эту задачу осознать. Буду очень благодарна за любые советы! Смотрела в книжках, ничего похожего не нашлось. Может вы мне порекомендуете какую-нибудь хорошую подробную книжку на эту тему. Или подскажите, как думать.

Отправлен: 28.08.2007, 17:31 Вопрос задала: Alenkakiss (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 12)

Отвечает: Сухомлин Кирилл Владимирович Здравствуйте, Alenkakiss! Для начала всегда можно попробовать полный перебор: N*(N–1)*(N–2)/6 ~ N3 Кубическая сложность — не так уж и ужасно. перебираете все тройки точек, подставляете их в уравнение: (x–x0)2 + (y–y0)2 = R2 получаете систему из трех уравнений с тремя неизвестными, решаете ее (это все проделывается аналитически, т.е. на бумажке). Вычитаете 1-ое из 2-го, получается что-то типа: (x22–x12) + (x1–x2)*x0 + (y22–y12) + (y1–y2)*y0 = 0 Аналогично, для вычитания 2-го из 3-го. Решаете относительно x0 и y0, затем подставляете их значения в любые из исходных 3-х и получаете значение радиуса. Получаете формулу для выражения x0, y0 и R через координаты трех точек: (x1; y1), (x2; y2), (x3; y3) И считаете число точек внутри окружности: (x–x0)2+(y–y0)2 ≤ R2 и вне. Ну и надо запоминать новый вариант, если он лучше предыдущих. В случае деления пополам или почти поровну (т.е. на n и n+1) можно прерывать поиск. --------- Не узнаешь - не попробуешь.

Ответ отправил: Сухомлин Кирилл Владимирович (статус: Специалист) Ответ отправлен: 28.08.2007, 20:06 Оценка за ответ: 5

Отвечает: Delph Здравствуйте, Alenkakiss! Высылаю Вам программу (в приложении) - мои тесты проходит. Форма у меня называется Form1, на ней лежит картинка TestImage: TImage и кнопка StartButton: TButton. Картинку сделайте квадратной, размер не важен. Приложение: unit MainUnit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; const PixelsCount = 80; Eps = 1e-9; type TPixel = Record x, y: Double; end; TCircle = Record Center: TPixel; Radius: Double; end; TForm1 = class(TForm) TestImage: TImage; StartButton: TButton; procedure StartButtonClick(Sender: TObject); private { Private declarations } Pixels: Array of TPixel; public { Public declarations } end; var Form1: TForm1; Function ColorResult(Red, Green, Blue: Byte): LongWord; Function Det22(x11, x12, x21, x22: Double): Double; Function CircleFind(p1, p2, p3: TPixel): TCircle; Procedure PixelsInit(var Pixels: Array of TPixel; N: Integer); Procedure PixelsScan(Pixels: Array of TPixel; var p1, p2, p3: TPixel); implementation uses Math; {$R *.dfm} function ColorResult; begin Result := Red + Green * 256 + Blue * 65536; end; function Det22; begin Result := x11*x22 - x21*x12; end; function CircleFind(p1, p2, p3: TPixel): TCircle; var Circle: TCircle; A, B, Cx, Cy, Dx, Dy, det: Double; begin A := p2.x * p2.x - p1.x * p1.x + p2.y * p2.y - p1.y * p1.y; B := p3.x * p3.x - p1.x * p1.x + p3.y * p3.y - p1.y * p1.y; Cx := 2 * (p2.x - p1.x); Cy := 2 * (p2.y - p1.y); Dx := 2 * (p3.x - p1.x); Dy := 2 * (p3.y - p1.y); try det := Det22(Cx, Cy, Dx, Dy); Circle.Center.x := Det22(A, Cy, B, Dy) / det; Circle.Center.y := Det22(Cx, A, Dx, B) / det; Circle.Radius := Sqrt(Sqr(Circle.Center.x - p1.x) + Sqr(Circle.Center.y - p1.y)); except Circle.Center.x := 0; Circle.Center.y := 0; Circle.Radius := -1; end; Result := Circle; end; procedure PixelsInit; var i: Integer; begin if N <= 0 then exit; Randomize; for i := 1 to N do begin Pixels[i - 1].x := Random; Pixels[i - 1].y := Random; end; end; procedure PixelsScan(Pixels: Array of TPixel; var p1, p2, p3: TPixel); var InCount, OutCount: Integer; (* Êîë-âî òî÷åê âíóòðè è âíå îêðóæíîñòè *) InCurr, OutCurr, i, j, k, l, m, n: Integer; R: Double; Circle: TCircle; begin InCount := 0; OutCount := PixelsCount; (* Ïåðåáèðàåì âñå âîçìîæíûå òðîéêè òî÷åê *) for i := 0 to PixelsCount - 1 do for j := 0 to PixelsCount - 1 do for k := 0 to PixelsCount - 1 do begin if (i = j) or (i = k) or (j = k) then Continue; InCurr := 0; OutCurr := 0; Circle := CircleFind(Pixels[i], Pixels[j], Pixels[k]); (* Ñ÷èòàåì òî÷êè âíóòðè è âíå îêðóæíîñòè. Åñëè òî÷êà ñîâïàäàåò î îäíîé èç òî÷åê òåêóùåé òðîéêè, ïðîïóñêàåì å¸ *) for l := 0 to PixelsCount - 1 do begin if (l = i) or (l = j) or (l = k) then Continue; R := sqrt(SQR(Pixels[l].x - Circle.Center.x) + SQR(Pixels[l].y - Circle.Center.y)); if R < Circle.Radius then inc(InCurr) else inc(OutCurr); end; (* Ñðàâíèâàåì ðåçóëüòàòû ñ ïîëó÷åííûìè ðàíåå *) if Abs(OutCurr - InCurr) < abs(OutCount - InCount) then begin OutCount := OutCurr; InCount := InCurr; p1 := Pixels[i]; p2 := Pixels[j]; p3 := Pixels[k]; end; end; end; procedure TForm1.StartButtonClick(Sender: TObject); var i, X, Y: Integer; p1, p2, p3: TPixel; R: Double; C: TCircle; InCount, OutCount, x1, x2, y1, y2: Integer; f: TextFile; begin SetLength(Pixels, PixelsCount); TestImage.Canvas.Brush.Color := ColorResult(0, 0, 64); TestImage.Canvas.FloodFill(2, 2, TestImage.Canvas.Pixels[2, 2], fsSurface); AssignFile(f, 'ProgOut.txt'); ReWrite(f); PixelsInit(Pixels, PixelsCount); PixelsScan(Pixels, p1, p2, p3); c := CircleFind(p1, p2, p3); WriteLn(f, 'Circle: C.x = ', C.Center.x:9:6, ', C.y = ', C.Center.y:9:6, ', R = ', C.Radius:9:6); WriteLn(f); WriteLn(f, 'Pixels:'); InCount := 0; OutCount := 0; x1 := Round((C.Center.x - C.Radius) * TestImage.Width); x2 := Round((C.Center.x + C.Radius) * TestImage.Width); y1 := Round((C.Center.y - C.Radius) * TestImage.Height); y2 := Round((C.Center.y + C.Radius) * TestImage.Height); TestImage.Canvas.Pen.Color := ColorResult(0, 0, 192); TestImage.Canvas.Ellipse(x1, y1, x2, y2); for i := 1 to PixelsCount do begin X := Round(Pixels[i-1].x * TestImage.Width); Y := Round(Pixels[i-1].y * TestImage.Height); R := sqrt(SQR(Pixels[i-1].x - C.Center.x) + SQR(Pixels[i-1].y - C.Center.y)); if (Abs(R - C.Radius) < Eps) then begin TestImage.Canvas.Pixels[X, Y] := clWhite; WriteLn(f, '(', Pixels[i-1].x:9:6, ', ', Pixels[i-1].y:9:6, ')', ' * * * * *'); end else if (R < C.Radius) then begin Inc(InCount); TestImage.Canvas.Pixels[X, Y] := clRed; WriteLn(f, '(', Pixels[i-1].x:9:6, ', ', Pixels[i-1].y:9:6, ')', ' In'); end else if (R > C.Radius) then begin Inc(OutCount); TestImage.Canvas.Pixels[X, Y] := clYellow; WriteLn(f, '(', Pixels[i-1].x:9:6, ', ', Pixels[i-1].y:9:6, ')', ' Out'); end; end; WriteLn(f); WriteLn(f, 'In: ', InCount, ' Out: ', OutCount); CloseFile(f); end; end. --------- Сомневайся во всём! Реальность часто бывает не такой, как мы о ней думаем.

Ответ отправил: Delph (статус: 8-ой класс) Ответ отправлен: 30.08.2007, 15:20 Оценка за ответ: 5

Вопрос № 100.014

Уважаемые эксперты. Как можно средствами Delphi 7 запретить определение и подключение устройств через USB порты? Заранее спасибо.

Отправлен: 28.08.2007, 17:55 Вопрос задал: T1000 (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Denisss Здравствуйте, T1000! Отключить USB порт можно с помощью утилиты devcon (в Windows XP Pro SP2 данная утилита присутствует по умолчанию, насчет остальных систем гарантировать не могу, скачать ее можно на сайте Microsoft, ссылка указана ранее). Если нужно отключить все порты USB, то нужно выполнить команду devcon disable @USB* Если нужно отключить какой-то определенный порт, то с помощью модуля Registry и класса TRegistry нужно просмотреть раздел [HKEY_LOCAL_MACHINESYSTEMCurrentControlSetEnumUSBROOT_HUB] - здесь хранятся идентификаторы USB портов. Допустим, Вы здесь обнаружили подраздел с именем "4&10af8b6f&0" - это и есть идентификатор порта. Чтобы его отключить, нужно теперь выполнить команду devcon disable @USBROOT_HUB4^&10af8b6f^&0 Учтите, что перед каждым знаком & нужно ставить символ ^. (Это можно сделать с помощью функции ReplaceString). Выполнение команды (точнее, запуск программы devcon.exe с указанными параметрами) можно производить с помощью функций WinExec (модуль Windows) и ShellExecute (модуль ShellAPI). Чтобы пользователь не видел окна сообщений программы devcon, можно ее запускать с параметром SW_HIDE. Удачи!

Ответ отправил: Denisss (статус: Профессионал) Россия, Москва ---- Ответ отправлен: 30.08.2007, 10:55

Вопрос № 100.026

Здравствуйте, уважаемые эксперты. С вставкой текста в Edit всё ясно, однако, возникают сложности с вставкой текста в Edit, находящийся в диалоговом окне. Необходимо вызвать в программе окно «Открыть файл», найти в нём Edit, вставить в найденный Edit имя файла (с полным путем) и нажать кнопку «Открыть». Получается, что когда я нажимаю в главном окне программы кнопку «Открыть файл» при помощи SendMessage(hSp,WM_COMMAND, $1395, 0), то диалоговое окно открывается, но и моя программа «застрявает» на этой строке, пока вручную не закрыть диалоговое окно. Пробовал PostMessage, программа не «застрявает», однако hOd := FindWindowEx(hSp, 0, '#13770 (Dialog)', 'Открыть') ничего не находит. Пробовал менять аргументы FindWindowEx самым разным образом, однако всегда получается hOd = 0. При этом Spy++ диалоговое окно-то видно. Не могу найти HWND диалогового окна, поэтому не могу найти и дочерние окна Edit и Button. Подскажите (для не программиста), есть ли какие-то особенности работы с диалоговыми окнами и как можно решить получившуюся задачу? За код буду особо благодарен.

Отправлен: 28.08.2007, 20:50 Вопрос задал: Зорин Владимир Вадимович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: chikanok Здравствуйте, Зорин Владимир Вадимович! Тож не особо понимаю ваш вопрос! Попробуйте между PostMessage и FindWindowEx сделать паузу! Sleep(время в милисекундах); Начните лучше с 500мс. А в параметрах поиска вы уверены?! Приложение: ... PostMessage(hSp,WM_COMMAND, $1395, 0); sleep(10);//Возможно понадобится больше или меньше hOd := FindWindowEx(hSp, 0, '#13770 (Dialog)', 'Открыть') ; ... --------- Главное желание,а там разберёмся!

Ответ отправил: chikanok (статус: 4-ый класс) Ответ отправлен: 28.08.2007, 23:28 Оценка за ответ: 4

Вопрос № 100.035

Здравствуйте уважаемые эксперты. Вопрос: Нужно сделать текстовый редактор похожий на Noteрad++(т.е чтобы каждый новый документ открывался в новой вкладке) P.S. Как сделать чтобы у каждой вкладки была своя закрывающая кнопка

Отправлен: 28.08.2007, 21:27 Вопрос задал: Badanin (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: chikanok Здравствуйте, Badanin! Перенесено в мини-форум Denisss --------- Главное желание,а там разберёмся!

Ответ отправил: chikanok (статус: 4-ый класс) Ответ отправлен: 28.08.2007, 23:32

© 2001-2007, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале Версия системы: 4.58 от 30.08.2007
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru