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

• Название: Советы по Delphi. Версия 1.0.6
• Автор: Валентин Озеров
• Жанр: Программирование

---

unit main;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,ExtCtrls, StdCtrls;

type TForm1 = class(TForm)

 Button1: TButton;

 Image1: TImage;

 Image2: TImage;

 procedure Button1Click(Sender: Tobject);

 procedure FormCreate(Sender: Tobject);

private

 { Private declarations }

public

 { Public declarations }

end;

var

 Form1: TForm1;

implementation

{$R *.DFM}

Procedure Tform1.Button1Click(Sender: Tobject);

 var winDC, srcdc, destdc : HDC;

 oldBitmap : HBitmap;

 iinfo : TICONINFO;

begin

 GetIconInfo(Image1.Picture.Icon.Handle, iinfo);

 WinDC:= getDC(handle);

 srcDC:= CreateCompatibleDC(WinDC);

 destDC:= CreateCompatibleDC(WinDC);

 oldBitmap:= SelectObject(destDC, iinfo.hbmColor);

 oldBitmap:= SelectObject(srcDC, iinfo.hbmMask);

 BitBlt(destdc, 0, 0, Image1.picture.icon.width, Image1.picture.icon.height, srcdc, 0, 0, SRCPAINT);

 Image2.picture.bitmap.handle := SelectObject(destDC, oldBitmap);

 DeleteDC(destDC);

 DeleteDC(srcDC);

 DeleteDC(WinDC);

 image2.Picture.Bitmap.savetofile(ExtractFilePath(Application.ExeName) + 'myfile.bmp');

end;

Procedure Tform1.FormCreate(Sender: Tobject);

begin

 image1.picture.icon.loadfromfile('c:\myicon.ico');

end;

end.

Unix-строки (чтение и запись Unix-файлов)

Данный модуль позволяет читать и записывать файлы формата Unix.

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

 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);