- 1
- 2
- 3
- 4
- 5
- . . .
- последняя (21) »
римские (смотри ниже).
function DecToBase(Decimal: Longint; const Base: Byte): String;
const Symbols: String[16] = '0123456789ABCDEF';
var
scratch: String;
remainder: Byte;
begin
scratch:= '';
repeat
remainder:= Decimal mod base;
scratch:= Symbols[remainder + 1] + scratch;
Decimal:= Decimal div base;
until (decimal = 0);
Result:= scratch;
end;
Передайте данной функции любую десятичную величину (1…3999), и она возвратит строку, содержащую точное значение в римской транскрипции.
function DecToRoman(Decimal: Longint ): String;
const Romans: Array[1..13] of String = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
Arabics: Array[1..13] of integer = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
var
i: Integer;
scratch: String;
begin
scratch:= '';
for i := 13 downto 1 do
while (decimal >= arabics[i]) do begin
Decimal:= Decimal – Arabics[i];
scratch:= scratch + Romans[i];
end;
Result:= scratch;
end;
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.
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.
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]; {Имя данного сопровождения}
Преобразование ICO в BMP
Решение 1
Попробуйте: var Icon: TIcon; Bitmap: TBitmap; begin Icon:= TIcon.Create; Bitmap:= TBitmap.Create; Icon.LoadFromFile('c:\picture.ico'); Bitmap.Width:= Icon.Width; Bitmap.Height:= Icon.Height; Bitmap.Canvas.Draw(0, 0, Icon); Bitmap.SaveToFile('c:\picture.bmp'); Icon.Free; Bitmap.Free; end;Решение 2
Способ преобразования изображения размером 32×32 в иконку. 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]; {Имя данного сопровождения}
- 1
- 2
- 3
- 4
- 5
- . . .
- последняя (21) »