Советы по Delphi. Версия 1.0.6 - страница 4
>
>end;
Следующая функция получает в качестве параметра Base (1..16) любую десятичную величину и возвращает результат в виде строки, содержащей точное значение BaseX. Вы можете использовать данный алгоритм для преобразования арабских чисел в римские (смотри ниже).
>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;
Преобразование ICO в BMP
Попробуйте:
>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-строки (чтение и запись 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;