unit vwmain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, ComCtrls, LCLType,
StdCtrls, Buttons, EditBtn, obs_prosu, vwmain.intf, vwmain.decl,
vwmain.presenter, vwmain.types;
type
{$define lbxfab-intf} //<--- HERE
{$i lbxfab.inc} //<--- HERE
{$UnDef lbxfab-intf} //<--- HERE
{ TViewMain }
TViewMain = class(TForm, IView)
bbtnAddDirToLbx: TBitBtn;
bbtnDelDirFromLbx: TBitBtn;
btnCreateProject: TButton;
btnClose: TButton;
chkAddProjectToRoot: TCheckBox;
chkDefaultDirs: TCheckBox;
dirEdtProjectRoot: TDirectoryEdit;
Edit1: TEdit;
edtAddDir: TEdit;
edtProjectName: TEdit;
gbProjectDir: TGroupBox;
ImageList1: TImageList;
lblProjectNameExtension: TLabel;
lblProjectDirs: TLabel;
lblProjectRoot: TLabel;
lblProjectName: TLabel;
lbxNewDirs: TListBox;
mmiProgramQuit: TMenuItem;
mmiProgram: TMenuItem;
mmViewMain: TMainMenu;
StatusBar1: TStatusBar;
procedure bbtnAddDirToLbxClick(Sender: TObject);
procedure btnCreateProjectClick(Sender: TObject);
procedure chkAddProjectToRootChange(Sender: TObject);
procedure chkDefaultDirsChange(Sender: TObject);
procedure dirEdtProjectRootChange(Sender: TObject);
procedure edtAddDirKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure edtProjectNameChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure lbxNewDirsDblClick(Sender: TObject);
procedure lbxNewDirsKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure mmiProgramQuitClick(Sender: TObject);
private
FSubscriber : TobsSubscriber; { Holds the Observer. }
FPresenter : TPresenter; { Holds the Presenter. }
FLbxItemIdx : Integer;
procedure EditEditingDone(Sender: TObject);
procedure EditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure EditExit(Sender: TObject);
function get_Presenter: IPresenter;
function get_Subscriber: IobsSubscriber;
procedure set_Presenter(AValue: IPresenter);
function Obj: TObject;
procedure ValidateEntry(Sender: TObject);
protected
procedure DoSetStaticTexts(aTextRec: PStaticTextsAll);
procedure DoSetStatusBarPaneltext(aData: Pointer);
procedure DoSetCheckEntry({%H-}aSender: TObject; aData: Pointer);
procedure DoSetProjectLocation(aSender: TObject; aData: Pointer);
procedure DoCreateDirs({%H-}anObj: TObject; aDirs: PDirectoriesRec);
procedure DoSetSubDirs({%H-}anObj: TObject; aData: PDirectoriesRec);
procedure DoLbxDblClick(anObj: TObject; aData: PListBoxFab);
procedure DoEditKeyUp(anObj: TObject; aData: PEditKeyUp);
procedure DoAddSubDirToList(anObj: TObject; aData: PDirectoriesRec);
public
{ Handle Observer Notifications }
procedure HandleObsNotify(aReason: TProviderReason; aNotifyClass: TObject; UserData: pointer);
property Subscriber: IobsSubscriber read get_Subscriber;
property Presenter: IPresenter read get_Presenter write set_Presenter;
end;
var
ViewMain: TViewMain;
implementation
{$R *.lfm}
{$define lbxfab-impl} //<--- HERE
{$i lbxfab.inc} //<--- HERE
{$UnDef lbxfab-impl} //<--- HERE
{ TViewMain }
procedure TViewMain.mmiProgramQuitClick(Sender: TObject);
begin
Close;
end;
function TViewMain.get_Presenter: IPresenter;
begin
Result:= FPresenter;
end;
function TViewMain.get_Subscriber: IobsSubscriber;
begin
Result:= FSubscriber;
end;
procedure TViewMain.set_Presenter(AValue: IPresenter);
begin
if aValue= nil then begin
if Assigned(FPresenter) then FPresenter.Provider.UnSubscribe(FSubscriber);
FPresenter.Free;
FPresenter:= nil;
exit;
end;
if TPresenter(aValue.Obj) <> fPresenter then begin
if Assigned(FPresenter) then fPresenter.Provider.UnSubscribe(FSubscriber); { we can't detach nil }
FPresenter.Free; { we own it }
if Assigned(aValue) then begin
FPresenter:= TPresenter(aValue.Obj);
FPresenter.Provider.Subscribe(FSubscriber);
FPresenter.GetStaticTexts(gstAll); // Get All static texts
end;
end;
end;
function TViewMain.Obj: TObject;
begin
Result:= self;
end;
procedure TViewMain.DoSetStaticTexts(aTextRec: PStaticTextsAll);
begin
with aTextRec^ do begin
Caption:= staVwMainTitle;
mmiProgram.Caption:= staMmiProgram;
mmiProgramQuit.Caption:= staMmiProgramQuit;
gbProjectDir.Caption:= staClear;
lblProjectName.Caption:= staLblProjectName;
lblProjectRoot.Caption:= staLblProjectLocation;
lblProjectNameExtension.Caption:= staLblProjectNameExtension;
lblProjectDirs.Caption:= staLblProjectDirs;
bbtnAddDirToLbx.Caption:= staClear;
btnCreateProject.Caption:= staBtnCreateProject;
btnClose.Caption:= staBtnClose;
chkAddProjectToRoot.Caption:= staChkAddProjectToRoot;
chkDefaultDirs.Caption:= staChkDefaultDirs;
edtProjectName.TextHint:= staEdtProjectNameTxtHint;
edtAddDir.TextHint:= staEdtAddDirHint;
edtProjectName.Text:= staClear;
dirEdtProjectRoot.Text:= staClear;
edtAddDir.Text:= staClear;
end;
end;
procedure TViewMain.DoSetStatusBarPaneltext(aData: Pointer);
begin
with PStatusbarPanelText(aData)^ do begin
StatusBar1.Panels[activePanel].Text:= PanelText;
end;
end;
procedure TViewMain.DoSetCheckEntry(aSender: TObject; aData: Pointer);
begin
with PValidateEntry(aData)^ do begin
if veLengthProjectIsCorrect then begin
if veUsedCharProjectIsCorrect then
edtProjectName.Color:= clDefault
else
edtProjectName.Color:= clFuchsia;
end
else if not veLengthProjectIsCorrect then begin
edtProjectName.Color:= clRed;
end;
if veLengthRootIsCorrect then begin
if veUsedCharRootIsCorrect then
dirEdtProjectRoot.Color:= clDefault
else
dirEdtProjectRoot.Color:= clFuchsia;
end
else if not veLengthRootIsCorrect then begin
dirEdtProjectRoot.Color:= clRed;
end;
FPresenter.SetStatusbartext(veMessage, 0);
btnCreateProject.Enabled:= veSucces;
end;
end;
procedure TViewMain.DoSetProjectLocation(aSender: TObject; aData: Pointer);
begin
with PProjectLocation(aData)^ do begin
TEdit(aSender).Text:= ProjectRootDir;
end;
end;
procedure TViewMain.DoCreateDirs(anObj: TObject; aDirs: PDirectoriesRec);
begin
FPresenter.SetStatusbartext(aDirs^.dirSuccesMsg, 0);
end;
procedure TViewMain.DoSetSubDirs(anObj: TObject; aData: PDirectoriesRec);
var
i, j: Integer;
begin
{ #todo : wrong place. should be in Model or lisbox unit. }
with PDirectoriesRec(aData)^ do begin
if AddSubDirs then begin
for i:=0 to length(DefaultSubDirs)-1 do begin
// add check if exists...
lbxNewDirs.AddItem(DefaultSubDirs[i], nil);
end;
end
else begin
for i:=0 to length(DefaultSubDirs)-1 do begin
for j:= lbxNewDirs.Items.Count-1 downto 0 do begin
if DefaultSubDirs[i] = lbxNewDirs.Items[j] then begin
lbxNewDirs.Items.Delete(j);
Break;
end;
end;
end;
end;
end;
end;
procedure TViewMain.EditEditingDone(Sender: TObject);
begin
lbxNewDirs.Items[FLbxItemIdx]:= (Sender As TEdit).Text;
end;
procedure TViewMain.EditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
FPresenter.EdtKeyUp(Sender, Key);
end;
procedure TViewMain.EditExit(Sender: TObject);
begin
with Sender as TEdit do begin
Destroy;
end;
end;
procedure TViewMain.DoLbxDblClick(anObj: TObject; aData: PListBoxFab);
begin
if TListBox(anObj).ItemIndex >= 0 then begin
With PListBoxFab(aData)^ do begin
TEdit(edt).OnEditingDone:= @EditEditingDone;
TEdit(edt).OnKeyUp:= @EditKeyUp;
TEdit(edt).OnExit:= @EditExit;
FLbxItemIdx:= TListBox(anObj).ItemIndex;
end;
end;
end;
procedure TViewMain.DoEditKeyUp(anObj: TObject; aData: PEditKeyUp);
begin
with PEditKeyUp(adata)^ do begin
case aKey of
VK_RETURN: begin
(anObj as TEdit).OnEditingDone:= nil;
EditEditingDone(TEdit(anObj));
lbxNewDirs.SetFocus; // keep the listbox focues. (without this an other component gets the focus).
end;
40: begin // Arrow down
(anObj as TEdit).OnEditingDone:= nil;
EditEditingDone(TEdit(anObj));
if FLbxItemIdx < lbxNewDirs.Items.Count-1 then
lbxNewDirs.ItemIndex := FLbxItemIdx + 1; // goto the next listbox item
lbxNewDirs.SetFocus;
end;
VK_ESCAPE: begin
(anObj as TEdit).OnEditingDone:= nil;
(anObj as TEdit).OnExit:= nil;
anObj.Destroy;
lbxNewDirs.SetFocus;
end;
end;
end;
end;
procedure TViewMain.DoAddSubDirToList(anObj: TObject; aData: PDirectoriesRec);
begin
with PDirectoriesRec(adata)^ do begin
if dirNewDirnames <> '' then
lbxNewDirs.AddItem(dirNewDirnames, nil);
end;
//if Length(edtAddDir.Text) > 0 then lbxNewDirs.AddItem(edtAddDir.Text,nil);
end;
procedure TViewMain.HandleObsNotify(aReason: TProviderReason;
aNotifyClass: TObject; UserData: pointer);
begin
case aReason of
prStaticTexts : DoSetStaticTexts(UserData);
prStatusBarPanelText : DoSetStatusBarPaneltext(UserData);
prCheckEntryLength : DoSetCheckEntry(aNotifyClass, UserData);
prProjectLocation : DoSetProjectLocation(aNotifyClass, UserData);
prCreateDirs : DoCreateDirs(aNotifyClass,UserData);
prSubDirDefault : DoSetSubDirs(aNotifyClass,UserData);
prListBoxDblClick : DoLbxDblClick(aNotifyClass,UserData);
prEdtKeyUp : DoEditKeyUp(aNotifyClass,UserData);
prSubDirToList : DoAddSubDirToList(aNotifyClass,UserData);
end;
end;
procedure TViewMain.FormCreate(Sender: TObject);
begin
FSubscriber:= CreateObsSubscriber(@HandleObsNotify); { Delegate messages }
Presenter:= TPresenter.Create; { the view owns the presenter }
chkDefaultDirs.Checked:= true; // Get the default dirs.
end;
procedure TViewMain.btnCreateProjectClick(Sender: TObject);
var
lRec: TCreateProjectDirectoryTransaction;
begin
try
lRec := FPresenter.TrxMan.StartTransaction(msCreateDir) as TCreateProjectDirectoryTransaction;
lRec.ProjectName:= edtProjectName.Text;
lrec.RootDir:= dirEdtProjectRoot.Text;
lRec.PrjNameInDir:= chkAddProjectToRoot.Checked;
if lbxNewDirs.Items.Count> 0 then begin
lRec.NewDirnames.AddStrings(lbxNewDirs.Items);
end;
fPresenter.TrxMan.CommitTransaction;
except
fPresenter.TrxMan.RollbackTransaction;
end;
end;
procedure TViewMain.bbtnAddDirToLbxClick(Sender: TObject);
var
lRec: TDirectoriesRec;
begin
lRec.dirNewDirnames:= edtAddDir.Text;
FPresenter.AddDirToList(Sender, lRec);
end;
procedure TViewMain.chkAddProjectToRootChange(Sender: TObject);
begin
if chkAddProjectToRoot.Checked then begin
ValidateEntry(Sender);
end
else begin
edtProjectNameChange(edtProjectName);
dirEdtProjectRootChange(dirEdtProjectRoot);
end;
end;
procedure TViewMain.chkDefaultDirsChange(Sender: TObject);
begin
FPresenter.AddDefaultSubDirs(lbxNewDirs, TCheckBox(Sender).Checked);
end;
procedure TViewMain.dirEdtProjectRootChange(Sender: TObject);
begin
ValidateEntry(Sender);
end;
procedure TViewMain.edtAddDirKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
lRec: TDirectoriesRec;
begin
case Key of
13: begin
lRec.dirNewDirnames:= edtAddDir.Text;
FPresenter.AddDirToList(Sender, lRec);
//Key:= 0;
end;
end;
end;
procedure TViewMain.edtProjectNameChange(Sender: TObject);
begin
// Is called when focus is left ? that's actually unnecessary. how to prevent that?
ValidateEntry(Sender);
end;
procedure TViewMain.ValidateEntry(Sender: TObject);
var
lveRec : TValidateEntry;
begin
lveRec.vePrjName:= edtProjectName.Text;
lveRec.veRootName:= dirEdtProjectRoot.Text;
lveRec.vePrjInRoot:= chkAddProjectToRoot.Checked;
//lveRec.veIsFolder:= IsFolder;
FPresenter.ValidateEntry(Sender, lveRec); // Sender is not used.
end;
procedure TViewMain.FormDestroy(Sender: TObject);
begin
if Assigned(FPresenter) then begin
FPresenter.Provider.UnSubscribe(FSubscriber);
FSubscriber.Free;
FPresenter.Free;
end;
end;
procedure TViewMain.lbxNewDirsDblClick(Sender: TObject);
begin
FPresenter.LbxNewDirsDblClick(Sender);
end;
procedure TViewMain.lbxNewDirsKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
113: begin // VK_F2
lbxNewDirsDblClick(sender);
end;
end;
end;
end.
Recent
