diff --git a/ide/lazres.pp b/ide/lazres.pp index 2db0aa4bce..19bb4cba37 100644 --- a/ide/lazres.pp +++ b/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. diff --git a/ide/lresources.pp b/ide/lresources.pp index fc909686e0..b80f6b12fd 100644 --- a/ide/lresources.pp +++ b/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); - end else begin - NewPos:=FindPosition(Name); - if (NewPos<0) then begin - NewPos:=0; - end else if (NewPos0 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; diff --git a/ide/main.pp b/ide/main.pp index ed441a69f4..722807566f 100644 --- a/ide/main.pp +++ b/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 x := 0 to RegCompPage.Count-1 do //for every component on the page.... 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 - Using the lresources.pp and registering components. - This is a major change but will create much more flexibility for the IDE. + Revision 1.25 2000/12/29 13:35:50 lazarus + Mattias submitted new lresources.pp and lazres.pp files. Shane Revision 1.23 2000/12/21 20:28:33 lazarus