unit ce_projgroup; {$I ce_defines.inc} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, ExtCtrls, Menus, Buttons, dialogs, ComCtrls, StdCtrls, ce_widget, ce_common, ce_interfaces, ce_writableComponent, ce_observer, ce_nativeproject, ce_dubproject, ce_anyprojloader, ce_sharedres; type (** * Represents a project in a project group *) TProjectGroupItem = class(TCollectionItem) private fFilename: string; fProj: ICECommonProject; published property filename: string read fFilename write fFilename; public property project: ICECommonProject read fProj; procedure lazyLoad; destructor destroy; override; end; (** * Collection that handles several project at once. *) TProjectGroup = class(TWritableLfmTextComponent, ICEProjectGroup, IFPObserver) private fProjectIndex: integer; fItems: TCollection; fModified: boolean; fOnChanged: TNotifyEvent; procedure setItems(value: TCollection); procedure setProjectIndex(value: integer); function getItem(index: integer): TProjectGroupItem; procedure doChanged; // procedure FPOObservedChanged(ASender : TObject; Operation : TFPObservedOperation; Data : Pointer); protected procedure afterLoad; override; procedure afterSave; override; published property items: TCollection read fItems write setItems; property projectIndex: integer read fProjectIndex write setProjectIndex; public constructor create(aOwner: TComponent); override; destructor destroy; override; // function singleServiceName: string; procedure addProject(aProject: ICECommonProject); procedure openGroup(const fname: string); procedure saveGroup(const fname: string); procedure closeGroup; function groupModified: boolean; function groupFilename: string; function projectCount: integer; function getProject(ix: Integer): ICECommonProject; function findProject(const fname: string): ICECommonProject; procedure selectProject(ix: Integer); // function addItem(const fname: string): TProjectGroupItem; property item[ix: integer]: TProjectGroupItem read getItem; default; property onChanged: TNotifyEvent read fOnChanged write fOnChanged; end; (** * GUI for a project group *) { TCEProjectGroupWidget } TCEProjectGroupWidget = class(TCEWidget, ICEProjectObserver) BtnAddProj: TBitBtn; btnAddUnfocused: TBitBtn; btnMoveDown: TBitBtn; btnMoveUp: TBitBtn; btnFreeFocus: TBitBtn; btnRemProj: TBitBtn; lstProj: TListView; Panel1: TPanel; Panel2: TPanel; StaticText1: TStaticText; procedure btnAddUnfocusedClick(Sender: TObject); procedure btnFreeFocusClick(Sender: TObject); procedure BtnAddProjClick(Sender: TObject); procedure btnMoveDownClick(Sender: TObject); procedure btnMoveUpClick(Sender: TObject); procedure btnRemProjClick(Sender: TObject); procedure lstProjDblClick(Sender: TObject); private fPrevProj: ICECommonProject; fFreeProj: ICECommonProject; fProjSubj: TCEProjectSubject; // procedure projNew(aProject: ICECommonProject); procedure projChanged(aProject: ICECommonProject); procedure projClosing(aProject: ICECommonProject); procedure projFocused(aProject: ICECommonProject); procedure projCompiling(aProject: ICECommonProject); procedure projCompiled(aProject: ICECommonProject; success: boolean); // procedure updateList; procedure handleChanged(sender: TObject); protected procedure DoShow; override; public constructor create(aOwner: TCOmponent); override; destructor destroy; override; end; implementation {$R *.lfm} var projectGroup: TProjectGroup; {$REGION TProjectGroup ---------------------------------------------------------} constructor TProjectGroup.create(aOwner: TComponent); begin inherited; fItems := TCollection.Create(TProjectGroupItem); fItems.FPOAttachObserver(self); EntitiesConnector.addSingleService(self); end; destructor TProjectGroup.destroy; begin fItems.Clear; fItems.Free; inherited; end; procedure TProjectGroup.setItems(value: TCollection); begin fItems.Assign(value); end; function TProjectGroup.getItem(index: integer): TProjectGroupItem; begin exit(TProjectGroupItem(fItems.Items[index])); end; procedure TProjectGroup.FPOObservedChanged(ASender: TObject; Operation: TFPObservedOperation; Data : Pointer); begin if operation = ooChange then fModified := true; end; procedure TProjectGroup.doChanged; begin if assigned(fOnChanged) then fOnChanged(self); end; procedure TProjectGroup.setProjectIndex(value: integer); begin if value < 0 then value := 0 else if value > fItems.Count-1 then value := fItems.Count-1; if fProjectIndex <> value then begin fProjectIndex := value; fModified := true; end; end; function TProjectGroup.addItem(const fname: string): TProjectGroupItem; var it: TCollectionItem; begin fModified := true; for it in fItems do begin if SameFileName(TProjectGroupItem(it).fFilename, fname) then exit(TProjectGroupItem(it)); end; result := TProjectGroupItem(fItems.Add); result.fFilename := fname; end; function TProjectGroup.getProject(ix: Integer): ICECommonProject; begin item[ix].lazyLoad; exit(item[ix].fProj); end; function TProjectGroup.findProject(const fname: string): ICECommonProject; var i: integer; begin result := nil; for i := 0 to projectCount-1 do if SameFileName(item[i].fFilename, fname) then begin item[i].lazyLoad; exit(item[i].fProj); end; end; procedure TProjectGroup.selectProject(ix: Integer); begin setProjectIndex(ix); end; procedure TProjectGroup.afterLoad; begin inherited; fModified:=false; end; procedure TProjectGroup.afterSave; begin inherited; fModified:=false; end; procedure TProjectGroup.addProject(aProject: ICECommonProject); var it: TCollectionItem; begin fModified := true; for it in fItems do begin if SameFileName(TProjectGroupItem(it).fFilename, aProject.filename) then exit; end; it := fItems.Add; TProjectGroupItem(it).fFilename := aProject.filename; TProjectGroupItem(it).fProj := aProject; aProject.inGroup(true); fProjectIndex := it.Index; doChanged; end; procedure TProjectGroup.openGroup(const fname: string); begin loadFromFile(fname); doChanged; end; procedure TProjectGroup.saveGroup(const fname: string); begin saveToFile(fname); end; procedure TProjectGroup.closeGroup; begin fItems.Clear; fFilename:= ''; fModified:=false; fProjectIndex := -1; doChanged; end; function TProjectGroup.groupModified: boolean; var i: integer; b: boolean = false; begin for i:= 0 to fItems.Count-1 do if (getItem(i).fProj <> nil) and getItem(i).fProj.modified then begin b := true; break; end; exit(fModified or b); end; function TProjectGroup.groupFilename: string; begin exit(Filename); end; function TProjectGroup.projectCount: integer; begin exit(fItems.Count); end; function TProjectGroup.singleServiceName: string; begin exit('ICEProjectGroup'); end; procedure TProjectGroupItem.lazyLoad; begin if fProj = nil then begin fProj := loadProject(fFilename, true); fProj.inGroup(true); end; end; destructor TProjectGroupItem.destroy; begin if fProj <> nil then fProj.getProject.free; fProj := nil; inherited; end; {$ENDREGION} {$REGION Widget Standard component things --------------------------------------} constructor TCEProjectGroupWidget.create(aOwner: TCOmponent); begin inherited; AssignPng(btnMoveUp, 'arrow_up'); AssignPng(btnMoveDown, 'arrow_down'); AssignPng(BtnAddProj, 'document_add'); AssignPng(btnRemProj, 'document_delete'); AssignPng(btnFreeFocus, 'pencil'); AssignPng(btnAddUnfocused, 'document_add'); projectGroup.onChanged:= @handleChanged; fProjSubj:= TCEProjectSubject.Create; end; destructor TCEProjectGroupWidget.destroy; begin fProjSubj.free; inherited; end; procedure TCEProjectGroupWidget.DoShow; begin inherited; updateList; end; {$ENDREGION} {$REGION Widget ICEProjectObserver ---------------------------------------------} procedure TCEProjectGroupWidget.projNew(aProject: ICECommonProject); begin fPrevProj := aProject; if not aProject.inGroup then fFreeProj := aProject; end; procedure TCEProjectGroupWidget.projChanged(aProject: ICECommonProject); begin updateList; end; procedure TCEProjectGroupWidget.projClosing(aProject: ICECommonProject); begin fPrevProj := nil; if aProject = fFreeProj then begin fFreeProj := nil; updateList; end; end; procedure TCEProjectGroupWidget.projFocused(aProject: ICECommonProject); begin fPrevProj := aProject; if not aProject.inGroup then begin fFreeProj := aProject; updateList; end else if (aProject = fFreeProj) and (aProject.inGroup) then begin fFreeProj := nil; updateList; end; end; procedure TCEProjectGroupWidget.projCompiling(aProject: ICECommonProject); begin end; procedure TCEProjectGroupWidget.projCompiled(aProject: ICECommonProject; success: boolean); begin end; {$ENDREGION} {$REGION Widget project group things -------------------------------------------} procedure TCEProjectGroupWidget.BtnAddProjClick(Sender: TObject); begin with TOpenDialog.Create(nil) do try if not execute then exit; if projectGroup.findProject(filename) <> nil then exit; projectGroup.addItem(filename); updateList; finally free; end; end; procedure TCEProjectGroupWidget.btnFreeFocusClick(Sender: TObject); begin if fFreeProj <> nil then subjProjFocused(fProjSubj, fFreeProj); end; procedure TCEProjectGroupWidget.btnAddUnfocusedClick(Sender: TObject); begin if fFreeProj = nil then exit; projectGroup.addProject(fFreeProj); fFreeProj := nil; updateList; end; procedure TCEProjectGroupWidget.btnMoveDownClick(Sender: TObject); begin if lstProj.ItemIndex = -1 then exit; if lstProj.ItemIndex = lstProj.Items.Count-1 then exit; // projectGroup.items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex + 1); lstProj.Items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex + 1); end; procedure TCEProjectGroupWidget.btnMoveUpClick(Sender: TObject); begin if lstProj.ItemIndex = -1 then exit; if lstProj.ItemIndex = 0 then exit; // projectGroup.items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex - 1); lstProj.Items.Exchange(lstProj.ItemIndex, lstProj.ItemIndex - 1); end; procedure TCEProjectGroupWidget.btnRemProjClick(Sender: TObject); begin if lstProj.ItemIndex = -1 then exit; projectGroup.items.Delete(lstProj.Selected.Index); updateList; end; procedure TCEProjectGroupWidget.lstProjDblClick(Sender: TObject); begin if lstProj.ItemIndex = -1 then exit; TProjectGroupItem(lstProj.Selected.Data).lazyLoad; subjProjFocused(fProjSubj, TProjectGroupItem(lstProj.Selected.Data).project); if projectGroup.projectIndex <> lstProj.ItemIndex then projectGroup.projectIndex := lstProj.ItemIndex; end; procedure TCEProjectGroupWidget.handleChanged(sender: TObject); begin updateList; if (projectGroup.projectIndex <> -1) and (projectGroup.projectIndex <> lstProj.ItemIndex) then begin lstProj.ItemIndex := projectGroup.projectIndex; lstProjDblClick(nil); end; end; procedure TCEProjectGroupWidget.updateList; var i: integer; p: TProjectGroupItem; const typeStr: array[TCEProjectFormat] of string = ('CE','DUB'); begin lstProj.Clear; for i := 0 to projectGroup.projectCount-1 do begin with lstProj.Items.Add do begin p := projectGroup.item[i]; p.lazyLoad; Data:= p; case p.project.getFormat of pfNative: Caption := p.fFilename.extractFileName; pfDub: Caption := TCEDubProject(p.project.getProject).json.Strings['name']; end; SubItems.Add(typeStr[p.fProj.getFormat]); SubItems.Add(p.fProj.configurationName(p.fProj.getActiveConfigurationIndex)); end; end; if fFreeProj <> nil then StaticText1.Caption:= 'Free standing: ' + shortenPath(fFreeProj.filename, 30) else StaticText1.Caption:= 'No free standing project'; end; {$ENDREGION} initialization projectGroup := TProjectGroup.create(nil); finalization projectGroup.Free; end.