Библиотека knigago >> Компьютеры: Разработка ПО >> Программирование: прочее >> Советы по Delphi. Версия 1.0.6


СЛУЧАЙНЫЙ КОММЕНТАРИЙ

# 1731, книга: Секреты Бильдербергского клуба
автор: Даниэль Эстулин

Книга «Секреты Бильдербергского клуба» Даниэля Эстулина представляет собой захватывающий взгляд на один из самых загадочных и влиятельных частных собраний в мире. Эстулин, известный исследователь и писатель-конспиролог, раскрывает перед читателями предполагаемую скрытую повестку дня Бильдербергского клуба, который традиционно собирает сотни политиков, финансистов, промышленников и представителей СМИ из Европы и Северной Америки. Автор утверждает, что клуб является своего рода теневым мировым...

Валентин Озеров - Советы по Delphi. Версия 1.0.6

Советы по Delphi. Версия 1.0.6
Книга - Советы по Delphi. Версия 1.0.6.  Валентин Озеров  - прочитать полностью в библиотеке КнигаГо
Название:
Советы по Delphi. Версия 1.0.6
Валентин Озеров

Жанр:

Современные российские издания, Литература ХXI века (эпоха Глобализации экономики), Windows, Программирование: прочее, Pascal, Delphi, Lazarus и т.п.

Изадано в серии:

неизвестно

Издательство:

неизвестно

Год издания:

-

ISBN:

неизвестно

Отзывы:

Комментировать

Рейтинг:

Поделись книгой с друзьями!

Помощь сайту: донат на оплату сервера

Краткое содержание книги "Советы по Delphi. Версия 1.0.6"

Аннотация к этой книге отсутствует.

Читаем онлайн "Советы по Delphi. Версия 1.0.6". [Страница - 5]

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 для сопровождения}

 Last       : SampleIndex; {Последний доступный индекс yyy}

 MinO, MaxO : Real;        {Диапазон значений yyy}

end;


var K0R, K1R, K2R, K3R: Observation;

 K0B, K1B, K2B, K3B : Observation;


{================== Переменные имени файла ===================}

var StandardDatabase: String[80];

 BaseFileName: String[80];

 StandardOutput: String[80];

 StandardInput: String[80];


{=============== Объявления процедур ==================}

procedure ReadWAVFile(var Ki, Kj : Observation);

procedure WriteWAVFile(var Ki, Kj : Observation);

procedure ScaleData(var Kk: Observation);

procedure InitallSignals;

procedure InitLinearSystem;


implementation

{$R *.DFM}


uses VarGraph, SysUtils;

{================== Стандартный формат WAV-файла ===================}

const MaxDataSize : LongInt = (MaxN+1)*2*2;

const MaxRIFFSize : LongInt = (MaxN+1)*2*2+36;

const StandardWAV : WAVHeader = (

 nChannels       : Word(2);

 nBitsPerSample  : LongInt(16);

 nSamplesPerSec  : LongInt(8000);

 nAvgBytesPerSec : LongInt(32000);

 RIFFSize        : LongInt((MaxN+1)*2*2+36);

 fmtSize         : LongInt(16);

 formatTag       : Word(1);

 nBlockAlign     : LongInt(4);

 DataSize        : LongInt((MaxN+1)*2*2)

);


{================== Сканирование переменных сопровождения ===================}

procedure ScaleData(var Kk : Observation);

var I : SampleIndex;

begin

 {Инициализация переменных сканирования}

 Kk.MaxO:= Kk.yyy[0];

 Kk.MinO:= Kk.yyy[0];

 {Сканирование для получения максимального и минимального значения}

 for I:= 1 to Kk.Last do begin

  if kk.maxo < kk.yyy[i] then kk.maxo:= kk.yyy[i];

  if kk.mino > kk.yyy[i] then kk.mino:= kk.yyy[i];

 end;

end; { scaledata }


procedure ScaleAllData;

begin

 ScaleData(K0R);

 ScaleData(K0B);

 ScaleData(K1R);

 ScaleData(K1B);

 ScaleData(K2R);

 ScaleData(K2B);

 ScaleData(K3R);

 ScaleData(K3B);

end; {scalealldata}


{================== Считывание/запись WAV-данных ===================}

VAR InFile, OutFile: file of Byte;

type Tag = (F0, T1, M1);

type FudgeNum = record

 case X:Tag of

 F0 : (chrs : array[0..3] of byte);

 T1 : (lint : LongInt);

 M1 : (up,dn: Integer);

end;


var ChunkSize  : FudgeNum;


procedure WriteChunkName(Name: String);

var i: Integer;

 MM: Byte;

begin

 for i:= 1 to 4 do begin

  MM:= ord(Name[i]);

  write(OutFile, MM);

 end;

end; {WriteChunkName}


procedure WriteChunkSize(LL:Longint);

var I: integer;

begin

 ChunkSize.x:=T1;

 ChunkSize.lint:=LL;

 ChunkSize.x:=F0;

 for I:= 0 to 3 do Write(OutFile,ChunkSize.chrs[I]);

end;


procedure WriteChunkWord(WW: Word);

var I: integer;

begin

--">

Оставить комментарий:


Ваш e-mail является приватным и не будет опубликован в комментарии.