diff --git a/lcl/forms.pp b/lcl/forms.pp index 704d6b8680..614897bb35 100644 --- a/lcl/forms.pp +++ b/lcl/forms.pp @@ -37,7 +37,7 @@ interface {$DEFINE HasDefaultValues} uses - Classes, SysUtils, TypInfo, Math, + Classes, SysUtils, Types, TypInfo, Math, AvgLvlTree, Maps, LCLVersion, LCLStrConsts, LCLType, LCLProc, LCLIntf, FileUtil, InterfaceBase, LResources, GraphType, Graphics, Menus, LMessages, CustomTimer, ActnList, ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls; diff --git a/lcl/graphics.pp b/lcl/graphics.pp index 7922fa42b8..885e2bc659 100644 --- a/lcl/graphics.pp +++ b/lcl/graphics.pp @@ -1462,10 +1462,13 @@ type procedure SetCurrent(const AValue: Integer); protected FCurrent: Integer; + FRequestedSize: TSize; procedure MaskHandleNeeded; override; procedure PaletteNeeded; override; + procedure CheckRequestedSize; function GetIndex(AFormat: TPixelFormat; AHeight, AWidth: Word): Integer; function GetBitmapHandle: HBITMAP; override; + class function GetDefaultSize: TSize; virtual; function GetMasked: Boolean; override; function GetMaskHandle: HBITMAP; override; function GetPalette: HPALETTE; override; @@ -1504,7 +1507,7 @@ type function MaskHandleAllocated: boolean; override; function PaletteAllocated: boolean; override; procedure SetHandles(ABitmap, AMask: HBITMAP); override; - function GetBestApplicationIndex: Integer; + function GetBestIndexForSize(ASize: TSize): Integer; property Current: Integer read FCurrent write SetCurrent; property Count: Integer read GetCount; @@ -1588,6 +1591,7 @@ type procedure SetCursorHandle(AValue: HCURSOR); protected procedure HandleNeeded; override; + class function GetDefaultSize: TSize; override; class function GetSharedImageClass: TSharedRasterImageClass; override; public class function GetFileExtensions: string; override; diff --git a/lcl/include/application.inc b/lcl/include/application.inc index 3a92d5f722..5c8bbf1619 100644 --- a/lcl/include/application.inc +++ b/lcl/include/application.inc @@ -876,7 +876,7 @@ var begin Icon.OnChange := nil; - Icon.Current := Icon.GetBestApplicationIndex; + Icon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON))); Widgetset.AppSetIcon(GetIconHandle); if FFormList<>nil then for i :=0 to FFormList.Count - 1 do diff --git a/lcl/include/cursorimage.inc b/lcl/include/cursorimage.inc index cdcd645cba..6707d257cf 100644 --- a/lcl/include/cursorimage.inc +++ b/lcl/include/cursorimage.inc @@ -103,4 +103,9 @@ begin FSharedImage.FHandle := WidgetSet.CreateIconIndirect(@IconInfo); end; +class function TCursorImage.GetDefaultSize: TSize; +begin + Result := Size(GetSystemMetrics(SM_CXCURSOR), GetSystemMetrics(SM_CYCURSOR)); +end; + diff --git a/lcl/include/customform.inc b/lcl/include/customform.inc index 766c9a5c30..180878f654 100644 --- a/lcl/include/customform.inc +++ b/lcl/include/customform.inc @@ -163,7 +163,7 @@ procedure TCustomForm.IconChanged(Sender: TObject); begin Icon.OnChange := nil; - Icon.Current := Icon.GetBestApplicationIndex; + Icon.Current := Icon.GetBestIndexForSize(Size(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON))); if HandleAllocated then TWSCustomFormClass(WidgetSetClass).SetIcon(Self, GetIconHandle); diff --git a/lcl/include/icnsicon.inc b/lcl/include/icnsicon.inc index 863b10b34f..e73f463ae9 100644 --- a/lcl/include/icnsicon.inc +++ b/lcl/include/icnsicon.inc @@ -108,7 +108,6 @@ procedure TIcnsIcon.IcnsProcess; var i, AIndex: integer; - IconType: TicnsIconType; ImagesForMask: TicnsIconTypes; IconImage: TIconImage; begin @@ -128,7 +127,6 @@ begin FreeAndNil(FMaskList); end; - IconType := iitNone; for i := 0 to FImageList.Count - 1 do begin // todo: we have no jpeg 2000 reader to decompress their data => skip for now @@ -141,13 +139,10 @@ begin IconImage := GetImagesClass.Create(FImageList[i]^.RawImage); Add(IconImage); end; - if FImageList[i]^.IconType > IconType then - begin - IconType := FImageList[i]^.IconType; - FCurrent := TSharedIcon(FSharedImage).Count - 1; - end; end; FreeAndNil(FImageList); + CheckRequestedSize; + FCurrent := GetBestIndexForSize(FRequestedSize); end; constructor TIcnsIcon.Create; diff --git a/lcl/include/icon.inc b/lcl/include/icon.inc index 23b1e1a681..2acf2751dc 100644 --- a/lcl/include/icon.inc +++ b/lcl/include/icon.inc @@ -377,6 +377,7 @@ constructor TCustomIcon.Create; begin inherited Create; FCurrent := -1; + FRequestedSize := Size(0, 0); end; procedure TCustomIcon.Delete(Aindex: Integer); @@ -424,6 +425,11 @@ begin end; end; +class function TCustomIcon.GetDefaultSize: TSize; +begin + Result := Size(GetSystemMetrics(SM_CXICON), GetSystemMetrics(SM_CYICON)); +end; + function TCustomIcon.GetIndex(AFormat: TPixelFormat; AHeight, AWidth: Word): Integer; begin Result := TSharedIcon(FSharedImage).GetIndex(AFormat, AHeight, AWidth); @@ -569,6 +575,20 @@ begin // nothing to do, handled by image itself end; +procedure TCustomIcon.CheckRequestedSize; +begin + if (FRequestedSize.cx = 0) and (FRequestedSize.cy = 0) then + FRequestedSize := GetDefaultSize; + + // if someone set only height then set width = height + if FRequestedSize.cx = 0 then + FRequestedSize.cx := FRequestedSize.cy; + + // if someone set only width then set height = width + if FRequestedSize.cy = 0 then + FRequestedSize.cy := FRequestedSize.cx; +end; + procedure TCustomIcon.ReadData(Stream: TStream); var Signature: array [0..3] of Char; @@ -598,8 +618,6 @@ var StreamStart: Int64; IconDir: array of TIconDirEntry; n: Integer; - MaxWidth, MaxHeight, MaxDepth: Word; - BestIndex: Word; IconImage: TIconImage; IntfImage: TLazIntfImage; PNGSig: array[0..7] of Byte; @@ -608,8 +626,6 @@ var ImgReader: TFPCustomImageReader; LazReader: ILazImageReader; RawImg: TRawImage; - Depth: Byte; - begin StreamStart := AStream.Position; AStream.Read(Header, SizeOf(Header)); @@ -633,11 +649,6 @@ begin SetLength(IconDir, Header.idCount); AStream.Read(IconDir[0], Header.idCount * SizeOf(IconDir[0])); - // Adjust all entries and find best (atm the order: max width, max height, max depth) - MaxWidth := 0; - MaxHeight := 0; - MaxDepth := 0; - BestIndex := 0; PNGReader := nil; DIBReader := nil; IntfImage := nil; @@ -692,36 +703,6 @@ begin else IntfImage.DataDescription := QueryDescription([riqfRGB, riqfAlpha, riqfMask]); // fallback to default ImgReader.ImageRead(AStream, IntfImage); - // update best image index - if IntfImage.Height > MaxHeight - then begin - MaxHeight := IntfImage.Height; - BestIndex := n; - end; - - if (IntfImage.Height = MaxHeight) - and (IntfImage.Width > MaxWidth) - then begin - MaxWidth := IntfImage.Width; - BestIndex := n; - end; - - if (IntfImage.Height = MaxHeight) - and (IntfImage.Width = MaxWidth) - then begin - // new icons have bpp in direntry, older not. - // So use it only for png (which itself is alway at bpp=32) - if (IconDir[n].bWidth = 0) or (IconDir[n].bHeight = 0) - then Depth := IconDir[n].wBpp - else Depth := IntfImage.DataDescription.Depth; - - if Depth > MaxDepth - then begin - MaxDepth := Depth; - BestIndex := n; - end; - end; - // Add image IntfImage.GetRawImage(RawImg, True); // Paul: don't set MaskBitsPerPixel to zero => windows will fail with no mask @@ -741,7 +722,9 @@ begin PNGReader.Free; IntfImage.Free; end; - FCurrent := BestIndex; + // Adjust all entries and find best (atm the order: best width, best height, max depth) + CheckRequestedSize; + FCurrent := GetBestIndexForSize(FRequestedSize); end; procedure TCustomIcon.Remove(AFormat: TPixelFormat; AHeight, AWidth: Word); @@ -769,21 +752,27 @@ begin // nothing end; -function TCustomIcon.GetBestApplicationIndex: Integer; +function TCustomIcon.GetBestIndexForSize(ASize: TSize): Integer; var - BestCX, BestCY, BestDepth, i, dx, dy, dd: Integer; + BestDepth, i, dx, dy, dd: Integer; CurRawImage: TRawImage; ScreenDC: HDC; begin Result := -1; - BestCX := GetSystemMetrics(SM_CXICON); - if BestCX = -1 then - BestCX := 32; + if ASize.cx <= 0 then + begin + ASize.cx := GetSystemMetrics(SM_CXICON); + if ASize.cx = -1 then + ASize.cx := 32; + end; - BestCY := GetSystemMetrics(SM_CYICON); - if BestCY = -1 then - BestCY := 32; + if ASize.cy <= 0 then + begin + ASize.cy := GetSystemMetrics(SM_CYICON); + if ASize.cy = -1 then + ASize.cy := 32; + end; ScreenDC := GetDC(0); BestDepth := GetDeviceCaps(ScreenDC, BITSPIXEL); @@ -796,21 +785,21 @@ begin for i := 0 to Count - 1 do begin CurRawImage := TIconImage(TSharedIcon(FSharedImage).FImages[i]).FImage; - if Abs(BestCX - CurRawImage.Description.Width) < dx then + if Abs(ASize.cx - CurRawImage.Description.Width) < dx then begin - dx := Abs(BestCX - CurRawImage.Description.Width); + dx := Abs(ASize.cx - CurRawImage.Description.Width); Result := i; end else - if Abs(BestCX - CurRawImage.Description.Width) = dx then + if Abs(ASize.cx - CurRawImage.Description.Width) = dx then begin - if Abs(BestCY - CurRawImage.Description.Height) < dy then + if Abs(ASize.cy - CurRawImage.Description.Height) < dy then begin - dy := Abs(BestCY - CurRawImage.Description.Height); + dy := Abs(ASize.cy - CurRawImage.Description.Height); Result := i; end else - if Abs(BestCY - CurRawImage.Description.Height) = dy then + if Abs(ASize.cy - CurRawImage.Description.Height) = dy then begin if Abs(BestDepth - CurRawImage.Description.Depth) < dd then begin @@ -834,7 +823,9 @@ end; procedure TCustomIcon.SetSize(AWidth, AHeight: integer); begin - raise EInvalidGraphicOperation.Create(rsIconImageSizeChange); + if FCurrent <> -1 + then raise EInvalidGraphicOperation.Create(rsIconImageSizeChange) + else FRequestedSize := Size(AWidth, AHeight); end; procedure TCustomIcon.UnshareImage(CopyContent: boolean);