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

Выпуск № 1139
от 06.06.2008, 07:05

Вопрос № 138.255

Подскажите как в Delphi 2007 работать с Excel. Раньше работал Delphi 7 и там был класс ExcelXP, а есть ли аналог для Delphi 2007?

Отправлен: 28.05.2008, 12:10 Вопрос задал: Владик (статус: 2-ой класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Лукьяненко Алексей Валериевич Здравствуйте, Владик! Если Вы устанавливали Delphi 2007 с выбором опции "Microsoft(R) Office Controls" - то есть, а если не выбирали - то нет.

Ответ отправил: Лукьяненко Алексей Валериевич (статус: Студент) Ответ отправлен: 28.05.2008, 12:20 Оценка за ответ: 5 Комментарий оценки: Спасибо за совет. И все же как можно установить этот класс, если делфи уже стоит?

Вопрос № 138.278

Здраствуйте. Имеется задача. Нужно создать тестовый файл где все вопросы будут перемешаны в случайном порядке. 1 Вопрос Ответ №1 Ответ №2 Ответ №3 Ответ №4 2 Вопрос Ответ №1 Ответ №2 Ответ №3 Ответ №4 2 Вопрос Ответ №1 Ответ №2 Ответ №3 Ответ №4 Задача состоит в том чтоб вопросы 1-3, каждый раз выдавались в случайном порядке, вместе с ответами и писались в текстовый файл. Как не ковырялся, никак не смог придумать реализацию, подскажите пожалуйста.

Отправлен: 28.05.2008, 13:41 Вопрос задал: Matecha Max A. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Павел Шведенко Здравствуйте, Matecha Max A.! У тебя есть список вопросов - пусть это будет одномерный массив X(10) Тогда второй массив Y(10) забиваешь по рэндому, с i=1 to 10, и смотришь если число встречается в массиве то окидываешь и рэндом испльзуешь снова. В конце концов соотвествие X Y 1 - 9 2 - 3 3 - 4 Берешь вопросы с массива Y. Вот алгоритм, что могу предложить. --------- Всегда

Ответ отправил: Павел Шведенко (статус: 2-ой класс) Ответ отправлен: 28.05.2008, 14:02

Вопрос № 138.310

Уважаемые эксперты, помогите написать програмку: Создать функцию Leng(f) для определения числа пустых строк в текстовом файле f.

Отправлен: 28.05.2008, 16:16 Вопрос задал: Sokolov Vitaliy Aleksandrovich (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: SHERRY Здравствуйте, Sokolov Vitaliy Aleksandrovich! Вот Ваша функция. function Leng(path: string): integer; // название функции, входящий параметр - путь к файлу, возвращаемый тип - целочисленный var s: string; // считываемая строка из файла count: integer; // счётчик пустых строк f: TextFile; // файловая переменная begin Leng := 0; count := 0; // инициализация AssignFile(f, path); // задаём файловой переменной f файл на диске, находящийся по адресу из переменной path Reset(f); // открываем файл для чтения While not EOF(f) do // до тех пор, пока не достигнут конец файла begin readln(f, s); // считываем строку из файла if length(s)=0 then inc(count); // если она пуста, то увеличим счётчик не единичку end; Leng := count; // функция должна вернуть результат. Это будет число из переменной count CloseFile(f); // закрываем файл end; --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 10-ый класс) Ответ отправлен: 28.05.2008, 17:11 Оценка за ответ: 5 Комментарий оценки: Отлично!

Вопрос № 138.390

Привет всем! Дана програма в паскале.Помогите ее оформить в Делфи. текст програмы смотреть в приложении. Приложение: uses crt; type Dtip=array [1..10,1..10] of real; Atip=array [1..10,1..10] of real; var Dmas:Dtip; Amas:Atip; n,m,i,j:integer; d,max:real; begin clrscr; writeln('Vvedite n i m:'); readln(n,m); writeln('Vvedite massiv:'); writeln; for i:=1 to n do for j:=1 to m do begin write ('Vvedite [',i,',',j,'] element massiva: '); readln(Dmas[i,j]); end; clrscr; max:=abs(Dmas[1,1]); for i:=1 to n do for j:=1 to m do begin if max<abs(Dmas[i,j]) then max:=abs(Dmas[i,j]); end; for i:=1 to n do for j:=1 to m do Amas[i,j]:=Dmas[i,j]/max; for i:=1 to n do begin writeln; for j:=1 to m do begin write (Dmas[i,j]:4:1,' '); end; end; Writeln; Writeln; Writeln('Poluchenyy massiv:'); Writeln; for i:=1 to n do begin writeln; for j:=1 to m do begin write (Amas[i,j]:4:1,' '); end; end; readkey; end.

Отправлен: 28.05.2008, 23:27 Вопрос задал: Клаткевич Денис Консантинович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Владик Здравствуйте, Клаткевич Денис Консантинович! Если интересно, могу выслать все приложение на мыло Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Mask, ExtCtrls; type TForm1 = class(TForm) Memo1: TMemo; Panel1: TPanel; Label3: TLabel; Panel2: TPanel; Edit1: TEdit; Label1: TLabel; Label2: TLabel; Edit2: TEdit; Button2: TButton; Edit3: TEdit; Button3: TButton; procedure Edit1KeyPress(Sender: TObject; var Key: Char); procedure Edit2KeyPress(Sender: TObject; var Key: Char); procedure Button2Click(Sender: TObject); procedure Edit3KeyPress(Sender: TObject; var Key: Char); procedure Button3Click(Sender: TObject); private { Private declarations } public { Public declarations } end; type Dtip=array [1..10,1..10] of real; Atip=array [1..10,1..10] of real; var Form1: TForm1; Dmas:Dtip; Amas:Atip; n,m,i,j:integer; d,max:real; s:string; implementation {$R *.dfm} procedure TForm1.Button2Click(Sender: TObject); begin if ((form1.Edit1.Text='') or (form1.Edit2.Text='')) then Showmessage('Введены не данные') else begin form1.panel1.visible:=true; i:=1; j:=1; form1.Label3.Caption:='Введите [1,1] елемент массива'; m:=StrToInt(form1.Edit1.Text); n:=StrToInt(form1.Edit2.Text); end; end; procedure TForm1.Button3Click(Sender: TObject); begin if i<=m then begin if j<=n then begin Dmas[i,j]:=StrToInt(form1.Edit3.Text); form1.Label3.Caption:='Введен ['+IntToStr(i)+','+IntToStr(j)+'] елемент массива'; form1.Edit3.Text:=''; j:=j+1; end; if (j=n+1)and(i<>m) then begin i:=i+1; j:=1; end else if (i=m)and(j=n+1) then begin max:=abs(Dmas[1,1]); for i:=1 to n do for j:=1 to m do begin if max>abs(Dmas[i,j]) then max:=abs(Dmas[i,j]); end; for i:=1 to n do for j:=1 to m do Amas[i,j]:=Dmas[i,j]/max; for i:=1 to n do begin for j:=1 to m do s:=s+FloatToStr(Dmas[i,j])+' '; form1.Memo1.Lines.Add(s); s:=''; end; form1.Memo1.Lines.Add(''); form1.Memo1.Lines.Add(''); form1.Memo1.Lines.Add('Полученный массив'); form1.Memo1.Lines.Add(''); for i:=1 to n do begin for j:=1 to m do s:=s+FloatToStr(Amas[i,j])+' '; form1.Memo1.Lines.Add(s); s:=''; end; end; end; end;

Ответ отправил: Владик (статус: 2-ой класс) Ответ отправлен: 29.05.2008, 16:18

Вопрос № 138.399

Здравствуйте, эксперты. К Вам такой вопрос: Дан текстовый файл, скажем 123.txt В нем находиться информация следующего рода: Привет, как дела? 4-2 Что нового ? 9*8 раолывраорыворо 4/2 влыоалвра 5+5. И так Нам нужно выбрать из этого файла все арифметические уравнения, посчитать их, и вывести скажем на форму, в МЕМО. Помогите, пожалуйста...

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

Отвечает: Павел Шведенко Здравствуйте, Makavely! Открываешь файл, чтение за раз из файла - 1 байт. Считываешь по символьно и проверяешь входит ли символ в множество цифр+арифметичские символы, как только символ входит в множество, флаг(переменная ИСТИНА/ЛОЖЬ) то что найдено уравнение становится ИСТИНА (с этого момента скидываешь в переменную буфер все символы, пока Флаг==ИСТИНА), как только очередной символ не входит в множество Флаг = ЛОЖЬ, снизу в коде после чтения символа и проверки на вхождение в множество проверка что флаг только что стал из ИСТИНА в ЛОЖЬ, тогда выводишь в Memo. Вот весь алгоритм. --------- Всегда

Ответ отправил: Павел Шведенко (статус: 2-ой класс) Ответ отправлен: 29.05.2008, 09:08 Оценка за ответ: 4 Комментарий оценки: Спасибо, можно разобраться, хотя бы подтолкнули на мысль...

Вопрос № 138.427

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

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

Отвечает: Абельхарисов Руслан / Marked One Здравствуйте, Chargos! Для того чтобы создать компонент Tlabel программно добавьте в Uses модуль StdCtrls. Потом объявите глобальную переменную MyLabel, её тип - TLabel. Положите на форму кнопку, по её нажатию мы будем создавать подпись. В обработчик события OnClick поставьте этот код: //Создание подписи procedure TForm2.Button1Click(Sender: TObject); begin   //Если подпись не создана, то создаем   if MyLabel = nil then    begin //Создаем подпись     MyLabel:=TLabel.Create(nil);     //помещаем её на форму     Form2.InsertControl(MyLabel);     //Изменяем заголовок, по умолчанию он пустой     MyLabel.Caption:='Программно созданная подпись';    end   else    //Если подпись уже создана, то выводим сообщение об ошибке    Application.MessageBox('Подпись уже создана!', 'Ошибка!!!', MB_OK + MB_ICONERROR); end; Обращаться к свойствам Label'а нужно так же как к положенному на форму. В приложении пример создающий подпись и позволяющий изменить её текст. Этот способ создания компонентов называется динамическим. Удачи!!! Приложение: unit Unit2; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm2 = class(TForm) Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; //компонент TLabel MyLabel: TLabel; implementation {$R *.dfm} //Создание подписи procedure TForm2.Button1Click(Sender: TObject); begin //Если подпись не создана, то создаем if MyLabel = nil then begin //Создаем подпись MyLabel:=TLabel.Create(nil); //помещаем её на форму Form2.InsertControl(MyLabel); //Изменяем заголовок, по умолчанию он пустой MyLabel.Caption:='Программно созданная подпись'; end else //Если подпись уже создана, то выводим сообщение об ошибке Application.MessageBox('Подпись уже создана!', 'Ошибка!!!', MB_OK + MB_ICONERROR); end; //Изменение подписи procedure TForm2.Button2Click(Sender: TObject); begin //Если подпись не создана, то выводим сообщение об ошибке и выходим из процедуры if MyLabel = nil then begin Application.MessageBox('Сначало создайте подпись!', 'Ошибка!!!', MB_OK + MB_ICONERROR); exit; end; //Иначе изменяем подпись MyLabel.Caption:=InPutBox('Заголовок', 'Введите новый текст: ', 'Текст'); end; end.

Ответ отправил: Абельхарисов Руслан / Marked One (статус: Студент) Ответ отправлен: 29.05.2008, 15:54

Вопрос № 138.478

Здравствуйте ув. Эксперты. Помогите, пожалуйста. У меня есть папка Directory и в ней есть разные файлы (*.jpg, *.avi, *.doc, *.dbf, *.txt и т.д.). Как сделать так, что по нажатию кнопки ОК, все эти файли сортируются по папкам, тоесть файли *.jpg в папку jpg, файлы *.dbf в папку dbf и т.д. Заранее спасибо, с нетерпением жду ответа.

Отправлен: 29.05.2008, 13:26 Вопрос задал: Зигура Ярослав Анатолиевич Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Raptor3 Здравствуйте, Зигура Ярослав Анатолиевич! Принцип работы - бежим по директории получаем имя файла(и его расширение). Проверяем существует ли директория с именем равным расширению(DirectoryExists) - если нет то содаем (CreateDir), перемещаем файл (MoveFile). Все!!! пример "бега" по директории в приложении(функция создает список файлов - модернизировать не составит труда) Приложение: procedure ListFileDir(Path: string; FileList: TStrings); var SR: TSearchRec; begin ExistsDirectory if FindFirst(Path + '*.*', faAnyFile, SR) = 0 then begin repeat if (SR.Attr <> faDirectory) then begin FileList.Add(SR.Name); end; until FindNext(SR) <> 0; FindClose(SR); end; end; --------- Программист - это человек который решает проблему, о которой вы не знаете, способом который вы не понимаете

Ответ отправил: Raptor3 (статус: 8-ой класс) Ответ отправлен: 29.05.2008, 14:06

Вопрос № 138.491

Здравствуйте уважаемы экперты, помогите мне пожалуйста. На форме есть немного CheckBox1, один Edit1, и Button1. CheckBox1 озаглавлен как avi, mp3, ico, и т.д. в Edit прописываю сайт а Button1 отвечает за скачивание файла вот таким образом const SourceFile = 'http://www.fishki.net/1.ico'; DestFile = 'C:Temp'; begin if DownloadFile(SourceFile, DestFile) then begin ShowMessage('Загрузка успешно завершена'); ShellExecute(Application.Handle, PChar('open'), PChar(DestFile), PChar(''), nil, SW_NORMAL) end else ShowMessage('Ошибка при загрузке ' + SourceFile) Как мне присоединить CheckBox1, что при галочке avi он скачивал бы видео файл, и аналогично другие. А не в программе постоянно переделывать эти строки: const SourceFile = 'http://www.fishki.net/1.ico'; DestFile = 'C:Temp'; Заранее спасибо большое С уважением sefiros

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

Отвечает: BlackRaider Здравствуйте, Sefiros! Несколько не понятно как вы отмечаете в обном Checkbox'е больше 2 параметров. Очевидно опечатались и несколько Checkbox'ов вообщем из const убираем. SourceFile = 'http://www.fishki.net/1.ico'; добавляем : var SourceFile:string; после begin пишем Самый простой вариант if checkbox1.checked then SourceFile = 'http://www.fishki.net/1.ico'; if checkbox2.checked then SourceFile = 'http://www.fishki.net/1.mp3'; if checkbox3.checked then SourceFile = 'http://www.fishki.net/1.avi'; и т.д. далее... а дельше по коду.который у вас есть.

Ответ отправил: BlackRaider (статус: 3-ий класс) Ответ отправлен: 29.05.2008, 15:06 Оценка за ответ: 5 Комментарий оценки: Спасибо большое, что откликнулись на мой вопрос. Я подумывал над тем, чтоб переместить SourceFile из const в var, а как же быть с Edit1 , я так понимаю, он лишний?

Вопрос № 138.509

ПРОШУ помощи. Завтра нужно сдать эту программу: Задача 1 Написать процедуры для записи в текстовый файл и считывания из файла массива из 20 целых чисел по четыре числа в каждой строке.

Отправлен: 29.05.2008, 16:40 Вопрос задал: Sokolov Vitaliy Aleksandrovich (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Gh0stik Здравствуйте, Sokolov Vitaliy Aleksandrovich! Вот код, который соответствует Вашему условию: const m=5; n=4; type mas=array [1..m,1..n] of integer; procedure fRead(var x:mas); //процедура чтения var i,j:integer; begin   assign(input,'input.txt'); reset(input);   for i:=1 to m do begin     for j:=1 to n do read(x[i,j]);     readln;   end;   close(input); end; procedure fWrite(x:mas);  //процедура записи var i,j:integer; begin   assign(output,'output.txt'); rewrite(output);   for i:=1 to m do begin     for j:=1 to n do write(x[i,j]:5);     writeln;   end;   close(output); end; //************* Основная программа ************** var a:mas; begin   //использование процедур   fRead(a);   fWrite(a); end. Примечание: При заполнении файла с данными (input.txt) вводите по четыре числа в строке разделённые пробелами! Good Luck! --------- Непечатный жаргон - это тот язык, которым решительно все программисты владеют в совершенстве.

Ответ отправил: Gh0stik (статус: Академик) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) WWW: http://gh0stik.rusfaq.ru/ ICQ: 289363162 ---- Ответ отправлен: 29.05.2008, 17:15 Оценка за ответ: 5 Комментарий оценки: Спасибо.

Вопрос № 138.527

Здраствуйте уважаемые эксперты! Подскажите как выделенному тексту(в Edit,memo, RichEdit....неважно) присвоить шрифт???

Отправлен: 29.05.2008, 17:28 Вопрос задал: Русяев Р.В. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Gaolong Здравствуйте, Русяев Р.В.! в приложении пример через Диалог для RichEdit Приложение: with FontDialog1 do if Execute then begin RichEdit1.SelAttributes.Name:=Font.Name; end; end;

Ответ отправил: Gaolong (статус: 1-ый класс) Ответ отправлен: 29.05.2008, 18:00

Вопрос № 138.541

Привет!!! Срочно нужна ваша помощь. Задание: Расположит на шахматной доске 8 ферзей, так чтобы они не угрожали друг другу. Поставим первого ферзя на какую нибудь клктку. Затем поставим второго ферзя на первую клетку и проверим, что уму не угрожает первый. Если угрожает, то передвинем второго ферзя и сново проверим, и т.д. Когда второй ферзь окажется на допустимой клетке, возбмём третего ферзя и будем двигать его, пока он не окажется в допустимой позиции, и т. д. Использовать рекурсивную функцию. Программа должна быть составлена на Delphi. Помогите пожалуйста изменить программу так чтобы она выводила ответ в компонент StringGrid и вместо объектов(ферзей) ставила цифры от 1 до 8. Количество вариантов и остальное ненужно. Вот сама программа, только я ни как не могу её изменить помогите кому не трудно. Заранее большое СПAСИБО!!! Текст программы перенесен в приложение. ----- ∙ Отредактировал: Denisss (Профессор) ∙ Дата редактирования: 29.05.2008, 18:25 Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TQueen = class (TObject); TForm1 = class(TForm) BitBtn1: TBitBtn; StringGrid1: TStringGrid; procedure BitBtn1Click(Sender: TObject); private function canAttack (testRow, testColumn : integer) : boolean; { Private declarations } public constructor Create (initialColumn : integer; nbr : TQueen); function findSolution : boolean; function advance : boolean; procedure print; { Public declarations } end; var Form1: TForm1; row : integer; column : integer; neighbor : TQueen; implementation {$R *.dfm} function Queen.findSolution : boolean; var done : boolean; begin done := false; findsolution := true; (* ïðîâåðêà ïîçèöèè *) if neighbor <> nil then while not done and neighbor.canAttack(row, column) do if not self.advance then begin findSolution := false; done := true; end; end; function Queen.advance : boolean: begin advance := false; (* ïðîáóåì ñëåäóþùóþ ñòðîêó *) if row < 8 then begin row := row + 1; advance := self.findSolution; end else begin (* íå ìîæåì äâèãàòüñÿ äàëüøå *) (* ñäâèíóòü ñîñåäà ê ñëåäóþùåìó ðåøåíèþ *) if neighbor <> nil then if not neighbor.advance then advance := false else begin row := 1; advance := self.findSolution; end; end; end; procedure TForm1.BitBtn1Click(Sender: TObject); begin lastQueen := nil; for i := 1 to 8 do begin (* ñîçäàòü è èíèöèàëèçèðîâàòü íîâîãî ôåðçÿ *) lastQueen := Queen.create(i, lastQueen); lastQueen.findSolution; end; // ïå÷àòü ðåøåíèÿ lastQueen.print; end; end.

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

Отвечает: Denisss Здравствуйте, Slim1210! См. пример в приложении. Поскольку Ваш код какой-то неполный, то полный код взял здесь: Т. Бадд. Объектно-ориентированное программирование в действии. Для того, чтобы пример при нажатии на кнопку выдавал каждый раз новый результат, я применил генератор случайных чисел (Random). Удачи! Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls, Buttons; type TQueen = class private (* поля данных *) fRow: integer; fColumn: integer; fNeighbor: TQueen; public (* инициализация *) constructor Create(col: integer; ngh: TQueen); (* операции *) function canAttack(testRow, testColumn: integer): boolean; function findSolution: boolean; function advance: boolean; property Row: Integer read fRow; property Column: Integer read fColumn; property Neighbour: TQueen read fNeighbor; end; TForm1 = class(TForm) BitBtn1: TBitBtn; StringGrid1: TStringGrid; procedure BitBtn1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation { TQueen } constructor TQueen.Create(col: integer; ngh: TQueen); begin inherited Create; (* инициализация нашего столбца и соседних значений *) fColumn:= col; fNeighbor:= ngh; (* начать со случайной строки *) fRow:= Random(8) + 1; end; function TQueen.advance: boolean; begin Result:= false; (* попробовать следующий ряд *) if (fRow < 8) then begin Inc(fRow); Result:= self.findSolution; end else begin (* дальше нельзя *) (* передвинуть соседа, чтобы получить следующее решение *) if (fNeighbor <> nil) then if not fNeighbor.advance then Result:= false else begin (* начать снова с горизонтали 1 *) fRow:= 1; Result:= self.findSolution; end; end; end; function TQueen.canAttack(testRow, testColumn: integer): boolean; var can: boolean; columnDifference: integer; begin (* проверить, одинаковые ли строки *) can:= (fRow = testRow); (* теперь проверить диагонали *) if not can then begin columnDifference:= testColumn - column; if ((fRow + columnDifference = testrow) or (fRow - columnDifference = testRow)) then can:= true; end; (* наконец проверить соседей *) if ((not can) and (fNeighbor <> nil)) then can:= fNeighbor.canAttack(testRow, testColumn); Result:= can; end; function TQueen.findSolution: boolean; var done: boolean; begin done:= false; Result:= true; (* найти подходящую позицию *) if (fNeighbor <> nil) then while (not done and fNeighbor.canAttack(fRow, fColumn)) do if not self.advance then begin Result:= false; done:= true; end; end; { TForm1 } {$R *.dfm} procedure TForm1.BitBtn1Click(Sender: TObject); var neighbor, lastQueen: TQueen; i, j: integer; begin (* Подготовим StingGrid *) with StringGrid1 do begin FixedCols:= 1; FixedRows:= 1; ColCount:= 9; RowCount:= 9; RowHeights[0]:= 24; ColWidths[0]:= 24; for i:= 0 to 9 do for j:= 0 to 9 do Cells[i, j]:= ' '; for i:= 1 to 8 do begin RowHeights[i]:= 24; ColWidths[i]:= 24; Cells[i, 0]:= ' ' + Char(Ord('a') + i - 1); Cells[0, i]:= ' ' + IntToStr(i); end; end; (* Подготавливаем генератор случайных чисел *) Randomize; neighbor:= nil; for i:= 1 to 8 do begin (* создать и инициализировать нового ферзя *) lastQueen:= TQueen.Create(i, neighbor); if not lastQueen.findSolution then MessageBox(Handle, 'Не удалось найти решения', 'Нет решения', MB_ICONASTERISK or MB_OK or MB_DEFBUTTON1); (* самый новый ферзь является следующим соседом *) neighbor:= lastQueen; end; for i:= 1 to 8 do begin with lastQueen do StringGrid1.Cells[Column, Row]:= ' ' + IntToStr(9-i); neighbor:= lastQueen.Neighbour; lastQueen.Free; lastQueen:= neighbor; end; end; end. --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессор) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 29.05.2008, 19:49

Вопрос № 138.546

Что писать в uses соответстцующего модуля, чтоб Дельфи "узнала" интерфейс IHTMLAnchorElement? Нашёл пример, где упоминается этот интерфейс, попробовать не получается. [Error] Unit1.pas(110): Undeclared identifier: 'IHTMLAnchorElement'

Отправлен: 29.05.2008, 18:39 Вопрос задал: Сергеев Алексей Павлович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Denisss Здравствуйте, Сергеев Алексей Павлович! В Delphi 7 этот интерфейс описан в модуле MSHTML (....BorlandDelphi7SourceInternetmshtml.pas). Успехов! --------- Будь осторожен, когда молишься ради чего-то, потому что можешь это получить...

Ответ отправил: Denisss (статус: Профессор) Россия, Москва ICQ: 281599577 ---- Ответ отправлен: 29.05.2008, 19:02 Оценка за ответ: 5 Комментарий оценки: Коротко, ясно и верно. Проблему решить удалось. Ещё был элемент везения: у меня как раз Delphi7

Вопрос № 138.602

здраствуйте!!! подскажите пожалуста как организовать поиск и замену переменных в коде делфи например есть вот такое: procedure TForm1.Button1Click(Sender: TObject); var i, w, e :Integer; s:string; begin s:=''; for i:=0 to 20 do begin end; end; переменный нужно изменить на произвольный набор символов procedure TForm1.Button1Click(Sender: TObject); var qwert, hghkmjk,hjhjhk :Integer; grew :string; begin grew:=''; for qwert:=0 to 20 do begin end; end;

Отправлен: 29.05.2008, 23:46 Вопрос задал: Дмитрий Сергеевич Казак (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 3)

Отвечает: Mukomelo Yevgeniy Bogdanovich Здравствуйте, Дмитрий Сергеевич Казак! В том случае, если Вам это нужно Не для ВУЗа или Колледжа, а просто Вам действительно необходимо поменять идентификаторы в программе, пользуйтесь Delphi 2007, там уже реализована данная возможность. Выделяете кусок листинга, кликаете по появившейся кнопочке слева от текста и меняете идентификатор в одном месте, и он меняется во всем выделенном фрагменте кода. --------- Никогда не бойся делать то, что ты не умеешь. Помни, ковчег был построен любителем. Профессионалы построили 'Титаник'.

Ответ отправил: Mukomelo Yevgeniy Bogdanovich (статус: 1-ый класс) Ответ отправлен: 30.05.2008, 05:55

Вопрос № 138.649

Подскажите пожалуйста как организовать ТОЧНЫЙ секундомер? TTimer не устраивает, так как очень большая погрешность 1минута=42секундам. 18 секунд погрешность это много.

Отправлен: 30.05.2008, 12:28 Вопрос задал: Владик (статус: 2-ой класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 8)

Отвечает: Raptor3 Здравствуйте, Владик! Вот найдено на просторах инета http://z-oleg.com/delphi/systimer.htm модуль mmsystem: Функция имеет вид: MMRESULT timeSetEvent( UINT uDelay, // Задержка в мс UINT uResolution, // Разрешающая способность LPTIMECALLBACK lpTimeProc, // Указатель на процедуру-обработчик DWORD dwUser, // Параметр разработчика UINT fuEvent // Тип события ); Приложение: Рассмотрим учебный пример, демонстрирующий особенности работы обычного таймер и мультимедиа-таймера: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, mmsystem, ExtCtrls; type TForm1 = class(TForm) Memo1: TMemo; Timer1: TTimer; Button1: TButton; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Button1Click(Sender: TObject); private { Private declarations } public MMTimer1 : integer; // Код мультимедийного таймера end; var Form1: TForm1; Cnt1, Cnt2 : integer; implementation {$R *.dfm} procedure MyTimerCallBackProg(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall; begin Inc(Cnt1); // Счетчик срабатывания мультимедиа таймера end; procedure TForm1.FormCreate(Sender: TObject); begin MMTimer1 := timeSetEvent(1,1,@MyTimerCallBackProg,100,TIME_PERIODIC); end; procedure TForm1.FormDestroy(Sender: TObject); begin // Удаление таймера при завершении программы timeKillEvent(MMTimer1); end; procedure TForm1.Timer1Timer(Sender: TObject); begin inc(Cnt2); // Счетчик срабатывания обычного таймера end; procedure TForm1.Button1Click(Sender: TObject); var t : integer; begin Memo1.Lines.Clear; Memo1.Lines.Add('Опыт 1 - Sleep на 5 секунд'); Cnt1 := 0; Cnt2 := 0; Sleep(5000); Memo1.Lines.Add('Число срабатываний мультимедиа таймера = '+IntToStr(Cnt1)); Memo1.Lines.Add('Число срабатываний TTimer c Interval=1 = '+IntToStr(Cnt2)); Memo1.Lines.Add('Опыт 2 - Цикл ожидания с Application.ProcessMessages'); Cnt1 := 0; Cnt2 := 0; t := GetTickCount; while GetTickCount - t < 5000 do Application.ProcessMessages; Memo1.Lines.Add('Число срабатываний мультимедиа таймера = '+IntToStr(Cnt1)); Memo1.Lines.Add('Число срабатываний TTimer c Interval=1 = '+IntToStr(Cnt2)); end; end. На форме необходимо разместить Memo1 типа TMemo и таймер типа TTimer с интервалом 1 и обрабочтчиком Timer1Timer. В этом примере очень хорошо видно, что на время Sleep обычный таймер не действует (т.к. он основан на сообщениях). Кроме того, очень наглядна разница в точности - мультимедийный таймер срабатывает примерно 5000 раз за 5 секунд (как и положено по его настройке). Обычный таймер в первом опыте не срабатывает вообще, во втором опыте срабатывает примерно 320 раз (т.е. примерно один раз в 15 мс) --------- Программист - это человек который решает проблему, о которой вы не знаете, способом который вы не понимаете

Ответ отправил: Raptor3 (статус: 8-ой класс) Ответ отправлен: 30.05.2008, 14:12 Оценка за ответ: 5 Комментарий оценки: Спасибо! Есть повод для продолжения работы.

Вопрос № 138.654

Здравствуйте, уважаемые эксперты! Подскажите, пожалуйста, в чем может быть проблема. У меня есть 2 программы, которые работают с одной таблицей ADOTable одновременно.В первой программе по кнопке(в бесконечном цикле) проверяются нажатия клавиш и вносятся в таблицу в определенную строчку. ADOTable.Edit; ...... ADOTable.Post; ADOTable.Edit; Во второй программе (тоже в бесконечном цикле) происходит чтение из этой же таблицы(с задержкой в секунду) и данные заносятся в соответствующие метки, причем каждый раз таблица открывается и закрывается. НО данные на форме в метках не изменяются. Сначала подумал на Post(в первой программе). Добавил после него Close/ Open. Но это не помогло. Подскажите, в чем может быть дело? Заранее спасибо!

Отправлен: 30.05.2008, 13:04 Вопрос задал: Chargos (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Arshvin Здравствуйте, Chargos!У вас не обновляется форма, на которой вы хотите увидеть результаты работы вашей программы, поскольку цикл у вас бесконечный, обновление компонентов формы происходит при выходе из подпрограммы. Попробуйте использоваться метод формы Update, тоесть например у вас имя переменной Form1, и вам надо написать Form1.Update. Только единственным недостатком этого метода обновления элементов формы является тот факт что форма "дергается" когда выполняется ее прорисовка

Ответ отправил: Arshvin (статус: 8-ой класс) Ответ отправлен: 02.06.2008, 07:39

Вопрос № 138.789

Предложенный в книге "Delphi7" под редакции А.Хоменко 2008г стр.230 код, с использованием страницы компонентов- Dialogs, диалог-FindDialog. 'Код поиска строки' ищет только первое появление в тексте заданной для поиска строки, в Memo1 . Кто подскажет, как изменить код, чтобы он искал последовательно заданную строку и дальше в тексте. А тому, кто даст полный код, могу дать полный код своей программы перевода пенсионного файла XML в текстовый типа 00013100.002 . Приложение: procedure TForm1.FindDialog1Find(Sender: TObject); begin //Ищется первое нахождение if pos(FindDialog1.FindText, Memo1.Text) <>0 then begin Memo1.HideSelection:=False; Memo1.SelStart:= pos(FindDialog1.FindText, Memo1.Text)-1; Memo1.SelLength:= Length(FindDialog1.FindText); end else MessageDlg('Строка '+ FindDialog1.FindText +' не найдена!',mtConfirmation,[mbYes],0); end;

Отправлен: 31.05.2008, 14:40 Вопрос задал: Алексеев Николай Тимофеевич (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Antony Belov Здравствуйте, Алексеев Николай Тимофеевич! Я пользуюсь вот этим способом, придумал не я. Права в тексте коментариев. Приложение: { **** UBPFD *********** by delphibase.endimus.com **** >> Поиск строки в редакторе Memo Зависимости: Windows, Classes, StdCtrls Автор: Fenik, chook_nu@uraltc.ru, Новоуральск Copyright: Автор: Федоровских Николай Дата: 26 июня 2002 г. ***************************************************** } function FindInMemo(Memo: TMemo; const FindText: string; FindDown, MatchCase: Boolean): Boolean; {Если строка найдена, то результат True, иначе - False; FindText : искомая строка; FindDown : True - поиск вниз от курсора ввода; False - поиск вверх от курсора ввода; MatchCase : True - с учетом регистра букв, False - не учитывая регистр бук. Если у Memo стоит автоперенос слов, то могут возникнуть проблемы - текст будет найден, но выделен не там где надо. Так что, для нормального поиска свойство ScrollBars у Memo ставить в ssBoth (ну или ssHorizontal)} function PosR2L(const FindStr, SrcStr: string): Integer; {Поиск последнего вхождения подстроки FindStr в строку SrcStr} var ps, L: Integer; function InvertSt(const S: string): string; {Инверсия строки S} var i: Integer; begin L := Length(S); SetLength(Result, L); for i := 1 to L do Result[i] := S[L - i + 1]; end; begin ps := Pos(InvertSt(FindStr), InvertSt(SrcStr)); if ps <> 0 then Result := Length(SrcStr) - Length(FindStr) - ps + 2 else Result := 0; end; function MCase(const s: string): string; {Перевод заглавных букв в строчные; Функция вызывается если регистр не учитывается} var i: Integer; begin Result := s; for i := 1 to Length(s) do begin case s[i] of 'A'..'Z', 'А'..'Я': Result[i] := Chr(Ord(s[i]) + 32); 'Ё': Result[i] := 'ё'; 'Ѓ': Result[i] := 'ѓ'; 'Ґ': Result[i] := 'ґ'; 'Є': Result[i] := 'є'; 'Ї': Result[i] := 'ї'; 'І': Result[i] := 'і'; 'Ѕ': Result[i] := 'ѕ'; end; end; end; var Y, X, SkipChars: Integer; FindS, SrcS: string; P: TPoint; begin Result := False; if MatchCase then FindS := FindText else FindS := MCase(FindText); P := Memo.CaretPos; if FindDown then {Поиск вправо и вниз от курсора ввода} for Y := P.y to Memo.Lines.Count do begin if Y <> P.y then {Если это не строка, в которой курсор вода, то ищем во всей строке} SrcS := Memo.Lines[Y] else {иначе обрезаем строку от курсора до конца} SrcS := Copy(Memo.Lines[Y], P.x + 1, Length(Memo.Lines[Y]) - P.x + 1); if not MatchCase then SrcS := MCase(SrcS); X := Pos(FindS, SrcS); if X <> 0 then begin if Y = P.y then Inc(X, P.x); P := Point(X, Y); Result := True; Break; {Выход из цикла} end end else {Поиск влево и вверх от курсора ввода} for Y := P.y downto 0 do begin if Y <> P.y then {Если это не строка, в которой курсор вода, то ищем во всей строке} SrcS := Memo.Lines[Y] else {иначе обрезаем строку от начала до курсора минус выделенный текст} SrcS := Copy(Memo.Lines[Y], 1, P.x - Memo.SelLength); if not MatchCase then SrcS := MCase(SrcS); X := PosR2L(FindS, SrcS); if X <> 0 then begin P := Point(X, Y); Result := True; Break; {Выход из цикла} end end; if Result then begin {Если текст найден - выделяем его} SkipChars := 0; for y := 0 to P.Y - 1 do Inc(SkipChars, Length(Memo.Lines[y])); Memo.SelStart := SkipChars + (P.Y * 2) + P.X - 1; Memo.SelLength := Length(FindText); end; end; Пример использования: procedure TForm1.FindDialog1Find(Sender: TObject); begin if not FindInMemo(Memo1, FindDialog1.FindText, frDown in FindDialog1.Options, frMatchCase in FindDialog1.Options) then Application.MessageBox('Поиск результатов не дал.', PChar(Application.Title), MB_OK or MB_ICONINFORMATION); end;

Ответ отправил: Antony Belov (статус: 1-ый класс) Ответ отправлен: 31.05.2008, 16:12 Оценка за ответ: 4 Комментарий оценки: Чувствуется, что человек хорошо знает Delphi. Хотелось, чтобы и дальше момогал мне и другим. Вот только я получаю все через The Bat. На оценку вышел по ссылке.А вот как отказаться от дальнейших ответов, которых пока нет. Спасибо Антону.Всё работает! Хотя не во всём разобрался.

Вопрос № 138.833

Дан текст програмы оформить его в делфи. Очень срочно нужно. Помогите пожалуйста уважаемые эксперты. Приложение: uses crt; var s:string; i,j,k:integer; begin clrscr; write('vvedi text:'); readln(s); i:=32; while i<=255 do begin k:=0; for j:=1 to length(s) do if chr(i)=s[j] then begin k:=k+1; end; if k>0 then writeln('simvol',chr(i),'vstrechaetsya',k,'raz(a)'); i:=i+1; end; readln; end.

Отправлен: 31.05.2008, 22:41 Вопрос задал: Клаткевич Денис Консантинович (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 11)

Отвечает: SHERRY Здравствуйте, Клаткевич Денис Консантинович! Меняем readln() на InputBox(), а writeln() на ShowMessage() Результат в приложении. Приложение: procedure TForm1.FormCreate(Sender: TObject); var s: string; i,j,k:integer; begin s := InputBox('Type string', 'Введите строку ниже:', 'bla-bla-bla'); i:=32; while i<=255 do begin k:=0; for j:=1 to length(s) do if chr(i)=s[j] then k:=k+1; if k<>0 then ShowMessage('Символ ' + chr(i) +' встречается ' + IntToStr(k) +' раз(a)'); i:=i+1; end; end; --------- Самурай без меча подобен самураю с мечём, только без меча..

Ответ отправил: SHERRY (статус: 10-ый класс) Ответ отправлен: 31.05.2008, 22:55

Отвечает: Gh0stik Здравствуйте, Клаткевич Денис Консантинович! В отличии от эксперта SHERRY, мы с Вами не будем искать сложных путей. Вам достаточно запустить Delphi, далее необходимо создать консольное приложение (меню NewOther... и выберите Console Application). Теперь просто замените весь текст открывшегося приложения на мой ;). program Project1; {$APPTYPE CONSOLE} var s:string;     i,j,k:integer; begin   write('vvedi text:');   readln(s);   i:=32;   while i<=255 do   begin     k:=0;     for j:=1 to length(s) do       if chr(i)=s[j] then       begin      & nbsp;  k:=k+1;       end;     if k>0 then       writeln('simvol ',chr(i),' vstrechaetsya ',k,' raz(a)');     i:=i+1;   end;   readln; end. Как видите Ваше приложение практически НИЧЕМ не изменилось. Good Luck! --------- Непечатный жаргон - это тот язык, которым решительно все программисты владеют в совершенстве.

Ответ отправил: Gh0stik (статус: Академик) Украина, Славянск Организация: Славянский государственный педагогический университет (Кафедра алгебры) WWW: http://gh0stik.rusfaq.ru/ ICQ: 289363162 ---- Ответ отправлен: 31.05.2008, 23:13

Отвечает: Павел Шведенко Здравствуйте, Клаткевич Денис Консантинович! Создаешь TEdit - Для ввода текста TButton - для обработки текста TListBox - для вывода строк (Элементы содержатся или в Items или Lines точно не помню - сорри) Приложение: Prodedure TButton_OnClick(Sender: TObject) var s:string; i,j,k:integer; begin TListBox.Lines.Clear; /// Повторное нажатие кнопки s := TEdit.Text ; i:=32; while i<=255 do begin k:=0; for j:=1 to length(s) do if chr(i)=s[j] then begin k:=k+1; end; if k>0 then //writeln('simvol',chr(i),'vstrechaetsya',k,'raz(a)'); TListBox.Lines.Add('simvol'+hr(i)+'vstrechaetsya'+k+'raz(a)'); i:=i+1; end; end. --------- Всегда

Ответ отправил: Павел Шведенко (статус: 2-ой класс) Ответ отправлен: 02.06.2008, 08:56

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