Работа с ресурсами без TResourceSteram
Материал из DRKB
Работа с ресурсами без TResourceStream[править | править код]
FindResource + LoadResource + LockResource
Определяем размеры картинки хранящейся в ресурсах[править | править код]
function PictureSize: TSize;
var
ResHandle: HWND;
ResData: HWND;
BMI: PBitmapInfo;
begin
Result.cx := 0;
Result.cy := 0;
ResHandle := FindResource(HInstance, MakeIntResource(200), RT_BITMAP);
if ResHandle <> 0 then
begin
ResData := LoadResource(HInstance, ResHandle);
if ResData <> 0 then
try
BMI := LockResource(ResData);
if Assigned(BMI) then
try
Result.cx := BMI.bmiHeader.biWidth;
Result.cy := BMI.bmiHeader.biHeight;
finally
UnlockResource(ResData);
end;
finally
FreeResource(ResData);
end;
end;
end;
ID: 02172
Получаем список всех ресурсов[править | править код]
function GetResourceList: Boolean;
var
Errors: Cardinal;
function CallBack(hModule: HMODULE; lpType: PChar; lpzName: LPTSTR; lParam: Longint): BOOL; stdcall;
var
Size: Cardinal;
begin
Result := True;
if Assigned(lpzName) then
begin
Size := Length(ResourceName);
Inc(Size);
SetLength(ResourceName, Size);
ResourceName[Size - 1] := ShortString(lpzName);
if (ResourceName[Size - 1] <> 'RES_INI')
and (ResourceName[Size - 1] <> 'RES_MDB') then
Inc(Errors);
end;
end;
begin
Result := True;
ResourceName := nil;
Errors := 0;
EnumResourceNames(HInstance, 'INSTALL', @CallBack, 0);
if (Length(ResourceName) <> 2) or (Errors > 0) then
begin
MessageBox(Handle, PChar(ERR_CORRUPT), PChar(ERR_GLOBAL), MB_OK + MB_ICONERROR);
Result := False;
PostQuitMessage(0);
end;
end;
ID: 02173
Извлекаем ресурс в файл[править | править код]
function ExtractResource: Boolean;
const
ResName = 'RES_MDB';
function FileWrite(Handle: Integer; const Buffer; Count: LongWord): Integer;
const
BlockSize = 1024;
type
TArray = array of Byte;
var
Buff: array [0..BlockSize - 1] of Byte;
Counter,
CurCount, A, I: LongWord;
begin
Counter := 0;
Result := Count;
I := 10;
repeat
if Count - Counter > BlockSize then
CurCount := BlockSize
else
CurCount := Count - Counter;
Move(TArray(@Buffer)[Counter], Buff[0], CurCount);
if WriteFile(THandle(Handle), Buff, CurCount, LongWord(Result), nil) then
Inc(Counter, CurCount)
else
begin
Result := -1;
Exit;
end;
A := Round((Counter / Count) * 100);
if A > I then
begin
I := A;
SendMessage(Progress, PBM_SETPOS, A, 0);
end;
until Counter = Count;
end;
var
ResHandle: HWND;
ResData: HWND;
LockRes: Pointer;
fHandle: Integer;
Size: Integer;
begin
Result := False;
try
ResHandle := FindResource(HInstance, PChar(ResName), 'INSTALL');
if ResHandle = 0 then Exit;
ResData := LoadResource(HInstance, ResHandle);
if ResData = 0 then Exit;
try
LockRes := LockResource(ResData);
if not Assigned(LockRes) then Exit;
try
fHandle := FileCreate(BasePath + '\MainDB.~mdb');
if fHandle = -1 then Exit;
try
Size := SizeofResource(HInstance, ResHandle);
if FileWrite(fHandle, LockRes^, Size) = -1 then Exit;
Result := True;
StatusDone := True;
finally
CloseHandle(THandle(fHandle));
end;
finally
UnlockResource(ResData);
end;
finally
FreeResource(ResData);
end;
finally
PostMessage(Handle, WM_NOTIFY_THREAD_RESULT, Integer(Result), 0);
end;
end;
ID: 02174
Отрисовываем картинку из ресурса на форме[править | править код]
procedure ShowPicture;
function Rect(Left, Top, Right, Bottom: Integer): TRect;
begin
Result.Left := Left;
Result.Top := Top;
Result.Right := Right;
Result.Bottom := Bottom;
end;
var
Bitmap: HBITMAP;
BitmapSize: TSize;
DC, BitmapDC, OldDC: HDC;
bLeft, bTop: Cardinal;
_Rect: TRect;
S: String;
Pen: HPEN;
begin
Bitmap := LoadBitmap(HInstance, MakeIntResource(200));
if Bitmap <> 0 then
try
BitmapSize := PictureSize;
DC := GetDC(Handle);
try
BitmapDC := CreateCompatibleDC(DC);
try
OldDC := SelectObject(BitmapDC, Bitmap);
try
bLeft := (Width - BitmapSize.cx);
bTop := 0;
StretchBlt(DC, 0, 0, bLeft, BitmapSize.cy, BitmapDC, 0, 0, 1, BitmapSize.cy, SRCCOPY);
BitBlt(DC, bLeft, bTop, BitmapSize.cx, BitmapSize.cy, BitmapDC, 0, 0, SRCCOPY);
SetBkMode(DC, OPAQUE);
if hFontBold <> 0 then
SelectObject(DC, hFontBold);
S := INFO1;
_Rect := Rect(10, 6, 230, 31);
DrawText(DC, PChar(S), Length(S), _Rect, DT_WORDBREAK);
if hFontNormal <> 0 then
SelectObject(DC, hFontNormal);
S := INFO2;
_Rect := Rect(10, 40, 280, 70);
DrawText(DC, PChar(S), Length(S), _Rect, DT_WORDBREAK + DT_NOCLIP);
S := INFO3;
_Rect := Rect(10, 55, 280, 100);
DrawText(DC, PChar(S), Length(S), _Rect, DT_WORDBREAK + DT_NOCLIP);
Pen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNSHADOW));
try
SelectObject(DC, Pen);
MoveToEx(DC, 6, 127, nil);
LineTo(DC, 349, 127);
finally
DeleteObject(Pen);
end;
Pen := CreatePen(PS_SOLID, 1, GetSysColor(COLOR_BTNHIGHLIGHT));
try
SelectObject(DC, Pen);
MoveToEx(DC, 348, 128, nil);
LineTo(DC, 5, 128);
finally
DeleteObject(Pen);
end;
finally
SelectObject(OldDC, Bitmap);
end;
finally
DeleteDC(BitmapDC);
end;
finally
ReleaseDC(Handle, DC);
end;
finally
DeleteObject(Bitmap);
end;
end;
Author: Rouse_
Source: Взято из http://forum.sources.ru
ID: 02175