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

Code:

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;

Code:

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;

Code:

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;

Code:

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;