ide: improve component icon search

git-svn-id: trunk@12961 -
This commit is contained in:
paul 2007-11-22 01:45:27 +00:00
parent afd12b522a
commit 122db22fd0
3 changed files with 35 additions and 2 deletions

View File

@ -1398,6 +1398,7 @@ function ReadXPMSize(XPM: PPChar; var Width, Height, ColorCount: integer
): boolean;
function LoadCursorFromLazarusResource(ACursorName: String): HCursor;
function LoadBitmapFromLazarusResource(ResourceName: String): TBitmap;
function LoadBitmapFromLazarusResourceHandle(Handle: TLResource): TBitmap;
var
{ Stores information about the current screen
@ -1470,6 +1471,26 @@ begin
CursorImage.Free;
end;
function LoadBitmapFromLazarusResourceHandle(Handle: TLResource): TBitmap;
var
Stream: TLazarusResourceStream;
GraphicClass: TGraphicClass;
begin
Result := nil;
Stream := nil;
try
Stream := TLazarusResourceStream.CreateFromHandle(Handle);
GraphicClass := GetGraphicClassForFileExtension(Stream.Res.ValueType);
if (GraphicClass <> nil) and (GraphicClass.InheritsFrom(TBitmap)) then
begin
Result := TBitmap(GraphicClass.Create);
Result.LoadFromStream(Stream);
end;
finally
Stream.Free;
end;
end;
function LoadBitmapFromLazarusResource(ResourceName: String): TBitmap;
var
Stream: TLazarusResourceStream;

View File

@ -81,6 +81,7 @@ type
public
constructor Create(const ResName: string; ResType: PChar);
constructor CreateFromID(ResID: Integer; ResType: PChar);
constructor CreateFromHandle(AHandle: TLResource);
function Write(const Buffer; Count: Longint): Longint; override;
property Res: TLResource read FRes;
end;
@ -4524,6 +4525,13 @@ begin
Initialize(PChar(PtrInt(ResID)), ResType);
end;
constructor TLazarusResourceStream.CreateFromHandle(AHandle: TLResource);
begin
inherited Create;
FRes := AHandle;
SetPointer(PChar(FRes.Value), Length(FRes.Value));
end;
function TLazarusResourceStream.Write(const Buffer; Count: Longint): Longint;
begin
Result := 0;

View File

@ -3407,9 +3407,13 @@ begin
end;
function TPkgComponent.GetIconCopy: TBitMap;
var
ResHandle: TLResource;
begin
if LazarusResources.Find(ComponentClass.ClassName) <> nil then
Result := LoadBitmapFromLazarusResource(ComponentClass.ClassName)
// prevent raising exception and speedup a bit search/load
ResHandle := LazarusResources.Find(ComponentClass.ClassName);
if ResHandle <> nil then
Result := LoadBitmapFromLazarusResourceHandle(ResHandle)
else
Result := nil;