Scott Duensing
ae2aef0119
Text-based protocol for serving Delphi-designed forms over serial. dfm2form converts binary DFM (TPF0) to protocol commands on Linux. formsrv loads .form files and sends/receives via pluggable transport. formcli creates native Win 3.1 controls and routes events back to server. Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
1290 lines
31 KiB
ObjectPascal
1290 lines
31 KiB
ObjectPascal
unit FormCli;
|
|
|
|
{ FormCli - Remote forms client engine for Delphi 1.0. }
|
|
{ }
|
|
{ Receives form/control commands from a server via a transport interface, }
|
|
{ creates native Windows 3.1 controls, and sends user events back. }
|
|
{ }
|
|
{ Transport is abstracted: TFormTransport defines ReadMessage/WriteMessage. }
|
|
{ The caller provides a concrete descendant (e.g., serial or string list). }
|
|
{ }
|
|
{ Call ProcessMessages from the main loop to pump incoming commands. }
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, Controls, Forms, StdCtrls, WinTypes, WinProcs;
|
|
|
|
const
|
|
MaxMsgLen = 4096;
|
|
|
|
type
|
|
{ Transport interface - override in descendant }
|
|
TFormTransport = class(TObject)
|
|
public
|
|
function ReadMessage(Buf: PChar; BufSize: Integer): Integer; virtual; abstract;
|
|
procedure WriteMessage(Buf: PChar; Len: Integer); virtual; abstract;
|
|
end;
|
|
|
|
TCtrlTypeE = (ctUnknown, ctLabel, ctEdit, ctButton,
|
|
ctCheckBox, ctListBox, ctComboBox, ctMemo);
|
|
|
|
{ Bound event flags }
|
|
TBoundEvent = (beDblClick, beKeyDown, beKeyUp,
|
|
beEnter, beExit, beMouseDown, beMouseUp, beMouseMove);
|
|
TBoundEvents = set of TBoundEvent;
|
|
|
|
{ Per-control record }
|
|
PFormCtrlRec = ^TFormCtrlRec;
|
|
TFormCtrlRec = record
|
|
CtrlId: Integer;
|
|
CtrlType: TCtrlTypeE;
|
|
Control: TControl;
|
|
Bound: TBoundEvents;
|
|
end;
|
|
|
|
{ Per-form record }
|
|
PFormRec = ^TFormRec;
|
|
TFormRec = record
|
|
FormId: Integer;
|
|
Form: TForm;
|
|
Ctrls: TList; { of PFormCtrlRec }
|
|
end;
|
|
|
|
{ Client engine }
|
|
TFormClient = class(TObject)
|
|
private
|
|
FTransport: TFormTransport;
|
|
FForms: TList; { of PFormRec }
|
|
FMsgBuf: PChar; { read buffer }
|
|
FTmpBuf: PChar; { scratch buffer for outgoing messages }
|
|
|
|
{ Command dispatch }
|
|
procedure DoCtrlCreate(P: PChar);
|
|
procedure DoCtrlSet(P: PChar);
|
|
procedure DoEventBind(P: PChar);
|
|
procedure DoEventUnbind(P: PChar);
|
|
procedure DoFormCreate(P: PChar);
|
|
procedure DoFormDestroy(P: PChar);
|
|
procedure DoFormHide(P: PChar);
|
|
procedure DoFormShow(P: PChar);
|
|
procedure DispatchCommand(Buf: PChar);
|
|
|
|
{ Form/control lookup }
|
|
function FindForm(FormId: Integer): PFormRec;
|
|
function FindCtrl(FR: PFormRec; CtrlId: Integer): PFormCtrlRec;
|
|
procedure FreeFormRec(FR: PFormRec);
|
|
procedure FreeCtrlRec(CR: PFormCtrlRec);
|
|
|
|
{ Property application }
|
|
procedure ApplyProp(CR: PFormCtrlRec; Key, Value: PChar);
|
|
procedure ApplyInlineProps(CR: PFormCtrlRec; P: PChar);
|
|
|
|
{ Event wiring }
|
|
procedure WireAutoEvents(CR: PFormCtrlRec);
|
|
procedure WireOptEvent(CR: PFormCtrlRec; const EventName: string);
|
|
procedure UnwireOptEvent(CR: PFormCtrlRec; const EventName: string);
|
|
|
|
{ Event handlers }
|
|
procedure HandleButtonClick(Sender: TObject);
|
|
procedure HandleCheckBoxClick(Sender: TObject);
|
|
procedure HandleComboBoxChange(Sender: TObject);
|
|
procedure HandleComboBoxSelect(Sender: TObject);
|
|
procedure HandleDblClick(Sender: TObject);
|
|
procedure HandleEditChange(Sender: TObject);
|
|
procedure HandleEnter(Sender: TObject);
|
|
procedure HandleExit(Sender: TObject);
|
|
procedure HandleFormClose(Sender: TObject; var Action: TCloseAction);
|
|
procedure HandleKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
procedure HandleKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
|
procedure HandleListBoxSelect(Sender: TObject);
|
|
procedure HandleMemoChange(Sender: TObject);
|
|
procedure HandleMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
procedure HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
|
|
procedure HandleMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
|
|
|
|
{ Outgoing event helpers }
|
|
procedure SendEvent(FormId, CtrlId: Integer; const EventName: string; const Data: string);
|
|
|
|
{ String parsing }
|
|
function ParseToken(var P: PChar; Buf: PChar; BufSize: Integer): Boolean;
|
|
function ParseInt(var P: PChar): Integer;
|
|
procedure UnescapeString(Src, Dst: PChar; DstSize: Integer);
|
|
procedure EscapeString(Src, Dst: PChar; DstSize: Integer);
|
|
public
|
|
constructor Create(ATransport: TFormTransport);
|
|
destructor Destroy; override;
|
|
procedure ProcessMessages;
|
|
property Transport: TFormTransport read FTransport;
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ ----- String parsing helpers --------------------------------------------- }
|
|
|
|
function TFormClient.ParseToken(var P: PChar; Buf: PChar; BufSize: Integer): Boolean;
|
|
var
|
|
I: Integer;
|
|
C: Char;
|
|
begin
|
|
Result := False;
|
|
{ Skip whitespace }
|
|
while (P^ = ' ') or (P^ = #9) do
|
|
Inc(P);
|
|
|
|
if P^ = #0 then
|
|
Exit;
|
|
|
|
I := 0;
|
|
|
|
if P^ = '"' then
|
|
begin
|
|
{ Quoted string }
|
|
Inc(P);
|
|
while (P^ <> #0) and (P^ <> '"') do
|
|
begin
|
|
if (P^ = '\') and ((P + 1)^ <> #0) then
|
|
begin
|
|
Inc(P);
|
|
C := P^;
|
|
case C of
|
|
'n': C := #10;
|
|
'r': C := #13;
|
|
't': C := #9;
|
|
'"': C := '"';
|
|
'\': C := '\';
|
|
end;
|
|
if I < BufSize - 1 then
|
|
begin
|
|
Buf[I] := C;
|
|
Inc(I);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if I < BufSize - 1 then
|
|
begin
|
|
Buf[I] := P^;
|
|
Inc(I);
|
|
end;
|
|
end;
|
|
Inc(P);
|
|
end;
|
|
if P^ = '"' then
|
|
Inc(P);
|
|
end
|
|
else
|
|
begin
|
|
{ Bare token }
|
|
while (P^ <> #0) and (P^ <> ' ') and (P^ <> #9) do
|
|
begin
|
|
if I < BufSize - 1 then
|
|
begin
|
|
Buf[I] := P^;
|
|
Inc(I);
|
|
end;
|
|
Inc(P);
|
|
end;
|
|
end;
|
|
|
|
Buf[I] := #0;
|
|
Result := I > 0;
|
|
end;
|
|
|
|
|
|
function TFormClient.ParseInt(var P: PChar): Integer;
|
|
var
|
|
Tok: array[0..31] of Char;
|
|
begin
|
|
if ParseToken(P, Tok, SizeOf(Tok)) then
|
|
Result := StrToIntDef(StrPas(Tok), 0)
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
|
|
procedure TFormClient.UnescapeString(Src, Dst: PChar; DstSize: Integer);
|
|
var
|
|
I: Integer;
|
|
C: Char;
|
|
begin
|
|
I := 0;
|
|
while (Src^ <> #0) and (I < DstSize - 1) do
|
|
begin
|
|
if (Src^ = '\') and ((Src + 1)^ <> #0) then
|
|
begin
|
|
Inc(Src);
|
|
C := Src^;
|
|
case C of
|
|
'n': C := #10;
|
|
'r': C := #13;
|
|
't': C := #9;
|
|
'"': C := '"';
|
|
'\': C := '\';
|
|
end;
|
|
Dst[I] := C;
|
|
Inc(I);
|
|
end
|
|
else
|
|
begin
|
|
Dst[I] := Src^;
|
|
Inc(I);
|
|
end;
|
|
Inc(Src);
|
|
end;
|
|
Dst[I] := #0;
|
|
end;
|
|
|
|
|
|
procedure TFormClient.EscapeString(Src, Dst: PChar; DstSize: Integer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
I := 0;
|
|
while (Src^ <> #0) and (I < DstSize - 2) do
|
|
begin
|
|
case Src^ of
|
|
'"':
|
|
begin
|
|
if I + 2 > DstSize - 1 then Break;
|
|
Dst[I] := '\'; Inc(I);
|
|
Dst[I] := '"'; Inc(I);
|
|
end;
|
|
'\':
|
|
begin
|
|
if I + 2 > DstSize - 1 then Break;
|
|
Dst[I] := '\'; Inc(I);
|
|
Dst[I] := '\'; Inc(I);
|
|
end;
|
|
#10:
|
|
begin
|
|
if I + 2 > DstSize - 1 then Break;
|
|
Dst[I] := '\'; Inc(I);
|
|
Dst[I] := 'n'; Inc(I);
|
|
end;
|
|
#13:
|
|
begin
|
|
if I + 2 > DstSize - 1 then Break;
|
|
Dst[I] := '\'; Inc(I);
|
|
Dst[I] := 'r'; Inc(I);
|
|
end;
|
|
#9:
|
|
begin
|
|
if I + 2 > DstSize - 1 then Break;
|
|
Dst[I] := '\'; Inc(I);
|
|
Dst[I] := 't'; Inc(I);
|
|
end;
|
|
else
|
|
Dst[I] := Src^;
|
|
Inc(I);
|
|
end;
|
|
Inc(Src);
|
|
end;
|
|
Dst[I] := #0;
|
|
end;
|
|
|
|
|
|
{ ----- Form/control lookup ------------------------------------------------ }
|
|
|
|
function TFormClient.FindForm(FormId: Integer): PFormRec;
|
|
var
|
|
I: Integer;
|
|
FR: PFormRec;
|
|
begin
|
|
Result := nil;
|
|
for I := 0 to FForms.Count - 1 do
|
|
begin
|
|
FR := PFormRec(FForms[I]);
|
|
if FR^.FormId = FormId then
|
|
begin
|
|
Result := FR;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TFormClient.FindCtrl(FR: PFormRec; CtrlId: Integer): PFormCtrlRec;
|
|
var
|
|
I: Integer;
|
|
CR: PFormCtrlRec;
|
|
begin
|
|
Result := nil;
|
|
for I := 0 to FR^.Ctrls.Count - 1 do
|
|
begin
|
|
CR := PFormCtrlRec(FR^.Ctrls[I]);
|
|
if CR^.CtrlId = CtrlId then
|
|
begin
|
|
Result := CR;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFormClient.FreeCtrlRec(CR: PFormCtrlRec);
|
|
begin
|
|
if CR^.Control <> nil then
|
|
CR^.Control.Free;
|
|
Dispose(CR);
|
|
end;
|
|
|
|
|
|
procedure TFormClient.FreeFormRec(FR: PFormRec);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to FR^.Ctrls.Count - 1 do
|
|
FreeCtrlRec(PFormCtrlRec(FR^.Ctrls[I]));
|
|
FR^.Ctrls.Free;
|
|
if FR^.Form <> nil then
|
|
FR^.Form.Free;
|
|
Dispose(FR);
|
|
end;
|
|
|
|
|
|
{ ----- Constructor / Destructor ------------------------------------------- }
|
|
|
|
constructor TFormClient.Create(ATransport: TFormTransport);
|
|
begin
|
|
inherited Create;
|
|
FTransport := ATransport;
|
|
FForms := TList.Create;
|
|
GetMem(FMsgBuf, MaxMsgLen);
|
|
GetMem(FTmpBuf, MaxMsgLen);
|
|
end;
|
|
|
|
|
|
destructor TFormClient.Destroy;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to FForms.Count - 1 do
|
|
FreeFormRec(PFormRec(FForms[I]));
|
|
FForms.Free;
|
|
FreeMem(FMsgBuf, MaxMsgLen);
|
|
FreeMem(FTmpBuf, MaxMsgLen);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
|
|
{ ----- ID encoding in Tag ------------------------------------------------ }
|
|
{ Tag := (FormId shl 16) or CtrlId }
|
|
|
|
{ ----- Event handlers ----------------------------------------------------- }
|
|
|
|
procedure TFormClient.SendEvent(FormId, CtrlId: Integer;
|
|
const EventName: string; const Data: string);
|
|
var
|
|
Msg: string;
|
|
begin
|
|
if Data = '' then
|
|
Msg := 'EVENT ' + IntToStr(FormId) + ' ' + IntToStr(CtrlId) + ' ' + EventName
|
|
else
|
|
Msg := 'EVENT ' + IntToStr(FormId) + ' ' + IntToStr(CtrlId) + ' ' + EventName + ' ' + Data;
|
|
|
|
StrPCopy(FTmpBuf, Msg);
|
|
FTransport.WriteMessage(FTmpBuf, Length(Msg));
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleButtonClick(Sender: TObject);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
SendEvent(FormId, CtrlId, 'Click', '');
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleCheckBoxClick(Sender: TObject);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
SendEvent(FormId, CtrlId, 'Click', '');
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleEditChange(Sender: TObject);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
Escaped: array[0..4095] of Char;
|
|
Txt: string;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
Txt := (Sender as TEdit).Text;
|
|
StrPCopy(FTmpBuf, Txt);
|
|
EscapeString(FTmpBuf, Escaped, SizeOf(Escaped));
|
|
SendEvent(FormId, CtrlId, 'Change', '"' + StrPas(Escaped) + '"');
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleMemoChange(Sender: TObject);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
Escaped: array[0..4095] of Char;
|
|
Txt: string;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
Txt := (Sender as TMemo).Text;
|
|
StrPCopy(FTmpBuf, Txt);
|
|
EscapeString(FTmpBuf, Escaped, SizeOf(Escaped));
|
|
SendEvent(FormId, CtrlId, 'Change', '"' + StrPas(Escaped) + '"');
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleComboBoxChange(Sender: TObject);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
Escaped: array[0..4095] of Char;
|
|
Txt: string;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
Txt := (Sender as TComboBox).Text;
|
|
StrPCopy(FTmpBuf, Txt);
|
|
EscapeString(FTmpBuf, Escaped, SizeOf(Escaped));
|
|
SendEvent(FormId, CtrlId, 'Change', '"' + StrPas(Escaped) + '"');
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleListBoxSelect(Sender: TObject);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
Idx: Integer;
|
|
Escaped: array[0..4095] of Char;
|
|
Txt: string;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
Idx := (Sender as TListBox).ItemIndex;
|
|
if Idx >= 0 then
|
|
Txt := (Sender as TListBox).Items[Idx]
|
|
else
|
|
Txt := '';
|
|
StrPCopy(FTmpBuf, Txt);
|
|
EscapeString(FTmpBuf, Escaped, SizeOf(Escaped));
|
|
SendEvent(FormId, CtrlId, 'Select',
|
|
IntToStr(Idx) + ' "' + StrPas(Escaped) + '"');
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleComboBoxSelect(Sender: TObject);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
Idx: Integer;
|
|
Escaped: array[0..4095] of Char;
|
|
Txt: string;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
Idx := (Sender as TComboBox).ItemIndex;
|
|
if Idx >= 0 then
|
|
Txt := (Sender as TComboBox).Items[Idx]
|
|
else
|
|
Txt := '';
|
|
StrPCopy(FTmpBuf, Txt);
|
|
EscapeString(FTmpBuf, Escaped, SizeOf(Escaped));
|
|
SendEvent(FormId, CtrlId, 'Select',
|
|
IntToStr(Idx) + ' "' + StrPas(Escaped) + '"');
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleDblClick(Sender: TObject);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
SendEvent(FormId, CtrlId, 'DblClick', '');
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleEnter(Sender: TObject);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
SendEvent(FormId, CtrlId, 'Enter', '');
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleExit(Sender: TObject);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
SendEvent(FormId, CtrlId, 'Exit', '');
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
SendEvent(FormId, CtrlId, 'KeyDown', IntToStr(Key));
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleKeyUp(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
SendEvent(FormId, CtrlId, 'KeyUp', IntToStr(Key));
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleMouseDown(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
Btn: Integer;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
Btn := Ord(Button);
|
|
SendEvent(FormId, CtrlId, 'MouseDown',
|
|
IntToStr(X) + ' ' + IntToStr(Y) + ' ' + IntToStr(Btn));
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleMouseUp(Sender: TObject; Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
Btn: Integer;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
Btn := Ord(Button);
|
|
SendEvent(FormId, CtrlId, 'MouseUp',
|
|
IntToStr(X) + ' ' + IntToStr(Y) + ' ' + IntToStr(Btn));
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleMouseMove(Sender: TObject; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
begin
|
|
Tag := (Sender as TControl).Tag;
|
|
FormId := Tag shr 16;
|
|
CtrlId := Tag and $FFFF;
|
|
SendEvent(FormId, CtrlId, 'MouseMove',
|
|
IntToStr(X) + ' ' + IntToStr(Y) + ' 0');
|
|
end;
|
|
|
|
|
|
procedure TFormClient.HandleFormClose(Sender: TObject;
|
|
var Action: TCloseAction);
|
|
var
|
|
Tag: Longint;
|
|
FormId: Integer;
|
|
begin
|
|
Tag := (Sender as TForm).Tag;
|
|
FormId := Tag shr 16;
|
|
SendEvent(FormId, 0, 'Close', '');
|
|
Action := caNone; { Server decides whether to destroy }
|
|
end;
|
|
|
|
|
|
{ ----- Event wiring ------------------------------------------------------- }
|
|
|
|
procedure TFormClient.WireAutoEvents(CR: PFormCtrlRec);
|
|
begin
|
|
case CR^.CtrlType of
|
|
ctButton:
|
|
(CR^.Control as TButton).OnClick := HandleButtonClick;
|
|
ctCheckBox:
|
|
(CR^.Control as TCheckBox).OnClick := HandleCheckBoxClick;
|
|
ctEdit:
|
|
(CR^.Control as TEdit).OnChange := HandleEditChange;
|
|
ctMemo:
|
|
(CR^.Control as TMemo).OnChange := HandleMemoChange;
|
|
ctListBox:
|
|
(CR^.Control as TListBox).OnClick := HandleListBoxSelect;
|
|
ctComboBox:
|
|
begin
|
|
(CR^.Control as TComboBox).OnClick := HandleComboBoxSelect;
|
|
(CR^.Control as TComboBox).OnChange := HandleComboBoxChange;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFormClient.WireOptEvent(CR: PFormCtrlRec; const EventName: string);
|
|
begin
|
|
if EventName = 'DblClick' then
|
|
begin
|
|
(CR^.Control as TControl).OnDblClick := HandleDblClick;
|
|
CR^.Bound := CR^.Bound + [beDblClick];
|
|
end
|
|
else if EventName = 'Enter' then
|
|
begin
|
|
if CR^.Control is TWinControl then
|
|
(CR^.Control as TWinControl).OnEnter := HandleEnter;
|
|
CR^.Bound := CR^.Bound + [beEnter];
|
|
end
|
|
else if EventName = 'Exit' then
|
|
begin
|
|
if CR^.Control is TWinControl then
|
|
(CR^.Control as TWinControl).OnExit := HandleExit;
|
|
CR^.Bound := CR^.Bound + [beExit];
|
|
end
|
|
else if EventName = 'KeyDown' then
|
|
begin
|
|
if CR^.Control is TWinControl then
|
|
(CR^.Control as TWinControl).OnKeyDown := HandleKeyDown;
|
|
CR^.Bound := CR^.Bound + [beKeyDown];
|
|
end
|
|
else if EventName = 'KeyUp' then
|
|
begin
|
|
if CR^.Control is TWinControl then
|
|
(CR^.Control as TWinControl).OnKeyUp := HandleKeyUp;
|
|
CR^.Bound := CR^.Bound + [beKeyUp];
|
|
end
|
|
else if EventName = 'MouseDown' then
|
|
begin
|
|
(CR^.Control as TControl).OnMouseDown := HandleMouseDown;
|
|
CR^.Bound := CR^.Bound + [beMouseDown];
|
|
end
|
|
else if EventName = 'MouseUp' then
|
|
begin
|
|
(CR^.Control as TControl).OnMouseUp := HandleMouseUp;
|
|
CR^.Bound := CR^.Bound + [beMouseUp];
|
|
end
|
|
else if EventName = 'MouseMove' then
|
|
begin
|
|
(CR^.Control as TControl).OnMouseMove := HandleMouseMove;
|
|
CR^.Bound := CR^.Bound + [beMouseMove];
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFormClient.UnwireOptEvent(CR: PFormCtrlRec; const EventName: string);
|
|
begin
|
|
if EventName = 'DblClick' then
|
|
begin
|
|
(CR^.Control as TControl).OnDblClick := nil;
|
|
CR^.Bound := CR^.Bound - [beDblClick];
|
|
end
|
|
else if EventName = 'Enter' then
|
|
begin
|
|
if CR^.Control is TWinControl then
|
|
(CR^.Control as TWinControl).OnEnter := nil;
|
|
CR^.Bound := CR^.Bound - [beEnter];
|
|
end
|
|
else if EventName = 'Exit' then
|
|
begin
|
|
if CR^.Control is TWinControl then
|
|
(CR^.Control as TWinControl).OnExit := nil;
|
|
CR^.Bound := CR^.Bound - [beExit];
|
|
end
|
|
else if EventName = 'KeyDown' then
|
|
begin
|
|
if CR^.Control is TWinControl then
|
|
(CR^.Control as TWinControl).OnKeyDown := nil;
|
|
CR^.Bound := CR^.Bound - [beKeyDown];
|
|
end
|
|
else if EventName = 'KeyUp' then
|
|
begin
|
|
if CR^.Control is TWinControl then
|
|
(CR^.Control as TWinControl).OnKeyUp := nil;
|
|
CR^.Bound := CR^.Bound - [beKeyUp];
|
|
end
|
|
else if EventName = 'MouseDown' then
|
|
begin
|
|
(CR^.Control as TControl).OnMouseDown := nil;
|
|
CR^.Bound := CR^.Bound - [beMouseDown];
|
|
end
|
|
else if EventName = 'MouseUp' then
|
|
begin
|
|
(CR^.Control as TControl).OnMouseUp := nil;
|
|
CR^.Bound := CR^.Bound - [beMouseUp];
|
|
end
|
|
else if EventName = 'MouseMove' then
|
|
begin
|
|
(CR^.Control as TControl).OnMouseMove := nil;
|
|
CR^.Bound := CR^.Bound - [beMouseMove];
|
|
end;
|
|
end;
|
|
|
|
|
|
{ ----- Property application ----------------------------------------------- }
|
|
|
|
procedure TFormClient.ApplyProp(CR: PFormCtrlRec; Key, Value: PChar);
|
|
var
|
|
S: string;
|
|
Unesc: array[0..4095] of Char;
|
|
N: Integer;
|
|
Lines: TStringList;
|
|
P: PChar;
|
|
Start: PChar;
|
|
begin
|
|
S := StrPas(Key);
|
|
|
|
if S = 'Caption' then
|
|
begin
|
|
UnescapeString(Value, Unesc, SizeOf(Unesc));
|
|
case CR^.CtrlType of
|
|
ctLabel: (CR^.Control as TLabel).Caption := StrPas(Unesc);
|
|
ctButton: (CR^.Control as TButton).Caption := StrPas(Unesc);
|
|
ctCheckBox: (CR^.Control as TCheckBox).Caption := StrPas(Unesc);
|
|
end;
|
|
end
|
|
else if S = 'Text' then
|
|
begin
|
|
UnescapeString(Value, Unesc, SizeOf(Unesc));
|
|
case CR^.CtrlType of
|
|
ctEdit: (CR^.Control as TEdit).Text := StrPas(Unesc);
|
|
ctComboBox: (CR^.Control as TComboBox).Text := StrPas(Unesc);
|
|
ctMemo:
|
|
begin
|
|
{ Convert \n to Lines }
|
|
(CR^.Control as TMemo).Lines.Clear;
|
|
Lines := TStringList.Create;
|
|
try
|
|
P := Unesc;
|
|
Start := P;
|
|
while P^ <> #0 do
|
|
begin
|
|
if P^ = #10 then
|
|
begin
|
|
P^ := #0;
|
|
Lines.Add(StrPas(Start));
|
|
Inc(P);
|
|
Start := P;
|
|
end
|
|
else if (P^ = #13) and ((P + 1)^ = #10) then
|
|
begin
|
|
P^ := #0;
|
|
Lines.Add(StrPas(Start));
|
|
Inc(P, 2);
|
|
Start := P;
|
|
end
|
|
else
|
|
Inc(P);
|
|
end;
|
|
if Start^ <> #0 then
|
|
Lines.Add(StrPas(Start));
|
|
(CR^.Control as TMemo).Lines.Assign(Lines);
|
|
finally
|
|
Lines.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
else if S = 'Items' then
|
|
begin
|
|
UnescapeString(Value, Unesc, SizeOf(Unesc));
|
|
case CR^.CtrlType of
|
|
ctListBox:
|
|
begin
|
|
(CR^.Control as TListBox).Items.Clear;
|
|
P := Unesc;
|
|
Start := P;
|
|
while P^ <> #0 do
|
|
begin
|
|
if P^ = #10 then
|
|
begin
|
|
P^ := #0;
|
|
(CR^.Control as TListBox).Items.Add(StrPas(Start));
|
|
Inc(P);
|
|
Start := P;
|
|
end
|
|
else
|
|
Inc(P);
|
|
end;
|
|
if Start^ <> #0 then
|
|
(CR^.Control as TListBox).Items.Add(StrPas(Start));
|
|
end;
|
|
ctComboBox:
|
|
begin
|
|
(CR^.Control as TComboBox).Items.Clear;
|
|
P := Unesc;
|
|
Start := P;
|
|
while P^ <> #0 do
|
|
begin
|
|
if P^ = #10 then
|
|
begin
|
|
P^ := #0;
|
|
(CR^.Control as TComboBox).Items.Add(StrPas(Start));
|
|
Inc(P);
|
|
Start := P;
|
|
end
|
|
else
|
|
Inc(P);
|
|
end;
|
|
if Start^ <> #0 then
|
|
(CR^.Control as TComboBox).Items.Add(StrPas(Start));
|
|
end;
|
|
end;
|
|
end
|
|
else if S = 'Checked' then
|
|
begin
|
|
N := StrToIntDef(StrPas(Value), 0);
|
|
if CR^.CtrlType = ctCheckBox then
|
|
(CR^.Control as TCheckBox).Checked := (N <> 0);
|
|
end
|
|
else if S = 'Enabled' then
|
|
begin
|
|
N := StrToIntDef(StrPas(Value), 1);
|
|
CR^.Control.Enabled := (N <> 0);
|
|
end
|
|
else if S = 'Visible' then
|
|
begin
|
|
N := StrToIntDef(StrPas(Value), 1);
|
|
CR^.Control.Visible := (N <> 0);
|
|
end
|
|
else if S = 'MaxLength' then
|
|
begin
|
|
N := StrToIntDef(StrPas(Value), 0);
|
|
if CR^.CtrlType = ctEdit then
|
|
(CR^.Control as TEdit).MaxLength := N;
|
|
end
|
|
else if S = 'ReadOnly' then
|
|
begin
|
|
N := StrToIntDef(StrPas(Value), 0);
|
|
case CR^.CtrlType of
|
|
ctEdit: (CR^.Control as TEdit).ReadOnly := (N <> 0);
|
|
ctMemo: (CR^.Control as TMemo).ReadOnly := (N <> 0);
|
|
end;
|
|
end
|
|
else if S = 'ScrollBars' then
|
|
begin
|
|
N := StrToIntDef(StrPas(Value), 0);
|
|
if CR^.CtrlType = ctMemo then
|
|
(CR^.Control as TMemo).ScrollBars := TScrollStyle(N);
|
|
end
|
|
else if S = 'TabOrder' then
|
|
begin
|
|
N := StrToIntDef(StrPas(Value), 0);
|
|
if CR^.Control is TWinControl then
|
|
(CR^.Control as TWinControl).TabOrder := N;
|
|
end
|
|
else if S = 'ItemIndex' then
|
|
begin
|
|
N := StrToIntDef(StrPas(Value), -1);
|
|
case CR^.CtrlType of
|
|
ctListBox: (CR^.Control as TListBox).ItemIndex := N;
|
|
ctComboBox: (CR^.Control as TComboBox).ItemIndex := N;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TFormClient.ApplyInlineProps(CR: PFormCtrlRec; P: PChar);
|
|
var
|
|
Token: array[0..4095] of Char;
|
|
Key: array[0..63] of Char;
|
|
Value: array[0..4095] of Char;
|
|
Eq: PChar;
|
|
begin
|
|
{ Parse Key="value" or Key=number pairs }
|
|
while ParseToken(P, Token, SizeOf(Token)) do
|
|
begin
|
|
{ Find '=' in token }
|
|
Eq := StrScan(Token, '=');
|
|
if Eq = nil then
|
|
Continue;
|
|
|
|
{ Split at '=' }
|
|
Eq^ := #0;
|
|
StrCopy(Key, Token);
|
|
|
|
{ Value might be quoted (already unquoted by ParseToken if entire token
|
|
was quoted). But here Key=Value is a single bare token, so the value
|
|
part after '=' needs special handling. }
|
|
|
|
{ Back up P to re-parse the value part properly }
|
|
{ Actually, the token was read as "Key=value" or "Key="value"" }
|
|
{ For Key="value", the quote is part of the remaining stream. }
|
|
{ Let's handle both cases: }
|
|
Inc(Eq);
|
|
if Eq^ = '"' then
|
|
begin
|
|
{ Value starts with quote - was not consumed by ParseToken since the
|
|
whole thing was read as bare token up to space. Actually ParseToken
|
|
reads bare tokens up to space, so Key="val" with no spaces reads as
|
|
one token: Key="val". Strip quotes manually. }
|
|
Inc(Eq);
|
|
StrCopy(Value, Eq);
|
|
{ Strip trailing quote }
|
|
if StrLen(Value) > 0 then
|
|
begin
|
|
if Value[StrLen(Value) - 1] = '"' then
|
|
Value[StrLen(Value) - 1] := #0;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
StrCopy(Value, Eq);
|
|
end;
|
|
|
|
ApplyProp(CR, Key, Value);
|
|
end;
|
|
end;
|
|
|
|
|
|
{ ----- Control type mapping ----------------------------------------------- }
|
|
|
|
function MapTypeName(Name: PChar): TCtrlTypeE;
|
|
var
|
|
S: string;
|
|
begin
|
|
S := StrPas(Name);
|
|
if S = 'Label' then
|
|
Result := ctLabel
|
|
else if S = 'Edit' then
|
|
Result := ctEdit
|
|
else if S = 'Button' then
|
|
Result := ctButton
|
|
else if S = 'CheckBox' then
|
|
Result := ctCheckBox
|
|
else if S = 'ListBox' then
|
|
Result := ctListBox
|
|
else if S = 'ComboBox' then
|
|
Result := ctComboBox
|
|
else if S = 'Memo' then
|
|
Result := ctMemo
|
|
else
|
|
Result := ctUnknown;
|
|
end;
|
|
|
|
|
|
{ ----- Command handlers --------------------------------------------------- }
|
|
|
|
procedure TFormClient.DoFormCreate(P: PChar);
|
|
var
|
|
FR: PFormRec;
|
|
FormId: Integer;
|
|
W: Integer;
|
|
H: Integer;
|
|
Title: array[0..255] of Char;
|
|
begin
|
|
FormId := ParseInt(P);
|
|
W := ParseInt(P);
|
|
H := ParseInt(P);
|
|
if not ParseToken(P, Title, SizeOf(Title)) then
|
|
Title[0] := #0;
|
|
|
|
New(FR);
|
|
FR^.FormId := FormId;
|
|
FR^.Form := TForm.CreateNew(Application);
|
|
FR^.Ctrls := TList.Create;
|
|
|
|
FR^.Form.Caption := StrPas(Title);
|
|
FR^.Form.ClientWidth := W;
|
|
FR^.Form.ClientHeight := H;
|
|
FR^.Form.Position := poScreenCenter;
|
|
FR^.Form.Tag := Longint(FormId) shl 16;
|
|
FR^.Form.OnClose := HandleFormClose;
|
|
|
|
FForms.Add(FR);
|
|
end;
|
|
|
|
|
|
procedure TFormClient.DoFormShow(P: PChar);
|
|
var
|
|
FormId: Integer;
|
|
FR: PFormRec;
|
|
begin
|
|
FormId := ParseInt(P);
|
|
FR := FindForm(FormId);
|
|
if FR <> nil then
|
|
FR^.Form.Show;
|
|
end;
|
|
|
|
|
|
procedure TFormClient.DoFormHide(P: PChar);
|
|
var
|
|
FormId: Integer;
|
|
FR: PFormRec;
|
|
begin
|
|
FormId := ParseInt(P);
|
|
FR := FindForm(FormId);
|
|
if FR <> nil then
|
|
FR^.Form.Hide;
|
|
end;
|
|
|
|
|
|
procedure TFormClient.DoFormDestroy(P: PChar);
|
|
var
|
|
FormId: Integer;
|
|
FR: PFormRec;
|
|
Idx: Integer;
|
|
begin
|
|
FormId := ParseInt(P);
|
|
FR := FindForm(FormId);
|
|
if FR = nil then
|
|
Exit;
|
|
|
|
Idx := FForms.IndexOf(FR);
|
|
if Idx >= 0 then
|
|
FForms.Delete(Idx);
|
|
|
|
FreeFormRec(FR);
|
|
end;
|
|
|
|
|
|
procedure TFormClient.DoCtrlCreate(P: PChar);
|
|
var
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
TypeName: array[0..31] of Char;
|
|
Left: Integer;
|
|
Top: Integer;
|
|
Width: Integer;
|
|
Height: Integer;
|
|
FR: PFormRec;
|
|
CR: PFormCtrlRec;
|
|
CType: TCtrlTypeE;
|
|
Ctrl: TControl;
|
|
begin
|
|
FormId := ParseInt(P);
|
|
CtrlId := ParseInt(P);
|
|
if not ParseToken(P, TypeName, SizeOf(TypeName)) then
|
|
Exit;
|
|
Left := ParseInt(P);
|
|
Top := ParseInt(P);
|
|
Width := ParseInt(P);
|
|
Height := ParseInt(P);
|
|
|
|
FR := FindForm(FormId);
|
|
if FR = nil then
|
|
Exit;
|
|
|
|
CType := MapTypeName(TypeName);
|
|
if CType = ctUnknown then
|
|
Exit;
|
|
|
|
{ Create the control }
|
|
Ctrl := nil;
|
|
case CType of
|
|
ctLabel:
|
|
begin
|
|
Ctrl := TLabel.Create(FR^.Form);
|
|
(Ctrl as TLabel).AutoSize := False;
|
|
end;
|
|
ctEdit:
|
|
Ctrl := TEdit.Create(FR^.Form);
|
|
ctButton:
|
|
Ctrl := TButton.Create(FR^.Form);
|
|
ctCheckBox:
|
|
Ctrl := TCheckBox.Create(FR^.Form);
|
|
ctListBox:
|
|
Ctrl := TListBox.Create(FR^.Form);
|
|
ctComboBox:
|
|
Ctrl := TComboBox.Create(FR^.Form);
|
|
ctMemo:
|
|
Ctrl := TMemo.Create(FR^.Form);
|
|
end;
|
|
|
|
if Ctrl = nil then
|
|
Exit;
|
|
|
|
{ Set parent and geometry }
|
|
if Ctrl is TWinControl then
|
|
(Ctrl as TWinControl).Parent := FR^.Form
|
|
else
|
|
Ctrl.Parent := FR^.Form;
|
|
|
|
Ctrl.Left := Left;
|
|
Ctrl.Top := Top;
|
|
Ctrl.Width := Width;
|
|
Ctrl.Height := Height;
|
|
Ctrl.Tag := (Longint(FormId) shl 16) or CtrlId;
|
|
|
|
{ Create control record }
|
|
New(CR);
|
|
CR^.CtrlId := CtrlId;
|
|
CR^.CtrlType := CType;
|
|
CR^.Control := Ctrl;
|
|
CR^.Bound := [];
|
|
|
|
FR^.Ctrls.Add(CR);
|
|
|
|
{ Wire auto events }
|
|
WireAutoEvents(CR);
|
|
|
|
{ Apply inline properties }
|
|
ApplyInlineProps(CR, P);
|
|
end;
|
|
|
|
|
|
procedure TFormClient.DoCtrlSet(P: PChar);
|
|
var
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
FR: PFormRec;
|
|
CR: PFormCtrlRec;
|
|
begin
|
|
FormId := ParseInt(P);
|
|
CtrlId := ParseInt(P);
|
|
|
|
FR := FindForm(FormId);
|
|
if FR = nil then
|
|
Exit;
|
|
|
|
CR := FindCtrl(FR, CtrlId);
|
|
if CR = nil then
|
|
Exit;
|
|
|
|
ApplyInlineProps(CR, P);
|
|
end;
|
|
|
|
|
|
procedure TFormClient.DoEventBind(P: PChar);
|
|
var
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
EventName: array[0..63] of Char;
|
|
FR: PFormRec;
|
|
CR: PFormCtrlRec;
|
|
begin
|
|
FormId := ParseInt(P);
|
|
CtrlId := ParseInt(P);
|
|
if not ParseToken(P, EventName, SizeOf(EventName)) then
|
|
Exit;
|
|
|
|
FR := FindForm(FormId);
|
|
if FR = nil then
|
|
Exit;
|
|
|
|
CR := FindCtrl(FR, CtrlId);
|
|
if CR = nil then
|
|
Exit;
|
|
|
|
WireOptEvent(CR, StrPas(EventName));
|
|
end;
|
|
|
|
|
|
procedure TFormClient.DoEventUnbind(P: PChar);
|
|
var
|
|
FormId: Integer;
|
|
CtrlId: Integer;
|
|
EventName: array[0..63] of Char;
|
|
FR: PFormRec;
|
|
CR: PFormCtrlRec;
|
|
begin
|
|
FormId := ParseInt(P);
|
|
CtrlId := ParseInt(P);
|
|
if not ParseToken(P, EventName, SizeOf(EventName)) then
|
|
Exit;
|
|
|
|
FR := FindForm(FormId);
|
|
if FR = nil then
|
|
Exit;
|
|
|
|
CR := FindCtrl(FR, CtrlId);
|
|
if CR = nil then
|
|
Exit;
|
|
|
|
UnwireOptEvent(CR, StrPas(EventName));
|
|
end;
|
|
|
|
|
|
{ ----- Command dispatch --------------------------------------------------- }
|
|
|
|
procedure TFormClient.DispatchCommand(Buf: PChar);
|
|
var
|
|
P: PChar;
|
|
Cmd: array[0..31] of Char;
|
|
begin
|
|
P := Buf;
|
|
if not ParseToken(P, Cmd, SizeOf(Cmd)) then
|
|
Exit;
|
|
|
|
if StrComp(Cmd, 'FORM.CREATE') = 0 then
|
|
DoFormCreate(P)
|
|
else if StrComp(Cmd, 'FORM.SHOW') = 0 then
|
|
DoFormShow(P)
|
|
else if StrComp(Cmd, 'FORM.HIDE') = 0 then
|
|
DoFormHide(P)
|
|
else if StrComp(Cmd, 'FORM.DESTROY') = 0 then
|
|
DoFormDestroy(P)
|
|
else if StrComp(Cmd, 'CTRL.CREATE') = 0 then
|
|
DoCtrlCreate(P)
|
|
else if StrComp(Cmd, 'CTRL.SET') = 0 then
|
|
DoCtrlSet(P)
|
|
else if StrComp(Cmd, 'EVENT.BIND') = 0 then
|
|
DoEventBind(P)
|
|
else if StrComp(Cmd, 'EVENT.UNBIND') = 0 then
|
|
DoEventUnbind(P);
|
|
end;
|
|
|
|
|
|
{ ----- Main loop entry point ---------------------------------------------- }
|
|
|
|
procedure TFormClient.ProcessMessages;
|
|
var
|
|
BytesRead: Integer;
|
|
begin
|
|
repeat
|
|
BytesRead := FTransport.ReadMessage(FMsgBuf, MaxMsgLen - 1);
|
|
if BytesRead > 0 then
|
|
begin
|
|
FMsgBuf[BytesRead] := #0;
|
|
DispatchCommand(FMsgBuf);
|
|
end;
|
|
until BytesRead <= 0;
|
|
end;
|
|
|
|
end.
|