Mattias submitted new lresources.pp and lazres.pp files.

Shane

git-svn-id: trunk@79 -

ide/lazres.pp

@@ -20,7 +20,8 @@ uses Classes, SysUtils, LResources;
 var
   ResourceFilename,BinFilename,BinExt,ResourceName,ResourceType:AnsiString;
   a:integer;
-  ResStream,BinStream:TFileStream;
+  ResFileStream,BinFileStream:TFileStream;
+  ResMemStream,BinMemStream:TMemoryStream;
 
 begin
   if ParamCount<2 then begin
@@ -29,29 +30,33 @@ begin
   end else begin
     ResourceFilename:=ParamStr(1);
     try
-      ResStream:=TFileStream.Create(ResourceFilename,fmCreate);
+      ResFileStream:=TFileStream.Create(ResourceFilename,fmCreate);
     except
       writeln('ERROR: unable to create file '''+ResourceFilename+'''');
       halt(1);
     end;
+    ResMemStream:=TMemoryStream.Create;
     try
       for a:=2 to ParamCount do begin
         BinFilename:=ParamStr(a);
         write(BinFilename);
         try
-          BinStream:=TFileStream.Create(BinFilename,fmOpenRead);
+          BinFileStream:=TFileStream.Create(BinFilename,fmOpenRead);
+          BinMemStream:=TMemoryStream.Create;
           try
+            BinMemStream.CopyFrom(BinFileStream,BinFileStream.Size);
+            BinMemStream.Position:=0;
             BinExt:=uppercase(ExtractFileExt(BinFilename));
             if BinExt='.LFM' then begin
               ResourceType:='FORMDATA';
-              ResourceName:=FindLFMClassName(BinStream);
+              ResourceName:=FindLFMClassName(BinMemStream);
               if ResourceName='' then begin
                 writeln(' ERROR: no resourcename');
                 halt(2);
               end;
               write(
                 ' ResourceName='''+ResourceName+''' Type='''+ResourceType+'''');
-              LFMtoLFCstream(BinStream,ResStream);
+              LFMtoLFCstream(BinMemStream,ResMemStream);
             end else begin
               ResourceType:=copy(BinExt,2,length(BinExt)-1);
               ResourceName:=ExtractFileName(BinFilename);
@@ -63,11 +68,12 @@ begin
               end;
               write(
                 ' ResourceName='''+ResourceName+''' Type='''+ResourceType+'''');
-              BinaryToLazarusResourceCode(BinStream,ResStream
+              BinaryToLazarusResourceCode(BinMemStream,ResMemStream
                  ,ResourceName,ResourceType);
             end;
           finally
-            BinStream.Free;
+            BinFileStream.Free;
+            BinMemStream.Free;
           end;
         except
           writeln('  ERROR: unable to read file '''+BinFilename+'''');
@@ -75,8 +81,11 @@ begin
         end;
         writeln('');
       end;
+      ResMemStream.Position:=0;
+      ResFileStream.CopyFrom(ResMemStream,ResMemStream.Size);
     finally
-      ResStream.Free;
+      ResMemStream.Free;
+      ResFileStream.Free;
     end;
   end;
 end.

ide/lresources.pp

@@ -15,9 +15,6 @@ unit lresources;
     include file.
 
   ToDo:
-    The ResourceList is currently a sorted list, which is okay for hundreds
-    of resources. But stringtables consist normally of thousands of entries.
-    Therefore a special StringTable Resource is needed.
 
 }
 {$mode objfpc}
@@ -36,8 +33,14 @@ type
   end;
 
   TLResourceList = class(TObject)
-    FList:TList;
+  private
+    FList:TList;  // main list with all resource pointer
+    FMergeList:TList; // list needed for mergesort
+    FSortedCount:integer; // 0 .. FSortedCount-1 resources are sorted
     function FindPosition(Name:AnsiString):integer;
+    procedure Sort;
+    procedure MergeSort(List,MergeList:TList;Pos1,Pos2:integer);
+    procedure Merge(List,MergeList:TList;Pos1,Pos2,Pos3:integer);
   public
     procedure Add(Name,ValueType,Value:AnsiString);
     function Find(Name:AnsiString):LResource;
@@ -53,11 +56,10 @@ function LFMtoLFCstream(LFMStream,LFCStream:TStream):boolean;
  // returns true if successful
 function FindLFMClassName(LFMStream:TStream):AnsiString;
 
-
 var LazarusResources:TLResourceList;
 
-implementation
 
+implementation
 
 procedure BinaryToLazarusResourceCode(BinStream,ResStream:TStream;
   ResourceName, ResourceType:AnsiString);
@@ -67,9 +69,9 @@ procedure BinaryToLazarusResourceCode(BinStream,ResStream:TStream;
     +#83#187#6#78#83
   );
 }
-const LineEnd:string=#10;
+const LineEnd:ShortString=#10;
   RightMargin:integer=79;
-var s,Indent:string;
+var s,Indent:ShortString;
   p,x:integer;
   c,h:char;
   RangeString,NewRangeString:boolean;
@@ -153,24 +155,35 @@ end;
 
 function LFMtoLFCfile(LFMfilename:ansistring):boolean;
 // returns true if successful
-var LFMStream,LFCStream:TFileStream;
+var
+  LFMFileStream,LFCFileStream:TFileStream;
+  LFMMemStream,LFCMemStream:TMemoryStream;
   LFCfilename,LFMfilenameExt:ansistring;
 begin
   Result:=true;
   try
-    LFMStream:=TFileStream.Create(LFMfilename,fmOpenRead);
+    LFMFileStream:=TFileStream.Create(LFMfilename,fmOpenRead);
+    LFMMemStream:=TMemoryStream.Create;
+    LFCMemStream:=TMemoryStream.Create;
     try
+      LFMMemStream.CopyFrom(LFMFileStream,LFMFileStream.Size);
+      LFMMemStream.Position:=0;
       LFMfilenameExt:=ExtractFileExt(LFMfilename);
       LFCfilename:=copy(LFMfilename,1,
                     length(LFMfilename)-length(LFMfilenameExt))+'.lfc';
-      LFCStream:=TFileStream.Create(LFCfilename,fmCreate);
+      Result:=LFMtoLFCstream(LFMMemStream,LFCMemStream);
+      if not Result then exit;
+      LFCMemStream.Position:=0;
+      LFCFileStream:=TFileStream.Create(LFCfilename,fmCreate);
       try
-        Result:=LFMtoLFCstream(LFMStream,LFCStream);
+        LFCFileStream.CopyFrom(LFCMemStream,LFCMemStream.Size);
       finally
-        LFCStream.Free;
+        LFCFileStream.Free;
       end;
     finally
-      LFMStream.Free;
+      LFMMemStream.Free;
+      LFCMemStream.Free;
+      LFMFileStream.Free;
     end;
   except
     Result:=false;
@@ -199,11 +212,15 @@ begin
   end;
 end;
 
+//==============================================================================
+
 { TLResourceList }
 
 constructor TLResourceList.Create;
 begin
   FList:=TList.Create;
+  FMergeList:=TList.Create;
+  FSortedCount:=0;
 end;
 
 destructor TLResourceList.Destroy;
@@ -218,35 +235,17 @@ begin
     FreeMem(p);
   end;
   FList.Free;
+  FMergeList.Free;
 end;
 
 procedure TLResourceList.Add(Name,ValueType,Value:AnsiString);
 var NewPLResource:PLResource;
-  NewPos,cmp:integer;
 begin
   GetMem(NewPLResource,SizeOf(LResource));
   NewPLResource^.Name:=Name;
   NewPLResource^.ValueType:=uppercase(ValueType);
   NewPLResource^.Value:=Value;
-  if FList.Count=0 then begin
+  FList.Add(NewPLResource);
-    FList.Add(NewPLResource);
-  end else begin
-    NewPos:=FindPosition(Name);
-    if (NewPos<0) then begin
-      NewPos:=0;
-    end else if (NewPos<FList.Count) then begin
-      cmp:=AnsiCompareText(LResource(FList[NewPos]^).Name,Name);
-      if cmp=0 then begin
-        // resource already exists
-        // ToDo: replace with an exception
-        writeln('[TLResourceList.Add] ERROR: LResource '''+Name+''' already exists.');
-        halt;
-      end else if cmp<0 then begin
-        inc(NewPos);
-      end;
-    end;
-    FList.Insert(NewPos,NewPLResource);
-  end;
 end;
 
 function TLResourceList.Find(Name:AnsiString):LResource;
@@ -266,6 +265,7 @@ end;
 function TLResourceList.FindPosition(Name:AnsiString):integer;
 var l,r,cmp:integer;
 begin
+  if FSortedCount<FList.Count then Sort;
   Result:=-1;
   l:=0;
   r:=FList.Count-1;
@@ -281,6 +281,69 @@ begin
   end;
 end;
 
+procedure TLResourceList.Sort;
+begin
+  if FSortedCount=FList.Count then exit;
+  // sort the unsorted elements
+  FMergeList.Count:=FList.Count;
+  MergeSort(FList,FMergeList,FSortedCount,FList.Count-1);
+  // merge both
+  Merge(FList,FMergeList,0,FSortedCount,FList.Count-1);
+  FSortedCount:=FList.Count;
+end;
+
+procedure TLResourceList.MergeSort(List,MergeList:TList; Pos1,Pos2:integer);
+var cmp,mid:integer;
+begin
+  if Pos1=Pos2 then begin
+  end else if Pos1+1=Pos2 then begin
+    cmp:=AnsiCompareText(
+           LResource(List[Pos1]^).Name,LResource(List[Pos2]^).Name);
+    if cmp>0 then begin
+      MergeList[Pos1]:=List[Pos1];
+      List[Pos1]:=List[Pos2];
+      List[Pos2]:=MergeList[Pos1];
+    end;
+  end else begin
+    if Pos2>Pos1 then begin
+      mid:=(Pos1+Pos2) shr 1;
+      MergeSort(List,MergeList,Pos1,mid);
+      MergeSort(List,MergeList,mid+1,Pos2);
+      Merge(List,MergeList,Pos1,mid+1,Pos2);
+    end;
+  end;
+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;
+begin
+  if (Pos1>=Pos2) or (Pos2>Pos3) then exit;
+  Src1Pos:=Pos2-1;
+  Src2Pos:=Pos3;
+  DestPos:=Pos3;
+  while (Src2Pos>=Pos2) and (Src1Pos>=Pos1) do begin
+    cmp:=AnsiCompareText(
+           LResource(List[Src1Pos]^).Name,LResource(List[Src2Pos]^).Name);
+    if cmp>0 then begin
+      MergeList[DestPos]:=List[Src1Pos];
+      dec(Src1Pos);
+    end else begin
+      MergeList[DestPos]:=List[Src2Pos];
+      dec(Src2Pos);
+    end;
+    dec(DestPos);
+  end;
+  while Src2Pos>=Pos2 do begin
+    MergeList[DestPos]:=List[Src2Pos];
+    dec(Src2Pos);
+    dec(DestPos);
+  end;
+  for a:=DestPos+1 to Pos3 do
+    List[a]:=MergeList[a];
+end;
+
 initialization
   LazarusResources:=TLResourceList.Create;
 

ide/main.pp

@@ -320,13 +320,12 @@ begin
                 Glyph := Pixmap1;
                 Visible := True;
                 Flat := True;
+                Down := True;
                 Name := 'GlobalMouseSpeedButton'+inttostr(i);
              end;
 
-             Writeln('REGCOMPPAGE.COUNT is '+Inttostr(RegCompPage.Count));
+             for x := 0 to RegCompPage.Count-1 do  //for every component on the page....
-             for x := 0 to RegCompPage.Count-1 do
                  begin
-                  Writeln('X = '+inttostr(x));
 		  RegComp := RegCompPage.Items[x];
                   IDEComponent := TIDEComponent.Create;
                   IdeComponent.RegisteredComponent := RegComp;
@@ -1086,7 +1085,6 @@ begin
           else
           begin
              Temp := nil;
-             Writeln('1');
              for i := 0 to Notebook1.Page[Notebook1.Pageindex].ControlCount-1 do
                  begin
                  if CompareText(TControl(Notebook1.Page[Notebook1.Pageindex].Controls[I]).Name, 'GlobalMouseSpeedButton'+inttostr(Notebook1.Pageindex)) = 0 then
@@ -1110,7 +1108,6 @@ begin
             begin
               SelectedComponent := nil;
              Temp := nil;
-             Writeln('2');
              for i := 0 to Notebook1.Page[Notebook1.Pageindex].ControlCount-1 do
                  begin
                  if CompareText(TControl(Notebook1.Page[Notebook1.Pageindex].Controls[I]).Name, 'GlobalMouseSpeedButton'+inttostr(Notebook1.Pageindex)) = 0 then
@@ -1132,9 +1129,7 @@ begin
        if SelectedComponent <> nil then
           TIDeComponent(IdeCompList.FindCompByRegComponent(SelectedComponent)).SpeedButton.Down := False;
        SelectedComponent := nil;
-       writeln('Setting speedbutton down');
              Temp := nil;
-             Writeln('3');
              for i := 0 to Notebook1.Page[Notebook1.Pageindex].ControlCount-1 do
                  begin
                  if CompareText(TControl(Notebook1.Page[Notebook1.Pageindex].Controls[I]).Name, 'GlobalMouseSpeedButton'+inttostr(Notebook1.Pageindex)) = 0 then
@@ -1736,9 +1731,8 @@ end.
 { =============================================================================
 
   $Log$
-  Revision 1.24  2000/12/29 13:14:04  lazarus
+  Revision 1.25  2000/12/29 13:35:50  lazarus
-  Using the lresources.pp and registering components.
+  Mattias submitted new lresources.pp and lazres.pp files.
-  This is a major change but will create much more flexibility for the IDE.
   Shane
 
   Revision 1.23  2000/12/21 20:28:33  lazarus