Статьи по Delphi (026)…

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

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

FindResource + LoadResource + LockResource.

Определяем размеры картинки хранящейся в ресурсах:

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;

©Drkb::02172.

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

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;

©Drkb::02173.

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

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;

©Drkb::02174.

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

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;

Взято из http://forum.sources.ru.

Автор: Rouse_

©Drkb::02175.