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

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;

Попробуйте:

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;

Способ преобразования изображения размером 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.

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;