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

Выпуск № 440
от 11.04.2006, 09:05

Вопрос № 39.430

Уважаемые Эксперты, подскажите пожалуйста: На канве формы рисую графики функций на синем фоне, а вывод на принтер нужно сделать на чисто-белом, как это реализовать? Спасибо!

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

Отвечает: Артём Шегеда Здравствуйте, Dems! Надуюсь, пример прост для понимания ;) Главное - перехват функции GetFormImage (именно она вызывается перед тем, как форма будет отпечатана на принтере) и функция замены одного цвета другим Приложение: type TForm1 = class(TForm) private { Private declarations } public { Public declarations } function GetFormImage : TBitmap; end; var Form1: TForm1; implementation {$R *.dfm} procedure ReplaceColor(Bitmap : TBitmap; Color, Replace: TColor); var OldBrushColor : TColor; begin OldBrushColor := Bitmap.Canvas.Brush.Color; Bitmap.Canvas.Brush.Color := Replace; Bitmap.Canvas.BrushCopy(Bitmap.Canvas.ClipRect, Bitmap, Bitmap.Canvas.ClipRect, Color); Bitmap.Canvas.Brush.Color := OldBrushColor; end; function TForm1.GetFormImage: TBitmap; begin Result := inherited GetFormImage; ReplaceColor(Result, clBlue, clWhite); end;

Ответ отправил: Артём Шегеда (статус: 5-ый класс) Ответ отправлен: 05.04.2006, 12:46 Оценка за ответ: 5 Комментарий оценки: Большое спасибо Артём Шегеда! Всё очень понятно, но почему-то пока не получается. Буду добиваться нужного результата. Спасибо ещё раз!, Dems.

Вопрос № 39.442

Уважаемые эксперты! Подскажите, пожалуйста, как корректно завершать приложение(программно), чтобы ничего не оставалось висеть в памяти, как, например, при Application.Destroy; . Спасибо!

Отправлен: 05.04.2006, 12:22 Вопрос задал: Андрющенко Вячеслав Васильевич (статус: Посетитель) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Проходящий Мимо Здравствуйте, Андрющенко Вячеслав Васильевич! Достаточно закрыть главную форму приложения, ну или же Application.Terminate; --------- Carpe diem!

Ответ отправил: Проходящий Мимо (статус: 2-ой класс) Ответ отправлен: 05.04.2006, 12:32

Отвечает: Лучников Ю.В. Здравствуйте, Андрющенко Вячеслав Васильевич! Если вы хотите закрыть свое приложение, то достаточно вызвать метод для главной формы Form1.Close. Ежели вы хотите закрывать любые приложения (не только свои), то вам достаточно послать главному окну этого приложения сообщение WM_QUIT. В приложении приведен пример закрытия калькулятора... Успехов! Приложение: procedure TForm1.Button1Click(Sender: TObject); var Hnd: HWND; begin //Ищем Хэндл окна, с заголовком "Калькулятор"... Hnd := FindWindow(nil, 'Êàëüêóëÿòîð'); //Если такое окно присутствует, то закрываем его... if (Hnd <> 0) then PostMessage(Hnd, WM_QUIT, 0, 0); end;

Ответ отправил: Лучников Ю.В. (статус: *Мастер) Россия, Киров WWW: Чат Кировской молодежи ICQ: 176308580 ---- Ответ отправлен: 05.04.2006, 12:40

Отвечает: Delphin Здравствуйте, Андрющенко Вячеслав Васильевич! Просто закрыть главную форму Frm_Main.Close; чтоб ничего не работало в потоках или Application.Terminate; --------- Обращаться в ICQ: 66550088 (Ally) или E-Mail: AvePassion@GMail.Com

Ответ отправил: Delphin (статус: Студент) Ответ отправлен: 05.04.2006, 13:53

Отвечает: Злоумышленник Здравствуйте, Андрющенко Вячеслав Васильевич! В дополнение к ответам. Как писали выше уважаемые эксперты, Frm_Main.Close и Application.Terminate корректно закрывают приложение, освобождая все выделенные ресурсы. Но хорошим стилем программирования считается перед закрытием освобождать выделенные ресурсы для всех объектов, созденных в программе с помощью Create. Это делается методом этих объектов Free. Т. е. если где-то в программе есть MyBitmap.Create, то должно быть и MyBitmap.Free

Ответ отправил: Злоумышленник (статус: 5-ый класс) Ответ отправлен: 05.04.2006, 14:56

Вопрос № 39.444

Здравствуйте, Уважаемые эксперты! Подскажите, пожалуйста, алгоритм, или код, или ссылку для следующей задачи: Нужно найти все серверы (TServerSocket) одной программы, к которым я могу подключиться (используя TClientSocket), как в играх с мультиплеером. Т.е все IP с портами. Заранее спасибо!

Отправлен: 05.04.2006, 12:58 Вопрос задал: Антон aka Stalker (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Артём Шегеда Здравствуйте, Антон aka Stalker! Я ранее упоминал библиотеку Delphi Fundamentals Library (http://rusfaq.ru/?Step=info&Action=Question&ID=39137). В ней есть две чудных компоненты, которые позволят решить поставленную задачу. В приложении - решение. Более наглядно будет, если запустить скомпиллированную программу на нескольких хостах сети. ;) Приложение: object Form1: TForm1 Left = 192 Top = 116 Width = 690 Height = 476 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.style="[]" OldCreateOrder = False OnCreate = FormCreate DesignSize = ( 682 449) PixelsPerInch = 96 TextHeight = 13 object Memo1: TMemo Left = 8 Top = 8 Width = 265 Height = 433 Anchors = [akLeft, akTop, akBottom] TabOrder = 0 end object Memo2: TMemo Left = 336 Top = 8 Width = 337 Height = 129 Anchors = [akLeft, akTop, akRight] TabOrder = 1 end object Button1: TButton Left = 336 Top = 144 Width = 75 Height = 25 Caption = 'Разослать' TabOrder = 2 OnClick = Button1Click end object fndUDPSocket1: TfndUDPSocket LocalPort = '3888' BroadcastOption = True OnDataAvailable = fndUDPSocket1DataAvailable Left = 232 Top = 8 end object fndUDPClientSocket1: TfndUDPClientSocket BroadcastOption = True Port = '3888' Left = 416 Top = 88 end end -------------------------------------- unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, cWindows, cSockets, cSocketsUDP; type TForm1 = class(TForm) fndUDPSocket1: TfndUDPSocket; Memo1: TMemo; Memo2: TMemo; Button1: TButton; fndUDPClientSocket1: TfndUDPClientSocket; procedure fndUDPSocket1DataAvailable(Sender: AUDPSocket); procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses WinSock; procedure TForm1.fndUDPSocket1DataAvailable(Sender: AUDPSocket); var s : string; Addr : TSockAddr; begin repeat Sender.ReadPacket(s, Addr); Memo1.Lines.Add(s); until Sender.ReceiveBufferSize<=0; end; procedure TForm1.Button1Click(Sender: TObject); begin fndUDPClientSocket1.Broadcast(fndUDPClientSocket1.Port, Memo2.Text); Memo2.Clear; end; procedure TForm1.FormCreate(Sender: TObject); begin fndUDPSocket1.Bind; fndUDPClientSocket1.Bind; end; end.

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

Вопрос № 39.460

Вопрос #2 Как определить системное время (через функцию GetTime или ещё как-то) с точностью до миллисекунд? По умалчиванию функция GetTime возвращает время до секунды. Короче, надо сделать новую функцию, типа такую: function GetTime2:Word; // Возвращает целое значение в Миллисекундах или function NewGetTime:Word; // Возвращает целое значение в Миллисекундах (Это нужно для определения времени вычислений некоторых сложных циклов и различных новых функций) Работает это так. Пример: var d_T, t1, t2 :Word; BEGIN t1:=NewGetTime; // Засекает начальное время ... Тело цикла ... t2:=NewGetTime; // Определяет конечное время d_T:=t2-t1; // Разница и есть время работы цикла Вывод('...'+d_T); END. Задача понятна? P.S. В Help'e по Delphi 7.0 нет даже формата записи 2-го параметра в функции GetTime. Или опишите, пожалуйста более подробно как пользоваться это функцией? Заранее всем... Алекс

Отправлен: 05.04.2006, 15:54 Вопрос задал: AlexD (статус: Посетитель) Всего ответов: 5 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Артём Шегеда Здравствуйте, AlexD! Позвольте, а чем не устраивает функция Now? В приложении - её реализация. Там чётко видно, что миллисекунды тоже учитываются. Для того, чтобы получить разницу в миллисекундах, нужно сделать так: Time := Now; // ...   Delta := (Now-Time)/(24*60*60*1000) // время в миллисекундах Приложение: function Now: TDateTime; var SystemTime: TSystemTime; begin GetLocalTime(SystemTime); with SystemTime do Result := EncodeDate(wYear, wMonth, wDay) + EncodeTime(wHour, wMinute, wSecond, wMilliseconds); end;

Ответ отправил: Артём Шегеда (статус: 5-ый класс) Ответ отправлен: 05.04.2006, 16:10

Отвечает: romodos Здравствуйте, AlexD! Предложу, как мне кажется, наиболее простое решение. Есть стандартная виндовая функция GetTickCount. Я именно ей всегда и пользуюсь (быстрей и легче). А пример ее использования вы уже сами написали t1:=GetTickCount; .... t:=GetTickCount-t1;// время выполнения всех операций Усе. Спасибо за внимание. --------- The Source is Our Soul. FAQ me off!

Ответ отправил: romodos (статус: Практикант) Ответ отправлен: 05.04.2006, 16:29

Отвечает: Проходящий Мимо Здравствуйте, AlexD! Оболочка для таймера высокой точности, автор - John Mertus Приложение: unit HRTimer; interface uses Windows; type THRTimer = class(TObject) constructor Create; function StartTimer: Boolean; function ReadTimer: Double; private StartTime: Double; ClockRate: Double; public Exists: Boolean; end; implementation constructor THRTimer.Create; { Получаем точное системное время и сохраняем его для дальнейшего } { использования. } var QW: TLargeInteger; begin inherited Create; Exists := QueryPerformanceFrequency(QW); ClockRate := QW.QuadPart; end; function THRTimer.StartTimer: Boolean; var QW: TLargeInteger; begin Result := QueryPerformanceCounter(QW); StartTime := QW.QuadPart; end; function THRTimer.ReadTimer: Double; var ET: TLargeInteger; begin QueryPerformanceCounter(ET); Result := 1000.0 * (ET.QuadPart - StartTime) / ClockRate; end; end. --------- Carpe diem!

Ответ отправил: Проходящий Мимо (статус: 2-ой класс) Ответ отправлен: 05.04.2006, 16:41

Отвечает: Злоумышленник Здравствуйте, AlexD! Не надо писать никаких функций, всё уже давно написано. В приложении привожу решение подобной проблемы, которое я сделал в своей программе не так давно. Я использовал стандартную функцию MilliSecondsBetween. Приложение: unit DateUtils; ... var Mlsec: Int64; tmNewTime,tmOldTime: TTime ... //Засекаем tmOldTime := Time; ... //Что-то делаем ... //Сделали, вычисляем, за сколько миллисекунд tmNewTime := Time; Mlsec := MilliSecondsBetween(tmNewTime,tmOldTime); //Показываем leTime.Text := IntToStr(Mlsec);

Ответ отправил: Злоумышленник (статус: 5-ый класс) Ответ отправлен: 05.04.2006, 21:01

Отвечает: sir henry Здравствуйте, AlexD! Вопрос несколько непонятен. GetTime выдает и милисекунды в своем составе. Единственный ее недостаток - разрешающая способность в ~50 мсек, это обусловлено часовым таймером системы. Если же нужно получить метки времени с точностью до едениц мсек, то лучше воспользоваться системной функцией GetTickCount, которая берет эти самые тики с генератора процессора. У Вас нечетко сформулирована задача, а без этого переходить к программированию - значит нарываться на логические ошибки. Проверено. :)

Ответ отправил: sir henry (статус: Академик) Россия, Красноярск ---- Ответ отправлен: 06.04.2006, 06:17

Вопрос № 39.463

Здравствуйте. (Сложный вопрос... и задание тоже) Кто бы мне помог создать "Строчный калькулятор"? В смысле вводишь формулу и она (т.е. функция эта) вычисляет значение. Я нашёл и скачал в Интернете 3 варианта функции вычисления по введённой формуле. Она (или, они) и скобки "понимала" и приоритет операций тоже. Но проблема в том что она "понимала" только довольно простые формулы. Например, f(x)=65*sin(32)= или (3+6)*5+10= ..., и к тому же поддерживала работу только с целыми числами в строке. Не говоря уже о переменных в самой формуле. Например, f(a,b)=B*cos(A)/52.36+tan(A) (Переменные A,B вводятся ЗАГЛАВНЫМИ буквами. Где отдельно можно было бы указать значения этих 2-х переменных и вставить их значения в эту формулу) Дробные числа (вещественные) она уже не понимала. А например, формулу, типа f(x)=25*sin(45)*cos(12)/log(5) - тем более не смогла вычислить. Не говоря уже о формуле: f(x)=B*sin(A)*cos(A)/log(B) (Где A и В - переменные) (Надеюсь, Вы следите за ходом моей мысли?) В итоге, мне пришлось написать (в Delphi 7.0) СОБСТВЕННУЮ функцию вычисления выше указанных вариантах. Она вычисляет ВСЕ стандартные математические функции (и кое-что новое, всего 14 штук) и 6 операций (*, /, +, -, ^, ) и работу c вещественными числами в строке формулы, например, 7.7+sin(3.25)*lg(4.12) и т.д. Все действия выполняются последовательно, без соблюдений скобок и приоритетов оперераций (в моему сожалению). Несколько дней потратил на разработку этой функции. Кроме того, она "понимает" действие (одно (?) или 2 - не помню уже) в скобках любой функции. Например, f(x)=cos(5.2^2) или f(x)=sin(25.4*0.4) Главное что это работает! В принципе, я доволен своей работой (сейчас делаю улучшенную программу рисование кривой графика функции по 2-ум переменным - A и В), но вот приоритеты операций и скобки я не смог обработать. Теперь о скорости работы. Формула, типа: 1.25^5.36*sin(3.52*1.36)/cos(5.36*1.23)+lg(53.36) (что довольно длинная) на моём новом компе (AMD Sempron 3100+) в цикле 60000 раз вычислялась примерно 2 сек. (если верить функции GetTime) . И по реальному времени тоже. Что соответствует 1-му вычислению за 1/30000 секунды. Если кто знает и готов сделать и предоставить НОВУЮ готовую функцию для вычисления по введённым формулам - буду ОЧЕНЬ признателен. Если нет - придётся пользоваться Своей функцией. Что тоже неплохо. Кажись всё. Заранее всем... Алекс

Отправлен: 05.04.2006, 16:02 Вопрос задал: AlexD (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Проходящий Мимо Здравствуйте, AlexD! Конечно, такие разработки есть, например: Парсер комбинированных выражений, Серебренников, Компьютерные технологии и ситемы, 2002. Конечно, тема достаточно сложная и без теории её не осилить. Могу предложить книгу Ахо, Сети, Ульман - "Компиляторы - принципы, технологии, инструменты", в которой детально все описано. Если нужно, могу выслать. --------- Carpe diem!

Ответ отправил: Проходящий Мимо (статус: 2-ой класс) Ответ отправлен: 05.04.2006, 16:33

Отвечает: Артём Шегеда Здравствуйте, AlexD! Мне кажется, что синтаксический анализ выражения в твоём проекте построен неправильно, поскольку нет никакого значения, сколько уровней вложенности у скобок и функций: ведь это элементарная рекурсия. Нашёл открывающую скобку - найди соответствующую ей закрывающую, а код между ними отпарси и получи значение. С приоритетом операций тоже заморочек не должно быть. Если нашёл два операнда, а между ними операцию, то проверь следующую операцию за ними. Если у следующей приоритет ниже, вычисли значение первой операции, если выше - отложи первый операнд и займись второй операцией... Ну, а чтобы что-то доделывать, нужно увидеть то, что есть ;)

Ответ отправил: Артём Шегеда (статус: 5-ый класс) Ответ отправлен: 05.04.2006, 16:48

Отвечает: AnD1 Здравствуйте, AlexD! Для реализации "парсинга" с учетом скобок и страшенства операций можно использовать ПОЛИЗ (польско-инверсная запись), поясню, т.е например дано выражение: (a+b)*c в ПОЛИЗ оно будет выглядеть т.о.: ab+c* Заметили, скобки пропали и сохранилось старшенство операций (имеется ввиду, что сохранилось страшинство операций для ПОЛИЗа). А считается такое выражение "изнутри" (т.е. приз аписи выражения в ПОЛИЗ сначалоидут операнды, а потом знаки операций). В приложении программа на Pasacl'e преобразовывающая выр-е в ПОЛИЗ (возможно работает криво :). И этот транслятор только для одномерных операций, т.е. такое "-а" она не съест :), да и вообще этот алгоритм тормознутый и кривой (кстати, придумал его Н.Вирт), так что он только для примера, по хорошему все это можно реализовать через "стек" без использования рекурсии. О ПОЛИЗе в нете можно найти кучу документации и примеров, кстати, ПОЛИЗ используется в компиляторах, так что есть смысл почитать что-н ибудь о создании компиляторов. Приложение: var s: string; sp: string; i: integer; procedure VIR; forward; procedure SL; forward; procedure MN; forward; procedure Vir; var zn: char; begin SL; while s[i] in ['+','-'] do begin zn:=s[i]; SL; i:=i+1; sp:=sp+zn; end; end; procedure SL; var zn: char; begin MN; while s[i] in ['*','/'] do begin zn:=s[i]; MN; i:=i+1; sp:=sp+zn end; end; procedure MN; begin if s[i]='(' then begin VIR; i:=i+1; {на счет этого я не уверен, возможно нужно будет поставить в др. место - выше или ниже а может и вообще не надо :) } end else sp:=sp+s[i]; i:=i+1; end; begin readln(s); sp:=''; i:=1; while i<=Length(s) do VIR; writeln(sp); //в переменной sp готовое выражение, преобразованное в ПОЛИЗ end.

Ответ отправил: AnD1 (статус: 3-ий класс) Ответ отправлен: 05.04.2006, 18:47

Вопрос № 39.502

Вопрос Как определить конец массива не используя максимального номера ячейки (не знаю как сказать)? Пример. Нужно сделать функцию например, записав: function MaxFloat(const Data:array of Float):Float; var MaxF; Begin ... ... ... Как проверить конец массива? result:=MaxF End;

Отправлен: 06.04.2006, 01:23 Вопрос задал: AlexD (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Boriss Здравствуйте, AlexD! Есть функция High, которая возвращает индекс максимального элемента массива, но счет всегда идет с нуля в подпрограмме. Вот как можно проверить: function TForm1.TestMax(const a: array of Double): Double; begin ShowMessageFmt('макс. индекс = %d', [High(a)]); Result:= a[High(a)]; end; --------- Вывод - то место в тексте, где вы устали думать

Ответ отправил: Boriss (статус: Профессор) Россия, Саранск Организация: факультет Электронной техники, Мордовский госуниверситет Адрес: г. Саранск WWW: Программирование на Паскале ---- Ответ отправлен: 06.04.2006, 07:59

Отвечает: Jadd Здравствуйте, AlexD! Есть функция length. Значит в Вашем случае это так: Result := Length(a)-1; Успехов. --------- Если в сердце дверь закрыта, нужно в печень постучаться

Ответ отправил: Jadd (статус: Профессионал) Адрес: Санкт-Петербург WWW: http://www.sport-diary.ru ICQ: 28260749 ---- Ответ отправлен: 06.04.2006, 10:12

Отвечает: Ataman N. N. Здравствуйте, AlexD! High(Data) - конец массива.

Ответ отправил: Ataman N. N. (статус: 10-ый класс) Ответ отправлен: 06.04.2006, 18:25

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