AI_Slop/WinComm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions
WinComm/forms/formcli.pas
Scott Duensing dd115d3727 Add BitBtn, SpeedButton, TabSet, Notebook, TabbedNotebook, MaskEdit, Outline, Bevel, Header, and ScrollBox control types 
Completes the Delphi 1.0 Standard, Additional, and Win31 component
palettes. DFM parser maps Tabs/Lines/Pages/Sections.Strings to Items
and TabIndex/PageIndex to ItemIndex. Kind extended with bk* idents
for BitBtn.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>
2026-03-05 15:13:59 -06:00

1997 lines
52 KiB
ObjectPascal
Raw Blame History

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, ExtCtrls, Menus, Buttons, Tabs,
TabNotBk, Mask, Outline, MPlayer, 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,
ctImage, ctGroupBox, ctRadioButton, ctPanel,
ctScrollBar, ctMediaPlayer,
ctMainMenu, ctPopupMenu, ctMenuItem, ctRadioGroup,
ctBitBtn, ctSpeedButton, ctTabSet, ctNotebook,
ctTabbedNotebook, ctMaskEdit, ctOutline, ctBevel,
ctHeader, ctScrollBox);
{ Bound event flags }
TBoundEvent = (beDblClick, beKeyDown, beKeyUp,
beEnter, beExit, beMouseDown, beMouseUp, beMouseMove,
beClick, beNotify);
TBoundEvents = set of TBoundEvent;
{ Per-control record }
PFormCtrlRec = ^TFormCtrlRec;
TFormCtrlRec = record
CtrlId: Integer;
CtrlType: TCtrlTypeE;
Control: TComponent;
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 }
FBasePath: string;
{ 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(FR: PFormRec; CR: PFormCtrlRec; Key, Value: PChar);
procedure ApplyInlineProps(FR: PFormRec; 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);
procedure HandleClick(Sender: TObject);
procedure HandleRadioButtonClick(Sender: TObject);
procedure HandleScrollBarChange(Sender: TObject);
procedure HandleMenuItemClick(Sender: TObject);
procedure HandleMaskEditChange(Sender: TObject);
procedure HandleMediaPlayerNotify(Sender: TObject);
procedure HandleRadioGroupClick(Sender: TObject);
procedure HandleTabSetChange(Sender: TObject);
procedure HandleTabbedNotebookChange(Sender: TObject);
{ 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;
property BasePath: string read FBasePath write FBasePath;
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
{ Menu items are owned by their parent menu and freed automatically }
if CR^.Control <> nil then
begin
if not (CR^.Control is TMenuItem) then
CR^.Control.Free;
end;
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 TComponent).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 TComponent).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 TComponent).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 TComponent).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 TComponent).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 TComponent).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 TComponent).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 TComponent).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 TComponent).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 TComponent).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 TComponent).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 TComponent).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 TComponent).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 TComponent).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 TComponent).Tag;
FormId := Tag shr 16;
CtrlId := Tag and $FFFF;
SendEvent(FormId, CtrlId, 'MouseMove',
IntToStr(X) + ' ' + IntToStr(Y) + ' 0');
end;
procedure TFormClient.HandleClick(Sender: TObject);
var
Tag: Longint;
FormId: Integer;
CtrlId: Integer;
begin
Tag := (Sender as TComponent).Tag;
FormId := Tag shr 16;
CtrlId := Tag and $FFFF;
SendEvent(FormId, CtrlId, 'Click', '');
end;
procedure TFormClient.HandleRadioButtonClick(Sender: TObject);
var
Tag: Longint;
FormId: Integer;
CtrlId: Integer;
begin
Tag := (Sender as TComponent).Tag;
FormId := Tag shr 16;
CtrlId := Tag and $FFFF;
SendEvent(FormId, CtrlId, 'Click', '');
end;
procedure TFormClient.HandleScrollBarChange(Sender: TObject);
var
Tag: Longint;
FormId: Integer;
CtrlId: Integer;
begin
Tag := (Sender as TComponent).Tag;
FormId := Tag shr 16;
CtrlId := Tag and $FFFF;
SendEvent(FormId, CtrlId, 'Change', IntToStr((Sender as TScrollBar).Position));
end;
procedure TFormClient.HandleMediaPlayerNotify(Sender: TObject);
var
Tag: Longint;
FormId: Integer;
CtrlId: Integer;
begin
Tag := (Sender as TComponent).Tag;
FormId := Tag shr 16;
CtrlId := Tag and $FFFF;
SendEvent(FormId, CtrlId, 'Notify', '');
end;
procedure TFormClient.HandleMenuItemClick(Sender: TObject);
var
Tag: Longint;
FormId: Integer;
CtrlId: Integer;
begin
Tag := (Sender as TComponent).Tag;
FormId := Tag shr 16;
CtrlId := Tag and $FFFF;
SendEvent(FormId, CtrlId, 'Click', '');
end;
procedure TFormClient.HandleRadioGroupClick(Sender: TObject);
var
Tag: Longint;
FormId: Integer;
CtrlId: Integer;
begin
Tag := (Sender as TComponent).Tag;
FormId := Tag shr 16;
CtrlId := Tag and $FFFF;
SendEvent(FormId, CtrlId, 'Click', IntToStr((Sender as TRadioGroup).ItemIndex));
end;
procedure TFormClient.HandleTabSetChange(Sender: TObject);
var
Tag: Longint;
FormId: Integer;
CtrlId: Integer;
begin
Tag := (Sender as TComponent).Tag;
FormId := Tag shr 16;
CtrlId := Tag and $FFFF;
SendEvent(FormId, CtrlId, 'Change', IntToStr((Sender as TTabSet).TabIndex));
end;
procedure TFormClient.HandleTabbedNotebookChange(Sender: TObject);
var
Tag: Longint;
FormId: Integer;
CtrlId: Integer;
begin
Tag := (Sender as TComponent).Tag;
FormId := Tag shr 16;
CtrlId := Tag and $FFFF;
SendEvent(FormId, CtrlId, 'Change', IntToStr((Sender as TTabbedNotebook).PageIndex));
end;
procedure TFormClient.HandleMaskEditChange(Sender: TObject);
var
Tag: Longint;
FormId: Integer;
CtrlId: Integer;
Escaped: array[0..4095] of Char;
Txt: string;
begin
Tag := (Sender as TComponent).Tag;
FormId := Tag shr 16;
CtrlId := Tag and $FFFF;
Txt := (Sender as TMaskEdit).Text;
StrPCopy(FTmpBuf, Txt);
EscapeString(FTmpBuf, Escaped, SizeOf(Escaped));
SendEvent(FormId, CtrlId, 'Change', '"' + StrPas(Escaped) + '"');
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;
ctRadioButton:
(CR^.Control as TRadioButton).OnClick := HandleRadioButtonClick;
ctScrollBar:
(CR^.Control as TScrollBar).OnChange := HandleScrollBarChange;
ctMenuItem:
(CR^.Control as TMenuItem).OnClick := HandleMenuItemClick;
ctRadioGroup:
(CR^.Control as TRadioGroup).OnClick := HandleRadioGroupClick;
ctBitBtn:
(CR^.Control as TBitBtn).OnClick := HandleButtonClick;
ctSpeedButton:
(CR^.Control as TSpeedButton).OnClick := HandleButtonClick;
ctTabSet:
(CR^.Control as TTabSet).OnChange := HandleTabSetChange;
ctTabbedNotebook:
(CR^.Control as TTabbedNotebook).OnChange := HandleTabbedNotebookChange;
ctMaskEdit:
(CR^.Control as TMaskEdit).OnChange := HandleMaskEditChange;
end;
end;
procedure TFormClient.WireOptEvent(CR: PFormCtrlRec; const EventName: string);
begin
if EventName = 'DblClick' then
begin
if CR^.Control is TControl then
(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
if CR^.Control is TControl then
(CR^.Control as TControl).OnMouseDown := HandleMouseDown;
CR^.Bound := CR^.Bound + [beMouseDown];
end
else if EventName = 'MouseUp' then
begin
if CR^.Control is TControl then
(CR^.Control as TControl).OnMouseUp := HandleMouseUp;
CR^.Bound := CR^.Bound + [beMouseUp];
end
else if EventName = 'MouseMove' then
begin
if CR^.Control is TControl then
(CR^.Control as TControl).OnMouseMove := HandleMouseMove;
CR^.Bound := CR^.Bound + [beMouseMove];
end
else if EventName = 'Click' then
begin
if CR^.Control is TImage then
(CR^.Control as TImage).OnClick := HandleClick
else if CR^.Control is TPanel then
(CR^.Control as TPanel).OnClick := HandleClick
else if CR^.Control is TGroupBox then
(CR^.Control as TGroupBox).OnClick := HandleClick;
CR^.Bound := CR^.Bound + [beClick];
end
else if EventName = 'Notify' then
begin
if CR^.Control is TMediaPlayer then
(CR^.Control as TMediaPlayer).OnNotify := HandleMediaPlayerNotify;
CR^.Bound := CR^.Bound + [beNotify];
end;
end;
procedure TFormClient.UnwireOptEvent(CR: PFormCtrlRec; const EventName: string);
begin
if EventName = 'DblClick' then
begin
if CR^.Control is TControl then
(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
if CR^.Control is TControl then
(CR^.Control as TControl).OnMouseDown := nil;
CR^.Bound := CR^.Bound - [beMouseDown];
end
else if EventName = 'MouseUp' then
begin
if CR^.Control is TControl then
(CR^.Control as TControl).OnMouseUp := nil;
CR^.Bound := CR^.Bound - [beMouseUp];
end
else if EventName = 'MouseMove' then
begin
if CR^.Control is TControl then
(CR^.Control as TControl).OnMouseMove := nil;
CR^.Bound := CR^.Bound - [beMouseMove];
end
else if EventName = 'Click' then
begin
if CR^.Control is TImage then
(CR^.Control as TImage).OnClick := nil
else if CR^.Control is TPanel then
(CR^.Control as TPanel).OnClick := nil
else if CR^.Control is TGroupBox then
(CR^.Control as TGroupBox).OnClick := nil;
CR^.Bound := CR^.Bound - [beClick];
end
else if EventName = 'Notify' then
begin
if CR^.Control is TMediaPlayer then
(CR^.Control as TMediaPlayer).OnNotify := nil;
CR^.Bound := CR^.Bound - [beNotify];
end;
end;
{ ----- Property application ----------------------------------------------- }
procedure TFormClient.ApplyProp(FR: PFormRec; CR: PFormCtrlRec; Key, Value: PChar);
var
S: string;
Unesc: array[0..4095] of Char;
N: Integer;
Lines: TStringList;
P: PChar;
Start: PChar;
PCR: PFormCtrlRec;
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);
ctGroupBox: (CR^.Control as TGroupBox).Caption := StrPas(Unesc);
ctRadioButton: (CR^.Control as TRadioButton).Caption := StrPas(Unesc);
ctPanel: (CR^.Control as TPanel).Caption := StrPas(Unesc);
ctMenuItem: (CR^.Control as TMenuItem).Caption := StrPas(Unesc);
ctRadioGroup: (CR^.Control as TRadioGroup).Caption := StrPas(Unesc);
ctBitBtn: (CR^.Control as TBitBtn).Caption := StrPas(Unesc);
ctSpeedButton: (CR^.Control as TSpeedButton).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);
ctMaskEdit: (CR^.Control as TMaskEdit).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;
ctRadioGroup:
begin
(CR^.Control as TRadioGroup).Items.Clear;
P := Unesc;
Start := P;
while P^ <> #0 do
begin
if P^ = #10 then
begin
P^ := #0;
(CR^.Control as TRadioGroup).Items.Add(StrPas(Start));
Inc(P);
Start := P;
end
else
Inc(P);
end;
if Start^ <> #0 then
(CR^.Control as TRadioGroup).Items.Add(StrPas(Start));
end;
ctTabSet:
begin
(CR^.Control as TTabSet).Tabs.Clear;
P := Unesc;
Start := P;
while P^ <> #0 do
begin
if P^ = #10 then
begin
P^ := #0;
(CR^.Control as TTabSet).Tabs.Add(StrPas(Start));
Inc(P);
Start := P;
end
else
Inc(P);
end;
if Start^ <> #0 then
(CR^.Control as TTabSet).Tabs.Add(StrPas(Start));
end;
ctNotebook:
begin
(CR^.Control as TNotebook).Pages.Clear;
P := Unesc;
Start := P;
while P^ <> #0 do
begin
if P^ = #10 then
begin
P^ := #0;
(CR^.Control as TNotebook).Pages.Add(StrPas(Start));
Inc(P);
Start := P;
end
else
Inc(P);
end;
if Start^ <> #0 then
(CR^.Control as TNotebook).Pages.Add(StrPas(Start));
end;
ctTabbedNotebook:
begin
(CR^.Control as TTabbedNotebook).Pages.Clear;
P := Unesc;
Start := P;
while P^ <> #0 do
begin
if P^ = #10 then
begin
P^ := #0;
(CR^.Control as TTabbedNotebook).Pages.Add(StrPas(Start));
Inc(P);
Start := P;
end
else
Inc(P);
end;
if Start^ <> #0 then
(CR^.Control as TTabbedNotebook).Pages.Add(StrPas(Start));
end;
ctOutline:
begin
(CR^.Control as TOutline).Lines.Clear;
P := Unesc;
Start := P;
while P^ <> #0 do
begin
if P^ = #10 then
begin
P^ := #0;
(CR^.Control as TOutline).Lines.Add(StrPas(Start));
Inc(P);
Start := P;
end
else
Inc(P);
end;
if Start^ <> #0 then
(CR^.Control as TOutline).Lines.Add(StrPas(Start));
end;
ctHeader:
begin
(CR^.Control as THeader).Sections.Clear;
P := Unesc;
Start := P;
while P^ <> #0 do
begin
if P^ = #10 then
begin
P^ := #0;
(CR^.Control as THeader).Sections.Add(StrPas(Start));
Inc(P);
Start := P;
end
else
Inc(P);
end;
if Start^ <> #0 then
(CR^.Control as THeader).Sections.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)
else if CR^.CtrlType = ctRadioButton then
(CR^.Control as TRadioButton).Checked := (N <> 0)
else if CR^.CtrlType = ctMenuItem then
(CR^.Control as TMenuItem).Checked := (N <> 0);
end
else if S = 'Enabled' then
begin
N := StrToIntDef(StrPas(Value), 1);
if CR^.Control is TControl then
(CR^.Control as TControl).Enabled := (N <> 0)
else if CR^.Control is TMenuItem then
(CR^.Control as TMenuItem).Enabled := (N <> 0);
end
else if S = 'Visible' then
begin
N := StrToIntDef(StrPas(Value), 1);
if CR^.Control is TControl then
(CR^.Control as TControl).Visible := (N <> 0)
else if CR^.Control is TMenuItem then
(CR^.Control as TMenuItem).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
else if CR^.CtrlType = ctMaskEdit then
(CR^.Control as TMaskEdit).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;
ctRadioGroup: (CR^.Control as TRadioGroup).ItemIndex := N;
ctTabSet: (CR^.Control as TTabSet).TabIndex := N;
ctNotebook: (CR^.Control as TNotebook).PageIndex := N;
ctTabbedNotebook: (CR^.Control as TTabbedNotebook).PageIndex := N;
end;
end
else if S = 'Stretch' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctImage then
(CR^.Control as TImage).Stretch := (N <> 0);
end
else if S = 'Center' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctImage then
(CR^.Control as TImage).Center := (N <> 0);
end
else if S = 'Transparent' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctImage then
(CR^.Control as TImage).Transparent := (N <> 0);
end
else if S = 'Picture' then
begin
if CR^.CtrlType = ctImage then
begin
UnescapeString(Value, Unesc, SizeOf(Unesc));
try
if FBasePath <> '' then
(CR^.Control as TImage).Picture.LoadFromFile(FBasePath + '\' + StrPas(Unesc))
else
(CR^.Control as TImage).Picture.LoadFromFile(StrPas(Unesc));
except
end;
end;
end
else if S = 'BevelOuter' then
begin
N := StrToIntDef(StrPas(Value), 1);
if CR^.CtrlType = ctPanel then
(CR^.Control as TPanel).BevelOuter := TBevelCut(N);
end
else if S = 'BevelInner' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctPanel then
(CR^.Control as TPanel).BevelInner := TBevelCut(N);
end
else if S = 'BorderStyle' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctPanel then
(CR^.Control as TPanel).BorderStyle := TBorderStyle(N);
end
else if S = 'Kind' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctScrollBar then
(CR^.Control as TScrollBar).Kind := TScrollBarKind(N)
else if CR^.CtrlType = ctBitBtn then
(CR^.Control as TBitBtn).Kind := TBitBtnKind(N);
end
else if S = 'Min' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctScrollBar then
(CR^.Control as TScrollBar).Min := N;
end
else if S = 'Max' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctScrollBar then
(CR^.Control as TScrollBar).Max := N;
end
else if S = 'Position' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctScrollBar then
(CR^.Control as TScrollBar).Position := N;
end
else if S = 'LargeChange' then
begin
N := StrToIntDef(StrPas(Value), 1);
if CR^.CtrlType = ctScrollBar then
(CR^.Control as TScrollBar).LargeChange := N;
end
else if S = 'SmallChange' then
begin
N := StrToIntDef(StrPas(Value), 1);
if CR^.CtrlType = ctScrollBar then
(CR^.Control as TScrollBar).SmallChange := N;
end
else if S = 'FileName' then
begin
if CR^.CtrlType = ctMediaPlayer then
begin
UnescapeString(Value, Unesc, SizeOf(Unesc));
if FBasePath <> '' then
(CR^.Control as TMediaPlayer).FileName := FBasePath + '\' + StrPas(Unesc)
else
(CR^.Control as TMediaPlayer).FileName := StrPas(Unesc);
end;
end
else if S = 'DeviceType' then
begin
if CR^.CtrlType = ctMediaPlayer then
begin
UnescapeString(Value, Unesc, SizeOf(Unesc));
S := StrPas(Unesc);
if S = 'dtAutoSelect' then
(CR^.Control as TMediaPlayer).DeviceType := dtAutoSelect
else if S = 'dtAVIVideo' then
(CR^.Control as TMediaPlayer).DeviceType := dtAVIVideo
else if S = 'dtCDAudio' then
(CR^.Control as TMediaPlayer).DeviceType := dtCDAudio
else if S = 'dtDAT' then
(CR^.Control as TMediaPlayer).DeviceType := dtDAT
else if S = 'dtDigitalVideo' then
(CR^.Control as TMediaPlayer).DeviceType := dtDigitalVideo
else if S = 'dtMMMovie' then
(CR^.Control as TMediaPlayer).DeviceType := dtMMMovie
else if S = 'dtOther' then
(CR^.Control as TMediaPlayer).DeviceType := dtOther
else if S = 'dtOverlay' then
(CR^.Control as TMediaPlayer).DeviceType := dtOverlay
else if S = 'dtScanner' then
(CR^.Control as TMediaPlayer).DeviceType := dtScanner
else if S = 'dtSequencer' then
(CR^.Control as TMediaPlayer).DeviceType := dtSequencer
else if S = 'dtVCR' then
(CR^.Control as TMediaPlayer).DeviceType := dtVCR
else if S = 'dtVideodisc' then
(CR^.Control as TMediaPlayer).DeviceType := dtVideodisc
else if S = 'dtWaveAudio' then
(CR^.Control as TMediaPlayer).DeviceType := dtWaveAudio
else
(CR^.Control as TMediaPlayer).DeviceType := dtAutoSelect;
end;
end
else if S = 'AutoOpen' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctMediaPlayer then
(CR^.Control as TMediaPlayer).AutoOpen := (N <> 0);
end
else if S = 'Command' then
begin
if CR^.CtrlType = ctMediaPlayer then
begin
UnescapeString(Value, Unesc, SizeOf(Unesc));
S := StrPas(Unesc);
try
if S = 'Open' then
(CR^.Control as TMediaPlayer).Open
else if S = 'Play' then
(CR^.Control as TMediaPlayer).Play
else if S = 'Stop' then
(CR^.Control as TMediaPlayer).Stop
else if S = 'Close' then
(CR^.Control as TMediaPlayer).Close
else if S = 'Pause' then
(CR^.Control as TMediaPlayer).Pause
else if S = 'Resume' then
(CR^.Control as TMediaPlayer).Resume
else if S = 'Rewind' then
(CR^.Control as TMediaPlayer).Rewind
else if S = 'Next' then
(CR^.Control as TMediaPlayer).Next
else if S = 'Previous' then
(CR^.Control as TMediaPlayer).Previous;
except
end;
end;
end
else if S = 'Parent' then
begin
if CR^.CtrlType = ctMenuItem then
begin
N := StrToIntDef(StrPas(Value), 0);
PCR := FindCtrl(FR, N);
if PCR <> nil then
begin
if PCR^.Control is TMenu then
(PCR^.Control as TMenu).Items.Add(CR^.Control as TMenuItem)
else if PCR^.Control is TMenuItem then
(PCR^.Control as TMenuItem).Add(CR^.Control as TMenuItem);
end;
end;
end
else if S = 'Columns' then
begin
N := StrToIntDef(StrPas(Value), 1);
if CR^.CtrlType = ctRadioGroup then
(CR^.Control as TRadioGroup).Columns := N;
end
else if S = 'ShortCut' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctMenuItem then
(CR^.Control as TMenuItem).ShortCut := N;
end
else if S = 'PopupMenu' then
begin
N := StrToIntDef(StrPas(Value), 0);
PCR := FindCtrl(FR, N);
if (PCR <> nil) and (PCR^.Control is TPopupMenu) and (CR^.Control is TControl) then
(CR^.Control as TControl).PopupMenu := PCR^.Control as TPopupMenu;
end
else if S = 'Layout' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctBitBtn then
(CR^.Control as TBitBtn).Layout := TButtonLayout(N)
else if CR^.CtrlType = ctSpeedButton then
(CR^.Control as TSpeedButton).Layout := TButtonLayout(N);
end
else if S = 'NumGlyphs' then
begin
N := StrToIntDef(StrPas(Value), 1);
if CR^.CtrlType = ctBitBtn then
(CR^.Control as TBitBtn).NumGlyphs := N
else if CR^.CtrlType = ctSpeedButton then
(CR^.Control as TSpeedButton).NumGlyphs := N;
end
else if S = 'GroupIndex' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctSpeedButton then
(CR^.Control as TSpeedButton).GroupIndex := N;
end
else if S = 'Down' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctSpeedButton then
(CR^.Control as TSpeedButton).Down := (N <> 0);
end
else if S = 'AllowAllUp' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctSpeedButton then
(CR^.Control as TSpeedButton).AllowAllUp := (N <> 0);
end
else if S = 'EditMask' then
begin
if CR^.CtrlType = ctMaskEdit then
begin
UnescapeString(Value, Unesc, SizeOf(Unesc));
(CR^.Control as TMaskEdit).EditMask := StrPas(Unesc);
end;
end
else if S = 'OutlineStyle' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctOutline then
(CR^.Control as TOutline).OutlineStyle := TOutlineStyle(N);
end
else if S = 'Shape' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctBevel then
(CR^.Control as TBevel).Shape := TBevelShape(N);
end
else if S = 'Style' then
begin
N := StrToIntDef(StrPas(Value), 0);
if CR^.CtrlType = ctBevel then
(CR^.Control as TBevel).Style := TBevelStyle(N);
end;
end;
procedure TFormClient.ApplyInlineProps(FR: PFormRec; 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(FR, 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 if S = 'Image' then
Result := ctImage
else if S = 'GroupBox' then
Result := ctGroupBox
else if S = 'RadioButton' then
Result := ctRadioButton
else if S = 'Panel' then
Result := ctPanel
else if S = 'ScrollBar' then
Result := ctScrollBar
else if S = 'MediaPlayer' then
Result := ctMediaPlayer
else if S = 'MainMenu' then
Result := ctMainMenu
else if S = 'PopupMenu' then
Result := ctPopupMenu
else if S = 'MenuItem' then
Result := ctMenuItem
else if S = 'RadioGroup' then
Result := ctRadioGroup
else if S = 'BitBtn' then
Result := ctBitBtn
else if S = 'SpeedButton' then
Result := ctSpeedButton
else if S = 'TabSet' then
Result := ctTabSet
else if S = 'Notebook' then
Result := ctNotebook
else if S = 'TabbedNotebook' then
Result := ctTabbedNotebook
else if S = 'MaskEdit' then
Result := ctMaskEdit
else if S = 'Outline' then
Result := ctOutline
else if S = 'Bevel' then
Result := ctBevel
else if S = 'Header' then
Result := ctHeader
else if S = 'ScrollBox' then
Result := ctScrollBox
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;
Comp: TComponent;
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 }
Comp := nil;
case CType of
ctLabel:
begin
Comp := TLabel.Create(FR^.Form);
(Comp as TLabel).AutoSize := False;
end;
ctEdit:
Comp := TEdit.Create(FR^.Form);
ctButton:
Comp := TButton.Create(FR^.Form);
ctCheckBox:
Comp := TCheckBox.Create(FR^.Form);
ctListBox:
Comp := TListBox.Create(FR^.Form);
ctComboBox:
Comp := TComboBox.Create(FR^.Form);
ctMemo:
Comp := TMemo.Create(FR^.Form);
ctImage:
begin
Comp := TImage.Create(FR^.Form);
(Comp as TImage).AutoSize := False;
end;
ctGroupBox:
Comp := TGroupBox.Create(FR^.Form);
ctRadioButton:
Comp := TRadioButton.Create(FR^.Form);
ctPanel:
Comp := TPanel.Create(FR^.Form);
ctScrollBar:
Comp := TScrollBar.Create(FR^.Form);
ctMediaPlayer:
Comp := TMediaPlayer.Create(FR^.Form);
ctMainMenu:
begin
Comp := TMainMenu.Create(FR^.Form);
FR^.Form.Menu := Comp as TMainMenu;
end;
ctPopupMenu:
Comp := TPopupMenu.Create(FR^.Form);
ctMenuItem:
Comp := TMenuItem.Create(FR^.Form);
ctRadioGroup:
Comp := TRadioGroup.Create(FR^.Form);
ctBitBtn:
Comp := TBitBtn.Create(FR^.Form);
ctSpeedButton:
Comp := TSpeedButton.Create(FR^.Form);
ctTabSet:
Comp := TTabSet.Create(FR^.Form);
ctNotebook:
Comp := TNotebook.Create(FR^.Form);
ctTabbedNotebook:
Comp := TTabbedNotebook.Create(FR^.Form);
ctMaskEdit:
Comp := TMaskEdit.Create(FR^.Form);
ctOutline:
Comp := TOutline.Create(FR^.Form);
ctBevel:
Comp := TBevel.Create(FR^.Form);
ctHeader:
Comp := THeader.Create(FR^.Form);
ctScrollBox:
Comp := TScrollBox.Create(FR^.Form);
end;
if Comp = nil then
Exit;
{ Set parent and geometry for visual controls }
if Comp is TWinControl then
begin
(Comp as TWinControl).Parent := FR^.Form;
(Comp as TControl).Left := Left;
(Comp as TControl).Top := Top;
(Comp as TControl).Width := Width;
(Comp as TControl).Height := Height;
end
else if Comp is TControl then
begin
(Comp as TControl).Parent := FR^.Form;
(Comp as TControl).Left := Left;
(Comp as TControl).Top := Top;
(Comp as TControl).Width := Width;
(Comp as TControl).Height := Height;
end;
{ else: non-visual (menus, menu items) — no parent or geometry }
Comp.Tag := (Longint(FormId) shl 16) or CtrlId;
{ Create control record }
New(CR);
CR^.CtrlId := CtrlId;
CR^.CtrlType := CType;
CR^.Control := Comp;
CR^.Bound := [];
FR^.Ctrls.Add(CR);
{ Wire auto events }
WireAutoEvents(CR);
{ Apply inline properties }
ApplyInlineProps(FR, 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(FR, 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.
Reference in a new issue View git blame Copy permalink