unit fDispatchersEditorForm; {----------------------------------------------------------------------------} { RemObjects SDK Library - Core Library { { compiler: Delphi 5 and up, Kylix 2 and up { platform: Win32, Linux { { (c)opyright RemObjects Software. all rights reserved. { { Using this code requires a valid license of the RemObjects SDK { which can be obtained at http://www.remobjects.com. {----------------------------------------------------------------------------} {$I ..\RemObjects.inc} interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, ComCtrls, uROClient, uROServer, uROHTTPDispatch, ActnList; type TDispatchersEditorForm = class(TForm) ListView: TListView; bAdd: TBitBtn; bDelete: TBitBtn; cbMessage: TComboBox; Label1: TLabel; Label3: TLabel; lblPathInfo: TLabel; ePathInfo: TEdit; cbEnabled: TComboBox; ActionList1: TActionList; ac_Add: TAction; ac_Remove: TAction; ac_Close: TAction; procedure bDeleteClick(Sender: TObject); procedure bAddClick(Sender: TObject); procedure ListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); procedure cbMessageChange(Sender: TObject); procedure cbEnabledChange(Sender: TObject); procedure ePathInfoChange(Sender: TObject); procedure ActionList1Update(Action: TBasicAction; var Handled: Boolean); procedure ac_CloseExecute(Sender: TObject); private fInChange: boolean; fServer : TROServer; fShowPathInfo, fSelectingItem : boolean; procedure LoadMessages; procedure RefreshDispatchers; procedure SetShowPathInfo(const Value: boolean); function GetDispatchers: TROMessageDispatchers; procedure SetServer(const Value: TROServer); function GetDispatcher: TROMessageDispatcher; public constructor Create(aServer : TROServer); reintroduce; destructor Destroy; override; property Server : TROServer read fServer write SetServer; property Dispatchers : TROMessageDispatchers read GetDispatchers; property Dispatcher : TROMessageDispatcher read GetDispatcher; end; var DispatchersEditorForm: TDispatchersEditorForm; implementation {$R *.dfm} const BoolStrs : array[boolean] of string = ('False', 'True'); { TDispatchersEditorForm } constructor TDispatchersEditorForm.Create(aServer : TROServer); begin inherited Create(NIL); fSelectingItem := FALSE; Server := aServer; RefreshDispatchers; if ListView.Items.Count > 0 then ListView.Items[0].Selected := true; end; destructor TDispatchersEditorForm.Destroy; begin inherited; end; procedure TDispatchersEditorForm.RefreshDispatchers; var idx, i : integer; item : TListItem; begin if fSelectingItem then Exit; if (ListView.Selected<>NIL) then idx := ListView.Selected.Index else idx := -1; ListView.Items.Clear; for i := 0 to (Dispatchers.Count-1) do begin item := ListView.Items.Add; item.Caption := BoolStrs[Dispatchers[i].Enabled]; item.SubItems.Add(Dispatchers[i].Name); if fShowPathInfo then item.SubItems.Add(TROHTTPDispatcher(Dispatchers[i]).PathInfo); end; if (idx>=0) and (idx0) and not Dispatchers.SupportsMultipleDispatchers then MessageDlg(Server.ClassName+' only supports one dispatcher', mtWarning, [mbOK],0) else begin Dispatchers.Add; RefreshDispatchers; ListView.Items[ListView.Items.Count-1].Selected := true; end; end; procedure TDispatchersEditorForm.ListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); begin fSelectingItem := TRUE; try if (Dispatcher<>NIL) then with Dispatcher do begin cbEnabled.ItemIndex := Ord(Enabled); if (Message<>NIL) then cbMessage.ItemIndex := cbMessage.Items.IndexOf(Message.Name) else cbMessage.ItemIndex := 0; if fShowPathInfo then ePathInfo.Text := TROHTTPDispatcher(Dispatcher).PathInfo; end; finally fSelectingItem := FALSE; end; end; function TDispatchersEditorForm.GetDispatchers: TROMessageDispatchers; begin result := fServer.Dispatchers; end; procedure TDispatchersEditorForm.LoadMessages; var i : integer; begin cbMessage.Items.Clear; cbMessage.Items.Add('-'); with fServer.Owner do for i := 0 to (ComponentCount-1) do begin if (Components[i] is TROMessage) then cbMessage.Items.Add(TROMessage(Components[i]).Name); end; end; procedure TDispatchersEditorForm.SetServer(const Value: TROServer); begin fServer := Value; if (Value=NIL) then Exit; // Just in case... Caption := fServer.Name+' Dispatchers'; SetShowPathInfo(Dispatchers is TROHTTPMessageDispatchers); LoadMessages; end; procedure TDispatchersEditorForm.cbMessageChange(Sender: TObject); begin if (Dispatcher=NIL) then Exit; if (cbMessage.Text<>'-') then Dispatcher.Message := TROMessage(fServer.Owner.FindComponent(cbMessage.Text)) else Dispatcher.Message := NIL; RefreshDispatchers; end; procedure TDispatchersEditorForm.cbEnabledChange(Sender: TObject); begin if (Dispatcher=NIL) then Exit; Dispatcher.Enabled := boolean(Ord(cbEnabled.ItemIndex)); RefreshDispatchers; end; procedure TDispatchersEditorForm.ePathInfoChange(Sender: TObject); begin if fInChange then exit; fInChange := true; try if (Dispatcher=NIL) then Exit; TROHTTPDispatcher(Dispatcher).PathInfo := ePathInfo.Text; //ePathInfo.Text := TROHTTPDispatcher(Dispatcher).PathInfo; //1.0.4: read back PathInfo value, because the Dispatcher might adjust it. RefreshDispatchers; finally fInChange := false; end; end; function TDispatchersEditorForm.GetDispatcher: TROMessageDispatcher; begin if (ListView.Selected=NIL) then result := NIL else result := Dispatchers[ListView.Selected.Index]; end; procedure TDispatchersEditorForm.ActionList1Update(Action: TBasicAction; var Handled: Boolean); begin ac_Remove.Enabled := Assigned(ListView.Selected); cbMessage.Enabled := ac_Remove.Enabled; ePathInfo.Enabled := ac_Remove.Enabled; cbEnabled.Enabled := ac_Remove.Enabled; end; procedure TDispatchersEditorForm.ac_CloseExecute(Sender: TObject); begin Close(); end; end.