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

Выпуск № 889
от 08.08.2007, 19:35

Вопрос № 97.143

Ув. эксперты. Скажите пожалуста, как пишется процедура открытия файла. также скажите плизз как пишется процедура удаления папки и процедура перезагрузки Windows. 3аранее огромное спасибо всем за ответы 5!

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

Отвечает: Градов Юрий Михайлович Здравствуйте, Патрикеев Сергей! 1. Пример удаления папки со всем содержимым в приложении (взято из DelphiWorld). 2. Перезагрузка с закрыванием всех процессов, также взята из DelphiWorld Приложение: function FullRemoveDir(Dir: string; DeleteAllFilesAndFolders, StopIfNotAllDeleted, RemoveRoot: boolean): Boolean; var i: Integer; SRec: TSearchRec; FN: string; begin Result := False; if not DirectoryExists(Dir) then exit; Result := True; // Добавляем слэш в конце и задаем маску - "все файлы и директории" Dir := IncludeTrailingBackslash(Dir); i := FindFirst(Dir + '*', faAnyFile, SRec); try while i = 0 do begin // Получаем полный путь к файлу или директорию FN := Dir + SRec.Name; // Если это директория if SRec.Attr = faDirectory then begin // Рекурсивный вызов этой же функции с ключом удаления корня if (SRec.Name <> '') and (SRec.Name <> '.') and (SRec.Name <> '..') then begin if DeleteAllFilesAndFolders then FileSetAttr(FN, faArchive); Result := FullRemoveDir(FN, DeleteAllFilesAndFolders, StopIfNotAllDeleted, True); if not Result and StopIfNotAllDeleted then exit; end; end else // Иначе удаляем файл begin if DeleteAllFilesAndFolders then FileSetAttr(FN, faArchive); Result := SysUtils.DeleteFile(FN); if not Result and StopIfNotAllDeleted then exit; end; // Берем следующий файл или директорию i := FindNext(SRec); end; finally SysUtils.FindClose(SRec); end; if not Result then exit; if RemoveRoot then // Если необходимо удалить корень - удаляем if not RemoveDir(Dir) then Result := false; end; Пример использования: FullRemoveDir('C:a', true, true, true); // Полное удаление папки C:a со всем её содержимым, // и с последующим удалением самой c:a procedure reboot; var hToken: THandle; tkp: _TOKEN_PRIVILEGES; DUMMY: PTokenPrivileges; DummyRL: Cardinal; begin DUMMY := nil; if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken ) then raise TShutdownEx.Create('OpenProcessToken failed'); if (not LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid)) then raise TShutdownEx.Create('LookupPrivilegeValue failed'); tkp.PrivilegeCount := 1; tkp.Privileges[0].Attributes := $0002; //SE_PRIVILEGE_ENABLED = $00002 AdjustTokenPrivileges(hToken, FALSE, tkp, 0, Dummy, DummyRL); if (GetLastError() <> ERROR_SUCCESS) then raise TShutdownEx.Create('AdjustTokenPrivileges failed'); if (not ExitWindowsEx(EWX_REBOOT or EWX_FORCE, 0)) then raise TShutdownEx.Create('ExitWindowsEx failed'); end; --------- Глаза боятся - руки делают!

Ответ отправил: Градов Юрий Михайлович (статус: Студент) Ответ отправлен: 02.08.2007, 20:58 Оценка за ответ: 5

Вопрос № 97.159

Доброго времени суток уважаемые эксперты не подскажите, как можно преобразовать строку string в массив integer. str:=Memo1.Text отсюда беру строку. StrtoInt ругаеться

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

Отвечает: Omickron Здравствуйте, Lexa82! Тип integer определён в Delphi как int32. Т.е. 32 разрядное целое число. Я полагаю, в строке Memo1.Text записано число, большее, чем может вместить в себя integer. Поэтому и генерируется исключение. Кроме того, эта функция не делает массив, а Вам нужен именно массив целых чисел. (преобразовать строку string в массив integer) Попробуйте организовать цикл: var mas:array of integer; i:integer; ...... for i:=1 to Length(Memo1.Text) do begin Length(mas):=Lengt(mas)+1; mas(High(mas)):=StrToInt(Memo1.Text[i]); end; Этот код можно улучшить: во-первых, везде, где есть преобразования чисел в строки и наоборот, этот код нужно заключать в блок try-except (try-finally); во-вторых, лучше завести строку s:string, в которую сразу записать строку из Memo1.Text. Это связано с тем, что на обращение к компоненту Memo1 и его свойству Text уходит больше времени и системных ресурсов, чем просто к статической строке. Надеюсь, я Вам помог. Удачи.

Ответ отправил: Omickron (статус: 3-ий класс) Ответ отправлен: 03.08.2007, 00:25 Оценка за ответ: 4

Отвечает: Louken Здравствуйте, Lexa82! Отвечаю на уточненный в минифоруме вопрос: "мне необходимо перевести выражение типа: 00 0A 1F 00 и.т.д. в массив типа byte". Функция ConvertHex (ее код в приложении) преобразует последовательность шестнадцатиричных чисел в последовательность десятичных чисел. Числа помещаются в динамический массив. Есть и ограничения у функции ConvertHex: строка не должна содержать других символов кроме пробела (в любых количествах), цифр и символов A - F в любом регистре (A/a); все шестнадцатиричные числа должны состоять из двух символов (не больше и не меньше). Если нужно усовершенствовать функцию или что-то не понятно, то пишите в минифорум. Удачи. Приложение: type TByteArray = array of byte; function ConvertHex(Str: string): TByteArray; //Пробегаем по строке с указанной позиции и пропускаем пробелы //Возращает номер очередного символа не пробела procedure GoToNoSpase(Str: string; var P: integer); var k: integer; begin k:=Length(Str); While (p<=k) and (Str[p]=' ') do Inc(p); end; //Преобразует число в шестнадцатиричной системе счисления в десятичную систему счисления function HexToByte(Str: string): byte; begin Result:=strtoint('$'+Str); end; var i,k,c: integer; s: string; begin k:=Length(Str); s:=''; c:=-1; i:=1; GoToNoSpase(Str, i); While i<=k do begin s:=Copy(Str, i, 2); Inc(i,3); Inc(c); SetLength(Result, c+1); Result[c]:=HexToByte(s); GoToNoSpase(Str, i); end; end;

Ответ отправил: Louken (статус: Студент) Ответ отправлен: 03.08.2007, 00:58 Оценка за ответ: 5 Комментарий оценки: Спасибо помогло

Отвечает: Виктор Пырлик Здравствуйте, Lexa82! Ваша задача, это анализатор строки. Простая по определению, но не по сути. Дело в том, что, алгоритм разбора строки может быть разным. На мой взгляд, оптимальный является работа с памятью по маске – т.е. с указателем на память, где размещен наш массив символов. Смещая «окно» - маску, мы забираем искомые данные, в нашем случае – числа. В приложении приведен код. Это просто пример возможного направления реализации. Основное на что в данном примере надо обратить внимание – на то, что работа ведется с одной строкой. Компонент TMemo – многострочный, следовательно, если надо анализировать несколько строк, надо просто в цикле их перебрать, или, получить указатель на Memo1.Text, тогда, можно сразу работать со всем массивом но делать проверку на управляющие символы. Код рабочий и прокомментирован. Если есть вопросы – спрашивайте. PS: конечно надо обрамлять такой код в защищенный блок try...except Приложение: procedure TForm1.Button1Click(Sender: TObject); var x,size,y,i:integer; s:String; ss:PChar; begin Edit1.Text := #0; //сюда будем отображать наши числа {в данном случае, ма проверяем только первую строку для проверки всех строк требуется цикл по Memo1.Lines[i]} s := Memo1.Lines[0];// Trim(s);// отсекаем управляющие елементы ss := @s[1]; // получаем указатель на строку size := strlen(ss); // получаем её размер ss[size] := #0; //на всякий случай, устанавоиваем терминатор строки x := Pos(' ',ss); //ищем первое вхождение i := 0;// пока индекс смещения равен 0 while((ss+i)<>#0)do begin y := StrToInt(Copy((ss+i),1,x-1));//получаем очередное число Edit1.Text := Edit1.Text + IntToStr(y)+' '; //отображаем его i := i + x; // увеличиваем индекс if(i < size)then //если индекс меньше длины строки begin x := Pos(' ',(ss+i)); //то ищем очередное вхождение if(x = 0)then x := strlen((ss+i))+1;//если вхождение не найдено - это последнее число end else break;// иначе завершаем цикл end; end; --------- Если ничего не помогло - надо читать инструкцию

Ответ отправил: Виктор Пырлик (статус: Студент) Ответ отправлен: 03.08.2007, 01:52

Отвечает: Bee.line Здравствуйте, Lexa82! Попробуйте RealToInt или VarToInt. И обратите внимание какой знак отделяет дробную часть числа (точка или запятая)

Ответ отправил: Bee.line (статус: 1-ый класс) Ответ отправлен: 03.08.2007, 07:32 Оценка за ответ: 3 Комментарий оценки: Вы когда отвечаете читайте внимательно

Отвечает: Mishell Здравствуйте, Lexa82! Смотрите пример в приложении - в нем все числа из строки для наглядности заносятся в ListBox1 (Вам же надо будет заносить их в ваш массив - вместо ListBox1.Items.Add...), ну а все нечисловые значения соотв. пропускаются. Приложение: procedure TForm1.Button1Click(Sender: TObject); const c='0123456789'; var s,num:string; i:integer; begin ListBox1.Clear; s:=Memo1.Text; num:=''; while s<>'' do begin if pos(s[1],c)>0 then begin num:=num+s[1]; end else if num<>'' then begin i:=StrToIntDef(num,0); ListBox1.Items.Add(IntToStr(i)); num:=''; end; delete(s,1,1); end; end;

Ответ отправил: Mishell (статус: 4-ый класс) Ответ отправлен: 03.08.2007, 10:34

Отвечает: Дмитрий С. Здравствуйте, Lexa82! Не всё сразу, друг мой :) советую "переделывать" не всё сразу, а поэлементно, т.е. каждый item (string) отдельно. --------- Наши программисты самые программистые программисты!..

Ответ отправил: Дмитрий С. (статус: 3-ий класс) Ответ отправлен: 03.08.2007, 14:23

Отвечает: Балацкий Александр Михайлович Здравствуйте, Lexa82! Уточните вопрос: как у вас расположены числа в Memo1. Вариант1 (массив байт): var i: integer; mb: array [1..x] of byte; s: String; ... s := Memo1.Text; For i:= 1 to Length(s) do mb[i]:=Odr(s[i]); Вариант 2 (Если в каждой строке Memo1 находится целое число): var mi: array [1..x] of integer; i, p: integer; ... If Memo1.Lines.Count > 0 Then For i:=0 to Memo1.Lines.Count -1 Do Val(Memo1.Lines[i],mi[i],p); --------- Еще не один гений не создал того, что не сломал бы другой

Ответ отправил: Балацкий Александр Михайлович (статус: 1-ый класс) Ответ отправлен: 04.08.2007, 12:18

Вопрос № 97.204

Уважаемые эксперты возник вопрос. у меня есть форма созданная в дизайнере, на ней PageControl c TabSheet'ami и есть Frame созданный тоже в дизайнере, мне нужно в рантайме прилепить этот фрейм к одному из листов PageControl'a как это сделать ?

Отправлен: 03.08.2007, 11:38 Вопрос задал: Кэр Лаэда (статус: Студент) Всего ответов: 4 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: Виктор Пырлик Здравствуйте, Кэр Лаэда! Создано 2 фрейма и на главной форме лежит PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; В конструкторе формы подгружаем фреймы, это можно делать и в процессе работы приложения. Код в приложении… Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, StdCtrls; type TForm1 = class(TForm) PageControl1: TPageControl; TabSheet1: TTabSheet; TabSheet2: TTabSheet; procedure FormCreate(Sender: TObject); private fr:array[0..2]of TFrame;//для наглядности - взят массив фрэймов public { Public declarations } end; var Form1: TForm1; implementation uses uFraime1, uFraime2; {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin fr[0] := TFrame1.Create(TabSheet1);//создаем первый фр. {тут можем настроить наш фрэйм} fr[0].Align := alClient; {--- конец настройки фрэйма ---} fr[0].Parent := TabSheet1;// назначаем родителя ему fr[1] := TFrame2.Create(TabSheet2);// создаём 2-й фр. {тут можем настроить наш фрэйм} fr[1].Align := alClient;// {--- конец настройки фрэйма ---} fr[1].Parent := TabSheet2;// назначаем родителя end; end. --------- Если ничего не помогло - надо читать инструкцию

Ответ отправил: Виктор Пырлик (статус: Студент) Ответ отправлен: 03.08.2007, 12:17 Оценка за ответ: 5 Комментарий оценки: Похоже на правду, я сделал так frameObs:=TframeObsczie.Create(aOwner); frameObs.Parent:=frm.cxPageControl1.Pages[0];

Отвечает: Delph Здравствуйте, Кэр Лаэда! Попробуйте свойству Parent присвоить тот TabSheet, который Вам нужен, примерно так: Frame1.Parent := TabSheet1; Честно говоря, я этот приём попробовал с GroupBox, и всё получилось на ура.

Ответ отправил: Delph (статус: 5-ый класс) Ответ отправлен: 03.08.2007, 12:21 Оценка за ответ: 5 Комментарий оценки: Ок вроди получилось но чуть подругому.

Отвечает: Mishell Здравствуйте, Кэр Лаэда! см. пример в приложении само-собой есть форма Form1, на ней PageControl1 и внем страница TabSheet1, а также есть фрэйм MyFrame Приложение: procedure TForm1.Button1Click(Sender: TObject); var fr:TMyFrame; begin fr:=TMyFrame.Create(Self); fr.Parent:=TabSheet1; end;

Ответ отправил: Mishell (статус: 4-ый класс) Ответ отправлен: 03.08.2007, 12:22 Оценка за ответ: 5 Комментарий оценки: Ага пасиба, вроди так и получилось

Отвечает: Shveps Здравствуйте, Кэр Лаэда! Это можно сделать "докованием". Для этого существует метод у подобных компонентов и объектов : ManualDock(NewDocSite: TWinControl; DropControl: TControl = nil; ControlSide: Tallign = alNone): boolean, где: NewDocSite - приемник; DropControl - другой компонен в приемнике, который должен разместить данного клиента; ControlSide - выравнивание докуемого клиента. --------- Пиво ф топку !!! Водку Тоже !!!

Ответ отправил: Shveps (статус: 6-ой класс) Ответ отправлен: 05.08.2007, 08:58

Вопрос № 97.228

Здравствуйте уважаемые эксперты. Параметр формы Borderstyle="bsNone." (это необходимо для внешнего вида) Как сделать так чтобы вид остался тот же и появлось возможность менять размер форты так как это происходит когда Borderstyle="bsSizeable."

Отправлен: 03.08.2007, 13:44 Вопрос задал: Левадный Тимур Русланович (статус: 1-ый класс) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Примак Руслан Николаевич Здравствуйте, Левадный Тимур Русланович! Я предлагаю сделать ручной обработчик. См. пример кода: Приложение: unit MainForm; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus; type TfrmMain = class(TForm) PopupMenu1: TPopupMenu; Exit1: TMenuItem; procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Exit1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; TResizeMode = (rsNone, rsVert, rsHorz); var frmMain: TfrmMain; StartResize: TPoint; ResizeMode: TResizeMode; implementation {$R *.dfm} procedure TfrmMain.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var DeltaX, DeltaY: Integer; begin if (X = 0) or (X = (ClientWidth-1)) then Cursor := crSizeWE else if (Y = 0) or (Y = (ClientHeight-1)) then Cursor := crSizeNS else Cursor := crDefault; if (ssLeft in Shift) then begin DeltaX := StartResize.X - X; DeltaY := StartResize.Y - Y; case ResizeMode of rsHorz: if X < (ClientWidth div 2) then frmMain.SetBounds(ClientToScreen(Point(X,Y)).X, Top, Width + DeltaX, Height) else begin Width := Width - DeltaX; StartResize := Point(X,Y); end; rsVert: if Y < (ClientHeight div 2) then frmMain.SetBounds(Left, ClientToScreen(Point(X,Y)).Y, Width, Height + DeltaY) else begin Height := Height - DeltaY; StartResize := Point(X,Y); end; end; end; end; procedure TfrmMain.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin StartResize := Point(X,Y); if (X = 0) or (X = (ClientWidth-1)) then ResizeMode := rsHorz else if (Y = 0) or (Y = (ClientHeight-1)) then ResizeMode := rsVert else ResizeMode := rsNone; end; procedure TfrmMain.Exit1Click(Sender: TObject); begin Close; end; end.

Ответ отправил: Примак Руслан Николаевич (статус: 3-ий класс) Ответ отправлен: 03.08.2007, 15:17 Оценка за ответ: 5 Комментарий оценки: Большое спасибо

Вопрос № 97.266

Пишу серьезную программу и хочется сделать для нее хороший интерфейс. Вот ищу компоненты-скины. Подскажите какие из них известны Вам и по возможности расскажите о их преимуществах. Можно и платные, но не чересчур дорогие (до 30-40$).

Отправлен: 03.08.2007, 19:25 Вопрос задал: Louken (статус: Студент) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 5)

Отвечает: Coupler Здравствуйте, Louken! Перепробовал много, но мне больше всего нравятся AlphaControls (выглядят наиболее серьезно, хорошо продуманы). В них практически для всех контролов есть свои, с использованием скинов. C этой страницы вы можете скачать бесплатную версию для жителей бывшего союза (без исходников, но полнофункциональную).

Ответ отправил: Coupler (статус: Практикант) Ответ отправлен: 03.08.2007, 19:34

Отвечает: Архангельский Андрей Германович Здравствуйте, Louken! Я использую Raize Components. Очень большой выбор всяких интерфейсных штучек, позволяют вертеть текст в разные стороны и выдавливать как хочешь. Хорошая замена библиотеке RxLib_2.5. Можно построить красивое меню. --------- Если дело заслуживает быть сделаным, то оно заслуживает, чтобы его сделали ХОРОШО

Ответ отправил: Архангельский Андрей Германович (статус: Специалист) Ответ отправлен: 03.08.2007, 19:35

Отвечает: Балацкий Александр Михайлович Здравствуйте, Louken! Нарисуйте. Поместите на форму Image1: TImage. Поместите Image1 ниже всех компонентов. Image1.Align := alClient; Image1.Pictue := 'C:\%ваш рисунок%.bmp'; Image1.Stretch := true; Form1.BorderIcon := [biSystemMenu, biMinimize]; Form1.BorderStyle := bsNone; //Не забудтье придумать какой нибудь способ //закрытия программы При необходимости сделать окно программы не прямоугольной формы. Используйте к примеру черный цвет в изображении для участков прозрачности. Form1.TransparentColor := true; Form1.TransparentColorValue := clBalck; Form1.Color := clBlack; Image1.Transparent := true; --------- Еще не один гений не создал того, что не сломал бы другой

Ответ отправил: Балацкий Александр Михайлович (статус: 1-ый класс) Ответ отправлен: 04.08.2007, 11:57

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