Работа с ресурсами -> Форум на Исходниках.Ру

	Наши проекты: Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту

Здравствуйте, Гость ! [18.188.142.69]

Модераторы: jack128, Rouse_, Krid

Ссылки по теме:

Работа с ресурсами (без TResourceSteram)

Работа с ресурсами , без TResourceSteram

Rouse_

Сообщ. #1 , 10.05.05, 12:45

Moderator

Профиль · PM

Поощрения: 4 Dgm

Рейтинг (т): 320

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;

Получаем список всех ресурсов

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;

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;

Извлекаем ресурс в файл

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;

Отрисовываем картинку из ресурса на форме:

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;

1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)

0 пользователей:

[ Script execution time: 0,0191 ] [ 15 queries used ] [ Generated: 17.05.24, 11:41 GMT ]