RusFAQ.ru: Программирование на Delphi

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

Выпуск № 402
от 03.03.2006, 12:45

Вопрос № 36.155

Всем ешё разок привет ! Кто мне скажет вчём ошибка ? Работаю под Delphi 9.0 Вот код: procedure TForm5.Button1Click(Sender: TObject); var LoginStrings, PassStrings:TStrings; i, j:Integer; begin //Создаём массив строк LoginStrings:=Tstrings.Create; PassStrings:=Tstrings.Create; //подгружаем файл LoginStrings.LoadFromFile(Edit1.Text); PassStrings.LoadFromFile(Edit2.Text); //Устанавливаем адрес и порт сервера IdPOP31.Host:= Edit3.Text; idpop31.Port:= StrToInt(Edit4.Text); //Начинаем перебор for i:=0 to LoginStrings.Count-1 do for j:=0 to PassStrings.Count-1 do begin //передаём имя и пароль компоненту idpop31.Username:=LoginStrings.Strings[i]; idpop31.Password:=PassStrings.Strings[j]; //пытаемся соединица try idpop31.Connect; except end; if idpop31.Connected then begin ShowMessage('Имя: '+LoginStrings.Strings[i]+' Пароль: '+PassStrings.Strings[j]); Label8.Caption:=('Имя '+LoginStrings.Strings[i]+' Пароль: '+PassStrings.Strings[j]); idpop31.Disconnect; Exit; end; end; //Уничтожаем массив строк LoginStrings.Free; PassStrings.Free; end; end.

Отправлен: 25.02.2006, 13:44 Вопрос задал: Tamashev Denis M (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: Ерёмин Андрей Здравствуйте, Tamashev Denis M! Очень распространённая ошибка. Всё дело в том, как вы создаёте переменную типа TStrings. При создании нужно указывать тип TStringList, а не TStrings, т.е.: LoginStrings:=TStringsList.Create; Дальше не смотрел, но уверен, что ошибка именно в этом. --------- Нет правила без исключений. Правило без исключений - исключение из правил.

Ответ отправил: Ерёмин Андрей (статус: Профессионал) Отправлен: 25.02.2006, 15:04 Оценка за ответ: 5 Комментарий оценки: Спасибо ! Будем пробовать !

Вопрос № 36.162

Здраствуйте эксперты!! Подскажите пожалуйста как на форме нарисовать оси координат и двигать элипс из начала координат по дуге и по прямой? Зарание спасибо!!!

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

Отвечает: sir henry Здравствуйте, F Ruslan R! Именно на форме? А чем Вам TImage не нравится? Впрочем, принцип рисования будет и там и там одинаковым, т.к. на обоих компонентах рисование дет на Canvas: Form1.Canvas.Метод_рисования; Image1.Canvas.Метод_рисования; Под методом рисования понимается любой метод, который воспроизводит тот или ино графический примитив. 1. Оси координат. Разбиваем плоскость на две части как по вертикалии, так и по горизонталии: SeredinaX:=Width div 2; SeredinaY:=height div 2; Рисуем две палки: MoveTo(SeredinaX, 0); LineTo(SeredinaX, Height); MoveTo(0, SeredinaY); LineTo(0, SeredinaY); Превращаем палки в рыбьи кости: x:=SeredinaX; While x Begin x:=x+5; MoveTo(x, SeredinaY-5); LineTo(x, SeredinaY+5); End; x:=SeredinaX; While x>0 Do Begin x:=x-5; MoveTo(x, SeredinaY-5); LineTo(x, SeredinaY+5); End; y:=SeredinaY; While y Begin MoveTo(SeredinaX-5, y); LineTo(SeredinaX+5); End; y:=SeredinaY; While y>0 Do Begin MoveTo(SeredinaX-5, y); LineTo(SeredinaX+5); End; 2. Движение эллипса. Самый простой способ - вычисление координат эллипса, рисование его каким либо цветом, задержка на некоторое время, потом рисование его-же, но цветом фона. procedure Ellipse(X1, Y1, X2, Y2: Integer); Координаты - квадрат, в котором вписан эллипс. 4. Движение по прямой. Нет проблем. Сначала нужно решить, какой функцией описывается эта прямая, а потом вычислять с помощью ее смещение и новые координаты. 3. Движение по дуге. Таже проблема - формула. :) Дуги ведь разные бывают. Простейший способ - вычислить начальную координату, потом с помощью синуса и косинуса вычислять коэффициент смещения по оси X и Y.

Ответ отправил: sir henry (статус: Академик) Отправлен: 25.02.2006, 16:58 Оценка за ответ: 5

Отвечает: Leshiy2006 Здравствуйте, F Ruslan R! Присвойте Form1.Canvas.Pen.Mode:=pmNotXor; Form1.Canvas.Ellipse(<Старые координаты>); <Здесь определяете новые координаты> Form1.Canvas.Ellipse(<Новые координаты>); Вот и все если что не понятно пишите вышлю исходник

Ответ отправил: Leshiy2006 (статус: 3-ий класс) Отправлен: 25.02.2006, 23:39 Оценка за ответ: 4 Комментарий оценки: Spasibo!!Vse dostatochno yasno!!!

Вопрос № 36.186

Здраствуйте! Подскажите пожалуста как из такого файла (см. в приложении) прочитать зачения и присвоить их соответсвующим lable'ам и Button'ам и др. элементам на форме? Спасибо!:) Приложение: //пояснения 1 lable1:=текст29 lable2:=текст256 и т.д. //пояснения 2 Button1:=текст489 Button1:=текст894 и т.д. //пояснения 3 и т.д.

Отправлен: 25.02.2006, 19:55 Вопрос задал: Yarking (статус: 1-ый класс) Всего ответов: 5 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Tamashev Denis M Ничего не понял ты хочешь открыть файл и вывести содержимое в label и button ,,,???,,, Так чтоли ??? : Button1.Caption:='текст489';

Ответ отправил: Tamashev Denis M (статус: 1-ый класс) Отправлен: 25.02.2006, 20:30

Отвечает: Ерёмин Андрей Hello, Yarking! В этом случае удобно воспользоваться ini-файлами. Правда, файл с параметрами придётся слегка модифицировать, но это нетрудно. Пример смотрите в приложении. В uses обязательно должен присутствовать модуль IniFiles. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа. --------- Нет правила без исключений. Правило без исключений - исключение из правил.

Ответ отправил: Ерёмин Андрей (статус: Профессионал) Отправлен: 25.02.2006, 21:17 Оценка за ответ: 5

Отвечает: SlavComp Здравствуйте, Yarking! Тут можно воспользоваться *.ini файлами. Пример записи и чтения значения в такой файл смотри в приложении. Приложение: //Прочитать значение function IniGetStringValue( TheIniFile: string; IniSection: string; StringName: string; DefaultString: string): string; var TheIni: TIniFile; begin TheIni := TIniFile.Create(Self); try Result := TheIni.ReadString( IniSection, StringName, DefaultString); if Result = '' then Result := DefaultString; finally TheIni.Free; end; end; //Записать значение function IniSetStringValue( TheIniFile: string; IniSection: string; StringName: string; StringValue: string): Boolean; var TheIni: TIniFile; begin TheIni := TIniFile.Create(Self); try try TheIni.WriteString( IniSection, StringName, StringValue); Result := True; except Result := False; end; finally TheIni.Free; end; end;

Ответ отправил: SlavComp (статус: 1-ый класс) Отправлен: 25.02.2006, 21:28 Оценка за ответ: 5

Отвечает: sir henry Здравствуйте, Yarking! Если количество значений и групп компонентов, которым нужно присвоить значение из файла заранее известно, то можно воспользоваться стандартным текстовым файлом, оставив в нем только значения: ****** Значения.txt ************ текст29 текст256 текст489 текст894 ****** Конец текстового файла *** Procedure ReadFromTxtFile; Var F: TextFile; Begin AssignFile(F, 'Значения.txt'); Reset(F); ReadLn(F, Label1.Caption); ReadLn(F, Label2.Caption); ReadLn(F, Button1.Caption); ReadLn(F, Button2.Caption); End; Каждой строчке в файле соответствует одно значение. Каждое ReadLn() в программе читает одну строку из файла и присваивает ее соответствующему элементу.

Ответ отправил: sir henry (статус: Академик) Отправлен: 26.02.2006, 06:35 Оценка за ответ: 3 Комментарий оценки: Количество значений много, Заранее даже может быть не известно. Структуру файла ни я придумал.

Отвечает: Ataman N. N. Здравствуйте, Yarking! Можно загрузить такой файл в Str: TStrings, только в файле знаки ":=" заменить на "=", тогда получиться структура вида Name=Value. При создании формы проходитесь по всем нужным компонентам и присваиваете им соответствующие значения, например так: for i := 0 to ComponentCount - 1 do begin if (Components[i] is TLabel) then//если это метка for j := 0 to Str.Count - 1 do if (Components[i] as TLabel).Name = Str[j] then begin (Components[i] as TLabel).Caption := Str.Values[Str.Names[j]]; Break; end; end; Данный алгоритм не какой-нибудь шаблон, а просто пример, и конечно же в нем есть много недостатков, с точки зрения продуктивности и скорости работы, но все в Ваших руках. Работайте!

Ответ отправил: Ataman N. N. (статус: 8-ой класс) Отправлен: 27.02.2006, 11:48

Вопрос № 36.199

Ув. эксперты, вопрос такой: как сделать чтобы в ListBox, были строки разного цвета, (цвет шрифта и цвет заливки) и если возможно в Memo тоже.... Спасибо....

Отправлен: 25.02.2006, 22:47 Вопрос задал: Wlp (статус: Посетитель) Всего ответов: 5 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Данилевич Игорь Владимирович Здравствуйте, Wlp! Вот пример с ListBox, с Memo не получится – используй RichEdit. Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; ListBox1: TListBox; procedure Button1Click(Sender: TObject); procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var s : string; begin ListBox1.Clear; s:='c:windows*.bmp'#0; ListBox1.Perform(LB_DIR, DDL_READWRITE, Longint(@s[1])); end; procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var Bitmap: TBitmap; Offset: Integer; BMPRect : TRect; begin with (Control as TListBox).Canvas do begin {в зависимости четная или нечетная строка меняем шрифт и цвет заливки как хотим} if Index mod 2 = 0 then begin Font.Name := 'Arial'; Font.Color := clred; Brush.Color := clyellow; end else begin Font.Name := 'Times'; Font.Color := clgreen; Brush.Color := clwhite; end; {очищаем прямоугольник} FillRect(Rect); {считываем картинку} Bitmap:=TBitMap.Create; Bitmap.LoadFromFile('c:windows'+ListBox1.Items[Index]); if Bitmap <> nil then begin {вычисляем квадрат для показа картинки} BMPRect:=Bounds(Rect.Left + 2, Rect.Top + 2, Rect.Bottom-Rect.Top-2, Rect.Bottom-Rect.Top-2); {рисуем картинку} StretchDraw(BMPRect, BitMap); Offset := Rect.Bottom-Rect.Top + 6; end else Offset := 2; {выводим текст} TextOut(Rect.Left+Offset,Rect.Top,Listbox1.Items[Index]); {не забыть освободить!} Bitmap.Free; end; end; procedure TForm1.FormCreate(Sender: TObject); begin ListBox1.Style := lbOwnerDrawFixed; end; end.

Ответ отправил: Данилевич Игорь Владимирович (статус: 1-ый класс) Отправлен: 25.02.2006, 23:47 Оценка за ответ: 5 Комментарий оценки: Смного интересного.....

Отвечает: Полховский Александр Владимирович Здравствуйте, Wlp! У ListBox'a есть свойство - Style, оно определяет, как будут прорисовываться строки. Поставьте на lbOwnerDrawFixed - получите возможность самостоятельной прорисовки. Пишем процедуру обработки на событие OnDrawItem: begin randomize; listbox1.Canvas.Font.Color:=(random(clwhite)); if odselected in state then listbox1.Canvas.Pen.Color:=clblack else listbox1.Canvas.Pen.Color:=clwhite; listbox1.Canvas.Rectangle(rect); listbox1.Canvas.TextOut(rect.Left+1, rect.Top+1, listbox1.Items[index]); end; Ну это так, пример, на самом деле там можно хоть Рембранта выводить в строки, всё, что угодно. lbOwnerDrawFixed не даёт возможности варьировать высотой строк. Если поставите на lbOwnerDrawVariable, то можно будет их ещё и по высоте разными сделать. По поводу TMemo затрудняюсь ответить, ибо нет у него аналогичного события. Ну ещё посмотрю, мож соображу. Там выше пример поинтереснее, но мой вроде попроще. --------- Спасём нашу хрупкую планету !

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

Отвечает: komatoz procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var j:integer; begin with (Control as TListBox).Canvas do begin //далее можно задать наше условие для цвета отдельных строк for j:=0 to st.Count-1 do if massiv[Index]=st[j] then Font.Color := clRed; //здесь любой ваш цвет FillRect(Rect); TextOut(Rect.Left, Rect.Top, (Control as TListBox).Items[Index]); end; end;

Ответ отправил: komatoz (статус: 2-ой класс) Отправлен: 26.02.2006, 03:14 Оценка за ответ: 5 Комментарий оценки: Спасибо...

Отвечает: Ерёмин Андрей Hello, Wlp! Для ListBox: обрабатывать событие OnDrawItem, где рисовать всё, что угодно. Рисовать нужно на ListBox.Canvas. А лично от себя я рекомендую установить GlobusLib. У компонента glListBox большое количество настроек - можно указать для строк другой цвет, шрифт, цвет фона, есть поддержка градиентов и многое другое! Сделать подобное в Memo сложнее, подобных компонент я не видел. --------- Нет правила без исключений. Правило без исключений - исключение из правил.

Ответ отправил: Ерёмин Андрей (статус: Профессионал) Отправлен: 26.02.2006, 07:23 Оценка за ответ: 5 Комментарий оценки: Обязательно посмотрю...... http://www.torry.net/vcl/packs/huge/globuslib.zip

Отвечает: Ataman N. N. Здравствуйте, Wlp! Для этого Вы должны сами рисовать те самые строки в событии OnDrawItem. Но прежде нужно указать Style ListBox'a lbOwnerDrawFixed или lbOwnerDrawVariable.

Ответ отправил: Ataman N. N. (статус: 8-ой класс) Отправлен: 27.02.2006, 11:34

Вопрос № 36.203

Здравствуйте господа программисты. Вопрос такой: как в TMemo или в TRichEdit выделить два или несколько слов не подряд? Заранее благодарен.

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

Отвечает: Полховский Александр Владимирович Здравствуйте, Leshiy2006! Насколько мне известно, никак. --------- Спасём нашу хрупкую планету !

Ответ отправил: Полховский Александр Владимирович (статус: Студент) Отправлен: 26.02.2006, 01:10

Отвечает: Ерёмин Андрей Здравствуйте, Leshiy2006! К сожалению, ещё рано говорить о подобных вещах. Данная возможность появилась впервые только в Microsoft Office XP. В Delphi она ещё не пришла. Единственное, что можно сделать - просто выделить два слова другим шрифтом - это, я думаю, вы умеете - комбинация SelStart и SelLength, а затем SetAttributes. --------- Нет правила без исключений. Правило без исключений - исключение из правил.

Ответ отправил: Ерёмин Андрей (статус: Профессионал) Отправлен: 26.02.2006, 07:18 Оценка за ответ: 5 Комментарий оценки: Спасибо!

Вопрос № 36.213

Здравствуйте, Уважаемые эксперты! В приложении программа рисует на координатной сетке графики функций sin и tg. График tg рисуется немного неправильно (тангенсоида не проходит через нужные точки), др основные тригонометрические функции также рисуются без проблем, кроме ctg конечно, ошибка все та же. Закоментированный способ не помогает, постоянно выходит ошибка. Может кто знает как исправить ошибку? (Огромное спасибо Полховскому Александру Владимировичу за ответ на вопрос № 35771) Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) 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; // координаты начала координатных осей dx,dy:integer; // шаг координатной сетки (в пикселах) x,y,i:integer; lx,ly:real; // метки (оцифровка) линий сетки по X и Y dlx,dly:real; // шаг меток (оцифровки) линий сетки по X и Y begin x0:=form1.ClientWidth div 2; // оси начинаются в центре form1 y0:=form1.ClientHeight div 2; dx:=50; dy:=50; // шар координатной сетки 50 пикселов dlx:=PI; // шаг меток оси X dly:=1.0; // шаг меток оси Y with form1.Canvas do begin MoveTo(x0,y0); LineTo(x0,0); // ось Y+ MoveTo(x0,y0); LineTo(x0,form1.Height); // ось Y- MoveTo(x0,y0); LineTo(form1.Width,y0); // ось X+ MoveTo(x0,y0); LineTo(0,y0); // ось X- TextOut(x0-12,y0+4,'0'); // выводим 0 в точке пересечения осей // засечки, сетка и оцифровка по оси X+ x:=x0+dx; // переходим на место 1-й засечки на оси X+ lx:=dlx; // 1-я метка - единица i:=1; repeat MoveTo(x,y0-3);LineTo(x,y0+3); // засечка begin if i mod 2 = 0 then TextOut(x-8,y0+5,floattostr(i/2)+'п') else TextOut(x-12,y0+5,floattostr(i)+'п/2'); // оцифровка end; Pen.Style:=psDot; // линия - штрихпунктирная MoveTo(x,0);LineTo(x,form1.Height); // линия сетки lx:=lx+dlx; // увеличиваем метку на шаг x:=x+dx; // переходим к следующей засечке i:=i+1; until (x>form1.Width); // засечки, сетка и оцифровка по оси X- lx:=0; // обнуляем метку lx:=lx-dlx; // теперь метки отрицательные x:=x0-dx; // переходим на место 1-й засечки на оси X- i:=-1; repeat MoveTo(x,y0-3);LineTo(x,y0+3); begin if i mod 2 = 0 then TextOut(x-8,y0+5,floattostr(i/2)+'п') else TextOut(x-12,y0+5,floattostr(i)+'п/2'); // оцифровка end; Pen.Style:=psDot; // линия - штрихпунктирная MoveTo(x,0);LineTo(x,form1.Height); // линия сетки lx:=lx-dlx; // уменьшаем метку на шаг, т. к. ось X- x:=x-dx; // переходим к следующей засечке i:=i-1; until (x<0); // засечки, сетка и оцифровка по оси Y+ ly:=dly; // 1-я метка - единица y:=y0-dx; // переходим на место 1-й засечки на оси Y+ repeat MoveTo(x0-3,y);LineTo(x0+3,y); // засечка TextOut(x0-12,y,FloatToStr(ly)); // оцифровка Pen.Style:=psDot; // линия - штрихпунктирная MoveTo(x0+form1.Width,y); LineTo(0,y); // линия сетки ly:=ly+dly; // увеличиваем мету на шаг y:=y-dy; // переходим к следующей засечке until (y<0); // засечки, сетка и оцифровка по оси Y- ly:=0; // обнуляем метку ly:=ly-dly; // отрицательные метки для оси Y- y:=y0+dy; // переходим на место 1-й засечки на оси Y- repeat MoveTo(x0-3,y);LineTo(x0+3,y); // засечка TextOut(x0-15,y,FloatToStr(ly)); // оцифровка Pen.Style:=psDot; // линия - штрихпунктирная MoveTo(x0+form1.Width,y); LineTo(0,y); // линия сетки y:=y+dy; // переходим к следующей засечке ly:=ly-dly; // уменьшаем метку на шаг т. к. Ось Y- until (y>form1.Height); moveto(0, y0); pen.Style:=psSolid; pen.Color:=clfuchsia; for x:=-20 to 20 do for y:=0 to 40 do begin lineto(x0+x*40+y, y0-round(40*sin((x+y/40)*pi/2))); end; moveto(0, y0); pen.Style:=psSolid; pen.Color:=clblack; for x:=-20 to 20 do for y:=0 to 40 do begin lineto(x0+x*40+y, y0-round(40*sin(x+y/40)/cos(x+y/40))); end; { moveto(0, y0); pen.Style:=psSolid; pen.Color:=clfuchsia; for x:=-20 to 20 do for y:=0 to 40 do begin lineto(x0+x*40+y, y0-round(40*sin((x+y/40)*pi/2)/cos((x+y/40)*pi/2))); end;} end; end; end.

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

Отвечает: sir henry Здравствуйте, Solovej! Насколько я понимаю, TG и CTG - это тангенс и котангенс? А почему бы Вам для их вычисления не использовать стандартные функции: Tan(X); CoTan(X); ???? Обращаю Ваше внимание, что вычисление координат X и Y канвы у Вас очень сложное, поэтому чтобы не пропустить там ошибку, вынесите вычисление координат в отдельные действия.

Ответ отправил: sir henry (статус: Академик) Отправлен: 26.02.2006, 06:23 Оценка за ответ: 5 Комментарий оценки: Вообще то, я забыл про модуль Math и думал, что в Delphi нет функций tan(x) и cotan(x) поэтому искал др способы их нахождения.

Отвечает: Denisss Здравствуйте, Solovej! Пришлось сделать несколько изменений: 1 sin, tg, ctg используют в Вашем коде шаг сетки = 40, а Вы сетку нарисовали с шагом 50, из-за этого основное несовпадение 2 В ctg сделал проверку на 0, чтобы не было ошибки деления на 0 3 Чтобы использовать встроенные функции Delphi, добавил в uses модуль Math 4 Небольшой косметический ремонт: 4.1 Добавил на форму TPaintBox, установил свойство Align = alClient и отрисовку стал проводить на нем 4.2 Свойству Form1.OnResize поставил OnPaint И др. изменения. Смотрите сами... (см. пример в приложении). Удачи! Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormPaint(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses Math; procedure TForm1.FormPaint(Sender: TObject); var x0, y0: integer; // координаты начала координатных осей x, y, i: integer; lx, ly: real; // метки (оцифровка) линий сетки по X и Y // dlx, dly: real; // шаг меток (оцифровки) линий сетки по X и Y tmpR: real; // временная переменная для хранения тангенса const // Это поможет исправить Вашу ошибку, // правда снизит точность, но Вы все равно этого // не заметите даже под микроскопом, // т.к. у Вас все равно происходит округление // с пом. функции Round Pi: real = 3.14; dXY = 50; // Шаг координатной сетки hdXy = 25; // Половина шага координатной сетки dlx: Real = 3.14 ; // шаг меток оси X dly: Real = 1.0; // шаг меток оси Y begin x0:= Self.ClientWidth shr 1; // оси начинаются в центре form1 y0:= Self.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, Self.Height); // ось Y- MoveTo(x0, y0); LineTo(Self.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-я метка - единица i:= 1; repeat MoveTo(x, y0 - 3); LineTo(x, y0 + 3); // засечка if ((i and 1) = 0) then TextOut(x - 8, y0 + 5, floattostr(i/2) + 'п') else TextOut(x - 12, y0 + 5, floattostr(i) + 'п/2'); // оцифровка Pen.Style:= psDot; // линия - штрихпунктирная MoveTo(x, 0); LineTo(x, Self.Height); // линия сетки lx:= lx + dlx; // увеличиваем метку на шаг x:= x + dXY; // переходим к следующей засечке inc(i); until (x > Self.Width); // засечки, сетка и оцифровка по оси X- lx:= 0; // обнуляем метку lx:= lx - dlx; // теперь метки отрицательные x:= x0 - dXY; // переходим на место 1-й засечки на оси X- i:= -1; repeat MoveTo(x, y0 - 3); LineTo(x, y0 + 3); if ((i and 1) = 0) then TextOut(x - 8, y0 + 5, floattostr(i/2) + 'п') else TextOut(x - 12, y0 + 5, floattostr(i) + 'п/2'); // оцифровка MoveTo(x, 0); LineTo(x, Self.Height); // линия сетки lx:= lx - dlx; // уменьшаем метку на шаг, т. к. ось X- x:= x - dXY; // переходим к следующей засечке dec(i); 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)); // оцифровка MoveTo(x0 + Self.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)); // оцифровка MoveTo(x0 + Self.Width, y); LineTo(0, y); // линия сетки y:= y + dXY; // переходим к следующей засечке ly:= ly - dly; // уменьшаем метку на шаг т. к. Ось Y- until (y > Self.Height); // тангенс рисуется сплошной линией pen.Style:= psSolid; // TG moveto(0, y0); for x:= -hdXY to Pred(hdXY) do for y:= 0 to Pred(dXY) do begin tmpR:= Tan((x + y/dXY) * Pi/2); if not (tmpR = 0.0) then lineto(x0 + x*dXY + y, y0 - round(dXY * tmpR)); end; // Цвет синуса и котангенса pen.Color:= clfuchsia; // SIN moveto(0, y0); for x:= -20 to 20 do for y:= 0 to dXY do lineto(x0 + x*dXY + y, y0 - round(dXY * sin((x + y/dXY) * pi/2))); // CTG moveto(0, y0); for x:= -hdXY to Pred(hdXY) do for y:= 0 to Pred(dXY) do begin tmpR:= Tan((x + y/dXY) * (Pi/2)); if not (tmpR = 0.0) then lineto(x0 + x*dXY + y, y0 - round(dXY/tmpR)); end; end; end; end.

Ответ отправил: Denisss (статус: Специалист) Отправлен: 26.02.2006, 12:26 Оценка за ответ: 5 Комментарий оценки: Жаль, что нет оценки больше 5. Я бы поставил минимум 10

Отвечает: Полховский Александр Владимирович Здравствуйте, Solovej! Пожалуйтса. Тут дело в том, что синус-то -- функция непрерывная, а тангенс и котангенс имеют абсциссы, в которых ордината стремится к +/- бесконечности. А посему, писать процедуру прорисовки придётся для каждой повторяющейся части. Это первое. Второе -- параметр функций sin и cos -- угол в радианах, а у тебя в параметрах стоят координаты в пикселях. Каждые 40 пикселей координата меняется на п/2. Во блин, сетку-то ты поменял, 50 там пикселей теперь. А я тут голову сломал. вот процедура для котангенса moveto(x0-20*100+50, y0); pen.Style:=psSolid; pen.Color:=clblack; for x:=-5 to 5 do begin moveto(x0+x*100-50, y0+100); for y:=1 to 99 do begin lineto(x0+x*100-50+y, y0-round(5*sin((x*100+y-50)*pi/100)/cos((x*100+y-50)*pi/100))); end; end; Умножил на 5, чтобы выразительнее был график. Если заметил, то точки в ординатами, кратными п/2 (то есть 50 -- шагу сетки) не прорисовываются, так как косинус даст 0 и вылезет ошибка. Это всё на самом деле просто, нарисовал бы на бумаге, понял бы всё. И в остальных на 50 не забудь поменять. --------- Спасём нашу хрупкую планету !

Ответ отправил: Полховский Александр Владимирович (статус: Студент) Отправлен: 26.02.2006, 17:59 Оценка за ответ: 5 Комментарий оценки: Sorry за то, что заставил голову сломать :) Просто в коде было много чего лишнего после моих экспериментов и когда код приводил в первоначальное состояние видимо забыл 50 на 40 исправить

Вопрос № 36.227

Здравия желаю, господа эксперты! У меня два вопроса: 1) как сделать форму с Borderstyle="bsNone" «перетаскиваемой» и чтобы она не отображалась на панели задач, а только на экране? 2) как сделать, чтобы MediaPlayer проигрывал «по кругу» все композиции из ListBox, например? Заранее благодарен.

Отправлен: 26.02.2006, 09:08 Вопрос задал: UnRe@l (статус: Посетитель) Всего ответов: 6 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Ерёмин Андрей Здравствуйте, UnRe@l! 1) Как это сделать, описано в этой статье (в самом конце) - делается очень легко. 2) Функцию плей-листа я уже когда-то показывал одному из читателей данной рассылки. В прикреплённом файле пример. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа. --------- Нет правила без исключений. Правило без исключений - исключение из правил.

Ответ отправил: Ерёмин Андрей (статус: Профессионал) Отправлен: 26.02.2006, 09:50 Оценка за ответ: 5

Отвечает: Ujin Antikvar Здравствуйте, UnRe@l! 1. решение этого вопроса очень простое unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST; private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.WMNCHitTest(var Message: TWMNCHitTest); begin inherited; Message.Result := HTCAPTION; end; end. --------- "Будущее принадлежит тем, кто верен своей мечте" - Элеонора Рузвельт

Ответ отправил: Ujin Antikvar (статус: 5-ый класс) Отправлен: 26.02.2006, 11:57 Оценка за ответ: 5

Отвечает: Данилевич Игорь Владимирович Здравствуйте, UnRe@l! 1) Можно сделать и подругому. Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormShow(Sender: TObject); private { Private declarations } public procedure WMLButtonDown(var M: TWMLButtonDown); message wm_LButtonDown; { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.WMLButtonDown(var M: TWMLButtonDown); begin //делаем форму перетаскиваемой. PostMessage(Form1.Handle, WM_SYSCOMMAND, $f012, 0); // inherited; end; procedure TForm1.FormShow(Sender: TObject); begin //прячем иконку приложения из панели задач. ShowWindow(Application.Handle, SW_HIDE); end; end.

Ответ отправил: Данилевич Игорь Владимирович (статус: 1-ый класс) Отправлен: 26.02.2006, 12:16 Оценка за ответ: 5

Отвечает: Vual Здравствуйте, UnRe@l! 1) Перетаскивание за форму: procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); const SC_DragMove = $F012; begin ReleaseCapture; perform(WM_SysCommand, SC_DragMove, 0); end; Не отображалась на панели задач: procedure TForm1.FormActivate(Sender: TObject); begin ShowWindow (Application.Handle, SW_HIDE); end;

Ответ отправил: Vual (статус: 1-ый класс) Отправлен: 26.02.2006, 17:02 Оценка за ответ: 5

Отвечает: Leshiy2006 Здравствуйте, UnRe@l! 1) По поводу перетаскивания см. приложение Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, XPMan, Buttons; type TForm1 = class(TForm) SpeedButton1: TSpeedButton; XPManifest1: TXPManifest; procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure FormActivate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin ReleaseCapture; Form1.Perform(WM_SYSCOMMAND,$F012,0); end; procedure TForm1.FormActivate(Sender: TObject); begin ShowWindow (Application.Handle, SW_HIDE); end; end.

Ответ отправил: Leshiy2006 (статус: 3-ий класс) Отправлен: 26.02.2006, 23:03 Оценка за ответ: 5

Отвечает: Diman_A Здравствуйте, UnRe@l! По поводу перетаскивания: private procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest; procedure TForm1.WMNCHitTest(var M: TWMNCHitTest); begin inherited; if M.Result = htClient then M.Result := htCaption; end; Чтобы прога не вылезала на панель задач, напиши в обработчике Onshow: ShowWindow(Application.Handle, sw_hide);

Ответ отправил: Diman_A (статус: 6-ой класс) Отправлен: 27.02.2006, 16:23

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

---

В избранное