Доработал [more=скрипт]
#define Background "Background.jpg"
[Setup]
AppName=Picture to Background
AppVerName=Picture to Background
CreateAppDir=false
OutputBaseFilename=PictureToBackground
OutputDir=.
[Files]
Source: {#Background}; Flags: dontcopy noencryption
Source: ImgGdiplus.dll; Flags: dontcopy noencryption
;есть в календаре SBRunScr, или здесь: url=http://victor-dobrov.narod.ru/ImgGdiplus.dll
[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; VolumeName: String; n: Integer; FS: TFileStream; Size, PicSize: TSize;
const SRCCOPY = $CC0020;
function GetDC(Wnd: HWnd): hDC; external 'GetDC@user32';
function CreateCompatibleDC(DC: hDC): hDC; external 'CreateCompatibleDC@gdi32';
function CreateCompatibleBitmap(DC: hDC; Width, Height: Integer): HBitmap; external 'CreateCompatibleBitmap@gdi32';
function GetMonitorInfo(hMonitor: Integer; var lpMonitorInfo: TagMonitorInfo): Boolean; external 'GetMonitorInfoA@user32';
function SelectObject(DC: hDC; p2: LongWord): LongWord; external 'SelectObject@gdi32';
function ReleaseDC(Wnd: HWnd; DC: hDC): Longint; external 'ReleaseDC@user32';
function DeleteDC(DC: hDC): Boolean; external 'DeleteDC@gdi32';
function ShowWindow(hWnd, nCmdShow: LongWord): LongWord; external 'ShowWindow@user32';
function LoadPicture(Sw: TSize; name: PChar): Longint; external '_LoadPicture@8@files:ImgGdiplus.dll stdcall delayload';
procedure StretchImg(LoadedImage, hDC: Longint; dstX, dstY, dstXE, dstYE, srcX, srcY, srcXE, srcYE: integer; dwROP: DWord); external '_StretchImg@44@files:ImgGdiplus.dll stdcall delayload';
procedure ReleaseImg(LoadedImage: Longint); external '_ReleaseImg@4@files:ImgGdiplus.dll stdcall delayload';
//function LoadPicture(Sw: TSize; name: PChar): Longint; external '_LoadPicture@8@files:IPicture.dll stdcall delayload';
//procedure StretchImg(LoadedImage, hDC: Longint; dstX, dstY, dstXE, dstYE, srcX, srcY, srcXE, srcYE: integer; dwROP: DWord); external '_StretchImg@44@files:IPicture.dll stdcall delayload';
//procedure ReleaseImg(LoadedImage: Longint); external '_ReleaseImg@4@files:IPicture.dll stdcall delayload';
Function ReadFileTag(File, FindStr: String; var Tag: String; Buffer: Integer; Global: Bool): Integer; var Str: String; Pos, Len: Integer; Begin
Result:= -1; FS:= TFileStream.Create(File, fmOpenRead);
if FS.Size < Buffer then Len:= FS.Size - Length(FindStr) else Len:= Buffer - Length(FindStr)
for Pos:= 0 to Len do begin SetLength(Str, Length(FindStr))
FS.Seek(Pos, soFromBeginning)
FS.ReadBuffer(Str, Length(Str)) // FS.Position - в следующей позиции
if Str = FindStr then begin Result:= Pos; FS.ReadBuffer(Tag, Length(Tag)); if not Global then Break; end;
end; FS.Free;
End;
Function GetPictureSize(File: String): TSize; var Buffer: String; Begin
SetLength(Buffer, $100) { буфер чтения бинарных данных}
Case Uppercase(ExtractFileExt(File)) of
'.GIF': begin
Mem[11]:= 4; Mem[12]:= 6; { позиция данных в тэге GIF}
n:= ReadFileTag(File, 'GIF8', Buffer, $200, false); end;
'.JPG','.JPEG': begin { тэг #FFC2 или #FFC0}
Mem[11]:= 6; Mem[12]:= 4; { тэг JFIF: позиция значений высоты и ширины в формате MotorolaWord}
n:= ReadFileTag(File, Chr($FF)+Chr($C0), Buffer, $8000, true) { загрузить в строку данные, если заголовок тэга найден}
if n < 0 then n:= ReadFileTag(File, Chr($FF)+Chr($C2), Buffer, $8000, true); end; { стандартный заголовок}
'.PNG': begin
Mem[11]:=15; Mem[12]:=19;
n:= ReadFileTag(File, 'PNG', Buffer, $200, false); end;
'.BMP': begin
Mem[11]:=18; Mem[12]:=22;
n:= ReadFileTag(File, 'BM', Buffer, $200, false); end;
end;
if n < 0 then MsgBox('Unknown Picture Size!', mbError, MB_OK);
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], показывающий в фоновом окне jpg, png, gif файлы.
Правильно определяются размеры всех PNG, GIF, BMP, JPEG картинок, если у кого не так, отпишите!
htuos – Спасибо и
