unit NumLock;
interface
uses ActiveX, ComObj, Windows, Classes, Graphics;
function CreateBitmapFromFile(FileName: String): TBitmap;
implementation
function CreateBitmapFromFile(FileName: String): TBitmap;
var
FPicture: IPicture;
hFile: THandle;
dwSize: DWORD;
hBuffer: Cardinal;
pBuffer: Pointer;
dummy: Cardinal;
pStream: IStream;
function GetMMWidth(): Integer;
begin
Result:=0;
FPicture.get_Width(Result);
end;
function GetMMHeight(): Integer;
begin
Result:=0;
FPicture.get_Height(Result);
end;
function GetWidth(): Integer;
var
dc: HDC;
begin
dc:=GetDC(0);
Result:=MulDiv(GetMMWidth, GetDeviceCaps(dc, LOGPIXELSX), 2540);
ReleaseDC(0, dc);
end;
function GetHeight(): Integer;
var
dc: HDC;
begin
dc:=GetDC(0);
Result:=MulDiv(GetMMHeight, GetDeviceCaps(dc, LOGPIXELSY), 2540);
ReleaseDC(0, dc);
end;
function GetPalette(): HPALETTE;
var
Handle: OLE_HANDLE;
begin
FPicture.get_hPal(Handle);
Result:=HPALETTE(Handle);
end;
begin
Result:=TBitmap.Create;
hFile:=CreateFile(PChar(FileName),
GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0
);
if hFile<>INVALID_HANDLE_VALUE then
begin
dwSize:=GetFileSize(hFile, nil);
hBuffer:=GlobalAlloc(GMEM_MOVEABLE, dwSize);
pBuffer:=GlobalLock(hBuffer);
ReadFile(hFile, pBuffer^, dwSize, dummy, nil);
GlobalUnlock(hBuffer);
CreateStreamOnHGlobal(hBuffer, True, pStream);
OleCheck(OleLoadPicture(pStream, 0, True, IPicture, FPicture));
GlobalFree(hBuffer);
Result.Width:=GetWidth;
Result.Height:=GetHeight;
Result.Palette:=GetPalette;
FPicture.Render(Result.Canvas.Handle,
0, 0, GetWidth, GetHeight,
0, GetMMHeight-1, GetMMWidth, -GetMMHeight,
Rect(0, 0, GetWidth, GetHeight));
CloseHandle(hFile);
end;
end;
initialization
OleInitialize(nil);
end.