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

звуковые файлы хранятся в blob-ах (WAV/.MP3/etc). как мне не сохраняя у пользователя на компьютере проиграть файл?

neznayka3
Может сохранить звук в поток (SaveToStream)? И в плеер грузить уже из потока (LoadFromStream).

Granmer
стандартный TMediaPlayer не работает с потоками.

зато sndPlaySound() работает...

antonn2
Тогда уже PlaySound(), sndPlaySound() живет для обратной совместимости, вот только она не умеет ничего кроме WAV играть, а вопросе было .MP3/etc

Добрый день. Нужен срочный и правильный ответ. Поправляю программу для заполнения налоговой декларации. Связи с человеком, который ее написал, нет. Написана она в DELPHI, а таблицы создаются в XML. Какие числовые типы есть в XML? И как вообше можно вывести число 54.63 в виде: 54-.63-------------?

LediB
А не мог бы ты выложить исходники программы ...
любопытно глянуть

Эм, тупой конечно вопрос у меня, но все же... Итак, имеем директорию в котрой находится наш файл и директория Skins. В директории Skins находятся остальные директории - названия папок для скинов. Так вот необходимо получить список этих папок в директории Skins. Код:


Код:
function ScanSkinDirs(PathDir : String) : Boolean;
var
FindData : TWin32FindData;
FindHandle : THandle;
Directory : String;
begin
FindHandle := FindFirstFile(PChar(PathDir + '*'), FindData);
try
if FindHandle <> INVALID_HANDLE_VALUE then
repeat
if Ord(FindData.cFileName[0]) <> 46 then
begin
if (FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY) then
begin
ScanSkinDirs(PathDir + FindData.cFileName + '\');
Directory := StringReplace(PChar(PathDir + FindData.cFileName), PathDir, '');
SendMessage(GetDlgItem(hTab, ID_CMBX_SKIN), CB_ADDSTRING, 0, Integer(PChar(Directory)));
end;
end;
until
Windows.FindNextFile(FindHandle, FindData) = FALSE;
finally
Windows.FindClose(FindHandle);
end;
Result := TRUE;
end;

Maks150988
а чуть чуть дебагером пройтись
итак :

Код: FindHandle := FindFirstFile(PChar(PathDir + '\*.*'), FindData);
try
if FindHandle <> INVALID_HANDLE_VALUE then
repeat
if Ord(FindData.cFileName[0]) <> 46 then
begin
if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)=FILE_ATTRIBUTE_DIRECTORY then
begin
ScanSkinDirs(PathDir + '\'+ FindData.cFileName);
Directory := StringReplace(PChar(PathDir + FindData.cFileName), PathDir, '', [rfReplaceAll]);
SendMessage(GetDlgItem(hTab, ID_CMBX_SKIN), CB_ADDSTRING, 0, Integer(PChar(Directory)));
end;
end;
until
Windows.FindNextFile(FindHandle, FindData) = FALSE;
finally
Windows.FindClose(FindHandle);
end;
Result := TRUE;

Maks150988 FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY <- вот тут ошибка. FindData.dwFileAttributes имеет в себе несколько флагов, не только FILE_ATTRIBUTE_DIRECTORY. Правильно проверять:

(FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY)=FILE_ATTRIBUTE_DIRECTORY

Dimoniusis
посмотри пост выше.
там не только эта ошибка

Спасибо вам. Ура.

Ммм... Еще вопросик.
http://webdrive.avtograd.ru/Download/Explorer/Download/BitBtnNonVCL.rar

Полазил по инету, нашел примерчик, подизменил для своих нужд. Этот аналог BitBtn VCL только без VCL грузим картинку на кнопку и все со стилем без потери манифеста. Все бы ничего, но память отжирается каждый раз. Связано вероятно с имэйджлистом. Как его корректнее уничтожать я не понял. И ведь прилично память жрет при открытии/закрытии диалога - примерно 100 кб. Там есть ImageList_Destroy. Пытался всунуть еще на всяий случай ДелетеОбъект. Вот этот ньюанс немного непонятен.

Кто подскажет способ ОЧЕНЬ БЫСТРО получить список файлов (с полным путем) в каталоге (и всех его подкаталогах). FindFirstFile и FindNextFile НЕ ПРЕДЛАГАТЬ - их быстродействие недостаточно.

а на сколько "недостаточно"? вообще то эти функции являются просто прослойками к АПИ, так что быстрее можно, но это проценты.
Может проще сразу пробежаться, сделать список. а потом только отлавливать добавленные/удалённые файлы?

А в целом, сильно ускорить не получиться - упираемся в то, что скорость доступа к жесткому диску конечна. Да и это всё сильно зависит от того, какая файловая система.

RSoFT1978
если есть listbox
var
D: PChar;
begin
D := 'C:\*.*';
ListBox2.Perform(LB_DIR,
DDL_ARCHIVE +
DDL_DIRECTORY +
DDL_EXCLUSIVE +
DDL_HIDDEN +
DDL_READONLY +
DDL_READWRITE +
DDL_SYSTEM,
Integer(d));

Работаю с текстовым файлом для его разбора на нужные строки. В этом файле строки расположны по нужным позициям. При чтении файла строка за строкой читается. Так какие стили нужно применить к ListView чтобы по мере чтения эти строки заносились каждая в следующую строку, а не разбрасывалась по списку в этом элементе?
Текущие стили: LVS_REPORT | LVS_SINGLESEL | LVS_SHOWSELALWAYS | LVS_SORTASCENDING | LVS_NOCOLUMNHEADER | LVS_NOSORTHEADER | WS_CHILD | WS_VISIBLE | WS_BORDER. Если LVS_SORTASCENDING заменить или убрать, список еще более разбросанный. Чего надо, непонятно вообще... С ListBox все проще, а тут вразнобой как-будто строки добавляются в список.

Цитата:

LVS_SORTASCENDING

Maks150988
прочитай что это за стиль (подсказка - сортировка)

Да че йпонятно что сортировка. Что LVS_SORTASCENDING или LVS&#8203;_SORTDESCENDING использовал - бестолку чего-то...

Maks150988
Если не трудно, то дай пример строки которую читаешь и скрин как в ЛистВью пишется (заодно код как пишешь в листвью).

[more]

Код:
function CreateColumnsListview(hLV : HWND) : Boolean;
begin
GetClientRect(hLV, rc);
lvc.mask := LVCF_TEXT or LVCF_WIDTH or LVCF_FMT;
lvc.cx := (rc.Right - rc.Left) - 5;
SendMessage(hLV, LVM_INSERTCOLUMN, 0, Integer(@lvc));
SendMessage(hLV, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, LVS_EX_FULLROWSELECT or LVS_EX_CHECKBOXES or LVS_EX_BORDERSELECT);
Result := TRUE;
end;

{ Обрабатываем строку для получения адреса и типа маршрута из файла }
function ParserServerFileRead(StrPrs : String) : String;
var
Route : String;
Domen : String;
begin
// Удаляем с первого символа строки 2 последующих символа - "/0" или "/1"
Delete(StrPrs, 1, 2);
// Получаем длину строки вместе с кареткой для последующего подсчета символов
Route := URLExtractFilePath(StrPrs);
// Удаляем последний символ каретки из полученной строки
Delete(Route, Length(Route), 1);
// Получаем типа маршрута, извлекая последние символы, из первоначальной строки
Domen := URLExtractFileName(StrPrs);
// Выводим конечный результат
Result := Route + Format(' (%s)', [Domen]);
end;

{ Проверяем условие для отметки строки в списке маршрутов }
function ParserServerFileCheck(StrPrs : String) : Boolean;
var
Check : Integer;
begin
if (Pos('1/', StrPrs) <> 0) then
Result := TRUE
else
Result := FALSE;
end;

{ Обрабатываем строку для получения маршрута в BAT файл}
function ParserStringWriteRoute(StrPrs : String) : String;
var
Domen : String;
Route : String;
I : Integer;
P : Integer;
begin
// Удаляем из начальной строки последний символ (скобка после названия)
Delete(StrPrs, Length(StrPrs), 1);
// Проходимся по всей строке и ищем начальную скобку перед названием
P := -1;
for I := Length(StrPrs) downto 1 do
begin
if StrPrs[I] = '(' then
begin
P := I;
Break;
end;
end;
// Если скобку нашли - получаем название из начальной строки
if P <> -1 then
Domen := Copy(StrPrs, P + 1, Length(StrPrs));
// Приравниваем начальную строку к строке маршрута
Route := StrPrs;
// Удаляем название из строки, включая 2 последних символа (две скобки из маршрута)
Delete(Route, Length(StrPrs) - Length(Domen) - 1, Length(Domen) + 2);
Result := Route;
end;

{ Обрабатываем строку для сохранения названия в пакетный файл}
function ParserStringWriteDomen(StrPrs : String) : String;
var
Domen : String;
I : Integer;
P : Integer;
begin
// Удаляем из начальной строки последний символ (скобка после названия)
Delete(StrPrs, Length(StrPrs), 1);
// Проходимся по все строке и ищем начальную скобку перед названием
P := -1;
for I := Length(StrPrs) downto 1 do
begin
if StrPrs[I] = '(' then
begin
P := I;
Break;
end;
end;
// Если скобку нашли - получаем название из начальной строки
if P <> -1 then
Domen := Copy(StrPrs, P + 1, Length(StrPrs));
Result := Domen;
end;

{ Загружаем строки в список из текстового файла }
function LoadRoutesServer(hLV : HWND) : Boolean;
var
S : String;
F : TextFile;
P : String;
begin
if FileExists(ExtractFilePath(ParamStr(0)) + 'Routes.txt') = TRUE then
begin
SendMessage(hLV, WM_SETREDRAW, Integer(FALSE), 0);
SendMessage(hLV, LVM_DELETEALLITEMS, 0, 0);
AssignFile(F, ExtractFilePath(ParamStr(0)) + 'Routes.txt');
Reset(F);
lvi.mask := LVIF_TEXT;
while not EOF(F) do
begin
ReadLn(F, S);
lvi.iSubItem := 0;
P := PChar(@S[1]);
if not((P = '')) then
begin
lvi.pszText := PChar(ParserServerFileRead(P));
SendMessage(hLV, LVM_INSERTITEM, 0, Integer(@lvi));
// Отмечаем чекбоксы строк, читая параметр из строки в файле
if ParserServerFileCheck(PChar(@S[1])) = TRUE then
ListView_SetCheckState(hLV, lvi.iItem - 1, TRUE);
end;
end;
CloseFile(F);
SendMessage(hLV, WM_SETREDRAW, Integer(TRUE), 0);
GetClientRect(hLV, rc);
SendMessage(hLV, LVM_SETCOLUMNWIDTH, 0, MAKELONG(((rc.Right - rc.Left) - 5), 0));
end;
Result := TRUE;
end;

часа полотора выяснял че после добавления TXPManifest при закрытии прога ругалась на uxtheme.dll - Eaccess violation получал каждый раз... Это aspr_ide.dll глючила - отладочная dll Asprotect'а... Как только прога запакована и работет без нее, все пучком...

Подскажите как при запущеной программе можно перерисовать цвет если в системе к примеру сменить тему оформления? [more=Код..]
function Blend(C1, C2: TColor; W1: Integer): TColor;
var
W2, A1, A2, D, F, G: Integer;
begin
if C1 < 0 then C1 := GetSysColor(C1 and $FF);
if C2 < 0 then C2 := GetSysColor(C2 and $FF);

if W1 >= 100 then D := 1000 else D := 100;

W2 := D - W1;
F := D div 2;

A2 := C2 shr 16 * W2;
A1 := C1 shr 16 * W1;
G := (A1 + A2 + F) div D and $FF;
Result := G shl 16;

A2 := (C2 shr 8 and $FF) * W2;
A1 := (C1 shr 8 and $FF) * W1;
G := (A1 + A2 + F) div D and $FF;
Result := Result or G shl 8;

A2 := (C2 and $FF) * W2;
A1 := (C1 and $FF) * W1;
G := (A1 + A2 + F) div D and $FF;
Result := Result or G;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.Color:=Blend(clHighlight, clWindow, 50);
end;
[/more]

Повесь на OnPaint вызов своей функции как 1 из вариантов. 2 Вариант, это отловить изменение темы оформления и вызвать функцию.

Может стоит после каждой перерисовки вызывать InvalidateRect?

Skipper
1 Вариант это понятно, 2 Вариант я незнаю как, уточню: как перерисовывать цвет на контролах где нет события OnPaint? в частности интересует перерисовка градиента в ToolBar.

Добавлено:
Также OnPaint неможет перерисовать цвет из такой функции:
uses
GraphUtil

Form1.Color:=GetShadowColor(clBtnFace,-25);

а .canvas не поможет? Или я ошибаюсь?

Sampron
Возможно вам это поможет: http://www.delphisources.ru/pages/faq/base/theme_changed.html

Frodo_Torbins
Интересный вариант но для цвета не подходит, на одну тему запаздывает.

Может кто сталкивался...

Непонятное поведением Combobox и Listbox в одной из форм программы - пустые списки на этапе выполнения. Причем, у формы есть как заполненные в дизайнере значения Items, так и формируемые при создании формы. Если в отладчике проследить заполнеие или сформировать Messagebox с текстом значений Items, то все нормально. Когда же форма выводится на екран, все списки пустые.