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

Выранивание строки. Есть Две строки хочу чтобы при объединении их получалось следующие
исходные строки 1
1.
2.1.
2.1.1.
исходные строки 2 соответственно
пример
ответ
задача
Хочу чтобы получилось
1. пример
2.1. ответ
2.1.1. задача
Делаю я это следующим образом определяю максимальную длину первой строки добавляю к другим первым строкам пробелы до максимальной длины. Но вот вчем беда длина строки с пробелами становиться равной но из разного количества пробелов получается не ровно
1. пример
2.1. ответ
2.1.1. задача
и чем больше пустых пробелов тем кривее все смещается.

SIgor33
Все зависит от шрифта, которым будет отображаться текст. Можно использовать моноширинный шрифт (как в редакторе кода), тогда все будет нормально. Или можно высчитывать правильное количество пробелов с помощью Canvas.TextWidth, хотя результат все равно будет не очень. Или с символами табуляции (#9) еще можно попробовать, они специально для этого и создавались.

Frodo_Torbins

Цитата:

Можно использовать моноширинный шрифт (как в редакторе кода)

ИМХО самый правильный способ, так как если начать потом прикручивать всякие стили (курсив, жирный) - то замучаешься.

Man_Without_Face
а так
Код:
with cmd do
begin
CommandText := 'INSERT INTO CSale.dbf (Descript) VALUES (:param1)';
Parameters.Clear;
Parameters.CreateParameter('param1', ftString, pdInput, 25, card_num);
Execute;
end;

greenpc
Спасибо большое, то что надо.

По поводу моей ситуации с MAPI и Outlook 2003 внос пути (у меня C:\Program Files\Common Files\System\MSMAPI\1049\ ) в системную переменную Path все решил.

Всех с наступающим. Вопрос по XML.
Есть несколько схем данных XSD. Есть файл XML содержащий несколько таблиц. Вопрос, как можно экспортировать XML в базу данных (dataset) - ищу автоматические или полуавтоматические варианты Delphi7. Порекомендуйте варианты решений.
В другом топике рекомендовали NativeXML но я так понял, что он только для ручного экспорта.

mcdie

В OmniXML в модуле OmniXMLDatabase есть процедуры для экспорта/импорта DataSet<->XML

Я как-то тестировал OmniXML vs. NativeXML.
OmniXML в 1.2-2 раза быстрее NativeXML при загрузке из MemoryStream, но при добавлении узлов "вручную", он по скорости существенно проигрывает.

Работаю с библиотекой BASS. Необходимо извлекать исполнителя и название композиции из мета тэгов, приходящих вместе с потоком. Одни тэги приходят одной строкой, а другие представляют собой последовательность нультерминированных строк с двойным заевршающим нулем как признак конца последовательности (ну тут как прям указатель на строки в WinApi если не ошибаюсь). Вид приходящих тэгов заранее известен. Всвязи с этим хотелось бы универсальный доступ и разбор. Я сделал пока так для примера (здесь второй тип тэгов):


Код:
function GetMetaValue(pszMeta: LPTSTR; pszExt: AnsiString): LPTSTR;
var
dwPos: Integer;
dwLen: Integer;
meta : LPTSTR;
value: Utf8String;
begin
Result := nil;
meta := pszMeta;
dwLen := Length(pszExt);
while (Length(meta) > 0) do
begin
dwPos := Pos(pszExt, meta);
if (dwPos > 0) then
begin
value := Copy(meta, dwLen + 1, Length(meta) - dwLen);
Result := LPTSTR(URLDecode(value));
end;
meta := meta + Length(meta) + 1;
end;
end;

function BassUtils_GetCastName(stream: HSTREAM): WideString;
var
ci : BASS_CHANNELINFO;
meta: LPTSTR;
tmp1: LPTSTR;
tmp2: LPTSTR;
begin
Result := '';
ZeroMemory(@ci, SizeOf(BASS_CHANNELINFO));
BASS_ChannelGetInfo(stream, ci);
case ci.ctype of
BASS_CTYPE_STREAM_WMA,
BASS_CTYPE_STREAM_WMA_MP3:
begin
meta := BASS_ChannelGetTags(stream, BASS_TAG_WMA);
if (meta <> nil) then
begin
tmp1 := LPTSTR(GetMetaValue(meta, 'author='));
tmp2 := LPTSTR(GetMetaValue(meta, 'title='));
Result := FmtCastName(tmp1, tmp2);
end;
end;
BASS_CTYPE_STREAM_OGG:
begin
meta := BASS_ChannelGetTags(stream, BASS_TAG_OGG);
if (meta <> nil) then
begin
tmp1 := LPTSTR(GetMetaValue(meta, 'ARTIST='));
tmp2 := LPTSTR(GetMetaValue(meta, 'TITLE='));
Result := FmtCastName(tmp1, tmp2);
end;
end;
else
begin
end;
end;
end;

Знатоки, помогите разрулить проблему с экспортом данных из датасета в таблицу Excel. Суть проблемы: нужно экспортировать данные из датасета в существующую таблицу Excel на определенный лист, например "Дата". Использовал EMS Advanced Data Export VCL, но компонент перезаписывает существующую таблицу Excel. Как эксортировать данные?

EugeneBoss3

Цитата:

Использовал EMS Advanced Data Export VCL, но компонент перезаписывает существующую таблицу Excel. Как эксортировать данные?

Предлагаю использовать компоненту XLSRadWriteII или NativeExcell они дают доступ к модификации любой ячейки. В цикле пробегаешься по датасету и пишешь куда надобно.

YuriyRR
Установил оба компонента, но в примерах не нашел как экспортировать данные из датасета на нужный лист. Может есть реализация? Пример, плиз.

Вижу, тут с активностью получше чем в топике С++builder. Кто нибудь работал с отчетами crystal reports из delphi/cpp через Ole ?
разобрался

EugeneBoss3

Цитата:

Может есть реализация? Пример, плиз.

Код правда скриптового движка, но по сути такой-же как в Delphi
[more]

Код:
program FRM5;

var
XLS: TXLSReadWriteII2;
QR: TpFIBQuery;
DY, DM, DD: word;

repname, fname: string;
ls, j: integer;

FGRP: integer;

sj: integer;

DS: TpFIBDataset;
DS2: TpFIBDataset;

s1: extended;
s2: extended;
s3: extended;

////////////////////////////////////////////////////////////////////////////////
procedure IncJ;
begin
j := j + 1;
XLS.Sheet[0].Range.Items[0, j, ls, j].Copy(0, j + 1);
end;

////////////////////////////////////////////////////////////////////////////////
// Начало программы
////////////////////////////////////////////////////////////////////////////////
begin
repname := ReadVariable('CURRENT_REPORT_NAME');

XLS := TXLSReadWriteII2.Create(SELF);
QR := TpFIBQuery.Create(SELF);
QR.Database := DATABASE;
QR.Transaction := TRANSACTION;

QR.SQL.Text := 'SELECT REP_DATA FROM IBR$REPORTP WHERE REP_NAME = RM';
QR.ExecWP([repname]);

DecodeDate(Date, DY, DM, DD);
fname := 'ФОРМА5_' + Format('%2.2d', [DD]) + Format('%2.2d', [DM]) +
Format('%4.4d', [DY]);
fname := ExpandFileName('.\REPORTS\' + ChangeFileExt(fname, '.xls'));
QR.FN('REP_DATA').SaveToFile(fname);
XLS.FileName := fname;
XLS.Read;

if not OpenAllDatasets(DATABASE, repname, True) then Exit;

DS := DatasetByName('PLAN');
DS2 := DatasetByName('DATA');

try

XLS.Sheets[0].AsString[5, 1] := FormatDateTime('dd.mm.yyyy', ReadVariable('TO_DATE'));

s1 := 0;
s2 := 0;
s3 := 0;
j := 12;
ls := 7;

XLS.Sheet[0].AsString[2, 3] := DS2.FN('NUM').AsString;

if DS2.FN('DAT').IsNull then
XLS.Sheet[0].AsString[2, 4] := ''
else
XLS.Sheet[0].AsDateTime[2, 4] := DS2.FN('DAT').AsDateTime;

XLS.Sheet[0].AsString[2, 5] := DS2.FN('NAME_SMALL').AsString;

if DS2.FN('FDAT').IsNull then
XLS.Sheet[0].AsString[2, 6] := ''
else
XLS.Sheet[0].AsDateTime[2, 6] := DS2.FN('FDAT').AsDateTime;

XLS.Sheet[0].AsFloat[2, 7] := DS2.FN('SUMDOG').AsFloat;
XLS.Sheet[0].AsFloat[2, 8] := DS2.FN('ACTOPLT').AsFloat;
XLS.Sheet[0].AsFloat[2, 9] := DS2.FN('SUMOPLT').AsFloat;

FGRP := 0;

//Основной отчет
while not DS.EOF do
begin
with XLS.Sheets[0] do
begin
IncJ;
sj := j;
AsString[0, j] := DS.FN('NPP').AsString;
AsString[1, j] := DS.FN('NAIM').AsString;
if DS.FN('PERC').IsNull then AsString[2, j] := '' else AsFloat[2, j] := DS.FN('PERC').Value;
if DS.FN('PSUM').IsNull then AsString[3, j] := '' else AsFloat[3, j] := DS.FN('PSUM').Value;
if DS.FN('PERF').IsNull then AsString[4, j] := '' else AsFloat[4, j] := DS.FN('PERF').Value;
if DS.FN('FSUM').IsNull then AsString[5, j] := '' else AsFloat[5, j] := DS.FN('FSUM').Value;
if DS.FN('OTKL').IsNull then AsString[6, j] := '' else AsFloat[6, j] := DS.FN('OTKL').Value;
if DS.FN('PTKL').IsNull then AsString[7, j] := '' else AsFloat[7, j] := DS.FN('PTKL').Value;

if DS.FN('BOLD').AsInteger = 1 then
XLS.Sheet[0].Range.Items[0, j, ls, j].FontStyle := [xfsBold]
else
XLS.Sheet[0].Range.Items[0, j, ls, j].FontStyle := [];

if DS.FN('COLOR').AsInteger = 1 then
XLS.Sheet[0].Range.Items[0, j, ls, j].FillPatternForeColor :=xcBrightGreen;

if DS.FN('GRP').AsInteger = 1 then FGRP := FGRP + 1
else if FGRP <> 0 then
begin
XLS.Sheets[0].Rows.AddIfNone_(j - FGRP, j - 1 );
XLS.Sheets[0].GroupRows(j - FGRP, j - 1, True);
FGRP := 0;
end;

end;
DS.Next;
end;
j := j + 1;
XLS.Sheets[0].Rows.AddIfNone_(j, j);
XLS.Sheets[0].DeleteRows(j,j);

XLS.Sheets[0].SheetProtection := [];
XLS.Write;
ShellExecute(Application.Handle, 'open', fname, '', '', SW_SHOWMAXIMIZED);

finally
XLS.Free;
QR.Free;
end;

end.

YuriyRR
Спасибо за участие. Попробовать можно, но хотелось бы узнать формат базы данных и описание полей таблицы.

Maks150988
Вы пытаетесь работать с указателями, но что то я нигде не вижу у вас необходимого при этом ручного управления распределением памяти. Почитайте для просвещения: http://www.transl-gunsmoker.ru/2009/09/pchars.html И по ссылкам там походить можно, это мега-полезный блог для делфина.

Frodo_Torbins
Спасибо. Вообще интересный блог. Перевел на строки возврат функции и все заработало, да и со строками проще работать.

У меня ко всем вопрос кто разбирается хорошо в теме. Собственно приведу небольшой пример. Есть последовательность действий, выполняемая в отдельном потоке. Естественно поток нужен только лишь для того, чтобы не стопорить интерфейс приложения во время длительного действия. Этот поток должен быть всегда один и нужны проверки дабы не создавать вторичные потоки по глупости. Например, длительный расчет чего-то там, но с возможностью прервать действие. Сделано сейчас так:

Глобальные переменные terminate: Boolean = TRUE и thread: DWORD = 0.
Имеется структура для передачи этому потоку.


Код: type
TThreadParams = packed record
Handle : THandle;
pszAnsi: AnsiString;
end;
PThreadParams = ^TThreadParams;

Хоть шапку уважайте:

Цитата:

Все большие куски кода (более 5 строк) оформляем в тег [morе] дабы уменьшить размер поста.

Maks150988
Рекомендация с BeginThread на самом деле очень полезна, т к эта функция переводит менеджер памяти в многопоточный режим, чего вы не делаете в своем коде.
Защиты от запуска нескольких копий потока я у вас вообще не вижу. Переменную thread вы сразу же обнуляете, а больше у вас никаких переменных нету.
WaitForSingleObject могла бы пригодится в коде кнопки Стоп для корректного завершения работы потока. К примеру: установили terminate и ждем пока можно будет закрыть хендл. TerminateThread же лучше использовать только в самых крайних случаях. Еще функция WaitForSingleObject могла бы помочь если бы вы захотели организовать кнопку Пауза.
Далее, если вы не будете закрывать хендл потока сразу же после старта, то после нажатия кнопки Прервать он у вас останется незакрытым. Один способ решить эту проблемму я только что описал. Второй способ - послать своему окну специальное сообщение (через PostMessage), и в его обработчике закрыть хендл.

Frodo_Torbins
Ладно, впринципе можно и без BeginThread обойтись, сам выставлю IsMultiThread в TRUE перед CreateThread и код колбэка в try/except заключу.

Цитата:

Защиты от запуска нескольких копий потока я у вас вообще не вижу. Переменную thread вы сразу же обнуляете, а больше у вас никаких переменных нету.

А как бы вы тогда организовали защиту от запуска нескольких копий потока?
Насчет WaitForSingleObject, непонятно сколько ставить таймаут, INFINITE или свое значение.

Цитата:

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

А закрывать то его надо в самом колбэке или после CreateThread? Я после CreateThread проверяю хэндл на ноль и закрываю. Или вообще неправильно я сделал?

Цитата:

Второй способ - послать своему окну специальное сообщение (через PostMessage), и в его обработчике закрыть хендл.

Забыл добавить, копируя куски кода сюда, в кнопке пуск такой код в самом начале:

Код: SendMessage(hWnd, WM_COMMAND, MakeWParam(IDC_STOP, BN_CLICKED), 0);

Maks150988
Я бы в кнопке запуска хендл не закрывал. Тогда ваше условие "if ((thread = 0) and (not terminate)) then" автоматически становится защитой от повторного запуска. Тогда кнопку Прервать можно было бы удалить, а Стоп переделать под ожидание корректного завершения работы потока.

Цитата:

Насчет WaitForSingleObject, непонятно сколько ставить таймаут, INFINITE или свое значение.

Можно INFINITE, но тогда использовать MsgWaitForMultipleObjects, чтобы не заблокировать интерфейс. Пример использования: http://www.transl-gunsmoker.ru/2010/04/blog-post_20.html

Цитата:

Забыл добавить, копируя куски кода сюда, в кнопке пуск такой код в самом начале:
SendMessage(hWnd, WM_COMMAND, MakeWParam(IDC_STOP, BN_CLICKED), 0);

Использование SendMessage для посылки сообщения текущему потоку равноценно прямому вызову соответствующего куска кода. Так что лучше просто выделить этот код в отдельную процедуру, и вызывать когда нужно.

Добавлено:
Вряд ли вам удастся закрыть хендл в калбеке, ведь его в этот момент будет использовать WaitForSingleObject. А если и закроете, то на вход TerminateThread попадет уже не корректный хендл. Проставьте всюду проверку ошибок - сами убедитесь.
С освобождением памяти все было и так нормально.

может кто делал авторизацию на сайте с sunaps ssl+сертификат ,или подскажите что можно использовать,авторизацию то я сделал но дальше первой страницы никак так как в запросе передает ключ я так понимаю генерированный сертификатами.

Frodo_Torbins
Так, давайте по порядку, что как исправить.

Цитата:

Я бы в кнопке запуска хендл не закрывал. Тогда ваше условие "if ((thread = 0) and (not terminate)) then" автоматически становится защитой от повторного запуска. Тогда кнопку Прервать можно было бы удалить, а Стоп переделать под ожидание корректного завершения работы потока.

Кнопку прервать тогда убираю. Надо бы с пуском и стопом разобраться полностью. А если заместо SendMessage послать PostMessage? Я так понимаю вы это и имели ввиду как закрытие хэндла? Мне убрать? Раз вот это:

Цитата:

Использование SendMessage для посылки сообщения текущему потоку равноценно прямому вызову соответствующего куска кода. Так что лучше просто выделить этот код в отдельную процедуру, и вызывать когда нужно.

И еще вот что.

Цитата:

С освобождением памяти все было и так нормально.

Не знаю, я ради интереса проставлял пустой MessageBox после диспоса и до него дело не доходило, поэтому и подумалось.

Maks150988
Если у вас переменная thread одновременно является и хендлом и индикатором того, что поток запущен, то тогда вариант удаления хендла в ответ на сообщение вам не подойдет. Т к мы не знаем когда прийдет сообщение отправленное через PostMessage, то все это время не сможем запустить новый поток. Из корректных способов остается только вариант с ожиданием.

Цитата:

Не знаю, я ради интереса проставлял пустой MessageBox после диспоса и до него дело не доходило, поэтому и подумалось.

Сложно что либо сказать не видя реального кода.

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

Frodo_Torbins
Код не могу предоставить. Пока "играюсь" на этом примере. Переменная thread является хэндлом потока, по ее нулевости я и определяю существует ли поток в данный момент или нет. Остановлюсь на использовании WaitForSingleObject.
А впринципе, а какая разница, WaitForSingleObject просто затормозит выполнение кода в основном потоке (именно код кнопки стоп), без разницы где уничтожится этот хэндл потока, даже если в колбэке будет корректно все "закрыто". Я же потом опять проверяю на нулевость перед TerminateThread.
Я привык уже на апи делать, всл не люблю.

Maks150988
Если калбек успеет закрыть хендл, то код после WaitForSingleObject не нужен. А если не успеет, то у вас возможна ситуация когда одновременно работают два одинаковых потока, что может привести к попытке одновременно редактировать одни данные и глюкам. Или же, если вы решили оставить TerminateThread, то глюки может вызвать ее применение. Причем в обоих случаях это будут глюки из серии "100 отработало нормально, а на 101 упало непонятно почему".

Maks150988
Frodo_Torbins
Предлагаю сделать отдельную тему, все таки потоки это не типовая задача. И лучше обсуждать в отдельной теме, просто мне читать кусками то тут то там не удобно, смысл уходит.

Здравствуйте!
Помогите пожалуйста: Мне надо чтобы при выборе\отмене чекбокса скрывались\отображались 2 компонента.
Пробовал так:


Код:
procedure TformMainMenu.checkGenerationClick(Sender: TObject);
begin
If edtName.Visible = True then
Begin
edtName.Visible := False;
cobxGenNames.Visible := True;
end;
If edtName.Visible = False then
Begin
edtName.Visible := True;
cobxGenNames.Visible := False;
end;
end;
end.

XOBAH
У чекбокса есть свойство Checked вот его и надо проверять в if. Ошибка же у вас выскакивает потому, что вы не знаете основ языка делфи. Для объединения нескольких действий используются ключевые слова begin и end, как в первом вашем примере. Вот только точка с запятой ставится не всегда.

XOBAH

Код: procedure TformMainMenu.checkGenerationClick(Sender: TObject);
begin
edtName.Visible := checkGeneration.Checked
cobxGenNames.Visible := checkGeneration.Checked;
end;