Разделы сайта:

Delphi.int.ru

Новости сайта
Регистрация »
Файловый архив
∙ Статьи
∙ Компоненты
∙ Plug-in's
∙ Документация
∙ Исходники
∙ Изображения
∙ Игры
∙ Программы
IRC-канал
Рассылки сайта
Дружеств. сайты
Каталог ссылок

Delphi.int.ru Expert

Разделы рассылки:

» Авторское слово
» Обучение Delphi
» Delphi.int.ru Expert
» Статья по Delphi
» Файловый архив
» Юмор

Количество читателей рассылки (07.04.2007, 15:00):
5460+1070+314= 6844.

Связь по e-mail:

admin@delphi.int.ru
expert@delphi.int.ru
info@delphi.int.ru

Создание нового проекта

Для создания "чистого листа" следует выбрать в меню File -> New -> Application. В разных версиях Delphi содержимое подменю New может немного отличаться, но всё основное присутствует всегда. После этого создаётся новый проект, такой, какой появляется при запуске Delphi.

Открытие существующего проекта (или файла)

Для этого существует команда File -> Open... Выбрав файл *.dpr, откроется проект, а выбрав какой-либо другой файл (например, *.pas или *.dfm) откроется что-либо другое (например, отдельная форма).

Сохранение

С сохранением есть несколько тонкостей. Исходя из того, что проект представляет собой совокупность нескольких файлов, можно сделать вывод, что сохранять нужно все эти файлы, а не какой-то в отдельности. Выбрав File -> Save, Вы сохраните только текущую форму, но не более того, а проект останется "висеть в воздухе". File -> Save As... - стандартный пункт, который делает то же самое, что и Save, только позволяет пересохранить файл (форму) под другим именем. Команда Save Project As... сохраняет файл проекта (*.dpr). Таким образом, чтобы сохранить проект полностью, нужно сохранить каждую из форм и сам проект. Делать это по отдельности достаточно неудобно, поэтому существует команда, облегчающая этот процесс: File -> Save All. При вызове этой команды сначала появится диалог для сохранения формы (если форм несколько, то и диалогов будет несколько), а затем диалог для сохранения проекта. После того, как все диалоги отраб отали, можно с уверенностью сказать, что проект сохранён полностью.

Для проекта можно установить множество разнообразных параметров. Все они находятся в окне Project -> Options. В частности, на вкладке Application можно указать заголовок проекта, который будет отображаться на кнопке программы на панели задач. Совет: всегда прописывайте заголовок своей программе, не оставляйте стандартного "Project1" - это резко бросается в глаза. На этой же вкладке можно выбрать иконку (значок) для приложения - файл *.ico размером 32х32 пикселя. В блоке Output settings можно указать расширение выходного файла. Заполнять это поле не обязательно - по умолчанию файлу присваивается расширение .exe. Однако в некоторых случаях эта настройка бывает полезной. Например, экранные программы-заставки представляют собой те же исполняемые exe-файлы, только имеют расширение .scr. Неудобно каждый раз после внесения изменений в программу, чтобы протестировать заставку, переименовыв ать файл. А прописав в указанное поле "scr" проблема мигом решится.

Вкладка Application в окне свойств проекта влияет на внешний вид кнопки программы на панели задач

Текст вопроса:

Как возможно таблицу БД представить в виде дерева с возможностями модификации данных? Как просто сделать дерево понятно.

Автор вопроса: Наташа (статус: Посетитель)
Дата и время отправки вопроса: 30.11.2006, 14:59
Получено ответов на вопрос: 2
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Помфюк Владимир Степанович (статус: 7-ой класс), 30.11.2006, 15:36]:

Здравствуйте, Наташа!
Дерево можно сделать в двух случаях:
1)есть серия таблиц которые ссылаются друг на друга (Задача->Работник->Отдел)
2)есть набор данных с полями, которые можно сгрупировать(select City, Department, FIO, ID from workers order by 1,2,3)
Рисовать дерево надо перебирая в данные цикле (или вложеных циклах). При создании каждого TreeNode в его свойство Data (тип - Pointer) надо занести указатель на record в который стоит записать начальное значение и условие которое идентифицирует запись (группу записей) и, при необходимости, таблицу. Тогда в событии OnEdited Вы легко сможете написать SQL-запрос обновления таблицы.
Еще: на OnDeletion всем этим датам надо сделать dispose.

Приложение:

TRecData=record InitialVal:String; WhereCond:String; end; PRecData=^TRecData; ............................ procedure PaintTree; var NodeData:PRecData; ......................... begin ...................... NewNode:=TreeView.Nodes.AddChild(PrevNode,qryWorkerDepartment.asString); new(NodeData); NodeData.InitialVal:=qryWorkerDepartment.asString; NodeData.WhereCond:='DEPARTMENT='''+qryWorkerDepartment.asString+''''; NewNode.Data:=NodeData; ...................... end; procedure TfrMy.TreeViewDeletion(Sender: TObject; Node: TTreeNode); var Data:PRecData; begin Data:=Node.Data; if Data<>nil Then dispose(Data); end;

2. [Отвечает: Alex Van Glukhman (статус: 7-ой класс), 30.11.2006, 16:39]:

Здравствуйте, Наташа!

Создать структуру дерева в зависимости от того что должно появиться в представлении например варианты
1.имя таблицы - поля - значения
2.имя таблицы - номер записи - значения полей
и т.д.
А далее структурой
Tbl.first;
while not Tbl.eof do
begin
...
//Переносим значения таблицы в TTreeView у каждого
//TreeViewItem есть свойство Text
...
Tbl.next
end;

Оценка за ответ: 5.

Текст вопроса:

Как программно в Delphi7 просмотреть права группы пользователей на указанную директорию, в которую входит текущий пользователь?

Автор вопроса: Наташа (статус: Посетитель)
Дата и время отправки вопроса: 30.11.2006, 15:00
Получено ответов на вопрос: 2
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Вадим К (статус: Средний уровень), 30.11.2006, 16:57]:

Обратитесь к справке по поводу функций ACL. В одном с недавних журналов Хакер был пример.

2. [Отвечает: Николай Рубан (статус: 2-ой класс), 01.12.2006, 12:32]:

Рекомендую Вам воспользовать командой Cacls.

Cacls
Просмотр или изменение файлов избирательных таблиц управления доступом (DACL).

В приложении смотрите пример использования, после выполнения команды создасться файл 1.txt, в котором будут данные о правах доступа к папке которая описана в переменной s.

Удачи!!!

Приложение:

uses ShellApi; ..... procedure TForm1.Button1Click(Sender: TObject); var s:string; begin s:='c:\temp'; ShellExecute(handle,PChar('open'),PChar('cmd'),PChar('/c cacls '+s+' > 1.txt'),nil,SW_HIDE); end;

Текст вопроса:

Здраствуйсте ув. эксперты!
Я так и не дождался ответа в вопросе 175. Поэтому задам его здесь еще раз.
Короче: как на delphi сделать что то типа рабочего стола в Windows? Главное чтобы значки можно было двигать "повсюду".

ЗЫ: Я пробовал через ListView но у меня не получилось

Автор вопроса: Александр (статус: Посетитель)
Дата и время отправки вопроса: 30.11.2006, 17:30
Получено ответов на вопрос: 3
Сообщений в форуме вопроса: 1
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Матвеев Игорь Владимирович (статус: Средний уровень), 01.12.2006, 08:25]:

Здравствуйте, Александр!
Что Вам мешает написать свой класс от TGraphicControl, содержащий в себе все нужные Вам данные (иконка, подпись и все остальное) и реализующий в себе методы выделения, перетаскивания и рисования. Потом пишите потомка, например от TPanel - хозяина всех этих значков. Он в свою очередь, должен содержать в себе методы выделения (с помощью клавиатуры), сохранения положения всех значков и т.д.

Оценка за ответ: 4.

2. [Отвечает: min@y™ (статус: 6-ой класс), 01.12.2006, 08:56]:

Лень читать хэлп по TListItem? Ладно, я сделал это за тебя. Вот тебе пример, как таскать мышой иконки по ListView в режиме vsIcon (см. приложение). Я такого никогда не делал, но поиск нужной инфы в хэлпе + написание примера заняло у меня 10 минут.

Приложение:

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ImgList, ComCtrls; type TForm1 = class(TForm) ListView1: TListView; ImageList1: TImageList; procedure ListView1DragDrop(Sender, Source: TObject; X, Y: Integer); procedure ListView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.ListView1DragDrop(Sender, Source: TObject; X, Y: Integer); var Item: TListItem; begin Item:= ListView1.Selected; if Assigned(Item) then Item.Position:= Point(X, Y); end; procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept:= Sender = Source; end; procedure TForm1.FormCreate(Sender: TObject); begin ListView1.DragMode:= dmAutomatic; end; end.

Оценка за ответ: 4.
Комментарий: Спасибо. Но разговаривать все же надо по вежливей.

3. [Отвечает: Denisss (статус: 2-ой класс), 01.12.2006, 20:45]:

Здравствуйте, Александр!

Небольшое дополнение к ответу min@y™. См. приложение.

Удачи!

Приложение:

procedure TForm1.ListView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept:= ((Sender = Source) and (ListView1.GetItemAt(X, Y) = nil)); end;

Оценка за ответ: 5.

Текст вопроса:

Доброе время суток, господа программисты. Как написать программу, в которой внутри будет защита от копирования. Вот допустим у меня есть файл, я пытаюсь его скопировать, а мне пишут, типо нельзя.

Автор вопроса: Geron (статус: 1-ый класс)
Дата и время отправки вопроса: 01.12.2006, 14:11
Получено ответов на вопрос: 1
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Матвеев Игорь Владимирович (статус: Средний уровень), 02.12.2006, 07:16]:

Здравствуйте, Geron!
Не совсем корректно задан вопрос - программа сама не может защитить себя от копирования, так как Вы описали, если она (программа) не запущена (если не рассматривать драйвера). В программу может быть вшит алгоритм защиты от копирования, например такой: при первом запуске определяется текущий каталог, сохраняется где-то и при последующих запусках программы сверяется с сохраненным. Если не совпадает - работа завершается. Естественно это только пример, на самом деле нужно использовать сразу несколько "критериев привязки к системе", таких как серийный номер и тип процессора, номер материнской платы, винчестера, логического диска т.д. Все эти данные должны где-то как-то хитро сохраняться, чтобы небыло возможности для их подмены, а потом сверяться.

Есть еще такая вещь как Таблицы Управления Доступом к файлам (ACL). Вы можете запретить доступ к файлу, а при использовании этого файла Вашей программой изменять права доступа, разрешая доступ на чтение.
Делается это с помощью консольной утилиты CACLS.
Вот пример как запретить доступ к файлу C:\test.dat:
CACLS "C:\test.dat" /P admin:N

Пример как разрешить только чтение файла:
CACLS "C:\test.dat" /P admin:R

Текст вопроса:

у моей программы не работает докачка, может кто-нибудь знает где ошибка?
Вот код которым я пользуюсь.

Приложение:

interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, WinInet, XPMan, StdCtrls, ComCtrls, Menus, ExtCtrls; Type TForm1 = Class(TForm) Edit1: TEdit; ProgressBar1: TProgressBar; Button: TButton; StatusBar1: TStatusBar; Timer1: TTimer; Button1: TButton; Button2: TButton; procedure FormCreate(Sender: TObject); procedure Edit1DblClick(Sender: TObject); procedure ButtonClick(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; Var Form1: TForm1; Stop: Boolean; cop1:string; FSize, RestartPos: Cardinal; Implementation {$R *.DFM} function GetInetFileSize(Const AURL: String): Integer; var HSession, HFile: HInternet; Buffer: array [1..20] of Char; BufferLen, Index: Cardinal; begin Result := 0; HSession := InternetOpen(NIL, INTERNET_OPEN_TYPE_PRECONFIG, NIL, NIL, 0); If Assigned(HSession) Then Begin HFile := InternetOpenURL(HSession, PChar(AURL), NIL, 0, INTERNET_FLAG_RELOAD, 0); Index := 0; BufferLen := 20; If HttpQueryInfo(HFile, HTTP_QUERY_CONTENT_LENGTH, @Buffer, BufferLen, Index) Then Result := StrToInt(StrPas(@Buffer)); InternetCloseHandle(HFile); InternetCloseHandle(Hsession); End; End; Procedure TForm1.FormCreate(Sender: TObject); Begin Stop := False; Button2.Enabled := False; End; procedure TForm1.Edit1DblClick(Sender: TObject); begin edit1.SelectAll; end; procedure TForm1.ButtonClick(Sender: TObject); var ild1:integer; lt1:string; begin lt1:=edit1.text; ild1:=LastDelimiter('/', lt1); cop1:=copy(lt1, ild1+1, ild1); Statusbar1.Panels[0].Text:=cop1; end; procedure TForm1.Button1Click(Sender: TObject); var HInet, hURL: HINTERNET; ReadLen, GlobRead: Cardinal; FBuf: array[1..1024] of Byte; F: File; lt, Header, cop:string; err:boolean; ild, ild1:integer; speed:double; tmp: integer; Begin Stop := false; timer1.Enabled:=true; RestartPos := 0; FSize := GetInetFileSize(Edit1.Text); Statusbar1.Panels[2].Text:=IntToStr(FSize)+'b'; Button1.Enabled := False; Button2.Enabled := True; lt:=edit1.text; ild:=LastDelimiter('/', lt); ild1:=LastDelimiter('.', lt); cop:=copy(lt, ild, ild1+3); If FileExists('C:\temp\'+cop ) Then Begin AssignFile(f, 'C:\temp\'+cop ); Reset(F, 1); RestartPos := FileSize(F); Seek(F, FileSize(F)); End Else begin AssignFile(f, 'C:\temp\'+cop ); ReWrite(f, 1); End; HInet := InternetOpen(NIL, PRE_CONFIG_INTERNET_ACCESS, NIL, NIL, 0); Header := 'Accept: */*'; HURL := InternetOpenURL(HInet, PChar(Edit1.Text), PChar(Header), StrLen(PChar(Header)), 0, 0); If RestartPos > 0 Then Begin InternetSetFilePointer(HURL, RestartPos, NIL, 0, 0); ProgressBar1.Min := 0; ProgressBar1.Max := FSize; ProgressBar1.Position := RestartPos; End Else Begin ProgressBar1.Min := 0; ProgressBar1.Max := FSize; End; repeat err:= InternetReadFile(HURL, @FBuf, SizeOf(FBuf), ReadLen); IF err= false then begin //&#206;&#248;&#232;&#225;&#234;&#224; &#247;&#242;&#229;&#237;&#232;&#255; ShowMessage ('&#207;&#240;&#238;&#232;&#231;&#238;&#248;&#229;&#235; &#238;&#225;&#235;&#238;&#236; :('); //&#209;&#238;&#238;&#225;&#249;&#232;&#236; &#232; &#226;&#251;&#245;&#238;&#228;&#232;&#236; exit; end; BlockWrite(F, FBuf, ReadLen); GlobRead:=GlobRead+ReadLen; RestartPos := FileSize(F); Statusbar1.Panels[1].Text:=IntToStr(RestartPos)+'b'; ProgressBar1.Position := RestartPos; Application.ProcessMessages; until (ReadLen < 1) or (Stop = true); Stop := False; Button1.Enabled := True; Button2.Enabled := False; InternetCloseHandle(HURL); InternetCloseHandle(HInet); CloseFile(F); end; procedure TForm1.Button2Click(Sender: TObject); begin Stop := True; Progressbar1.Position:=0; Button1.Enabled := True; Button2.Enabled := False; end; procedure TForm1.Timer1Timer(Sender: TObject); var ii:real; s:string; begin ii:=RestartPos/(FSize/100); s:=floattostr(ii); s:=copy(s, 1, 4); if statusbar1.Panels[1].Text=statusbar1.Panels[2].Text then begin statusbar1.Panels[3].Text:='Ready'; timer1.Enabled:=false; end else statusbar1.Panels[3].Text:=s+'%'; end;

Автор вопроса: Evghenusi (статус: Посетитель)
Дата и время отправки вопроса: 01.12.2006, 23:00
Получено ответов на вопрос: 1
Сообщений в форуме вопроса: 3
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Alex Van Glukhman (статус: 7-ой класс), 02.12.2006, 00:20]:

Здравствуйте, Evghenusi!

В коде отсутствует метод Append. А вообще это лучше делать через TFileStream

Текст вопроса:

Здравствуте, подскажите как сделать программную непрерывную задержку звука на 1-2сек. (например вход микрофон, выход колонки)
Спасибо.

Автор вопроса: Ed13 (статус: Посетитель)
Дата и время отправки вопроса: 04.12.2006, 11:04
Получено ответов на вопрос: 1
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Alex Van Glukhman (статус: 7-ой класс), 04.12.2006, 16:34]:

Здравствуйте, Ed13!

Данная тема достаточно сложная. Вот исходник для работы со звуком на низком уровне. Попробуйте разобраться. Удачи!!!

Приложение:

Ниже приведен код, обрабатывающий аудиосигнал, получаемый со входа звуковой карты (SoundBlaster). Надеюсь он поможет разобраться вам с этой сложной темой. Включенный в код модуль RECUNIT делает всю изнурительную работу по извлечению звука со входа звуковой карты. var WaveRecorder: TWaveRecorder; ... WaveRecorder := TwaveRecorder(2048, 4); // 4 размером 2048 байт { Устанавливает параметры дискретизации } with WaveRecorder.pWavefmtEx do begin wFormatTag := WAVE_FORMAT_PCM; nChannels := 1; nSamplesPerSec := 20000; wBitsPerSample := 16; nAvgBytesPerSec := nSamplesPerSec * (wBitsPerSample div 8) * nChannels; end; // Затем используем вариантную запись, поскольку я не знаю // как получить адрес самого объекта WaveRecorder.SetupRecord(@WaveRecorder); // Начинаем запись WaveRecorder.StartRecord; ...При каждом заполнении буфера вызывается процедура WaveRecorder.Processbuffer. // Заканчиваем запись WaveRecorder.StopRecord; WaveRecorder.Destroy; { Имя файла: RECUNIT.PAS V 1.01 Создан: Авг 19 1996 в 21:56 на IBM ThinkPad Ревизия #7: Авг 22 1997, 15:01 на IBM ThinkPad -John Mertus Данный модуль содержит необходимые процедуры для записи звука. Версия 1.00 - первый релиз 1.01 - добавлен TWaveInGetErrorText } {-----------------Unit-RECUNIT---------------------John Mertus---Авг 96---} unit RECUNIT; {*************************************************************************} interface uses Windows, MMSystem, SysUtils, MSACM; { Ниже определен класс TWaveRecorder для обслуживания входа звуковой } { карты. Ожидается, что новый класс будет производным от TWaveRecorder } { и перекроет TWaveRecorder.ProcessBuffer. После начала записи данная } { процедура вызывается каждый раз при наличии в буфере аудио-данных. } const MAX_BUFFERS = 8; type PWaveRecorder = ^TWaveRecorder; TWaveRecorder = class(TObject) constructor Create(BfSize, TotalBuffers: Integer); destructor Destroy; override; procedure ProcessBuffer(uMsg: Word; P: Pointer; n: Integer); virtual; private fBufferSize: Integer; // Размер буфера BufIndex: Integer; fTotalBuffers: Integer; pWaveHeader: array[0..MAX_BUFFERS - 1] of PWAVEHDR; hWaveHeader: array[0..MAX_BUFFERS - 1] of THANDLE; hWaveBuffer: array[0..MAX_BUFFERS - 1] of THANDLE; hWaveFmtEx: THANDLE; dwByteDataSize: DWORD; dwTotalWaveSize: DWORD; RecordActive: Boolean; bDeviceOpen: Boolean; { Внутренние функции класса } function InitWaveHeaders: Boolean; function AllocPCMBuffers: Boolean; procedure FreePCMBuffers; function AllocWaveFormatEx: Boolean; procedure FreeWaveFormatEx; function AllocWaveHeaders: Boolean; procedure FreeWaveHeader; function AddNextBuffer: Boolean; procedure CloseWaveDeviceRecord; public { Public declarations } pWaveFmtEx: PWaveFormatEx; WaveBufSize: Integer; // Размер поля nBlockAlign InitWaveRecorder: Boolean; RecErrorMessage: string; QueuedBuffers, ProcessedBuffers: Integer; pWaveBuffer: array[0..MAX_BUFFERS - 1] of lpstr; WaveIn: HWAVEIN; { Дескриптор Wav-устройства } procedure StopRecord; function 477576218068 StartRecord: Boolean; Function477576218068 SetupRecord(P: PWaveRecorder): Boolean; end; {*************************************************************************} implementation {-------------TWaveInGetErrorText-----------John Mertus---14-Июнь--97--} function TWaveInGetErrorText(iErr: Integer): string; { Выдает сообщения об ошибках WaveIn в формате Pascal } { iErr - номер ошибки } { } {**********************************************************************} var PlayInErrorMsgC: array[0..255] of Char; begin waveInGetErrorText(iErr, PlayInErrorMsgC, 255); TWaveInGetErrorText := StrPas(PlayInErrorMsgC); end; {-------------InitWaveHeaders---------------John Mertus---14-Июнь--97--} function TWaveRecorder.AllocWaveFormatEx: Boolean; { Распределяем формат большого размера, требуемый для инсталляции ACM-в} { } {**********************************************************************} var MaxFmtSize: UINT; begin { maxFmtSize - сумма sizeof(WAVEFORMATEX) + pwavefmtex.cbSize } if (acmMetrics(0, ACM_METRIC_MAX_SIZE_FORMAT, maxFmtSize) <> 0) > then begin RecErrorMessage := 'Ошибка получения размера формата максимального сжатия'; AllocWaveFormatEx := False; Exit; end; { распределяем структуру WAVEFMTEX } hWaveFmtEx := GlobalAlloc(GMEM_MOVEABLE, maxFmtSize); if (hWaveFmtEx = 0) then begin RecErrorMessage := 'Ошибка распределения памяти для структуры WaveFormatEx'; AllocWaveFormatEx := False; Exit; end; pWaveFmtEx := PWaveFormatEx(GlobalLock(hWaveFmtEx)); if (pWaveFmtEx = nil) then begin RecErrorMessage := 'Ошибка блокировки памяти WaveFormatEx'; AllocWaveFormatEx := False; Exit; end; { инициализация формата в стандарте PCM } ZeroMemory(pwavefmtex, maxFmtSize); pwavefmtex.wFormatTag := WAVE_FORMAT_PCM; pwavefmtex.nChannels := 1; pwavefmtex.nSamplesPerSec := 20000; pwavefmtex.nBlockAlign := 1; pwavefmtex.wBitsPerSample := 16; pwavefmtex.nAvgBytesPerSec := pwavefmtex.nSamplesPerSec * (pwavefmtex.wBitsPerSample div 8) * pwavefmtex.nChannels; pwavefmtex.cbSize := 0; { Все успешно, идем домой } AllocWaveFormatEx := True; end; {-------------InitWaveHeaders---------------John Mertus---14-Июнь--97--} function TWaveRecorder.InitWaveHeaders: Boolean; { Распределяем память, обнуляем заголовок wave и инициализируем } { } {**********************************************************************} var i: Integer; begin { делаем размер буфера кратным величине блока... } WaveBufSize := fBufferSize - (fBufferSize mod pwavefmtex.nBlockAlign); { Устанавливаем wave-заголовки } for i := 0 to fTotalBuffers - 1 do with pWaveHeader[i]^ do begin lpData := pWaveBuffer[i]; // адрес буфера waveform dwBufferLength := WaveBufSize; // размер, в байтах, буфера dwBytesRecorded := 0; // смотри ниже dwUser := 0; // 32 бита данных пользователя dwFlags := 0; // смотри ниже dwLoops := 0; // смотри ниже lpNext := nil; // зарезервировано; должен быть ноль reserved := 0; // зарезервировано; должен быть ноль end; InitWaveHeaders := TRUE; end; {-------------AllocWaveHeader----------------John Mertus---14-Июнь--97--} function TWaveRecorder.AllocWaveHeaders: Boolean; { Распределяем и блокируем память заголовка } { } {***********************************************************************} var i: Integer; begin for i := 0 to fTotalBuffers - 1 do begin hwaveheader[i] := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE or GMEM_ZEROINIT, sizeof(TWAVEHDR)); if (hwaveheader[i] = 0) then begin { Примечание: Это может привести к утечке памяти, надеюсь скоро исправить } RecErrorMessage := 'Ошибка распределения памяти для wave-заголовка'; AllocWaveHeaders := FALSE; Exit; end; pwaveheader[i] := GlobalLock(hwaveheader[i]); if (pwaveheader[i] = nil) then begin { Примечание: Это может привести к утечке памяти, надеюсь скоро исправить } RecErrorMessage := 'Не могу заблокировать память заголовка для записи'; AllocWaveHeaders := FALSE; Exit; end; end; AllocWaveHeaders := TRUE; end; {---------------FreeWaveHeader---------------John Mertus---14-Июнь--97--} procedure TWaveRecorder.FreeWaveHeader; { Просто освобождаем распределенную AllocWaveHeaders память. } { } {***********************************************************************} var i: Integer; begin for i := 0 to fTotalBuffers - 1 do begin if (hWaveHeader[i] <> 0) then begin GlobalUnlock(hwaveheader[i]); GlobalFree(hwaveheader[i]); hWaveHeader[i] := 0; end end; end; {-------------AllocPCMBuffers----------------John Mertus---14-Июнь--97--} function TWaveRecorder.AllocPCMBuffers: Boolean; { Распределяем и блокируем память waveform. } { } {***********************************************************************} var i: Integer; begin for i := 0 to fTotalBuffers - 1 do begin hWaveBuffer[i] := GlobalAlloc(GMEM_MOVEABLE or GMEM_SHARE, fBufferSize); if (hWaveBuffer[i] = 0) then begin { Здесь возможна утечка памяти } RecErrorMessage := 'Ошибка распределения памяти wave-буфера'; AllocPCMBuffers := False; Exit; end; pWaveBuffer[i] := GlobalLock(hWaveBuffer[i]); if (pWaveBuffer[i] = nil) then begin { Здесь возможна утечка памяти } RecErrorMessage := 'Ошибка блокирования памяти wave-буфера'; AllocPCMBuffers := False; Exit; end; pWaveHeader[i].lpData := pWaveBuffer[i]; end; AllocPCMBuffers := TRUE; end; {--------------FreePCMBuffers----------------John Mertus---14-Июнь--97--} procedure TWaveRecorder.FreePCMBuffers; { Освобождаем использованную AllocPCMBuffers память. } { } {***********************************************************************} var i: Integer; begin for i := 0 to fTotalBuffers - 1 do begin if (hWaveBuffer[i] <> 0) then begin GlobalUnlock(hWaveBuffer[i]); GlobalFree(hWaveBuffer[i]); hWaveBuffer[i] := 0; pWaveBuffer[i] := nil; end; end; end; {--------------FreeWaveFormatEx--------------John Mertus---14-Июнь--97--} procedure TWaveRecorder.FreeWaveFormatEx; { Просто освобождаем заголовки ExFormat headers } { } {***********************************************************************} begin if (pWaveFmtEx = nil) then Exit; GlobalUnlock(hWaveFmtEx); GlobalFree(hWaveFmtEx); pWaveFmtEx := nil; end; {-------------TWaveRecorder.Create------------John Mertus-----Авг--97--} constructor TWaveRecorder.Create(BFSize, TotalBuffers: Integer); { Устанавливаем wave-заголовки, инициализируем указатели данных и } { и распределяем буферы дискретизации } { BFSize - размер буфера в байтах } { } {**********************************************************************} var i: Integer; begin inherited Create; for i := 0 to fTotalBuffers - 1 do begin hWaveHeader[i] := 0; hWaveBuffer[i] := 0; pWaveBuffer[i] := nil; pWaveFmtEx := nil; end; fBufferSize := BFSize; fTotalBuffers := TotalBuffers; { распределяем память для структуры wave-формата } if (not AllocWaveFormatEx) then begin InitWaveRecorder := FALSE; Exit; end; { ищем устройство, совместимое с доступными wave-характеристиками } if (waveInGetNumDevs < 1) then begin RecErrorMessage := 'Не найдено устройств, способных записывать звук'; InitWaveRecorder := FALSE; Exit; end; { распределяем память wave-заголовка } if (not AllocWaveHeaders) then begin InitWaveRecorder := FALSE; Exit; end; { распределяем память буфера wave-данных } if (not AllocPCMBuffers) then begin InitWaveRecorder := FALSE; Exit; end; InitWaveRecorder := TRUE; end; {---------------------Destroy----------------John Mertus---14-Июнь--97--} destructor TWaveRecorder.Destroy; { Просто освобождаем всю память, распределенную InitWaveRecorder. } { } {***********************************************************************} begin FreeWaveFormatEx; FreePCMBuffers; FreeWaveHeader; inherited Destroy; end; {------------CloseWaveDeviceRecord-----------John Mertus---14-Июнь--97--} procedure TWaveRecorder.CloseWaveDeviceRecord; { Просто освобождаем (закрываем) waveform-устройство. } { } {***********************************************************************} var i: Integer; begin { если устройство уже закрыто, то выходим } if (not bDeviceOpen) then Exit; { работа с заголовками - unprepare } for i := 0 to fTotalBuffers - 1 do if (waveInUnprepareHeader(WaveIn, pWaveHeader[i], sizeof(TWAVEHDR)) <> 0) then RecErrorMessage := 'Ошибка в waveInUnprepareHeader'; { сохраняем общий объем записи и обновляем показ } dwTotalwavesize := dwBytedatasize; { закрываем входное wave-устройство } if (waveInClose(WaveIn) <> 0) then RecErrorMessage := 'Ошибка закрытия входного устройства'; { сообщаем вызвавшей функции, что устройство закрыто } bDeviceOpen := FALSE; end; {------------------StopRecord-----------------John Mertus---14-Июнь--97--} procedure TWaveRecorder.StopRecord; { Останавливаем запись и устанавливаем некоторые флаги. } { } {***********************************************************************} var iErr: Integer; begin RecordActive := False; iErr := waveInReset(WaveIn); { прекращаем запись и возвращаем стоящие в очереди буферы } if (iErr <> 0) then begin RecErrorMessage := 'Ошибка в waveInReset'; end; CloseWaveDeviceRecord; end; {--------------AddNextBuffer------------------John Mertus---14-Июнь--97--} function TWaveRecorder.AddNextBuffer: Boolean; { Добавляем буфер ко входной очереди и переключаем буферный индекс. } { } {***********************************************************************} var iErr: Integer; begin { ставим буфер в очередь для получения очередной порции данных } iErr := waveInAddBuffer(WaveIn, pwaveheader[bufindex], sizeof(TWAVEHDR)); if (iErr <> 0) then begin StopRecord; RecErrorMessage := 'Ошибка добавления буфера' + TWaveInGetErrorText(iErr); AddNextBuffer := FALSE; Exit; end; { переключаемся на следующий буфер } bufindex := (bufindex + 1) mod fTotalBuffers; QueuedBuffers := QueuedBuffers + 1; AddNextBuffer := TRUE; end; {--------------BufferDoneCallBack------------John Mertus---14-Июнь--97--} procedure BufferDoneCallBack( hW: HWAVE; // дескриптор waveform-устройства uMsg: DWORD; // посылаемое сообщение dwInstance: DWORD; // экземпляр данных dwParam1: DWORD; // определяемый приложением параметр dwParam2: DWORD; // определяемый приложением параметр ); stdcall; { Вызывается при наличии у wave-устройства какой-либо информации, } { например при заполнении буфера } { } {***********************************************************************} var BaseRecorder: PWaveRecorder; begin BaseRecorder := Pointer(DwInstance); with BaseRecorder^ do begin ProcessBuffer(uMsg, pWaveBuffer[ProcessedBuffers mod fTotalBuffers], WaveBufSize); if (RecordActive) then case uMsg of WIM_DATA: begin BaseRecorder.AddNextBuffer; ProcessedBuffers := ProcessedBuffers + 1; end; end; end; end; {------------------StartRecord---------------John Mertus---14-Июнь--97--} function TWaveRecorder.StartRecord: Boolean; { Начало записи. } { } {***********************************************************************} var iErr, i: Integer; begin { начало записи в первый буфер } iErr := WaveInStart(WaveIn); if (iErr <> 0) then begin CloseWaveDeviceRecord; RecErrorMessage := 'Ошибка начала записи wave: ' + TWaveInGetErrorText(iErr); end; RecordActive := TRUE; { ставим в очередь следующие буферы } for i := 1 to fTotalBuffers - 1 do if (not AddNextBuffer) then begin StartRecord := FALSE; Exit; end; StartRecord := True; end; {-----------------SetupRecord---------------John Mertus---14-Июнь--97--} function TWaveRecorder.SetupRecord(P: PWaveRecorder): Boolean; { Данная функция делает всю работу по созданию waveform-"записывателя". } { } {***********************************************************************} var iErr, i: Integer; begin dwTotalwavesize := 0; dwBytedatasize := 0; bufindex := 0; ProcessedBuffers := 0; QueuedBuffers := 0; { открываем устройство для записи } iErr := waveInOpen(@WaveIn, WAVE_MAPPER, pWaveFmtEx, Integer(@BufferDoneCallBack), Integer(P), CALLBACK_FUNCTION + WAVE_ALLOWSYNC); if (iErr <> 0) then begin RecErrorMessage := 'Не могу открыть входное устройство для записи: ' + ^M + TWaveInGetErrorText(iErr); SetupRecord := FALSE; Exit; end; { сообщаем CloseWaveDeviceRecord(), что устройство открыто } bDeviceOpen := TRUE; { подготавливаем заголовки } InitWaveHeaders(); for i := 0 to fTotalBuffers - 1 do begin iErr := waveInPrepareHeader(WaveIn, pWaveHeader[I], sizeof(TWAVEHDR)); if (iErr <> 0) then begin CloseWaveDeviceRecord; RecErrorMessage := 'Ошибка подготовки заголовка для записи: ' + ^M + TWaveInGetErrorText(iErr); SetupRecord := FALSE; Exit; end; end; { добавляем первый буфер } if (not AddNextBuffer) then begin SetupRecord := FALSE; Exit; end; SetupRecord := TRUE; end; {-----------------ProcessBuffer---------------John Mertus---14-Июнь--97--} procedure TWaveRecorder.ProcessBuffer(uMsg: Word; P: Pointer; n: Integer); { Болванка процедуры, вызываемой при готовности буфера. } { } {***********************************************************************} begin end; end.

Текст вопроса:

1. Перемещаю в игровой программе картинки Image в цикле While, используя Form.Update. При исполнении программы нервирует постоянное мерцание при перерисовке объектов. Используя вместо циклов таймеры, результат получше, но не хочу. Можно ли сделать вывод более мягким и сглаженным?

2. Как узнать количество принятых и переданных модемом данных в байтах?

Автор вопроса: Павлов Евгений Владимирович (статус: Посетитель)
Дата и время отправки вопроса: 07.12.2006, 01:16
Получено ответов на вопрос: 3
Сообщений в форуме вопроса: 1
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Матвеев Игорь Владимирович (статус: Средний уровень), 07.12.2006, 03:19]:

Здравствуйте, Павлов Евгений Владимирович!
1. Основная идея избавления от мерцания - не совершать промежуточных закрашиваний. При использовании TImage эти лишние отрисовки появляются. Вам нужно лучше использовать единое поле для рисования, скажем TPaintBox и отрисовывать в нем изображения самостоятельно методом Draw (он самый быстрый в GDI). Если картинка изменила свое положение Вы можете вычислять области, которые необходимо закрасить фоном, но не закрашивая текущее положение картинки. Если перемещения картинок сложные и этот вариант не проходит - заведите канву в памяти (используя TBitmap, т.к. TCanvas - виртуальный класс) и рисуйте на нем, а в конце, когда все отрисаванно - просто выводите на экран.

2. Начните искать с вот этой ссылки - http://delphi.about.com/od/fullcodeprojects/l/aa112903a.htm.

2. [Отвечает: Dron (статус: 10-ый класс), 07.12.2006, 08:05]:

Здравствуйте, Павлов Евгений Владимирович!
1. Конечно, делать стандартными средствами графическую игру - это неправильно. Даже если вам удастся избавиться от мерцания, могут появиться новые проблемы. Например, если вы будете перемещать одновременно большое количество изображений. Для написания 2D-игр лучше использовать соответствующие готовые движки. Самый распространённый - DelphiX. Там никакого мерцания, естественно, не будет. При этом, конечно, вам потребуется какое-то время на изучение базовых принципов работы с движком.
Загрузить движок можно здесь: ftp://rada.evpanet.com/soft/UnDelphiX_D7.zip

Оценка за ответ: 5.
Комментарий: Спасибо за помощь. Любая информация полезна. Правда, я никогда не понимал использование готовых движков вместо собственных идей.

3. [Отвечает: Вадим К (статус: Средний уровень), 07.12.2006, 12:49]:

Рекоменую уйти от отрисовки в цикле и перейти к отрисовке по таймеру/потоку. Мож это как бы сложно, но потом это окупиться десятикрат.
По поводу отрисовки. Для быстрой отрисовки я использую следующий приём. Рисую вначале на TBitmap,который создан динамчески в памяти, а потом одной строкой переношу на форму. Лучше рисовать в обработчике OnPaint по следующей причине: Windows в этот момент ожидает от вас отрисовки и не "мучиться сама".
В общем код для отрисовки схематически должен выглядеть так. Дополнительный поток, который реализует логику, анализирует клавишы, таймеры и решает, что куда поставить. Поменяв некоторые переменные, он вызывает PostMessage(Form1.handle, WM_Paint,0,0) и этим генерит сообщение о необходимости перерисовки. Windows ставит это сообщение в очередь и через некоторое время оно приходит к вашей проге. В ответ на это в обработчике OnPaint вы должны проанализировав переменные, отрисовать картинку.
Я не рекомендую использовать SendMessage по той причине, что она дожидается результата сообщения, а если в программе используются критические секции, то нарваться на взаимоблокировку - раз плюнуть. При таком подходе "дёрганий" картинки практически нет и скорость заметно повышается. Замечу, что если в очереди будет два сообщения WM_PAINT (ваша процедура не успевает их обработать) - то Windows вправе удалить эти сообщения.

Оценка за ответ: 5.
Комментарий: Ответ хороший но сложный для понимания начинающего, коим я являюсь, програмиста. Зато теперь я знаю в каком направлении двигаться. Правда, текст кода процедуры не помешал бы.А вообще я ценю любую помощь.

Текст вопроса:

Где взять исходный код на Delphi или на Pascal для расчета NхN-размерных матриц методом Гаусcа?

Автор вопроса: Петров (статус: Посетитель)
Дата и время отправки вопроса: 07.12.2006, 17:08
Получено ответов на вопрос: 2
Сообщений в форуме вопроса: 1
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Alex Van Glukhman (статус: 7-ой класс), 07.12.2006, 20:48]:

Здравствуйте, Петров!
Наверное надо войти в Delphi и попытаться ручками написать реализацию решения. Голая математика почти как калькулятор. Ну ежели с Pascal так всё сложно то - поиск по Yandex. Google и т.д.

2. [Отвечает: Матвеев Игорь Владимирович (статус: Средний уровень), 08.12.2006, 01:39]:

Здравствуйте, Петров!
Взято из справочника DelphiWorld.
www.delphiworld.narod.ru

Приложение:

{ **** UBPFD *********** by delphibase.endimus.com **** >> Метод Гаусса решения системы линейных уравнений Рещение системы линейных уравнений (возможно переопределенной) методом Гаусса. Определяется ситуация, что система не имеет рещений. Ситуация, когда система имеет более чем одно решение не рассматривается. В случае удачного завершения возвращает нуль. Зависимости: System Автор: Mystic, mystic2000@newmail.ru, ICQ:125905046, Харьков Copyright: (C) Mystic Дата: 25 апреля 2002 г. ***************************************************** } function LinGauss(M, N: Integer; Data: PExtended; X: PExtended): Cardinal; var PtrData: PExtended; PtrData1, PtrData2: PExtended; Temp: Extended; I, J, Row: Integer; Max: Extended; MaxR: Integer; begin Assert(M >= N, 'Invalid start data'); for I := 0 to N - 1 do // Для каждой переменной begin // 1. Поиск максимального элемента PChar(PtrData) := PChar(Data) + I * (N + 2) * SizeOf(Extended); MaxR := I; Max := PtrData^; for J := I + 1 to M - 1 do begin PChar(PtrData) := PChar(PtrData) + (N + 1) * SizeOf(Extended); if Abs(PtrData^) > Abs(Max) then begin Max := PtrData^; MaxR := J; end; end; // 2. А вдруг неразрешима? if Abs(Max) < 1.0E-10 then begin Result := $FFFFFFFF; Exit; end; // 3. Меняем местами строки if MaxR <> I then begin PChar(PtrData1) := PChar(Data) + MaxR * (N + 1) * SizeOf(Extended); PChar(PtrData2) := PChar(Data) + I * (N + 1) * SizeOf(Extended); for J := 0 to N do begin Temp := PtrData1^; PtrData1^ := PtrData2^; PtrData2^ := Temp; PChar(PtrData1) := PChar(PtrData1) + SizeOf(Extended); PChar(PtrData2) := PChar(PtrData2) + SizeOf(Extended); end; end; // 4. Пересчет направляющей строки PChar(PtrData) := PChar(Data) + I * (N + 1) * SizeOf(Extended); for J := 0 to N do begin PtrData^ := PtrData^ / Max; PChar(PtrData) := PChar(PtrData) + SizeOf(Extended); end; // 5. Пересчет всей оставшйся части таблицы PtrData1 := Data; for Row := 0 to M - 1 do begin if Row = I then begin PChar(PtrData1) := PChar(PtrData1) + (N + 1) * SizeOf(Extended); Continue; end; PChar(PtrData2) := PChar(Data) + I * (N + 1) * SizeOf(Extended); Temp := PExtended(PChar(PtrData1) + I * SizeOf(Extended))^; for J := 0 to N do begin PtrData1^ := PtrData1^ - Temp * PtrData2^; PChar(PtrData1) := PChar(PtrData1) + SizeOf(Extended); PChar(PtrData2) := PChar(PtrData2) + SizeOf(Extended); end; end; end; // 6. Проверка того, что система переопределена PChar(PtrData) := PChar(Data) + N * (N + 1) * SizeOf(Extended); for I := N to M - 1 do for J := 0 to N do begin if Abs(PtrData^) > 1.0E-10 then begin Result := $FFFFFFFF; Exit; end; PChar(PtrData) := PChar(PtrData) + SizeOf(Extended); end; // Все ОК PChar(PtrData) := PChar(Data) + N * SizeOf(Extended); for I := 0 to N - 1 do begin X^ := PtrData^; PChar(X) := PChar(X) + SizeOf(Extended); PChar(PtrData) := PChar(PtrData) + (N + 1) * SizeOf(Extended); end; Result := 0; end;

Текст вопроса:

Доброго всем времени суток!
В Дельфи программирую недавно, поэтому часто возникают вопросы. Например, такой: как создать всплывпющую подсказку. На "канве" карта. Нужно при перемещении мыши вблизи точки расположения населенного пункта (из базы данных) всплывала подсказка с названием города.
Заранее благодарю за конкретную помощь.

Автор вопроса: Драганов Василий Михайлович (статус: Посетитель)
Дата и время отправки вопроса: 08.12.2006, 22:42
Получено ответов на вопрос: 3
Сообщений в форуме вопроса: 3
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Виталий Лещенко (статус: 3-ий класс), 08.12.2006, 23:31]:

Здравствуйте, Драганов!
Можно сделать так:
1. в базе хранишь координыта на карте + дополнительную информацию для показа.
2. в класс TImage грузишь нужную картинку.
3. замем делаешь обработчик события OnMouseMove
4. в нем делаешь выборку из базы по нужным координатам. (тебе будут переданы координыты мыши)
5. позиционируешь компонент TLabel, например, в нужное место... и все.
6. если при выборке не найдено ниодного населенного пункта, то просто скрываешь TLabel

Приложение:

Если необходима детализация, то обращайся на форум http://forum.vitaliy.org/ С радостью отвечу на все вопросы... на которые знаю ответы.

Оценка за ответ: 4.

2. [Отвечает: Бубырь Александр Николаевич (статус: 3-ий класс), 09.12.2006, 12:42]:

Делал когда-то подобную вещь на базе MapObject.
Только это делал не на OnMouseMove, а по таймеру.
Приведу кусок своего кода, думаю можно понять:
Если переделать определение координат с MapObject на свое, и свой массив точек с метками, остальное должно работать.
Успехов.

Приложение:

procedure TFormMap.Timer1Timer(Sender: TObject); Const Interval=3; Var p,p1,p2:IMoPoint; f:Integer; d:Double; begin //Отображение поставленых меток при наведении мыши if (MapX=MapLX) and (MapY=MapLY) then begin // mouse didn't move Timer1.Enabled:=False; p:=IMoPoint(CreateOleObject('MapObjects2.Point')); p1:=Map1.ToMapPoint(MapX-Interval,MapY-Interval); p2:=Map1.ToMapPoint(MapX+Interval,MapY+Interval); if P2.X<P1.X then begin D:=P2.X; P2.X:=P1.X; P1.X:=D; end; if P2.Y<P1.Y then begin D:=P2.Y; P2.Y:=P1.Y; P1.Y:=D; end; for f:=0 to Map1.TrackingLayer.EventCount-1 do begin P.X:=Map1.TrackingLayer.Event[f].X; P.Y:=Map1.TrackingLayer.Event[f].Y; if (P.X>=P1.X) and (P.Y>=P1.Y) and (P.X<=P2.X) and (P.Y<=P2.Y) then begin LabelInfo.Caption:=EventInfo[f]; LabelInfo.Left:=MapX+10; LabelInfo.Top:=MapY; LabelInfo.Visible:=True; Break; end else LabelInfo.Visible:=False; end; end else begin MapLX:=MapX; MapLY:=MapY; end; end;

Оценка за ответ: 2.

3. [Отвечает: Alex Van Glukhman (статус: 7-ой класс), 09.12.2006, 16:09]:

Здравствуйте, Драганов!

То что описал Виталий Лещенко достаточно приемлимый вариант, только в дополнение к написанномиу им
1. База данных хранит координаты границ населённого пункта к примеру определенного прямоугольником(Xmin, Ymin, Xmax, Ymax) иначе точку в один пиксель на экране ловить не очень удобно. Необходимо объявить переменную типа TRect для хранения координат объекта и str типа String для значения Caption TLabel
2. На OnMouseMove проверяется нахождение курсора в границах области объекта выбрав значения X и Y и проверив соответствие координат X, Y в пределах TRect.
X, Y не в TRect - запрос в БД на наличие объекта в БД если его нет то проверяем TLabel, если TLabel Visible=true, то Visible=false и Caption='' иначе ничего не делаем.
Если объект в баазе данных то если TLabel не видима то включаем её со значением из БД и присваиваем координаты объекта переменной TRect и значение заносим в str, если видима то если значение в БД <> str то изменяем Caption у TLabel в противном случае ничего не делаем.
Это необходимо для избежания мерцания TLabel и чрезмерных количеств выполнения запросов к БД. Вместо TLabel можно использовать Hnt: THintWindow

Подробно обращайся в ICQ 165711772

Оценка за ответ: 3.

Текст вопроса:

Здравствуйте эксперты!
прошу прощения за ламерский вопрос, я учусь программировать на Delphi. Есть строка с путем к некоторому файлу, например: D:\catalog\file.exe, как мне отбросить имя файла и оставить только имя одного каталога, например получая эту строку через TOpenDialog.
Спасибо за ответ.

Автор вопроса: Alexey (статус: Посетитель)
Дата и время отправки вопроса: 09.12.2006, 02:15
Получено ответов на вопрос: 2
Сообщений в форуме вопроса: 0
Страница данного вопроса >>

» Ответы на данный вопрос:

1. [Отвечает: Dron (статус: 10-ый класс), 09.12.2006, 08:15]:

Здравствуйте, Alexey!
Это можно сделать с помощью функций ExtractFilePath и ExtractFileDir. Их отличие состоит только в том, будет ли у выданного пути слеш "\" в конце... Первая выдаёт путь вместе с ним, вторая - без него. Использовать функции очень легко - в скобках нужно указать строку в явном виде, либо строковую переменную, а на выходе прочитать значение. См. пример в приложении. Удачи!

Приложение:

Var Path1,Path2: String; Begin Path1:='D:\catalog\file.exe'; Path2:=ExtractFilePath(Path1); End;

Оценка за ответ: 5.

2. [Отвечает: Дима Гусаков (статус: 1-ый класс), 09.12.2006, 13:42]:

Здравствуйте, Alexey!
if OpenDialog1.Execute then
Label1.Caption := ExtractFilePath(OpenDialog1.FileName);

Оценка за ответ: 5.