[SOLVED] Design time package create resource for project
lazarus / 10-Designer

----------------------------------------------------------------------
YarUnderoaker · 2010-09-05 23:02

I need that procedure placed in the design package would be added some
custom data to resources of the project.
Now I do this like
Code: [Select]procedure MaterialManagerUpdateResource(Data: Pointer;
Size: Integer);
var
  buffer: AnsiString;
  res: TLResource;
  LazProject: TLazProject;
begin
  SetLength(buffer, Size*2);
  BinToHex(PChar(Data), PAnsiChar(buffer), Size);
  res := LazarusResources.Find('MaterialManagerData', 'STR');
  if not Assigned(res) then
    LazarusResources.Add('MaterialManagerData', 'STR', buffer)
  else
    res.Value := buffer;
  // LazProject := LazarusIDE.ActiveProject;
  // LazProject.Resources.Update; This is don't work because
TLazProject is not TProject
end; I run lazarus.lpi to debug design time and when I push button to
save test project, raise error in ProjectIcon.pas in function
TProjectIcon.UpdateResources.
When I do this without debugging design time, nothing to raise, but
desired resources do not inserted in applicaton.
I'm doing right? What I missed?

----------------------------------------------------------------------
YarUnderoaker · 2010-09-06 20:19

Studying source of IDE I solved the problem 


Code: [Select]  TMaterialManagerData = class(TAbstractProjectResource)
  public
    function UpdateResources(AResources: TAbstractProjectResources;
                             const MainFilename: string): Boolean;
override;
    procedure WriteToProjectFile(AConfig: TObject; Path: String);
override;
    procedure ReadFromProjectFile(AConfig: TObject; Path: String);
override;
  end;

function TMaterialManagerData.UpdateResources(
  AResources: TAbstractProjectResources; const MainFilename: string):
Boolean;
var
  ResList: TStringList;
  Res: TGenericResource;
  RName, RType: TResourceDesc;
begin
  Result := True;
  ResList := MaterialManager.GetResourceList;
  if Assigned(ResList) then
  begin
    RType := TResourceDesc.Create(GLS_RC_String_Type);
    RName := TResourceDesc.Create(glsMaterialManagerData);
    Res := TGenericResource.Create(RType, RName);
    RType.Free;
    RName.Free;
    ResList.SaveToStream(Res.RawData);
    AResources.AddSystemResource(Res);
    ResList.Destroy;
  end;
end;

procedure TMaterialManagerData.WriteToProjectFile(AConfig: TObject;
Path: String);
begin
  // Nothing here
end;

procedure TMaterialManagerData.ReadFromProjectFile(AConfig: TObject;
Path: String);
begin
  // Nothing here
end;

initialization

  RegisterProjectResource(TMaterialManagerData);
UpdateResources called by IDE before saving or building project, so
need only save data to resource stream

Code load resource runtime
Code: [Select] 
var
  FPResource: TFPResourceHandle;
  function IsResourceExist: Boolean;
  begin
    FPResource := FindResource(HInstance, PChar(ResName), ResType);
    Result := FPResource <> 0;
  end;
begin
   if LazarusResources.Find(ResName, ResType) <> nil then
    Result := TLazarusResourceStream.Create(ResName, ResType)
  {$ifndef ver2_2}
  else if IsResourceExist then
    Result := TLazarusResourceStream.CreateFromHandle(HInstance,
FPResource)
  {$endif}
  else NotifyError;
end;

----------------------------------------------------------------------
YarUnderoaker · 2010-09-09 18:40

I discovered an interesting thing 
Lazarus can't load resource data from "res" file when project opened
unlike Delphi.
It just recreate they every time when project building or saving.
But it does not matter, information about resources or resources
themselves can be stored in "lpi" file.
To do this using the method previously unused:
Code: [Select]procedure
TMaterialManagerData.WriteToProjectFile(AConfig: TObject; Path:
String);
var
  ResList: TStringList;
begin
  if Assigned(AConfig) then
  begin
    ResList := MaterialManager.GetResourceList;
    if Assigned(ResList) then
    begin
      TXMLConfig(AConfig).SetValue(Path+'GLScene/MaterialManager/Resou
rceList', ResList.Text);
      ResList.Destroy;
    end
    else
      TXMLConfig(AConfig).DeleteValue(Path+'GLScene/MaterialManager/Re
sourceList');
  end;
end;

procedure TMaterialManagerData.ReadFromProjectFile(AConfig: TObject;
Path: String);
var
  ResList: TStringList;
  s: string;
begin
  if Assigned(AConfig) then
  begin
    s := TXMLConfig(AConfig).GetValue(Path+'GLScene/MaterialManager/Re
sourceList', '');
    if Length(s) > 0 then
    begin
      ResList := TStringList.Create;
      ResList.Text := s;
      ResList.SaveToStream(StoreStream);
      ResList.Destroy;
    end;
  end;
end;
The only bad thing that the information is stored in text form, not
binary, but so be it.