Minor fixes to GUIContext
This commit is contained in:
parent
4a287a0715
commit
b2e6510d19
@ -13,6 +13,7 @@ object X2ServiceContextGUIForm: TX2ServiceContextGUIForm
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
Position = poScreenCenter
|
||||
OnCloseQuery = FormCloseQuery
|
||||
DesignSize = (
|
||||
285
|
||||
@ -27,7 +28,7 @@ object X2ServiceContextGUIForm: TX2ServiceContextGUIForm
|
||||
Anchors = [akLeft, akBottom]
|
||||
Caption = '&Close'
|
||||
TabOrder = 0
|
||||
ExplicitTop = 180
|
||||
OnClick = btnCloseClick
|
||||
end
|
||||
object gbStatus: TGroupBox
|
||||
AlignWithMargins = True
|
||||
@ -42,7 +43,6 @@ object X2ServiceContextGUIForm: TX2ServiceContextGUIForm
|
||||
Align = alTop
|
||||
Caption = ' Status '
|
||||
TabOrder = 1
|
||||
ExplicitWidth = 261
|
||||
object lblStatus: TLabel
|
||||
Left = 34
|
||||
Top = 26
|
||||
@ -50,11 +50,13 @@ object X2ServiceContextGUIForm: TX2ServiceContextGUIForm
|
||||
Height = 13
|
||||
Caption = 'Starting...'
|
||||
end
|
||||
object Shape1: TShape
|
||||
object shpStatus: TShape
|
||||
Left = 12
|
||||
Top = 24
|
||||
Width = 16
|
||||
Height = 16
|
||||
Brush.Color = 33023
|
||||
Shape = stCircle
|
||||
end
|
||||
end
|
||||
object gbCustomControl: TGroupBox
|
||||
@ -89,7 +91,6 @@ object X2ServiceContextGUIForm: TX2ServiceContextGUIForm
|
||||
TabOrder = 0
|
||||
Text = '128'
|
||||
OnChange = edtControlCodeChange
|
||||
ExplicitWidth = 173
|
||||
end
|
||||
object btnSend: TButton
|
||||
Left = 180
|
||||
@ -99,7 +100,7 @@ object X2ServiceContextGUIForm: TX2ServiceContextGUIForm
|
||||
Anchors = [akTop, akRight]
|
||||
Caption = '&Send'
|
||||
TabOrder = 1
|
||||
ExplicitLeft = 251
|
||||
OnClick = btnSendClick
|
||||
end
|
||||
end
|
||||
end
|
||||
|
@ -20,14 +20,16 @@ type
|
||||
btnClose: TButton;
|
||||
gbStatus: TGroupBox;
|
||||
lblStatus: TLabel;
|
||||
Shape1: TShape;
|
||||
shpStatus: TShape;
|
||||
gbCustomControl: TGroupBox;
|
||||
lblControlCode: TLabel;
|
||||
edtControlCode: TEdit;
|
||||
btnSend: TButton;
|
||||
|
||||
procedure edtControlCodeChange(Sender: TObject);
|
||||
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||||
procedure edtControlCodeChange(Sender: TObject);
|
||||
procedure btnSendClick(Sender: TObject);
|
||||
procedure btnCloseClick(Sender: TObject);
|
||||
private
|
||||
FContext: IX2ServiceContext;
|
||||
FService: IX2Service;
|
||||
@ -35,6 +37,8 @@ type
|
||||
procedure DoShow; override;
|
||||
|
||||
procedure CMAfterShow(var Msg: TMessage); message CM_AFTERSHOW;
|
||||
|
||||
function GetControlCode: Byte;
|
||||
public
|
||||
property Context: IX2ServiceContext read FContext write FContext;
|
||||
property Service: IX2Service read FService write FService;
|
||||
@ -45,12 +49,20 @@ implementation
|
||||
uses
|
||||
System.Math,
|
||||
System.SysUtils,
|
||||
Vcl.Graphics,
|
||||
Winapi.Windows;
|
||||
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
|
||||
const
|
||||
StatusColorStarting = $00B0FFB0;
|
||||
StatusColorStarted = clGreen;
|
||||
StatusColorStopping = $008080FF;
|
||||
StatusColorStopped = clRed;
|
||||
|
||||
|
||||
// #ToDo1 -oMvR: 21-10-2016: separate service handling out to thread to prevent blocking of the UI
|
||||
|
||||
|
||||
@ -65,26 +77,45 @@ end;
|
||||
|
||||
procedure TX2ServiceContextGUIForm.CMAfterShow(var Msg: TMessage);
|
||||
begin
|
||||
shpStatus.Brush.Color := StatusColorStarting;
|
||||
lblStatus.Caption := 'Starting...';
|
||||
lblStatus.Update;
|
||||
Application.ProcessMessages;
|
||||
|
||||
if Service.Start(Context) then
|
||||
lblStatus.Caption := 'Started'
|
||||
else
|
||||
begin
|
||||
shpStatus.Brush.Color := StatusColorStarted;
|
||||
lblStatus.Caption := 'Started';
|
||||
end else
|
||||
begin
|
||||
shpStatus.Brush.Color := StatusColorStopped;
|
||||
lblStatus.Caption := 'Failed to start';
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2ServiceContextGUIForm.edtControlCodeChange(Sender: TObject);
|
||||
begin
|
||||
edtControlCode.Text := IntToStr(Min(Max(StrToIntDef(edtControlCode.Text, 0), 128), 255));
|
||||
edtControlCode.Text := IntToStr(GetControlCode);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2ServiceContextGUIForm.btnSendClick(Sender: TObject);
|
||||
begin
|
||||
Service.DoCustomControl(GetControlCode);
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2ServiceContextGUIForm.btnCloseClick(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
|
||||
procedure TX2ServiceContextGUIForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
|
||||
begin
|
||||
shpStatus.Brush.Color := StatusColorStopping;
|
||||
lblStatus.Caption := 'Stopping...';
|
||||
lblStatus.Update;
|
||||
Application.ProcessMessages;
|
||||
|
||||
CanClose := Service.Stop;
|
||||
|
||||
@ -92,4 +123,10 @@ begin
|
||||
lblStatus.Caption := 'Failed to stop';
|
||||
end;
|
||||
|
||||
|
||||
function TX2ServiceContextGUIForm.GetControlCode: Byte;
|
||||
begin
|
||||
Result := Byte(Min(Max(StrToIntDef(edtControlCode.Text, 0), 128), 255));
|
||||
end;
|
||||
|
||||
end.
|
||||
|
@ -26,6 +26,8 @@ uses
|
||||
constructor TX2ServiceContextGUI.Create(AService: IX2Service);
|
||||
begin
|
||||
inherited Create;
|
||||
|
||||
StartService(AService);
|
||||
end;
|
||||
|
||||
|
||||
|
@ -65,12 +65,14 @@ implementation
|
||||
function TX2CustomService.Start(AContext: IX2ServiceContext): Boolean;
|
||||
begin
|
||||
FContext := AContext;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
function TX2CustomService.Stop: Boolean;
|
||||
begin
|
||||
FContext := nil;
|
||||
Result := True;
|
||||
end;
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user