Советы по Delphi. Версия 1.0.6 - [4]

unit StreamFile;

interface

Uses SysUtils;

Procedure AssignStreamFile(var f: text; FileName: String);

implementation

Const BufferSize = 128;

Type
 TStreamBuffer = Array[1..High(Integer)] of Char;
 TStreamBufferPointer = ^TStreamBuffer;
 TStreamFileRecord = Record
  Case Integer Of
  1: (
   Filehandle: Integer;
   Buffer: TStreamBufferPointer;
   BufferOffset: Integer;
   ReadCount: Integer;
  );
  2: (
   Dummy : Array[1..32] Of Char
  )
  End;

Function StreamFileOpen(var f : TTextRec): Integer;
Var
 Status: Integer;
Begin
 With TStreamFileRecord (F.UserData) Do Begin
  GetMem(Buffer, BufferSize);
  Case F.Mode Of
  fmInput:
   FileHandle:= FileOpen(StrPas(F.Name), fmShareDenyNone);
  fmOutput:
   FileHandle:= FileCreate(StrPas(F.Name));
  fmInOut:
  Begin
   FileHandle:= FileOpen(StrPas(F.Name), fmShareDenyNone Or fmOpenWrite or fmOpenRead);
   If FileHandle <> -1 Then status:= FileSeek(FileHandle, 0, 2); { Перемещаемся в конец файла. }
   F.Mode:= fmOutput;
  End;
  End;
  BufferOffset:= 0;
  ReadCount:= 0;
  F.BufEnd:= 0;  { В этом месте подразумеваем что мы достигли конца файла (eof). }
  If FileHandle = -1 Then Result := -1
  Else Result:= 0;
 End;
End;

Function StreamFileInOut(var F: TTextRec): Integer;
 Procedure Read(var Data: TStreamFileRecord);
  Procedure CopyData;
  Begin
  While (F.BufEnd < Sizeof(F.Buffer) - 2) And (Data.BufferOffset <= Data.ReadCount) And (Data.Buffer [Data.BufferOffset] <> #10) Do Begin
    F.Buffer[F.BufEnd]:= Data.Buffer^[Data.BufferOffset];
    Inc(Data.BufferOffset);
    Inc(F.BufEnd);
   End;
   If Data.Buffer [Data.BufferOffset] = #10 Then Begin
    F.Buffer[F.BufEnd]:= #13;
    Inc(F.BufEnd);
    F.Buffer[F.BufEnd]:= #10;
    Inc(F.BufEnd);
    Inc(Data.BufferOffset);
   End;
  End;

 Begin
  F.BufEnd:= 0;
  F.BufPos:= 0;
  F.Buffer:= '';
  Repeat Begin
   If (Data.ReadCount = 0) Or (Data.BufferOffset > Data.ReadCount) Then Begin
    Data.BufferOffset:= 1;
    Data.ReadCount:= FileRead(Data.FileHandle, Data.Buffer^, BufferSize);
   End;
   CopyData;
  End Until (Data.ReadCount = 0) Or (F.BufEnd >= Sizeof (F.Buffer) - 2);
  Result:= 0;
 End;

 Procedure Write(var Data: TStreamFileRecord);
 Var
  Status: Integer;
  Destination: Integer;
  II: Integer;
 Begin
  With TStreamFileRecord(F.UserData) Do Begin
   Destination:= 0;
   For II:= 0 To F.BufPos - 1 Do Begin
    If F.Buffer[II] <> #13 Then Begin
     Inc(Destination);
     Buffer^[Destination]:= F.Buffer[II];
    End;
   End;
   Status:= FileWrite(FileHandle, Buffer^, Destination);
   F.BufPos:= 0;
   Result:= 0;
  End;
 End;

Begin
 Case F.Mode Of
 fmInput:
  Read(TStreamFileRecord(F.UserData));
 fmOutput:
  Write(TStreamFileRecord(F.UserData));
 End;
End;

Function StreamFileFlush(var F: TTextRec): Integer;
Begin
 Result:= 0;
End;

Function StreamFileClose(var F : TTextRec): Integer;
Begin
 With TStreamFileRecord(F.UserData) Do Begin
  FreeMem(Buffer);
  FileClose(FileHandle);
 End;
 Result:= 0;
End;

Procedure AssignStreamFile(var F: Text; Filename: String);
Begin
 With TTextRec(F) Do Begin
  Mode:= fmClosed;
  BufPtr:= @Buffer;
  BufSize:= Sizeof(Buffer);
  OpenFunc:= @StreamFileOpen;
  InOutFunc:= @StreamFileInOut;
  FlushFunc:= @StreamFileFlush;
  CloseFunc:= @StreamFileClose;
  StrPLCopy(Name, FileName, Sizeof(Name) - 1);
 End;
End;

end.

Преобразование BMP в JPEG в Delphi 3

Используя Delphi 3, как мне сохранить BMP-изображение в JPEG-файле?

Допустим, Image1 – компонент TImage, содержащий растровое изображение. Используйте следующий фрагмент кода для конвертации вашего изображения в JPEG-файл:

var
 MyJpeg: TJpegImage;
 Image1: TImage;
begin
 Image1:= TImage.Create;
 MyJpeg:= TJpegImage.Create;
 Image1.LoadFromFile('TestImage.BMP');  // Чтение изображения из файла
 MyJpeg.Assign(Image1.Picture.Bitmap);  // Назначание изображения объекту MyJpeg
 MyJpeg.SaveToFile('MyJPEGImage.JPG');  // Сохранение на диске изображения в формате JPEG
end;

Декомпиляция звукового файла формата Wave и получение звуковых данных

Интересно, есть ли технология преобразования Wave-формата в обычный набор звуковых данных? К примеру, мне необходимо удалить заголовок и механизм (метод) сжатия, которые могут компилироваться и сохраняться вместе с Wave-файлами.

У меня есть программа под D1/D2, которая читает WAV-файлы и вытаскивает исходные данные, но она не может их восстанавить, используя зашитый алгоритм сжатия.

unit LinearSystem;

interface
{============== Тип, описывающий формат WAV ==================}
type wavheader = record
 nChannels       : Word;
 nBitsPerSample  : LongInt;
 nSamplesPerSec  : LongInt;
 nAvgBytesPerSec : LongInt;
 RIFFSize        : LongInt;
 fmtSize         : LongInt;
 formatTag       : Word;
 nBlockAlign     : LongInt;
 DataSize        : LongInt;
end;

{============== Поток данных сэмпла ========================}
const MaxN = 300;  { максимальное значение величины сэмпла }
type SampleIndex = 0..MaxN+3;
type DataStream = array[SampleIndex] of Real;
var N: SampleIndex;

{============== Переменные сопровождения ======================}
type Observation = record
 Name       : String[40];  {Имя данного сопровождения}
 yyy        : DataStream;  {Массив указателей на данные}
 WAV        : WAVHeader;   {Спецификация WAV для сопровождения}