» Вопросы по Delphi (все версии) - часть 3

Vitus_Bering

Цитата:

Нужно программно сохранить web-страницу в текстовый файл.

http://forum.ru-board.com/topic.cgi?forum=33&topic=3288#1
надо все таки учиться фильтром пользоваться

Подскажите, пожалуйста, как сделать следующее.
Имеется локальная база данных Access (просто файл *.mdb). Для связи с БД используются ADOConnection->ADOTable->DataSet.
Нужно, чтобы при вводе полей новой записи, например в DBEdit, пользователю не надо было полностью набирать значение поля, если такое значение уже есть в БД, и это уже имеющееся значение подставлялось бы в этот DBEdit.

onyxhall lookup-поля, если я правильно понял

jONES1979

Почитал про lookup-поля - нет, похоже то, что мне надо называется инкрементный (или инкрементальный?) поиск.
Кто в курсе подскажите как это организовать при вводе новой записи в БД.

onyxhall
с DBEdit такие хитройсти не выйдут, капай в сторону MRU технологии

onyxhall
тебе правильно сказали DBLookup, при наборе значения (если все правильно сделал) автоматически предлагаются соотв варианты.

Мой совет используй компоненты Dev Express QuantumGrid и все твои проблемы исчезнут
там это все уже реализованно давно!

http://www.devexpress.com/Downloads/VCL/ExQuantumGrid/Index.xml

onyxhall
я б посоветовел Ehlib, т.к. он не такой громадный как DevExpress. И то что тебе надо там устанавливается одной пропертей колонки - MRUList

Ну вот найдено обычное для Delphi решение - компонент. JvDBSearchEdit из JVCL.
Для него задается DataSource и DataField, и ВСЕ. Все отлично ищется и подставляется.
Я посмотрел и MRU вообще и MRUList у DBEditEh в частности - можно все реализовать, но сделать это сложнее, чем с вышеназванным компонентом.

realduddits
Вот только начинаю осваивать QuantumGrid - отличный грид, наверное самый навороченый из всех, что вообще есть. Можешь подсказать как такую функциональность получить используя его? Очень интересно.

значит так вот такая вот прога. Короче прога должна связать определенные две-три клавиши и присвоить их одной, но так что бы эта кнопка должна работать в другой проге. Как это реализовать.

Через RegisterHotKey регистрируешь горячую клавишу (посмотри как сделать глобальный хоткей - где то уже было), а потом при событии горячки генерируешь событие на клавиатуру через keybd_event - это точно было, сам давал куски рабочего кода, так что фильтр и вперед

Перетаскивание с помощью мыши между listbox-сами
Делаю так
Ставлю у обоих ListBox DragMode = dmAutomatic

В onDragOver у ListBox1 пишу
Accept := Source = ListBox2

В onDragOver у ListBox2 пишу
Accept := Source = ListBox1

В onDragDrop у ListBox1 пишу:
if (Source = ListBox2) and (ListBox2.ItemIndex >= 0) then
ListBox1.Items.Insert(ListBox1.ItemAtPos(Point(X,Y), true), ListBox2.Items[ListBox2.ItemIndex]);

В onDragDrop у ListBox2 соотвественно:

if (Source = ListBox1) and (ListBox1.ItemIndex >= 0) then
ListBox2.Items.Insert(ListBox2.ItemAtPos(Point(X,Y), true), ListBox1.Items[ListBox1.ItemIndex]);

Нужно сделать так, чтобы при перетаскивании из Л1 строка изчезала в Л2 появлялась.
Как победить?

JonyBes

Цитата:

Нужно сделать так, чтобы при перетаскивании из Л1 строка изчезала в Л2 появлялась.

Не понял... когда надо изчезнет строку - после перемещение, или...?

Добавлено:
JonyBes
Если простое перетаскивание, что мешает сделать так:

Код:
if (Source = ListBox1) and (ListBox1.ItemIndex >= 0) then
begin
ListBox2.Items.Insert(ListBox2.ItemAtPos(Point(X,Y), true), ListBox1.Items[ListBox1.ItemIndex]);
ListBox1.Items.Delete(ListBox1.ItemIndex);
end;

Как загнать список папок в заданном каталоге.
Просмотрел все форум, ответа не нашел. Мне нужен простой способ найти только папки первого уровня в нужном коталоге и все!

JonyBes
DirectoryListBox на вкладке Win 3.1

Добавлено:
Есть еще вот такая вот процедурка

Код: // список содержимого папки
procedure ScanDir(StartDir, Mask: string; aList: TStrings);
var
SearchRec: TSearchRec;
begin
if Mask = '' then
Mask := '*.*';
if StartDir[Length(StartDir)] <> '\' then
StartDir := StartDir + '\';
if SysUtils.FindFirst(StartDir + Mask, faAnyFile, SearchRec) = 0 then
begin
repeat Application.ProcessMessages;
if (SearchRec.Attr and faDirectory) <> faDirectory then
aList.Add(StartDir + SearchRec.Name)
else
if (SearchRec.Name <> '..') and (SearchRec.Name <> '.')then
begin
aList.Add(StartDir + SearchRec.Name + '\');
ScanDir(StartDir + SearchRec.Name + '\', Mask, aList);
end;
until SysUtils.FindNext(SearchRec) <> 0;
SysUtils.FindClose(SearchRec);
end;
end;

Почему listbox помимо нужной информации содержит мусор какой-то
Вот что я получаю в отладчике:
rzListBox6.Items.Text    '06-107049-09'#$D#$A
поэтому сравнения типа
if rzListBox6.Items.Text<>sr.Name then
rzListBox1.Items.Add(sr.Name);
работаю не корректно
Как это победить?

JonyBes
ListBox.Items.Text содержит в виде многострочного текста текстовки всех итемов, в конце каждой строки стоит перевод строки (#13#10 или #$D#$A).
А побеждать... смотря что ты хочешь сделать: что такое sr? как должен себя вести алгоритм в случае если в листбоксе несколько строк? Если надо убрать перевод строки в конце используй Trim()

JonyBes
Может тебе подойдет во это:

Цитата:

if rzListBox6.Items.IndexOf(sr.Name) < 0 then
rzListBox1.Items.Add(sr.Name);

makbeth
Спасибо решение как раз то что надо!

Ребята может быть у кого то есть HYPERSTR (желательн оверсию попозднее, последня я про которую слышал v6.03) ?
В интернете просто катастрофа какая то -не найти.
Интересуют функции нечеткого сравнению строк (те которые есть медленные)

Добавлено:
Выковарял как бы функцию similar с какогото китайского сайта.

ShIvADeSt
А мож код еще раз написать если не влом)

Как отследить новый файл в каталоге если даты изменения и создания у файлов остаются родные, т.е. по дате искать невозможно.
То что файл пришел фиксирую с помощью dcFolderMonitorа из набора компонент Disk Controls. Что делать дальше ?
Общая задача такая - В каталоге куча папок с файлами, если в каталог пришел новый файл то скопировать его в другой каталог.

ArtemiyUO
У меня только HyperString v6.0, там есть функция similar (на ассемблере).

JonyBes
Цитата:

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

Кроме даты модификации, ещё есть Дата Создания - проверьте, если она изменяется, тогда выбирайте по ней (TSearchRec.FindData.ftCreationTime : TFileTime,
или, если нужно TDateTime - тогда
FileTimeToLocalDateTime( SearchRec.FindData.ftCreationTime )

JonyBes
[more=Вот как это примерно делается]
Использование ReadDirectoryChangesW

Очень хорошая функция, только " Windows 95/98/Me: Unsupported" . Т.е. в Win9x этой функции нет. Но мы же пишем для NT, а там с этой функцией все в порядке (если 3-ий сервис пак для NT3.1 поставили ))

Кратко пройдемся по описанию функции (взято из windows



function ReadDirectoryChangesW(
hDirectory: THandle; // описатель каталога, за которым надо следить
lpBuffer: Pointer; // Указатель на буфер, в который будет записана информация
nBufferLength: DWORD; // Размер буфера
bWatchSubtree: Bool; // Следить ли за подкаталогами
dwNotifyFilter: DWORD; // Фильтр действий
lpBytesReturned: LPDWORD; // Сколько было записано в буфер
lpOverlapped: POverlapped; // Для асинхронной работы
lpCompletionRoutine: FARPROC // Функция, которая будет вызвана при окончании операции
): BOOL; stdcall;




Чтобы программа могла нормально работать во время ожидания очередного изменения, мы функции мониторинга выделим отдельный поток. Поток " сделан" на WinAPI (функция WorkThread). При нажатии на одну кнопку он будет создаваться, а на другую - жестоко уничтожаться. Вся полезная информация будет выводиться в TListView.

Функция потока будет описана так:



procedure WorkThread(LV: TListView); stdcall;




LV - это то, во что мы будем выводить инфу. И не забывайте stdcall;

А вот ее текст:



procedure WorkThread(LV : TListView);stdcall;
var
hDir : THandle;

lpBuf : Pointer;
Ptr : Pointer;

cbReturn : Cardinal;
FileName : PWideChar;

Item : TListItem;
sTime : _SYSTEMTIME;
begin
// Сначала нам надо получить описатель каталога, за которым мы будем следить
// В данном примере это будет весь диск C:
hDir := CreateFile ('C:\',GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE
or FILE_SHARE_DELETE,nil,OPEN_EXISTING,FILE_FLAG_BACKUP_SEMANTICS,0);
// Если ошиблись...
if hDir = INVALID_HANDLE_VALUE
then begin ShowMessage(SysErrorMessage(GetLastError)); exit; end;

// Выделяем память под буфер
// const BUF_SIZE = 2048 - думаю вполне достаточно
GetMem(lpBuf,BUF_SIZE);

repeat
// очищаем память перед записью в нее (на всякий случай)
ZeroMemory(lpBuf,BUF_SIZE);

// Теперь мы будем ждать пока чего-нибудь в интересующем нас каталоге
// изменится или произойдет ошибка (и мы выйдем из цикла)
// FILE_NOTIFY_CHANGE - это список флагов - о них ниже.
if not ReadDirectoryChangesW(hDir,lpBuf,BUF_SIZE,true,
FILE_NOTIFY_CHANGE,@cbReturn,nil,nil)
then Break;

// Сюда мы попадаем, если функция выполнилась успешно
// и lpBuf указывает на одну или несколько структур FILE_NOTIFY_INFORMATION
Ptr:=lpBuf;




Отойдем пока от исходного кода и рассмотрим, что у нас появится в буфере. В данный момент lpBuf и Ptr указывают на первую структуру FILE_NOTIFY_INFORMATION. Вторым полем этой структуры является - Action -тип действия, которое было совершено. Четвертым - FileName - первый символ имени файла. Имя файла не заканчивается нулем #0 и для определения его длины используется 3 параметр - FileNameLength. При этом надо учесть, что имя файла в формате Unicode т.е. каждый символ занимает 2 байта, а FileNameLength дается в байтах. Придется эту длину делить на 2, чтобы узнать кол-во символов.

Но возникает вопрос - как узнать, сколько таких структур было записано в буфер. Для этого используется 1 параметр структуры - NextEntryOffset. Если он не равен нулю, то в нем будет кол-во байт, через которые находится следующая запись и нам надо сдвинуть указатель на это кол-во байт, чтобы " получить" следующую структуру. И так далее, пока NextEntryOffset не будет равен 0 (т.е. эта запись была последней).



repeat
// Добавляем новый элемент в TListView (ViewStyle = vsReport )
Item := LV.Items.Add;

// Выделяем память под имя файла
GetMem(FileName,PFileNotifyInformation(Ptr).FileNameLength+2);
// Очищаем память - чтобы последним символом после копирования
// был бы #0 нуль
ZeroMemory(FileName,PFileNotifyInformation(Ptr).FileNameLength+2);
// WinAPI функция для копирования Unicode строки
lstrcpynW(FileName,PFileNotifyInformation(Ptr).FileName,
PFileNotifyInformation(Ptr).FileNameLength div 2+1);
// Имя файла у нас дается относительно папки
// т.е.если изменится файл C:\File\test.dat, то FileName
// будет равно File\test.dat
Item.Caption:='C:\'+FileName;
// Имя файла нам больше не нужно - очищаем память
FreeMem(FileName);

// Определяем тип произошедшего действия
case PFileNotifyInformation(Ptr).Action of
FILE_ACTION_ADDED : Item.SubItems.Add('Файл был создан');
FILE_ACTION_REMOVED : Item.SubItems.Add('Файл был удален');
FILE_ACTION_MODIFIED : Item.SubItems.Add('Файл был изменен');
FILE_ACTION_RENAMED_OLD_NAME :
Item.SubItems.Add('Файл был переименован и в имени файла - предыдущее имя');
FILE_ACTION_RENAMED_NEW_NAME :
Item.SubItems.Add('новое имя после переименования');
else Item.SubItems.Add('Произошло что-то странное');
end;

// Время, когда произошло событие
GetLocalTime(sTime);
with sTime do
Item.SubItems.Add(Format('%.2d:%.2d:%.2d',[wHour,wMinute,wSecond])); // 13:54:20

// Если эта запись не последняя (NextEntryOffset < > 0), то...
if PFileNotifyInformation(Ptr).NextEntryOffset=0
then Break
else begin
// ... добавляем строку в примечания (если интересно посмотреть смещение)
Item.SubItems.Add('Offset : '+
IntToStr(PFileNotifyInformation(Ptr).NextEntryOffset));
//Передвигаем указатель на NextEntryOffset байт вперед
Inc(Cardinal(Ptr),PFileNotifyInformation(Ptr).NextEntryOffset);
// Теперь Ptr указывает на следующую запись
end;

// Передвигать надо именно Ptr, а не lpBuf
until false;

until false;

// Очищаем память
FreeMem(lpBuf);
end;




Параметр функции dwNotifyFilter - действия, информацию о которых мы хотим получать.

FILE_NOTIFY_CHANGE_FILE_NAME - создание, удаление, переименование файла.
FILE_NOTIFY_CHANGE_DIR_NAME - созданием и удаление каталога.
FILE_NOTIFY_CHANGE_ATTRIBUTES - изменение атрибутов файла.
FILE_NOTIFY_CHANGE_SIZE - изменение размера файла.
FILE_NOTIFY_CHANGE_LAST_WRITE - изменение файла (это и предыдущее уведомление будет получено только в момент реальной записи файла на диск).
FILE_NOTIFY_CHANGE_LAST_ACCESS - изменение времени последнего доступа.
FILE_NOTIFY_CHANGE_CREATION - изменение времени создания файла.
FILE_NOTIFY_CHANGE_SECURITY - изменение параметров безопасности (прав доступа и т.д.)
У меня в примере используются FILE_NOTIFY_CHANGE_FILE_NAME, FILE_NOTIFY_CHANGE_DIR_NAME и FILE_NOTIFY_CHANGE_LAST_WRITE.

А теперь надо только запустить поток.



procedure TForm1.Button1Click(Sender: TObject);
var
ThID : Cardinal;
begin
// hThread - THandle - глобальная переменная
// Создаем поток
// LV - TListView, WorkThread - функция выше
hThread:=CreateThread(nil,0,@WorkThread,LV,0,ThID);
// В случае неудачи выводим сообщение
if hThread=0 then ShowMessage(SysErrorMessage(GetLastError));
end;




У меня в исходниках поток останавливается функцией TerminateThread(hThread,Cardinal(-1)). Но при таком завершении не будут освобождены все ресурсы, занятые потоком (а это как минимум BUF_SIZE байт памяти. Вместо этой функции было бы лучше использовать SuspendThread(hThread), а при запуске проверять на существование потока WaitForSingleObject(hThread,0)= WAIT_TIMEOUT и если он существует - делать ResumeThread(hThread)

[/more]

ХАЙ

Народ подскажите как реализовать такую штуку: в RichEdit нада удалить все строки которые находятся между двумя пустыми, причем пустые строки трогать не нада.... Что то не выходит

Заранее спасибо....

Добрый день. Подскажите поржалуста как в Delphi можно реализовать FFt преобразование, может существуют библиотеки? Может существуют некии модули спектроанилизаторы?

rutra13

вроде то что тебе надо, но код не проверял

[more=unit Demo]
unit DemoForm;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type

TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
Edit1: TEdit;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var

Form1: TForm1;

implementation

{$R *.DFM}

uses cplx, cplxfft1, MMSystem;

procedure TForm1.Button1Click(Sender: TObject);
var
j: integer;
s: string;
src, dest: PScalars;
norm: extended;
d, N, count: integer;
st, et: longint;
begin
d := StrToIntDef(edit1.text, -1);
if d < 1 then
raise
exception.Create('глубина рекурсии должны быть положительным целым числом');
N := integer(1) shl d;
GetMem(Src, N * Sizeof(TScalar));
GetMem(Dest, N * SizeOf(TScalar));
for j := 0 to N - 1 do
begin
src^[j] := MakeComplex(random, random);
end;
begin
st := timeGetTime;
FFT(d, Src, dest);
et := timeGetTime;
end;
Memo1.Lines.Add('N = ' + IntToStr(N));
Memo1.Lines.Add('норма ожидания: ' + #9 + FloatToStr(N * 2 / 3));
norm := 0;
for j := 0 to N - 1 do
norm := norm + AbsSquared(src^[j]);
Memo1.Lines.Add('Норма данных: ' + #9 + FloatToStr(norm));
norm := 0;
for j := 0 to N - 1 do
norm := norm + AbsSquared(dest^[j]);
Memo1.Lines.Add('Норма FT: ' + #9#9 + FloatToStr(norm));
Memo1.Lines.Add('Время расчета FFT: ' + #9
+ inttostr(et - st)
+ ' мс.');
Memo1.Lines.Add(' ');
FreeMem(Src);
FreeMem(DEst);
end;
end.
[/more]

[more=unit cplx]
unit cplx;

interface

type

PReal = ^TReal;
TReal = extended;
PComplex = ^TComplex;
TComplex = record
r: TReal;
i: TReal;
end;

function MakeComplex(x, y: TReal): TComplex;
function Sum(x, y: TComplex): TComplex;
function Difference(x, y: TComplex): TComplex;
function Product(x, y: TComplex): TComplex;
function TimesReal(x: TComplex; y: TReal): TComplex;
function PlusReal(x: TComplex; y: TReal): TComplex;
function EiT(t: TReal): TComplex;
function ComplexToStr(x: TComplex): string;
function AbsSquared(x: TComplex): TReal;

implementation

uses SysUtils;

function MakeComplex(x, y: TReal): TComplex;
begin
with result do
begin
r := x;
i := y;
end;
end;

function Sum(x, y: TComplex): TComplex;
begin
with result do
begin
r := x.r + y.r;
i := x.i + y.i;
end;
end;

function Difference(x, y: TComplex): TComplex;
begin
with result do
begin
r := x.r - y.r;
i := x.i - y.i;
end;
end;

function EiT(t: TReal): TComplex;
begin
with result do
begin
r := cos(t);
i := sin(t);
end;
end;

function Product(x, y: TComplex): TComplex;
begin
with result do
begin
r := x.r * y.r - x.i * y.i;
i := x.r * y.i + x.i * y.r;
end;
end;

function TimesReal(x: TComplex; y: TReal): TComplex;
begin
with result do
begin
r := x.r * y;
i := x.i * y;
end;
end;

function PlusReal(x: TComplex; y: TReal): TComplex;
begin
with result do
begin
r := x.r + y;
i := x.i;
end;
end;

function ComplexToStr(x: TComplex): string;
begin
result := FloatToStr(x.r)
+ ' + '
+ FloatToStr(x.i)
+ 'i';
end;

function AbsSquared(x: TComplex): TReal;
begin
result := x.r * x.r + x.i * x.i;
end;
end.
[/more]

[more=unit cplxfft1]
unit cplxfft1;

interface

uses Cplx;

type
PScalar = ^TScalar;
TScalar = TComplex; {Легко получаем преобразование в реальную величину}
PScalars = ^TScalars;
TScalars = array[0..High(integer) div SizeOf(TScalar) - 1]
of TScalar;

const
TrigTableDepth: word = 0;
TrigTable: PScalars = nil;

procedure InitTrigTable(Depth: word);

procedure FFT(Depth: word;Src: PScalars;Dest: PScalars);

{Перед вызовом Src и Dest ТРЕБУЕТСЯ распределение

(integer(1) shl Depth) * SizeOf(TScalar) байт памяти!}

implementation

procedure DoFFT(Depth: word;

Src: PScalars;

SrcSpacing: word;

Dest: PScalars);

{рекурсивная часть, вызываемая при готовности FFT}

var

j, N: integer;

Temp: TScalar;

Shift: word;

begin

if Depth = 0 then

begin

Dest^[0] := Src^[0];

exit;

end;



N := integer(1) shl (Depth - 1);



DoFFT(Depth - 1, Src, SrcSpacing * 2, Dest);

DoFFT(Depth - 1, @Src^[SrcSpacing], SrcSpacing * 2, @Dest^[N]);



Shift := TrigTableDepth - Depth;



for j := 0 to N - 1 do

begin

Temp := Product(TrigTable^[j shl Shift],

Dest^[j + N]);

Dest^[j + N] := Difference(Dest^[j], Temp);

Dest^[j] := Sum(Dest^[j], Temp);

end;

end;



procedure FFT(Depth: word;

Src: PScalars;
Dest: PScalars);
var
j, N: integer;
Normalizer: extended;
begin
N := integer(1) shl depth;
if Depth TrigTableDepth then
InitTrigTable(Depth);
DoFFT(Depth, Src, 1, Dest);
Normalizer := 1 / sqrt(N);
for j := 0 to N - 1 do
Dest^[j] := TimesReal(Dest^[j], Normalizer);
end;

procedure InitTrigTable(Depth: word);
var
j, N: integer;
begin
N := integer(1) shl depth;
ReAllocMem(TrigTable, N * SizeOf(TScalar));
for j := 0 to N - 1 do
TrigTable^[j] := EiT(-(2 * Pi) * j / N);

TrigTableDepth := Depth;

end;


initialization;

finalization

ReAllocMem(TrigTable, 0);
end.
[/more]

По ошибке использовал в названии таблицы зарезервированное слово "User", из-за чего не работали запросы.
Создал новый Table и DataSource, прописал путь к новой таблице "Useres". При запуске запроса Delphi начинает ругаться что нет файлов "Useres.DB", "Useres.DBF", "Useres.txt", "Useres" в каталоге. Все таблицы находятся в каталоге Data. При копировании этих файлов в каталог все работает! В чем может быть проблема? (такое происходит именно при запросе)

в запросе написать имя таблицы толи в кавычках, толи в квадратных скобках. И отказаться от BDE