paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-25 23:39:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fixed some valis resourcetypes

Browse Source 
git-svn-id: trunk@13771 -
This commit is contained in:
marc 2008-01-15 23:45:39 +00:00
parent d49945c877
commit 56d9683e1a
2 changed files with 44 additions and 4 deletions

31
lcl/graphics.pp
View File

@ -1314,6 +1314,7 @@ type
procedure InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); override;
public
class function GetFileExtensions: string; override;
function LazarusResourceTypeValid(const ResourceType: string): boolean; override;
property Bitmaps: TObjectList read FBitmaps;
destructor Destroy; override;
procedure AddBitmap(Bitmap: TBitmap); { Note that Ownership passes to TIcon }
@ -2049,6 +2050,22 @@ begin
TLazReaderIcon(ImgReader).Icon := self;
end;
function TIcon.LazarusResourceTypeValid(const ResourceType: string): boolean;
var
ResType: String;
begin
if Length(ResourceType) < 3 then Exit(False);
ResType := UpperCase(ResourceType);
case ResType[1] of
'I': begin
Result := (ResType = 'ICO') or (ResType = 'ICON');
end;
else
Result := inherited LazarusResourceTypeValid(ResType);
end;
end;
class function TIcon.GetFileExtensions: string;
begin
Result:='ico';
@ -2082,9 +2099,19 @@ begin
end;
function TCursorImage.LazarusResourceTypeValid(const ResourceType: string): boolean;
var
ResType: String;
begin
Result := inherited LazarusResourceTypeValid(ResourceType) or
(AnsiCompareText(ResourceType,'CUR')=0);
if Length(ResourceType) < 3 then Exit(False);
ResType := UpperCase(ResourceType);
case ResType[1] of
'C': begin
Result := (ResType = 'CUR') or (ResType = 'CURSOR');
end;
else
Result := inherited LazarusResourceTypeValid(ResType);
end;
end;
function TCursorImage.ReleaseCursorHandle: HCURSOR;

17
lcl/include/bitmap.inc
View File

@ -269,9 +269,22 @@ begin
end;
function TBitmap.LazarusResourceTypeValid(const ResourceType: string): boolean;
var
ResType: String;
begin
Result := AnsiSameText(ResourceType,'XPM')
or AnsiSameText(ResourceType,'BMP');
if Length(ResourceType) < 3 then Exit(False);
ResType := UpperCase(ResourceType);
case ResType[1] of
'B': begin
Result := (ResType = 'BMP') or (ResType = 'BITMAP');
end;
'X': begin
Result := Restype = 'XPM';
end;
else
Result := False;
end;
end;
procedure TBitMap.Mask(ATransparentColor: TColor);