1
0
mirror of synced 2024-09-19 01:36:08 +00:00

Minor fixes to GUIContext

This commit is contained in:
Mark van Renswoude 2016-10-21 14:35:35 +02:00
parent 4a287a0715
commit b2e6510d19
4 changed files with 54 additions and 12 deletions

View File

@ -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

View File

@ -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.

View File

@ -26,6 +26,8 @@ uses
constructor TX2ServiceContextGUI.Create(AService: IX2Service);
begin
inherited Create;
StartService(AService);
end;

View File

@ -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;