- added TLResources.Find by Name and ValueType (it was by Name only before)

- new class TLazarusResourceStream similar to TResourceStream
- some code needed resource stream has been switched to use TLazarusResourceStream

git-svn-id: trunk@11429 -

ideintf/ideimagesintf.pas

@@ -108,8 +108,7 @@ var
   Names: TStringList;
   Graphic: TGraphic;
   GraphicClass: TGraphicClass;
-  Res: TLResource;
+  Stream: TLazarusResourceStream;
-  Stream: TStream;
 begin
   Result := GetImageIndex(ImageSize, ImageName);
   if Result = -1 then
@@ -131,30 +130,27 @@ begin
     
     if List <> nil then
     begin
-      Res := LazarusResources.Find(ImageName);
+      try
-      if (Res <> nil) and (Res.Value <> '') then
+        Stream := TLazarusResourceStream.Create(ImageName, nil);
+        if (Stream.Res <> nil) then
         begin
-        GraphicClass := GetGraphicClassForFileExtension(Res.ValueType);
+          GraphicClass := GetGraphicClassForFileExtension(Stream.Res.ValueType);
           if GraphicClass <> nil then
           begin
             Graphic := GraphicClass.Create;
             if Graphic is TBitmap then
             try
-            Stream := TMemoryStream.Create;
-            try
-              Stream.Write(Res.Value[1], length(Res.Value));
-              Stream.Position := 0;
               Graphic.LoadFromStream(Stream);
               Result := List.Add(TBitmap(Graphic), nil);
               Names.AddObject(ImageName, TObject(PtrInt(Result)));
-            finally
-              Stream.Free;
-            end;
             finally
               Graphic.Free;
             end;
           end;
         end;
+        Stream.Free;
+      except
+      end;
     end;
   end;
 end;

lcl/graphics.pp

@@ -1474,29 +1474,26 @@ end;
 
 function LoadBitmapFromLazarusResource(ResourceName: String): TBitmap;
 var
-  Res: TLResource;
+  Stream: TLazarusResourceStream;
-  Stream: TStream;
   GraphicClass: TGraphicClass;
 begin
   Result := nil;
-  Res := LazarusResources.Find(ResourceName);
+  Stream := nil;
-  if (Res <> nil) and (Res.Value <> '') then
+  try
+    Stream := TLazarusResourceStream.Create(ResourceName, nil);
+    if (Stream.Res <> nil) then
     begin
-    GraphicClass := GetGraphicClassForFileExtension(Res.ValueType);
+      GraphicClass := GetGraphicClassForFileExtension(Stream.Res.ValueType);
       if (GraphicClass <> nil) and (GraphicClass.InheritsFrom(TBitmap)) then
       begin
         Result := TBitmap(GraphicClass.Create);
-      Stream := TMemoryStream.Create;
-      try
-        Stream.Write(Res.Value[1], length(Res.Value));
-        Stream.Position := 0;
         Result.LoadFromStream(Stream);
+      end;
+    end;
   finally
     Stream.Free;
   end;
 end;
-  end;
-end;
 
 procedure Register;
 begin

lcl/lresources.pp

@@ -37,7 +37,7 @@ interface
 
 uses
   Classes, SysUtils, Types, FPCAdds, TypInfo, DynQueue, LCLProc, LCLStrConsts,
-  LazConfigStorage;
+  LazConfigStorage, RtlConsts;
 
 type
   { TLResourceList }
@@ -64,11 +64,25 @@ type
     destructor Destroy;  override;
     procedure Add(const Name, ValueType, Value: AnsiString);
     procedure Add(const Name, ValueType: AnsiString; const Values: array of string);
-    function Find(const Name: AnsiString):TLResource;
+    function Find(const Name: AnsiString): TLResource; overload;
+    function Find(const Name, ValueType: AnsiString): TLResource; overload;
     function Count: integer;
     property Items[Index: integer]: TLResource read GetItems;
   end;
 
+  { TLazarusResourceStream }
+
+  TLazarusResourceStream = class(TCustomMemoryStream)
+  private
+    FRes: TLResource;
+    procedure Initialize(Name, ResType: PChar);
+  public
+    constructor Create(const ResName: string; ResType: PChar);
+    constructor CreateFromID(ResID: Integer; ResType: PChar);
+    function Write(const Buffer; Count: Longint): Longint; override;
+    property Res: TLResource read FRes;
+  end;
+
 {$IFDEF TRANSLATESTRING}
   { TAbstractTranslator}
   TAbstractTranslator = class(TObject)//Should it be somewhat more than TObject?
@@ -1117,7 +1131,8 @@ begin
 end;
 
 destructor TLResourceList.Destroy;
-var a:integer;
+var
+  a: integer;
 begin
   for a := 0 to FList.Count - 1 do
     TLResource(FList[a]).Free;
@@ -1150,17 +1165,18 @@ begin
         NewLResource.Free;
         exit;
       end;
-    
+    1:
-    1: NewLResource.Value:=Values[0];
+      NewLResource.Value:=Values[0];
   else
     TotalLen := 0;
-    for i:=Low(Values) to High(Values) do begin
+    for i := Low(Values) to High(Values) do
       inc(TotalLen, length(Values[i]));
-    end;
     SetLength(NewLResource.Value, TotalLen);
     p := 1;
-    for i:=Low(Values) to High(Values) do begin
+    for i := Low(Values) to High(Values) do
-      if length(Values[i])>0 then begin
+    begin
+      if length(Values[i]) > 0 then
+      begin
         Move(Values[i][1], NewLResource.Value[p], length(Values[i]));
         inc(p, length(Values[i]));
       end;
@@ -1181,14 +1197,47 @@ begin
     Result := nil;
 end;
 
+function TLResourceList.Find(const Name, ValueType: AnsiString): TLResource;
+var
+  P, I: Integer;
+begin
+  P := FindPosition(Name);
+  if P >= 0 then
+  begin
+    // Since we can have many resources that have the same name but different type
+    // we should look before and after found position (dont forget that we are searching
+    // them by dividing intervals)
+  
+    // look before position
+    for I := P - 1 downto 0 do
+    begin
+      Result := TLResource(FList[I]);
+      if (Result.Name = Name) and (Result.ValueType = ValueType) then
+        Exit;
+    end;
+    // look from position
+    for I := P to FList.Count - 1 do
+    begin
+      Result := TLResource(FList[I]);
+      if (Result.Name = Name) and (Result.ValueType = ValueType) then
+        Exit;
+    end;
+    Result := nil;
+  end
+  else
+    Result := nil;
+end;
+
 function TLResourceList.FindPosition(const Name: AnsiString): Integer;
-var L,R,C: Integer;
+var
+  L, R, C: Integer;
 begin
   if FSortedCount < FList.Count then
     Sort;
   L := 0;
   R := FList.Count-1;
-  while (L <= R) do begin
+  while (L <= R) do
+  begin
     Result := (L + R) shr 1;
     C := AnsiCompareText(Name, TLResource(FList[Result]).Name);
     if C < 0 then
@@ -1209,7 +1258,8 @@ end;
 
 procedure TLResourceList.Sort;
 begin
-  if FSortedCount=FList.Count then exit;
+  if FSortedCount = FList.Count then
+    exit;
   // sort the unsorted elements
   FMergeList.Count := FList.Count;
   MergeSort(FList, FMergeList, FSortedCount, FList.Count - 1);
@@ -1219,19 +1269,25 @@ begin
 end;
 
 procedure TLResourceList.MergeSort(List, MergeList: TList; Pos1, Pos2: integer);
-var cmp,mid:integer;
+var
+  cmp, mid: integer;
+begin
+  if Pos1 = Pos2 then
+  begin
+  end else
+  if Pos1 + 1 = Pos2 then
+  begin
+    cmp := AnsiCompareText(TLResource(List[Pos1]).Name, TLResource(List[Pos2]).Name);
+    if cmp > 0 then
     begin
-  if Pos1=Pos2 then begin
-  end else if Pos1+1=Pos2 then begin
-    cmp:=AnsiCompareText(
-           TLResource(List[Pos1]).Name,TLResource(List[Pos2]).Name);
-    if cmp>0 then begin
       MergeList[Pos1] := List[Pos1];
       List[Pos1] := List[Pos2];
       List[Pos2] := MergeList[Pos1];
     end;
-  end else begin
+  end else
-    if Pos2>Pos1 then begin
+  begin
+    if Pos2 > Pos1 then
+    begin
       mid := (Pos1 + Pos2) shr 1;
       MergeSort(List, MergeList, Pos1, mid);
       MergeSort(List, MergeList, mid + 1, Pos2);
@@ -1243,25 +1299,30 @@ end;
 procedure TLResourceList.Merge(List, MergeList: TList; Pos1, Pos2, Pos3: integer);
 // merge two sorted arrays
 // the first array ranges Pos1..Pos2-1, the second ranges Pos2..Pos3
-var Src1Pos,Src2Pos,DestPos,cmp,a:integer;
+var
+  Src1Pos, Src2Pos, DestPos, cmp, a: integer;
 begin
-  if (Pos1>=Pos2) or (Pos2>Pos3) then exit;
+  if (Pos1 >= Pos2) or (Pos2 > Pos3) then
+    exit;
   Src1Pos := Pos2 - 1;
   Src2Pos := Pos3;
   DestPos := Pos3;
-  while (Src2Pos>=Pos2) and (Src1Pos>=Pos1) do begin
+  while (Src2Pos >= Pos2) and (Src1Pos >= Pos1) do
-    cmp:=AnsiCompareText(
+  begin
-           TLResource(List[Src1Pos]).Name,TLResource(List[Src2Pos]).Name);
+    cmp:=AnsiCompareText(TLResource(List[Src1Pos]).Name, TLResource(List[Src2Pos]).Name);
-    if cmp>0 then begin
+    if cmp > 0 then
+    begin
       MergeList[DestPos] := List[Src1Pos];
       dec(Src1Pos);
-    end else begin
+    end else
+    begin
       MergeList[DestPos] := List[Src2Pos];
       dec(Src2Pos);
     end;
     dec(DestPos);
   end;
-  while Src2Pos>=Pos2 do begin
+  while Src2Pos >= Pos2 do
+  begin
     MergeList[DestPos] := List[Src2Pos];
     dec(Src2Pos);
     dec(DestPos);
@@ -4381,6 +4442,38 @@ begin
   end;
 end;
 
+{ TLazarusResourceStream }
+
+procedure TLazarusResourceStream.Initialize(Name, ResType: PChar);
+begin
+  if ResType <> nil then
+    FRes := LazarusResources.Find(Name, ResType)
+  else
+    FRes := LazarusResources.Find(Name);
+    
+  if FRes = nil then
+    raise EResNotFound.CreateFmt(SResNotFound, [Name]);
+  SetPointer(PChar(FRes.Value), Length(FRes.Value));
+end;
+
+constructor TLazarusResourceStream.Create(const ResName: string; ResType: PChar);
+begin
+  inherited Create;
+  Initialize(PChar(ResName), ResType);
+end;
+
+constructor TLazarusResourceStream.CreateFromID(ResID: Integer; ResType: PChar);
+begin
+  inherited Create;
+  Initialize(PChar(PtrInt(ResID)), ResType);
+end;
+
+function TLazarusResourceStream.Write(const Buffer; Count: Longint): Longint;
+begin
+  Result := 0;
+  raise EStreamError.Create(SCantWriteResourceStreamError);
+end;
+
 //------------------------------------------------------------------------------
 procedure InternalInit;
 begin