Автор: Victor_Dobrov
Дата сообщения: 27.07.2008 00:45
Chanka, вот исправленный [more=скрипт загрузки jpg]
#define Background "Background.jpg"
#define LoadImageLib "ImgGdiplus.dll" ;или IPicture.dll, ImgCtx.dll - идут с программой SBRunScr, или здесь: url=http://victor-dobrov.narod.ru/ImgGdiplus.dll
[Setup]
AppName=Picture to Background
AppVerName=Picture to Background
CreateAppDir=false
OutputBaseFilename=PictureToBackground
OutputDir=.
[Files]
Source: {#Background}; Flags: dontcopy noencryption
Source: {#LoadImageLib}; Flags: dontcopy noencryption
[Code]
type hDC = Longint; TSize = record CX, CY: UInt; end; TagMonitorInfo = record cbSize: DWord; Monitor, Work: TRect; dwFlags: DWord; end;
var MonitorInfo: TagMonitorInfo; BackgroundForm: TForm; BackgroundImage: TBitmapImage; Mem: array[0..31] of Integer; n: Integer; FS: TFileStream; Size, PicSize: TSize;
const SRCCOPY = $CC0020;
function GetDC(Wnd: HWnd): hDC; external 'GetDC@user32 stdcall delayload';
function CreateCompatibleDC(DC: hDC): hDC; external 'CreateCompatibleDC@gdi32 stdcall delayload';
function CreateCompatibleBitmap(DC: hDC; Width, Height: Integer): HBitmap; external 'CreateCompatibleBitmap@gdi32 stdcall delayload';
function SelectObject(DC: hDC; p2: LongWord): LongWord; external 'SelectObject@gdi32 stdcall delayload';
function ReleaseDC(Wnd: HWnd; DC: hDC): Longint; external 'ReleaseDC@user32 stdcall delayload';
function DeleteDC(DC: hDC): Boolean; external 'DeleteDC@gdi32 stdcall delayload';
function LoadPicture(Sw: TSize; name: PChar): Longint; external '_LoadPicture@8@files:{#LoadImageLib} stdcall delayload';
procedure StretchImg(Image, hDC: Longint; X,Y,XE,YE, srcX,srcY,srcXE,srcYE: Integer; dwROP: DWord); external '_StretchImg@44@files:{#LoadImageLib} stdcall delayload';
procedure ReleaseImg(LoadedImage: Longint); external '_ReleaseImg@4@files:{#LoadImageLib} stdcall delayload';
function ShowWindow(hWnd, nCmdShow: LongWord): LongWord; external 'ShowWindow@user32';
function GetMonitorInfo(hMonitor: Integer; var lpMonitorInfo: TagMonitorInfo): Boolean; external 'GetMonitorInfoA@user32';
Function ReadFileTag(File, onSet: String; var Tag: String; Buffer: Integer; First: Bool): Integer; var Str: String; Ind, Len: Integer; Begin
Result:= -1; FS:= TFileStream.Create(File, fmOpenRead);
if FS.Size < Buffer then Len:= FS.Size - Length(onSet) else Len:= Buffer - Length(onSet)
for Ind:= 0 to Len do begin SetLength(Str, Length(onSet))
FS.Seek(Ind, soFromBeginning)
FS.ReadBuffer(Str, Length(Str)) // FS.Position - в следующей позиции
if Str = onSet then begin Result:= Ind; FS.ReadBuffer(Tag, Length(Tag)); if First then Break; end;
end; FS.Free;
End;
Function GetPictureSize(File: String): TSize; var Buffer: String; Begin
Result.CX:= 0; Result.CY:= 0; SetLength(Buffer, $100) { буфер чтения бинарных данных}
Case Uppercase(ExtractFileExt(File)) of
'.JPG','.JPEG': begin { тэг JFIF: #FFC2 или #FFC0}
Mem[11]:= 6; Mem[12]:= 4; { позиция значений высоты и ширины в формате MotorolaWord}
n:= ReadFileTag(File, Chr($FF)+Chr($C2), Buffer, $6000, true) { загрузить в строку данные, если заголовок тэга найден}
if n < 0 then n:= ReadFileTag(File, Chr($FF)+Chr($C1), Buffer, $4000, true)
if n < 0 then n:= ReadFileTag(File, Chr($FF)+Chr($C0), Buffer, $8000, false); end; { расширенный заголовок}
'.BMP': begin
Mem[11]:=18; Mem[12]:=22; n:= ReadFileTag(File, 'BM', Buffer, $200, true); end;
'.GIF': begin
Mem[11]:= 4; Mem[12]:= 6; n:= ReadFileTag(File,'GIF8', Buffer, $200, true); end;
'.PNG': begin
Mem[11]:=15; Mem[12]:=19; n:= ReadFileTag(File, 'PNG', Buffer, $200, true); end;
end;
if n < 0 then begin MsgBox('Unknown Picture Size!', mbError, MB_OK); end;
if (Uppercase(ExtractFileExt(File)) = '.BMP') or (Uppercase(ExtractFileExt(File)) = '.GIF') then n:= -1 else n:= 1 { для Bmp и Gif менять мл. и ст. байт}
Result.CX:= Ord(Buffer[Mem[11]]) shl 8 + Ord(Buffer[Mem[11]+n]); Result.CY:= Ord(Buffer[Mem[12]]) shl 8 + Ord(Buffer[Mem[12]+n])
End;
Procedure PictureToBitmap(Parent: TWinControl; Bitmap: TBitmapImage; File: String); var PicStream, MemDC, WinDC: hDC; tmpBitmap: HBitmap; Begin
Size.CX:= Bitmap.Width; Size.CY:= Bitmap.Height;
PicSize:= GetPictureSize(File)
PicStream:= LoadPicture(Size, File);
WinDC:= GetDC(Parent.Handle);
MemDC:= CreateCompatibleDC(WinDC);
tmpBitmap:= CreateCompatibleBitmap(WinDC, Size.CX, Size.CY);
SelectObject(MemDC, tmpBitmap); { чтобы рисовать, нужно выбрать битмап в контекст, но напрямую не рисуется, поэтому используется временный}
StretchImg(PicStream, MemDC, 0, 0, Size.CX, Size.CY, 0, 0, PicSize.CX, PicSize.CY, SRCCOPY);
Bitmap.Bitmap.Handle:= tmpBitmap;
DeleteDC(MemDC); ReleaseDC(Parent.Handle, WinDC); ReleaseImg(PicStream); Parent.Invalidate;
End;
Procedure BackgroundOnActivate(Sender: TObject); Begin if WizardForm.Visible then WizardForm.Show End;
Procedure BackgroundOnResize(Sender: TObject); Begin
PictureToBitmap(BackgroundForm, BackgroundImage, ExpandConstant('{tmp}\' + ExtractFileName('{#Background}')));
if WizardForm.Visible then WizardForm.Show
End;
Procedure InitializeWizard; Begin
ExtractTemporaryFile(ExtractFileName('{#Background}'));
BackgroundForm:= TForm.Create(nil)
BackgroundForm.Caption:= WizardForm.Caption
BackgroundForm.BorderStyle:= bsNone { убрать для показа заголовка}
// BackgroundForm.OnResize:= @BackgroundOnResize;
BackgroundForm.OnActivate:= @BackgroundOnActivate;
MonitorInfo.cbSize:= SizeOf(MonitorInfo); GetMonitorInfo(1, MonitorInfo)
BackgroundImage:= TBitmapImage.Create(BackgroundForm);
BackgroundImage.SetBounds(0,0, MonitorInfo.Monitor.Right, MonitorInfo.Monitor.Bottom)
BackgroundImage.Align:= alClient;
// BackgroundImage.Stretch:= True;
BackgroundImage.Enabled:= False;
BackgroundImage.Parent:= BackgroundForm;
PictureToBitmap(BackgroundForm, BackgroundImage, ExpandConstant('{tmp}\' + ExtractFileName('{#Background}')));
ShowWindow(BackgroundForm.Handle, sw_ShowMaximized) // фоновое окно на полный экран
End;
Procedure DeinitializeSetup; Begin BackgroundForm.Free; End;
[/more], укажи свою картинку в ключе Background и проверь с новым вариантом.
