Отправляет email-рассылки с помощью сервиса Sendsay
  Все выпуски  

СообЧА. Программирование на Delphi


Служба Рассылок Subscribe.Ru
Subscribe.Ru :СообЧа программирование на дельфи !
—Сообча : программирование на дельфи

Здесь могла бы быть ваша реклама: обращайтесь ко мне...


СооБча ™: И коротко о погоде...
 В этом выпуске:

Если рассылка долго не ходит,то у меня диал-ап " кончился " :(

 

Коротко о разгоне: Scream if you wanna go faster... :)

Рассылки Subscribe.Ru это стильно удобно, и информативно!
СообЧа (СООБщество ЧАйников). Обмен опытом, вопросы, ответы.
подпишись и подпиши друга!!!!

 Contact (Связь с Нами):

Pixel@novgorod.net + Subject:

Vcl Haunting

"Золотой Чайник"

Вопрос по дельфи N (номер версии)

Help!

 

 

Новости (Слово о нашем спонсоре...)

К заголовку

Лучшие товары ОЗОНА

Игрушки

  • Sudden Strike(противостояние 3) убойная ТАКТИЧЕСКИ ГРАМОТНАЯ RTS на тему 2й мировой войны...
  • Демиурги: Вы фанат Magic the Gathering? Тогда это для вас!!!!

Книги по Дельфи которые ВЫ ОБЯЗАНЫ ПРОЧИТАТЬ...

Купите- не пожалеете!

 

Низкоуровневые процедуры обработки звука

К заголовку

Ниже приведен код, обрабатывающий аудиосигнал, получаемый со входа звуковой карты (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 477576218068StartRecord : 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.


 

 

 

 

Rtf to HTML

К заголовку

Мне нужно перевести содержимое компонента RTF в HTML с помощью Delphi. Кто-нибудь знает как это сделать?
Приведу программу, которую я использую для преобразования содержимого RichEdit в SGML-код. Она не формирует полный HTML-аналог, но вы сами можете добавить необходимый RTF-код и его интерпретацию в HTML-тэги.

Код содержит интуитивно понятные комментарии и строки на шведском языке, нецелесообразные для перевода.



function rtf2sgml (text : string) : string;
{Funktion for att konvertera en RTF-rad till SGML-text.}
var
temptext : string;
start : integer;
begin
text := stringreplaceall (text,'&','##amp;');
text := stringreplaceall (text,'##amp','&amp');
text := stringreplaceall (text,'\'+chr(39)+'e5','&aring;');
text := stringreplaceall (text,'\'+chr(39)+'c5','&Aring;');
text := stringreplaceall (text,'\'+chr(39)+'e4','&auml;');
text := stringreplaceall (text,'\'+chr(39)+'c4','&Auml;');
text := stringreplaceall (text,'\'+chr(39)+'f6','&ouml;');
text := stringreplaceall (text,'\'+chr(39)+'d6','&Ouml;');
text := stringreplaceall (text,'\'+chr(39)+'e9','&eacute;');
text := stringreplaceall (text,'\'+chr(39)+'c9','&Eacute;');
text := stringreplaceall (text,'\'+chr(39)+'e1','&aacute;');
text := stringreplaceall (text,'\'+chr(39)+'c1','&Aacute;');
text := stringreplaceall (text,'\'+chr(39)+'e0','&agrave;');
text := stringreplaceall (text,'\'+chr(39)+'c0','&Agrave;');
text := stringreplaceall (text,'\'+chr(39)+'f2','&ograve;');
text := stringreplaceall (text,'\'+chr(39)+'d2','&Ograve;');
text := stringreplaceall (text,'\'+chr(39)+'fc','&uuml;');
text := stringreplaceall (text,'\'+chr(39)+'dc','&Uuml;');
text := stringreplaceall (text,'\'+chr(39)+'a3','&#163;');
text := stringreplaceall (text,'\}','#]#');
text := stringreplaceall (text,'\{','#[#');
text := stringreplaceall (text,'{\rtf1\ansi\deff0\deftab720','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\fonttbl',''); {Skall alltid tas bort}
text := stringreplaceall (text,'{\f0\fnil MS Sans Serif;}','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\f1\fnil\fcharset2 Symbol;}','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\f2\fswiss\fprq2 System;}}','');{Skall alltid tas bort}
text := stringreplaceall (text,'{\colortbl\red0\green0\blue0;}','');{Skall alltid tas bort}
{I version 2.01 av Delphi finns inte \cf0 med i RTF-rutan. Tog darfor bort
det efter \fs16 och la istallet en egen tvatt av \cf0.}
//temptext := hamtastreng (text,'{\rtf1','\deflang');
//text := stringreplace (text,temptext,''); {Hamta och radera allt fran start till deflang}
text := stringreplaceall (text,'\cf0','');
temptext := hamtastreng (text,'\deflang','\pard');{Plocka fran deflang till pard for att fa }
text := stringreplace (text,temptext,'');{oavsett vilken lang det ar. Norska o svenska ar olika}
{Har skall vi plocka bort fs och flera olika siffror beroende pa vilka alternativ vi godkanner.}
//text := stringreplaceall (text,'\fs16','');{8 punkter}
//text := stringreplaceall (text,'\fs20','');{10 punkter}
{Nu stadar vi istallet bort alla tvasiffriga fontsize.}
while pos ('\fs',text) >0 do

begin
application.processmessages;
start := pos ('\fs',text);
Delete(text,start,5);
end;
text := stringreplaceall (text,'\pard\plain\f0 ','<P>');
text := stringreplaceall (text,'\par \plain\f0\b\ul ','</P><MELLIS>');
text := stringreplaceall (text,'\plain\f0\b\ul ','</P><MELLIS>');
text := stringreplaceall (text,'\plain\f0','</MELLIS>');
text := stringreplaceall (text,'\par }','</P>');
text := stringreplaceall (text,'\par ','</P><P>');
text := stringreplaceall (text,'#]#','}');
text := stringreplaceall (text,'#[#','{');
text := stringreplaceall (text,'\\','\');
result := text;
end;



//Нижеприведенный кусок кода вырезан из довольно большой программы, вызывающей вышеприведенную функцию.
//Я знаю что мог бы использовать потоки вместо использования отдельного файла, но у меня не было времени для реализации этого


utfilnamn := mditted.exepath+stringreplace(stringreplace(extractfilename(pathname),'.TTT',''),'.ttt','') + 'ut.RTF';
brodtext.lines.savetofile (utfilnamn);
temptext := '';
assignfile(tempF,utfilnamn);
reset (tempF);
try
while not eof(tempF) do
begin
readln (tempF,temptext2);
temptext2 := stringreplaceall (temptext2,'\'+chr(39)+'b6','');
temptext2 := rtf2sgml (temptext2);
if temptext2 <>'' then temptext := temptext+temptext2;
application.processmessages;
end;
finally
closefile (tempF);
end;
deletefile (utfilnamn);
temptext := stringreplaceall (temptext,'</MELLIS> ','</MELLIS>');
temptext := stringreplaceall (temptext,'</P> ','</P>');
temptext := stringreplaceall (temptext,'</P>'+chr(0),'</P>');
temptext := stringreplaceall (temptext,'</MELLIS></P>','</MELLIS>');
temptext := stringreplaceall (temptext,'<P></P>','');
temptext := stringreplaceall (temptext,'</P><P></MELLIS>','</MELLIS><P>');
temptext := stringreplaceall (temptext,'</MELLIS>','<#MELLIS><P>');
temptext := stringreplaceall (temptext,'<#MELLIS>','</MELLIS>');
temptext := stringreplaceall (temptext,'<P><P>','<P>');
temptext := stringreplaceall (temptext,'<P> ','<P>');
temptext := stringreplaceall (temptext,'<P>-','<P>_');
temptext := stringreplaceall (temptext,'<P>_','<CITAT>_');
while pos('<CITAT>_',temptext)>0 do
begin
application.processmessages;
temptext2 := hamtastreng (temptext,'<CITAT>_','</P>');
temptext := stringreplace (temptext,temptext2+'</P>',temptext2+'</CITAT>');
temptext := stringreplace (temptext,'<CITAT>_','<CITAT>-');
end;
writeln (F,'<BRODTEXT>'+temptext+'</BRODTEXT>');

 

 

Показ окна без главной формы

К заголовку

Меня кто-то спрашивал давно, об этом, надеюсь ему это еще надо...

Попробуйте этот код в любом вторичном окне, которое вы НЕ хотите сопровождать главным окном:



...
private {Это включается в объявления формы.}
{ Private declarations }
procedure CreateParams(VAR Params: TCreateParams); override;
...


procedure TForm2.CreateParams(VAR Params: TCreateParams);
begin
Inherited CreateParams(Params);
Params.WndParent := GetDesktopWindow;
end;

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


 

До встречи...

Zaluskiy Anton(COOLer)  и Khrapunov Kirill(Pixel)  - ведущие проекта    "Мир Delphi" Copyright : Pixelsoftware(Pixel)& Delphi 2000(COOLer)


к3кй TopList SpyLOG

http://subscribe.ru/
E-mail: ask@subscribe.ru
Отписаться
Убрать рекламу

В избранное