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-строки (чтение и запись 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: