report mouse over api

This commit is contained in:
April Ayres-Griffiths 2019-04-02 19:44:27 +11:00
parent 72a3aa2024
commit 407c37545a
10 changed files with 917 additions and 78 deletions

View File

@ -1,7 +1,7 @@
object GUIForm: TGUIForm
Left = 589
Left = 2353
Height = 491
Top = 177
Top = 125
Width = 807
AlphaBlendValue = 128
Caption = 'MicroM8 Simple GUI Prototype'
@ -144,128 +144,220 @@ object GUIForm: TGUIForm
Caption = 'Video'
object miScanLineInt: TMenuItem
Caption = 'Scanline Intensity'
OnClick = miScanLineIntClick
object miSLI0: TMenuItem
Caption = '0'
RadioItem = True
OnClick = miSLIClick
end
object miSLI1: TMenuItem
Caption = '1'
RadioItem = True
OnClick = miSLIClick
end
object miSLI2: TMenuItem
Caption = '2'
RadioItem = True
OnClick = miSLIClick
end
object miSLI3: TMenuItem
Caption = '3'
RadioItem = True
OnClick = miSLIClick
end
object miSLI4: TMenuItem
Caption = '4'
RadioItem = True
OnClick = miSLIClick
end
object miSLI5: TMenuItem
Caption = '5'
RadioItem = True
OnClick = miSLIClick
end
object miSLI6: TMenuItem
Caption = '6'
RadioItem = True
OnClick = miSLIClick
end
object miSLI7: TMenuItem
Caption = '7'
RadioItem = True
OnClick = miSLIClick
end
object miSLI8: TMenuItem
Caption = '8'
RadioItem = True
OnClick = miSLIClick
end
object miSLI9: TMenuItem
Caption = '9'
RadioItem = True
OnClick = miSLIClick
end
end
object miGRRenderMode: TMenuItem
Caption = 'GR Render Mode'
OnClick = miGRRenderModeClick
object miGRVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miGRVoxelsClick
end
object miGRRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miGRRasterClick
end
end
object MenuItem15: TMenuItem
Caption = 'HGR Render Mode'
OnClick = MenuItem15Click
object miColorDots: TMenuItem
Caption = 'Color Dots'
RadioItem = True
OnClick = miColorDotsClick
end
object miColorVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miColorVoxelsClick
end
object miColorRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miColorRasterClick
end
object miMonoDots: TMenuItem
Caption = 'Mono Dots'
RadioItem = True
OnClick = miMonoDotsClick
end
object miMonoVoxels: TMenuItem
Caption = 'Mono Voxels'
RadioItem = True
OnClick = miMonoVoxelsClick
end
object miMonoRaster: TMenuItem
Caption = 'Mono Raster'
RadioItem = True
OnClick = miMonoRasterClick
end
end
object MenuItem16: TMenuItem
Caption = 'DHGR Render Mode'
OnClick = MenuItem16Click
object miDHRColorDots: TMenuItem
Caption = 'Color Dots'
RadioItem = True
OnClick = miDHRColorDotsClick
end
object miDHRColorVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miDHRColorVoxelsClick
end
object miDHRColorRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miDHRColorRasterClick
end
object miDHRMonoDots: TMenuItem
Caption = 'Mono Dots'
RadioItem = True
OnClick = miDHRMonoDotsClick
end
object miDHRMonoVoxels: TMenuItem
Caption = 'Mono Voxels'
RadioItem = True
OnClick = miDHRMonoVoxelsClick
end
object miDHRMonoRaster: TMenuItem
Caption = 'Mono Raster'
RadioItem = True
OnClick = miDHRMonoRasterClick
end
object N1: TMenuItem
Caption = '-'
end
object miDHGREN: TMenuItem
Caption = 'Enhanced Mode'
OnClick = miDHGRENClick
object miDHREMAuto: TMenuItem
Caption = 'Autodetect'
RadioItem = True
OnClick = miDHREMAutoClick
end
object miDHREMOn: TMenuItem
Caption = 'On'
RadioItem = True
OnClick = miDHREMOnClick
end
object miDHREMOff: TMenuItem
Caption = 'Off'
RadioItem = True
OnClick = miDHREMOffClick
end
end
end
object miSHR: TMenuItem
Caption = 'SuperHires Render Mode'
OnClick = miSHRClick
object miSHRColorDots: TMenuItem
Caption = 'Color Dots'
RadioItem = True
OnClick = miSHRColorDotsClick
end
object miSHRColorVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miSHRColorVoxelsClick
end
object miSHRColorRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miSHRColorRasterClick
end
end
end
object Input: TMenuItem
Caption = 'Input'
object miINPAllCaps: TMenuItem
Caption = 'All Caps'
end
object miINPJoystick: TMenuItem
Caption = 'Joystick'
end
object miINPMouseMode: TMenuItem
Caption = 'Mouse Mode'
OnClick = miINPMouseModeClick
object miINPMMJoystick: TMenuItem
Caption = 'Joystick'
RadioItem = True
OnClick = miINPMMJoystickClick
end
object miINPMMDPAD: TMenuItem
Caption = 'D-Pad'
RadioItem = True
OnClick = miINPMMDPADClick
end
object miINPMMGEOS: TMenuItem
Caption = 'GEOS'
RadioItem = True
OnClick = miINPMMGEOSClick
end
object miINPMMDDraw: TMenuItem
Caption = 'Dazzle Draw'
RadioItem = True
OnClick = miINPMMDDrawClick
end
object miINPMMOff: TMenuItem
Caption = 'Off'
RadioItem = True
OnClick = miINPMMOffClick
end
end
end
end
object ImageList1: TImageList
Height = 48
@ -2227,4 +2319,10 @@ object GUIForm: TGUIForm
left = 111
top = 327
end
object MouseTimer: TTimer
Interval = 50
OnTimer = MouseTimerTimer
left = 187
top = 387
end
end

View File

@ -26,6 +26,20 @@ type
MenuItem11: TMenuItem;
MenuItem12: TMenuItem;
MenuItem13: TMenuItem;
miDHGREN: TMenuItem;
Input: TMenuItem;
miINPMMOff: TMenuItem;
miINPMMDDraw: TMenuItem;
miINPMMGEOS: TMenuItem;
miINPMMDPAD: TMenuItem;
miINPMMJoystick: TMenuItem;
miINPJoystick: TMenuItem;
miINPAllCaps: TMenuItem;
miINPMouseMode: TMenuItem;
miDHREMAuto: TMenuItem;
miDHREMOn: TMenuItem;
miDHREMOff: TMenuItem;
N1: TMenuItem;
miSHRColorRaster: TMenuItem;
miSHRColorVoxels: TMenuItem;
miSHRColorDots: TMenuItem;
@ -84,6 +98,7 @@ type
StatusBar1: TStatusBar;
hc: TFPHttpClient;
CheckTimer: TTimer;
MouseTimer: TTimer;
ToolBar1: TToolBar;
procedure BackdropImageClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
@ -100,6 +115,8 @@ type
procedure FormShow(Sender: TObject);
procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure FormWindowStateChange(Sender: TObject);
procedure MenuItem15Click(Sender: TObject);
procedure MenuItem16Click(Sender: TObject);
procedure MenuItem1Click(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
procedure Freeze;
@ -110,27 +127,43 @@ type
procedure miD1FileClick(Sender: TObject);
procedure miD2BlankClick(Sender: TObject);
procedure miD2FileClick(Sender: TObject);
procedure miDHGRENClick(Sender: TObject);
procedure miDHRColorDotsClick(Sender: TObject);
procedure miDHRColorRasterClick(Sender: TObject);
procedure miDHRColorVoxelsClick(Sender: TObject);
procedure miDHREMAutoClick(Sender: TObject);
procedure miDHREMOffClick(Sender: TObject);
procedure miDHREMOnClick(Sender: TObject);
procedure miDHRMonoDotsClick(Sender: TObject);
procedure miDHRMonoRasterClick(Sender: TObject);
procedure miDHRMonoVoxelsClick(Sender: TObject);
procedure miFileCatClick(Sender: TObject);
procedure miGRRasterClick(Sender: TObject);
procedure miGRRenderModeClick(Sender: TObject);
procedure miGRVoxelsClick(Sender: TObject);
procedure miINPMMDDrawClick(Sender: TObject);
procedure miINPMMDPADClick(Sender: TObject);
procedure miINPMMGEOSClick(Sender: TObject);
procedure miINPMMJoystickClick(Sender: TObject);
procedure miINPMMOffClick(Sender: TObject);
procedure miINPMouseModeClick(Sender: TObject);
procedure miINPMouseModeDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; AState: TOwnerDrawState);
procedure miIntFPClick(Sender: TObject);
procedure miIntINTClick(Sender: TObject);
procedure miIntLOGOClick(Sender: TObject);
procedure miMonoDotsClick(Sender: TObject);
procedure miMonoRasterClick(Sender: TObject);
procedure miMonoVoxelsClick(Sender: TObject);
procedure miScanLineIntClick(Sender: TObject);
procedure miSHRClick(Sender: TObject);
procedure miSHRColorDotsClick(Sender: TObject);
procedure miSHRColorRasterClick(Sender: TObject);
procedure miSHRColorVoxelsClick(Sender: TObject);
procedure miSLIClick(Sender: TObject);
procedure miSPEjectClick(Sender: TObject);
procedure miSPFileClick(Sender: TObject);
procedure MouseTimerTimer(Sender: TObject);
procedure UnFreeze;
procedure HideM8;
procedure menuRebootVMClick(Sender: TObject);
@ -147,11 +180,14 @@ type
procedure ToolButton5Click(Sender: TObject);
procedure InsertDisk(Filename: string; Drive: integer);
procedure UpdateConfig(path: string; value: string; persist: boolean);
function GetConfig(path: string): string;
procedure SendMouseState(x, y: longint);
private
lx, ly, lw, lh: integer;
lastShowTime: TDateTime;
lastHideTime: TDateTime;
hidden: boolean;
lastMouseX, lastMouseY: longint;
public
procedure AppActivate(Sender: TObject);
procedure AppDeactivate(Sender: TObject);
@ -255,6 +291,23 @@ begin
ShowM8;
end;
procedure TGUIForm.miDHGRENClick(Sender: TObject);
var
value: string;
begin
// DHGR Enhanced menu
value := GetConfig('video/init.video.dhgrhighbit');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'0': miDHREMAuto.Checked := true;
'1': miDHREMOff.Checked := true;
'2': miDHREMOn.Checked := true;
end;
end;
end;
procedure TGUIForm.miDHRColorDotsClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.dhgrmode', '0', true );
@ -270,6 +323,27 @@ begin
UpdateConfig( 'video/init.video.dhgrmode', '1', true );
end;
{
DHB_MIXED_AUTO = 0
DHB_MIXED_ON = 1
DHB_MIXED_OFF = 2
}
procedure TGUIForm.miDHREMAutoClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.dhgrhighbit', '0', true );
end;
procedure TGUIForm.miDHREMOffClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.dhgrhighbit', '2', true );
end;
procedure TGUIForm.miDHREMOnClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.dhgrhighbit', '1', true );
end;
procedure TGUIForm.miDHRMonoDotsClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.dhgrmode', '4', true );
@ -295,11 +369,84 @@ begin
UpdateConfig( 'video/init.video.grmode', '2', true );
end;
procedure TGUIForm.miGRRenderModeClick(Sender: TObject);
var
value: string;
begin
// GR Render Mode menu
value := GetConfig('video/init.video.grmode');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'1': miGRVoxels.Checked := true;
'2': miGRRaster.Checked := true;
end;
end;
end;
procedure TGUIForm.miGRVoxelsClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.grmode', '1', true );
end;
procedure TGUIForm.miINPMMJoystickClick(Sender: TObject);
begin
UpdateConfig('input/init.mouse', '0', true);
end;
procedure TGUIForm.miINPMMDPadClick(Sender: TObject);
begin
UpdateConfig('input/init.mouse', '1', true);
end;
procedure TGUIForm.miINPMMGEOSClick(Sender: TObject);
begin
UpdateConfig('input/init.mouse', '2', true);
end;
procedure TGUIForm.miINPMMDDrawClick(Sender: TObject);
begin
UpdateConfig('input/init.mouse', '3', true);
end;
procedure TGUIForm.miINPMMOffClick(Sender: TObject);
begin
UpdateConfig('input/init.mouse', '4', true);
end;
procedure TGUIForm.miINPMouseModeClick(Sender: TObject);
var
value: string;
begin
{
MM_MOUSE_JOYSTICK = 0
MM_MOUSE_DPAD = 1
MM_MOUSE_GEOS = 2
MM_MOUSE_DDRAW = 3
MM_MOUSE_OFF = 4
}
value := GetConfig('input/init.mouse');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'0': miINPMMJoystick.Checked := true;
'1': miINPMMDPAD.Checked := true;
'2': miINPMMGEOS.Checked := true;
'3': miINPMMDDraw.Checked := true;
'4': miINPMMOff.Checked := true;
end;
end;
end;
procedure TGUIForm.miINPMouseModeDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; AState: TOwnerDrawState);
begin
end;
procedure TGUIForm.miIntFPClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/interpreter/fp');
@ -330,6 +477,47 @@ begin
UpdateConfig( 'video/init.video.hgrmode', '4', true );
end;
procedure TGUIForm.miScanLineIntClick(Sender: TObject);
var
value: string;
begin
// SHR Render Mode menu
value := GetConfig('video/init.video.scanline');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'1.00': miSLI0.Checked := true;
'0.88': miSLI1.Checked := true;
'0.77': miSLI2.Checked := true;
'0.66': miSLI3.Checked := true;
'0.55': miSLI4.Checked := true;
'0.44': miSLI5.Checked := true;
'0.33': miSLI6.Checked := true;
'0.22': miSLI7.Checked := true;
'0.11': miSLI8.Checked := true;
'0.00': miSLI9.Checked := true;
end;
end;
end;
procedure TGUIForm.miSHRClick(Sender: TObject);
var
value: string;
begin
// SHR Render Mode menu
value := GetConfig('video/init.video.shrmode');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'0': miSHRColorDots.Checked := true;
'1': miSHRColorVoxels.Checked := true;
'2': miSHRColorRaster.Checked := true;
end;
end;
end;
procedure TGUIForm.miSHRColorDotsClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.shrmode', '0', true );
@ -370,6 +558,29 @@ begin
ShowM8;
end;
procedure TGUIForm.MouseTimerTimer(Sender: TObject);
var
x, y: longint;
p, q: TPoint;
begin
x := Mouse.CursorPos.x;
y := Mouse.CursorPos.y;
if (x <> lastMouseX) or (y <> lastMouseY) then
begin
//StatusBar1.SimpleText := 'Global mouse pos is ('+IntToStr(x)+', '+IntToStr(y)+')';
lastMouseX := x;
lastMouseY := y;
q := TPoint.Create(0,0);
p := embedPanel.ClientToScreen(q);
if (x >= longint(p.X)) and (x < longint(p.X)+longint(embedPanel.Width)) and
(y >= longint(p.Y)) and (y < longint(p.Y)+longint(embedPanel.Height)) then
begin
//StatusBar1.SimpleText := StatusBar1.SimpleText + ' (in window)';
SendMouseState( x - longint(p.X), y - longint(p.Y) );
end;
end;
end;
procedure TGUIForm.UnFreeze;
begin
self.hc.Get('http://localhost:38911/api/control/window/unfreeze');
@ -452,6 +663,24 @@ begin
Respo.Destroy;
end;
procedure TGUIForm.SendMouseState(x, y: longint);
var
json, S: string;
Respo: TStringStream;
begin
if key = 8 then
key := 127;
json := '{"x":' + IntToStr(x) +
',"y":'+IntToStr(y) +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/input/mouseevent',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=S;
Respo.Destroy;
end;
procedure TGUIForm.SendKey(key: Integer; ScanCode: Integer; KeyAction: Integer; Mods: Integer);
var
json, S: string;
@ -511,6 +740,21 @@ begin
Respo.Destroy;
end;
function TGUIForm.GetConfig(path: string): string;
var
json, S, pval: string;
Respo: TStringStream;
f: TReplaceFlags;
begin
json := '{"path":"' + path +
'"}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/settings/get',json,Respo);
Result := Respo.DataString;
self.StatusBar1.SimpleText:=json;
Respo.Destroy;
end;
procedure TGUIForm.tbDisk1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
@ -781,6 +1025,46 @@ begin
ShowM8;
end;
procedure TGUIForm.MenuItem15Click(Sender: TObject);
var
value: string;
begin
// HGR Render Mode menu
value := GetConfig('video/init.video.hgrmode');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'0': miColorDots.Checked := true;
'1': miColorVoxels.Checked := true;
'2': miColorRaster.Checked := true;
'3': miMonoDots.Checked := true;
'4': miMonoVoxels.Checked := true;
'5': miMonoRaster.Checked := true;
end;
end;
end;
procedure TGUIForm.MenuItem16Click(Sender: TObject);
var
value: string;
begin
// DHGR Render Mode menu
value := GetConfig('video/init.video.dhgrmode');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'0': miDHRColorDots.Checked := true;
'1': miDHRColorVoxels.Checked := true;
'2': miDHRColorRaster.Checked := true;
'3': miDHRMonoDots.Checked := true;
'4': miDHRMonoVoxels.Checked := true;
'5': miDHRMonoRaster.Checked := true;
end;
end;
end;
procedure TGUIForm.MenuItem2Click(Sender: TObject);
begin
Application.Terminate();

View File

@ -12,7 +12,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="90"/>
<UsageCount Value="176"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
@ -21,9 +21,9 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<TopLine Value="685"/>
<CursorPos X="4" Y="281"/>
<UsageCount Value="90"/>
<TopLine Value="387"/>
<CursorPos X="34" Y="412"/>
<UsageCount Value="176"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
@ -32,130 +32,130 @@
<EditorIndex Value="1"/>
<TopLine Value="576"/>
<CursorPos X="49" Y="591"/>
<UsageCount Value="22"/>
<UsageCount Value="65"/>
<Loaded Value="True"/>
</Unit2>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="main.pas"/>
<Caret Line="96" Column="43" TopLine="75"/>
<Caret Line="292" Column="78" TopLine="255"/>
</Position1>
<Position2>
<Filename Value="main.pas"/>
<Caret Line="468" Column="61" TopLine="556"/>
<Caret Line="293" Column="78" TopLine="256"/>
</Position2>
<Position3>
<Filename Value="main.pas"/>
<Caret Line="164" Column="72" TopLine="130"/>
<Caret Line="294" Column="78" TopLine="257"/>
</Position3>
<Position4>
<Filename Value="main.pas"/>
<Caret Line="165" Column="72" TopLine="131"/>
<Caret Line="295" Column="78" TopLine="258"/>
</Position4>
<Position5>
<Filename Value="main.pas"/>
<Caret Line="166" Column="72" TopLine="132"/>
<Caret Line="296" Column="78" TopLine="259"/>
</Position5>
<Position6>
<Filename Value="main.pas"/>
<Caret Line="167" Column="72" TopLine="133"/>
<Caret Line="297" Column="78" TopLine="260"/>
</Position6>
<Position7>
<Filename Value="main.pas"/>
<Caret Line="231" Column="15" TopLine="211"/>
<Caret Line="300" Column="78" TopLine="263"/>
</Position7>
<Position8>
<Filename Value="main.pas"/>
<Caret Line="233" Column="8" TopLine="214"/>
<Caret Line="305" Column="16" TopLine="300"/>
</Position8>
<Position9>
<Filename Value="main.pas"/>
<Caret Line="385" Column="25" TopLine="361"/>
<Caret Line="583" Column="44" TopLine="562"/>
</Position9>
<Position10>
<Filename Value="main.pas"/>
<Caret Line="374" Column="61" TopLine="354"/>
<Caret Line="564" Column="43" TopLine="545"/>
</Position10>
<Position11>
<Filename Value="main.pas"/>
<Caret Line="115" Column="76" TopLine="106"/>
<Caret Line="569" Column="44" TopLine="545"/>
</Position11>
<Position12>
<Filename Value="main.pas"/>
<Caret Line="234" Column="96" TopLine="214"/>
<Caret Line="356" Column="5" TopLine="347"/>
</Position12>
<Position13>
<Filename Value="main.pas"/>
<Caret Line="115" Column="15" TopLine="96"/>
<Caret Line="283" Column="34" TopLine="270"/>
</Position13>
<Position14>
<Filename Value="main.pas"/>
<Caret Line="234" Column="100" TopLine="214"/>
<Caret Line="281" TopLine="267"/>
</Position14>
<Position15>
<Filename Value="main.pas"/>
<Caret Line="384" Column="23" TopLine="354"/>
<Caret Line="873" TopLine="850"/>
</Position15>
<Position16>
<Filename Value="main.pas"/>
<Caret Line="391" Column="23" TopLine="361"/>
<Caret Line="882" Column="18" TopLine="850"/>
</Position16>
<Position17>
<Filename Value="main.pas"/>
<Caret Line="241" Column="7" TopLine="216"/>
<Caret Line="874" TopLine="864"/>
</Position17>
<Position18>
<Filename Value="main.pas"/>
<Caret Line="224" Column="3" TopLine="222"/>
<Caret Line="371" Column="17" TopLine="360"/>
</Position18>
<Position19>
<Filename Value="main.pas"/>
<Caret Line="219" Column="47" TopLine="217"/>
<Caret Line="374" Column="30" TopLine="361"/>
</Position19>
<Position20>
<Filename Value="main.pas"/>
<Caret Line="220" Column="47" TopLine="218"/>
<Caret Line="426" TopLine="411"/>
</Position20>
<Position21>
<Filename Value="main.pas"/>
<Caret Line="221" Column="47" TopLine="219"/>
<Caret Line="422" Column="51" TopLine="411"/>
</Position21>
<Position22>
<Filename Value="main.pas"/>
<Caret Line="222" Column="47" TopLine="220"/>
<Caret Line="475" Column="21" TopLine="445"/>
</Position22>
<Position23>
<Filename Value="main.pas"/>
<Caret Line="223" Column="47" TopLine="221"/>
<Caret Line="439" Column="13" TopLine="420"/>
</Position23>
<Position24>
<Filename Value="main.pas"/>
<Caret Line="224" Column="47" TopLine="222"/>
<Caret Line="427" TopLine="419"/>
</Position24>
<Position25>
<Filename Value="main.pas"/>
<Caret Line="231" Column="47" TopLine="229"/>
<Caret Line="401" Column="12" TopLine="383"/>
</Position25>
<Position26>
<Filename Value="main.pas"/>
<Caret Line="190" Column="3" TopLine="183"/>
<Caret Line="405" Column="30" TopLine="383"/>
</Position26>
<Position27>
<Filename Value="main.pas"/>
<Caret Line="201" Column="3" TopLine="184"/>
<Caret Line="388" Column="3" TopLine="384"/>
</Position27>
<Position28>
<Filename Value="main.pas"/>
<Caret Line="197" Column="3" TopLine="185"/>
<Caret Line="394" Column="3" TopLine="385"/>
</Position28>
<Position29>
<Filename Value="main.pas"/>
<Caret Line="270" Column="3" TopLine="250"/>
<Caret Line="400" Column="3" TopLine="386"/>
</Position29>
<Position30>
<Filename Value="main.pas"/>
<Caret Line="281" Column="3" TopLine="251"/>
<Caret Line="406" Column="3" TopLine="387"/>
</Position30>
</JumpHistory>
<RunParams>

View File

@ -1,7 +1,7 @@
object GUIForm: TGUIForm
Left = 589
Left = 2353
Height = 491
Top = 177
Top = 125
Width = 807
AlphaBlendValue = 128
Caption = 'MicroM8 Simple GUI Prototype'
@ -144,128 +144,220 @@ object GUIForm: TGUIForm
Caption = 'Video'
object miScanLineInt: TMenuItem
Caption = 'Scanline Intensity'
OnClick = miScanLineIntClick
object miSLI0: TMenuItem
Caption = '0'
RadioItem = True
OnClick = miSLIClick
end
object miSLI1: TMenuItem
Caption = '1'
RadioItem = True
OnClick = miSLIClick
end
object miSLI2: TMenuItem
Caption = '2'
RadioItem = True
OnClick = miSLIClick
end
object miSLI3: TMenuItem
Caption = '3'
RadioItem = True
OnClick = miSLIClick
end
object miSLI4: TMenuItem
Caption = '4'
RadioItem = True
OnClick = miSLIClick
end
object miSLI5: TMenuItem
Caption = '5'
RadioItem = True
OnClick = miSLIClick
end
object miSLI6: TMenuItem
Caption = '6'
RadioItem = True
OnClick = miSLIClick
end
object miSLI7: TMenuItem
Caption = '7'
RadioItem = True
OnClick = miSLIClick
end
object miSLI8: TMenuItem
Caption = '8'
RadioItem = True
OnClick = miSLIClick
end
object miSLI9: TMenuItem
Caption = '9'
RadioItem = True
OnClick = miSLIClick
end
end
object miGRRenderMode: TMenuItem
Caption = 'GR Render Mode'
OnClick = miGRRenderModeClick
object miGRVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miGRVoxelsClick
end
object miGRRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miGRRasterClick
end
end
object MenuItem15: TMenuItem
Caption = 'HGR Render Mode'
OnClick = MenuItem15Click
object miColorDots: TMenuItem
Caption = 'Color Dots'
RadioItem = True
OnClick = miColorDotsClick
end
object miColorVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miColorVoxelsClick
end
object miColorRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miColorRasterClick
end
object miMonoDots: TMenuItem
Caption = 'Mono Dots'
RadioItem = True
OnClick = miMonoDotsClick
end
object miMonoVoxels: TMenuItem
Caption = 'Mono Voxels'
RadioItem = True
OnClick = miMonoVoxelsClick
end
object miMonoRaster: TMenuItem
Caption = 'Mono Raster'
RadioItem = True
OnClick = miMonoRasterClick
end
end
object MenuItem16: TMenuItem
Caption = 'DHGR Render Mode'
OnClick = MenuItem16Click
object miDHRColorDots: TMenuItem
Caption = 'Color Dots'
RadioItem = True
OnClick = miDHRColorDotsClick
end
object miDHRColorVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miDHRColorVoxelsClick
end
object miDHRColorRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miDHRColorRasterClick
end
object miDHRMonoDots: TMenuItem
Caption = 'Mono Dots'
RadioItem = True
OnClick = miDHRMonoDotsClick
end
object miDHRMonoVoxels: TMenuItem
Caption = 'Mono Voxels'
RadioItem = True
OnClick = miDHRMonoVoxelsClick
end
object miDHRMonoRaster: TMenuItem
Caption = 'Mono Raster'
RadioItem = True
OnClick = miDHRMonoRasterClick
end
object N1: TMenuItem
Caption = '-'
end
object miDHGREN: TMenuItem
Caption = 'Enhanced Mode'
OnClick = miDHGRENClick
object miDHREMAuto: TMenuItem
Caption = 'Autodetect'
RadioItem = True
OnClick = miDHREMAutoClick
end
object miDHREMOn: TMenuItem
Caption = 'On'
RadioItem = True
OnClick = miDHREMOnClick
end
object miDHREMOff: TMenuItem
Caption = 'Off'
RadioItem = True
OnClick = miDHREMOffClick
end
end
end
object miSHR: TMenuItem
Caption = 'SuperHires Render Mode'
OnClick = miSHRClick
object miSHRColorDots: TMenuItem
Caption = 'Color Dots'
RadioItem = True
OnClick = miSHRColorDotsClick
end
object miSHRColorVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miSHRColorVoxelsClick
end
object miSHRColorRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miSHRColorRasterClick
end
end
end
object Input: TMenuItem
Caption = 'Input'
object miINPAllCaps: TMenuItem
Caption = 'All Caps'
end
object miINPJoystick: TMenuItem
Caption = 'Joystick'
end
object miINPMouseMode: TMenuItem
Caption = 'Mouse Mode'
OnClick = miINPMouseModeClick
object miINPMMJoystick: TMenuItem
Caption = 'Joystick'
RadioItem = True
OnClick = miINPMMJoystickClick
end
object miINPMMDPAD: TMenuItem
Caption = 'D-Pad'
RadioItem = True
OnClick = miINPMMDPADClick
end
object miINPMMGEOS: TMenuItem
Caption = 'GEOS'
RadioItem = True
OnClick = miINPMMGEOSClick
end
object miINPMMDDraw: TMenuItem
Caption = 'Dazzle Draw'
RadioItem = True
OnClick = miINPMMDDrawClick
end
object miINPMMOff: TMenuItem
Caption = 'Off'
RadioItem = True
OnClick = miINPMMOffClick
end
end
end
end
object ImageList1: TImageList
Height = 48
@ -2227,4 +2319,10 @@ object GUIForm: TGUIForm
left = 111
top = 327
end
object MouseTimer: TTimer
Interval = 50
OnTimer = MouseTimerTimer
left = 187
top = 387
end
end

Binary file not shown.

Binary file not shown.

Binary file not shown.

View File

@ -1,7 +1,7 @@
object GUIForm: TGUIForm
Left = 589
Left = 2353
Height = 491
Top = 177
Top = 125
Width = 807
AlphaBlendValue = 128
Caption = 'MicroM8 Simple GUI Prototype'
@ -144,143 +144,220 @@ object GUIForm: TGUIForm
Caption = 'Video'
object miScanLineInt: TMenuItem
Caption = 'Scanline Intensity'
OnClick = miScanLineIntClick
object miSLI0: TMenuItem
Caption = '0'
RadioItem = True
OnClick = miSLIClick
end
object miSLI1: TMenuItem
Caption = '1'
RadioItem = True
OnClick = miSLIClick
end
object miSLI2: TMenuItem
Caption = '2'
RadioItem = True
OnClick = miSLIClick
end
object miSLI3: TMenuItem
Caption = '3'
RadioItem = True
OnClick = miSLIClick
end
object miSLI4: TMenuItem
Caption = '4'
RadioItem = True
OnClick = miSLIClick
end
object miSLI5: TMenuItem
Caption = '5'
RadioItem = True
OnClick = miSLIClick
end
object miSLI6: TMenuItem
Caption = '6'
RadioItem = True
OnClick = miSLIClick
end
object miSLI7: TMenuItem
Caption = '7'
RadioItem = True
OnClick = miSLIClick
end
object miSLI8: TMenuItem
Caption = '8'
RadioItem = True
OnClick = miSLIClick
end
object miSLI9: TMenuItem
Caption = '9'
RadioItem = True
OnClick = miSLIClick
end
end
object miGRRenderMode: TMenuItem
Caption = 'GR Render Mode'
OnClick = miGRRenderModeClick
object miGRVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miGRVoxelsClick
end
object miGRRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miGRRasterClick
end
end
object MenuItem15: TMenuItem
Caption = 'HGR Render Mode'
OnClick = MenuItem15Click
object miColorDots: TMenuItem
Caption = 'Color Dots'
RadioItem = True
OnClick = miColorDotsClick
end
object miColorVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miColorVoxelsClick
end
object miColorRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miColorRasterClick
end
object miMonoDots: TMenuItem
Caption = 'Mono Dots'
RadioItem = True
OnClick = miMonoDotsClick
end
object miMonoVoxels: TMenuItem
Caption = 'Mono Voxels'
RadioItem = True
OnClick = miMonoVoxelsClick
end
object miMonoRaster: TMenuItem
Caption = 'Mono Raster'
RadioItem = True
OnClick = miMonoRasterClick
end
end
object MenuItem16: TMenuItem
Caption = 'DHGR Render Mode'
OnClick = MenuItem16Click
object miDHRColorDots: TMenuItem
Caption = 'Color Dots'
RadioItem = True
OnClick = miDHRColorDotsClick
end
object miDHRColorVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miDHRColorVoxelsClick
end
object miDHRColorRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miDHRColorRasterClick
end
object miDHRMonoDots: TMenuItem
Caption = 'Mono Dots'
RadioItem = True
OnClick = miDHRMonoDotsClick
end
object miDHRMonoVoxels: TMenuItem
Caption = 'Mono Voxels'
RadioItem = True
OnClick = miDHRMonoVoxelsClick
end
object miDHRMonoRaster: TMenuItem
Caption = 'Mono Raster'
RadioItem = True
OnClick = miDHRMonoRasterClick
end
object N1: TMenuItem
Caption = '-'
end
object MenuItem14: TMenuItem
object miDHGREN: TMenuItem
Caption = 'Enhanced Mode'
OnClick = miDHGRENClick
object miDHREMAuto: TMenuItem
Caption = 'Autodetect'
RadioItem = True
OnClick = miDHREMAutoClick
end
object miDHREMOn: TMenuItem
Caption = 'On'
RadioItem = True
OnClick = miDHREMOnClick
end
object miDHREMOff: TMenuItem
Caption = 'Off'
RadioItem = True
OnClick = miDHREMOffClick
end
end
end
object miSHR: TMenuItem
Caption = 'SuperHires Render Mode'
OnClick = miSHRClick
object miSHRColorDots: TMenuItem
Caption = 'Color Dots'
RadioItem = True
OnClick = miSHRColorDotsClick
end
object miSHRColorVoxels: TMenuItem
Caption = 'Color Voxels'
RadioItem = True
OnClick = miSHRColorVoxelsClick
end
object miSHRColorRaster: TMenuItem
Caption = 'Color Raster'
RadioItem = True
OnClick = miSHRColorRasterClick
end
end
end
object Input: TMenuItem
Caption = 'Input'
object miINPAllCaps: TMenuItem
Caption = 'All Caps'
end
object miINPJoystick: TMenuItem
Caption = 'Joystick'
end
object miINPMouseMode: TMenuItem
Caption = 'Mouse Mode'
OnClick = miINPMouseModeClick
object miINPMMJoystick: TMenuItem
Caption = 'Joystick'
RadioItem = True
OnClick = miINPMMJoystickClick
end
object miINPMMDPAD: TMenuItem
Caption = 'D-Pad'
RadioItem = True
OnClick = miINPMMDPADClick
end
object miINPMMGEOS: TMenuItem
Caption = 'GEOS'
RadioItem = True
OnClick = miINPMMGEOSClick
end
object miINPMMDDraw: TMenuItem
Caption = 'Dazzle Draw'
RadioItem = True
OnClick = miINPMMDDrawClick
end
object miINPMMOff: TMenuItem
Caption = 'Off'
RadioItem = True
OnClick = miINPMMOffClick
end
end
end
end
object ImageList1: TImageList
Height = 48
@ -2242,4 +2319,10 @@ object GUIForm: TGUIForm
left = 111
top = 327
end
object MouseTimer: TTimer
Interval = 50
OnTimer = MouseTimerTimer
left = 187
top = 387
end
end

278
main.pas
View File

@ -26,7 +26,16 @@ type
MenuItem11: TMenuItem;
MenuItem12: TMenuItem;
MenuItem13: TMenuItem;
MenuItem14: TMenuItem;
miDHGREN: TMenuItem;
Input: TMenuItem;
miINPMMOff: TMenuItem;
miINPMMDDraw: TMenuItem;
miINPMMGEOS: TMenuItem;
miINPMMDPAD: TMenuItem;
miINPMMJoystick: TMenuItem;
miINPJoystick: TMenuItem;
miINPAllCaps: TMenuItem;
miINPMouseMode: TMenuItem;
miDHREMAuto: TMenuItem;
miDHREMOn: TMenuItem;
miDHREMOff: TMenuItem;
@ -89,6 +98,7 @@ type
StatusBar1: TStatusBar;
hc: TFPHttpClient;
CheckTimer: TTimer;
MouseTimer: TTimer;
ToolBar1: TToolBar;
procedure BackdropImageClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
@ -105,6 +115,8 @@ type
procedure FormShow(Sender: TObject);
procedure FormUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char);
procedure FormWindowStateChange(Sender: TObject);
procedure MenuItem15Click(Sender: TObject);
procedure MenuItem16Click(Sender: TObject);
procedure MenuItem1Click(Sender: TObject);
procedure MenuItem2Click(Sender: TObject);
procedure Freeze;
@ -115,27 +127,43 @@ type
procedure miD1FileClick(Sender: TObject);
procedure miD2BlankClick(Sender: TObject);
procedure miD2FileClick(Sender: TObject);
procedure miDHGRENClick(Sender: TObject);
procedure miDHRColorDotsClick(Sender: TObject);
procedure miDHRColorRasterClick(Sender: TObject);
procedure miDHRColorVoxelsClick(Sender: TObject);
procedure miDHREMAutoClick(Sender: TObject);
procedure miDHREMOffClick(Sender: TObject);
procedure miDHREMOnClick(Sender: TObject);
procedure miDHRMonoDotsClick(Sender: TObject);
procedure miDHRMonoRasterClick(Sender: TObject);
procedure miDHRMonoVoxelsClick(Sender: TObject);
procedure miFileCatClick(Sender: TObject);
procedure miGRRasterClick(Sender: TObject);
procedure miGRRenderModeClick(Sender: TObject);
procedure miGRVoxelsClick(Sender: TObject);
procedure miINPMMDDrawClick(Sender: TObject);
procedure miINPMMDPADClick(Sender: TObject);
procedure miINPMMGEOSClick(Sender: TObject);
procedure miINPMMJoystickClick(Sender: TObject);
procedure miINPMMOffClick(Sender: TObject);
procedure miINPMouseModeClick(Sender: TObject);
procedure miINPMouseModeDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; AState: TOwnerDrawState);
procedure miIntFPClick(Sender: TObject);
procedure miIntINTClick(Sender: TObject);
procedure miIntLOGOClick(Sender: TObject);
procedure miMonoDotsClick(Sender: TObject);
procedure miMonoRasterClick(Sender: TObject);
procedure miMonoVoxelsClick(Sender: TObject);
procedure miScanLineIntClick(Sender: TObject);
procedure miSHRClick(Sender: TObject);
procedure miSHRColorDotsClick(Sender: TObject);
procedure miSHRColorRasterClick(Sender: TObject);
procedure miSHRColorVoxelsClick(Sender: TObject);
procedure miSLIClick(Sender: TObject);
procedure miSPEjectClick(Sender: TObject);
procedure miSPFileClick(Sender: TObject);
procedure MouseTimerTimer(Sender: TObject);
procedure UnFreeze;
procedure HideM8;
procedure menuRebootVMClick(Sender: TObject);
@ -152,11 +180,14 @@ type
procedure ToolButton5Click(Sender: TObject);
procedure InsertDisk(Filename: string; Drive: integer);
procedure UpdateConfig(path: string; value: string; persist: boolean);
function GetConfig(path: string): string;
procedure SendMouseState(x, y: longint);
private
lx, ly, lw, lh: integer;
lastShowTime: TDateTime;
lastHideTime: TDateTime;
hidden: boolean;
lastMouseX, lastMouseY: longint;
public
procedure AppActivate(Sender: TObject);
procedure AppDeactivate(Sender: TObject);
@ -260,6 +291,23 @@ begin
ShowM8;
end;
procedure TGUIForm.miDHGRENClick(Sender: TObject);
var
value: string;
begin
// DHGR Enhanced menu
value := GetConfig('video/init.video.dhgrhighbit');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'0': miDHREMAuto.Checked := true;
'1': miDHREMOff.Checked := true;
'2': miDHREMOn.Checked := true;
end;
end;
end;
procedure TGUIForm.miDHRColorDotsClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.dhgrmode', '0', true );
@ -275,6 +323,27 @@ begin
UpdateConfig( 'video/init.video.dhgrmode', '1', true );
end;
{
DHB_MIXED_AUTO = 0
DHB_MIXED_ON = 1
DHB_MIXED_OFF = 2
}
procedure TGUIForm.miDHREMAutoClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.dhgrhighbit', '0', true );
end;
procedure TGUIForm.miDHREMOffClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.dhgrhighbit', '2', true );
end;
procedure TGUIForm.miDHREMOnClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.dhgrhighbit', '1', true );
end;
procedure TGUIForm.miDHRMonoDotsClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.dhgrmode', '4', true );
@ -300,11 +369,84 @@ begin
UpdateConfig( 'video/init.video.grmode', '2', true );
end;
procedure TGUIForm.miGRRenderModeClick(Sender: TObject);
var
value: string;
begin
// GR Render Mode menu
value := GetConfig('video/init.video.grmode');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'1': miGRVoxels.Checked := true;
'2': miGRRaster.Checked := true;
end;
end;
end;
procedure TGUIForm.miGRVoxelsClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.grmode', '1', true );
end;
procedure TGUIForm.miINPMMJoystickClick(Sender: TObject);
begin
UpdateConfig('input/init.mouse', '0', true);
end;
procedure TGUIForm.miINPMMDPadClick(Sender: TObject);
begin
UpdateConfig('input/init.mouse', '1', true);
end;
procedure TGUIForm.miINPMMGEOSClick(Sender: TObject);
begin
UpdateConfig('input/init.mouse', '2', true);
end;
procedure TGUIForm.miINPMMDDrawClick(Sender: TObject);
begin
UpdateConfig('input/init.mouse', '3', true);
end;
procedure TGUIForm.miINPMMOffClick(Sender: TObject);
begin
UpdateConfig('input/init.mouse', '4', true);
end;
procedure TGUIForm.miINPMouseModeClick(Sender: TObject);
var
value: string;
begin
{
MM_MOUSE_JOYSTICK = 0
MM_MOUSE_DPAD = 1
MM_MOUSE_GEOS = 2
MM_MOUSE_DDRAW = 3
MM_MOUSE_OFF = 4
}
value := GetConfig('input/init.mouse');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'0': miINPMMJoystick.Checked := true;
'1': miINPMMDPAD.Checked := true;
'2': miINPMMGEOS.Checked := true;
'3': miINPMMDDraw.Checked := true;
'4': miINPMMOff.Checked := true;
end;
end;
end;
procedure TGUIForm.miINPMouseModeDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; AState: TOwnerDrawState);
begin
end;
procedure TGUIForm.miIntFPClick(Sender: TObject);
begin
self.hc.Get('http://localhost:38911/api/control/interpreter/fp');
@ -335,6 +477,47 @@ begin
UpdateConfig( 'video/init.video.hgrmode', '4', true );
end;
procedure TGUIForm.miScanLineIntClick(Sender: TObject);
var
value: string;
begin
// SHR Render Mode menu
value := GetConfig('video/init.video.scanline');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'1.00': miSLI0.Checked := true;
'0.88': miSLI1.Checked := true;
'0.77': miSLI2.Checked := true;
'0.66': miSLI3.Checked := true;
'0.55': miSLI4.Checked := true;
'0.44': miSLI5.Checked := true;
'0.33': miSLI6.Checked := true;
'0.22': miSLI7.Checked := true;
'0.11': miSLI8.Checked := true;
'0.00': miSLI9.Checked := true;
end;
end;
end;
procedure TGUIForm.miSHRClick(Sender: TObject);
var
value: string;
begin
// SHR Render Mode menu
value := GetConfig('video/init.video.shrmode');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'0': miSHRColorDots.Checked := true;
'1': miSHRColorVoxels.Checked := true;
'2': miSHRColorRaster.Checked := true;
end;
end;
end;
procedure TGUIForm.miSHRColorDotsClick(Sender: TObject);
begin
UpdateConfig( 'video/init.video.shrmode', '0', true );
@ -375,6 +558,29 @@ begin
ShowM8;
end;
procedure TGUIForm.MouseTimerTimer(Sender: TObject);
var
x, y: longint;
p, q: TPoint;
begin
x := Mouse.CursorPos.x;
y := Mouse.CursorPos.y;
if (x <> lastMouseX) or (y <> lastMouseY) then
begin
//StatusBar1.SimpleText := 'Global mouse pos is ('+IntToStr(x)+', '+IntToStr(y)+')';
lastMouseX := x;
lastMouseY := y;
q := TPoint.Create(0,0);
p := embedPanel.ClientToScreen(q);
if (x >= longint(p.X)) and (x < longint(p.X)+longint(embedPanel.Width)) and
(y >= longint(p.Y)) and (y < longint(p.Y)+longint(embedPanel.Height)) then
begin
//StatusBar1.SimpleText := StatusBar1.SimpleText + ' (in window)';
SendMouseState( x - longint(p.X), y - longint(p.Y) );
end;
end;
end;
procedure TGUIForm.UnFreeze;
begin
self.hc.Get('http://localhost:38911/api/control/window/unfreeze');
@ -457,6 +663,21 @@ begin
Respo.Destroy;
end;
procedure TGUIForm.SendMouseState(x, y: longint);
var
json, S: string;
Respo: TStringStream;
begin
json := '{"x":' + IntToStr(x) +
',"y":'+IntToStr(y) +
'}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/input/mouseevent',json,Respo);
S := Respo.DataString;
self.StatusBar1.SimpleText:=S;
Respo.Destroy;
end;
procedure TGUIForm.SendKey(key: Integer; ScanCode: Integer; KeyAction: Integer; Mods: Integer);
var
json, S: string;
@ -516,6 +737,21 @@ begin
Respo.Destroy;
end;
function TGUIForm.GetConfig(path: string): string;
var
json, S, pval: string;
Respo: TStringStream;
f: TReplaceFlags;
begin
json := '{"path":"' + path +
'"}';
Respo := TStringStream.Create('');
self.hc.SimpleFormPost('http://localhost:38911/api/control/settings/get',json,Respo);
Result := Respo.DataString;
self.StatusBar1.SimpleText:=json;
Respo.Destroy;
end;
procedure TGUIForm.tbDisk1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
@ -786,6 +1022,46 @@ begin
ShowM8;
end;
procedure TGUIForm.MenuItem15Click(Sender: TObject);
var
value: string;
begin
// HGR Render Mode menu
value := GetConfig('video/init.video.hgrmode');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'0': miColorDots.Checked := true;
'1': miColorVoxels.Checked := true;
'2': miColorRaster.Checked := true;
'3': miMonoDots.Checked := true;
'4': miMonoVoxels.Checked := true;
'5': miMonoRaster.Checked := true;
end;
end;
end;
procedure TGUIForm.MenuItem16Click(Sender: TObject);
var
value: string;
begin
// DHGR Render Mode menu
value := GetConfig('video/init.video.dhgrmode');
StatusBar1.SimpleText := value;
if value <> '' then
begin
case value of
'0': miDHRColorDots.Checked := true;
'1': miDHRColorVoxels.Checked := true;
'2': miDHRColorRaster.Checked := true;
'3': miDHRMonoDots.Checked := true;
'4': miDHRMonoVoxels.Checked := true;
'5': miDHRMonoRaster.Checked := true;
end;
end;
end;
procedure TGUIForm.MenuItem2Click(Sender: TObject);
begin
Application.Terminate();

70
poc.lps
View File

@ -12,7 +12,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="90"/>
<UsageCount Value="178"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
@ -21,9 +21,9 @@
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<TopLine Value="338"/>
<CursorPos X="89" Y="362"/>
<UsageCount Value="90"/>
<TopLine Value="553"/>
<CursorPos X="22" Y="572"/>
<UsageCount Value="178"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
@ -32,130 +32,130 @@
<EditorIndex Value="1"/>
<TopLine Value="576"/>
<CursorPos X="49" Y="591"/>
<UsageCount Value="22"/>
<UsageCount Value="66"/>
<Loaded Value="True"/>
</Unit2>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="main.pas"/>
<Caret Line="231" Column="47" TopLine="229"/>
<Caret Line="297" Column="78" TopLine="260"/>
</Position1>
<Position2>
<Filename Value="main.pas"/>
<Caret Line="190" Column="3" TopLine="183"/>
<Caret Line="300" Column="78" TopLine="263"/>
</Position2>
<Position3>
<Filename Value="main.pas"/>
<Caret Line="201" Column="3" TopLine="184"/>
<Caret Line="305" Column="16" TopLine="300"/>
</Position3>
<Position4>
<Filename Value="main.pas"/>
<Caret Line="197" Column="3" TopLine="185"/>
<Caret Line="583" Column="44" TopLine="562"/>
</Position4>
<Position5>
<Filename Value="main.pas"/>
<Caret Line="270" Column="3" TopLine="250"/>
<Caret Line="564" Column="43" TopLine="545"/>
</Position5>
<Position6>
<Filename Value="main.pas"/>
<Caret Line="281" Column="4" TopLine="685"/>
<Caret Line="569" Column="44" TopLine="545"/>
</Position6>
<Position7>
<Filename Value="main.pas"/>
<Caret Line="196" Column="62" TopLine="190"/>
<Caret Line="356" Column="5" TopLine="347"/>
</Position7>
<Position8>
<Filename Value="main.pas"/>
<Caret Line="197" Column="62" TopLine="191"/>
<Caret Line="283" Column="34" TopLine="270"/>
</Position8>
<Position9>
<Filename Value="main.pas"/>
<Caret Line="198" Column="62" TopLine="192"/>
<Caret Line="281" TopLine="267"/>
</Position9>
<Position10>
<Filename Value="main.pas"/>
<Caret Line="199" Column="62" TopLine="193"/>
<Caret Line="873" TopLine="850"/>
</Position10>
<Position11>
<Filename Value="main.pas"/>
<Caret Line="200" Column="62" TopLine="194"/>
<Caret Line="882" Column="18" TopLine="850"/>
</Position11>
<Position12>
<Filename Value="main.pas"/>
<Caret Line="201" Column="62" TopLine="195"/>
<Caret Line="874" TopLine="864"/>
</Position12>
<Position13>
<Filename Value="main.pas"/>
<Caret Line="203" Column="62" TopLine="197"/>
<Caret Line="371" Column="17" TopLine="360"/>
</Position13>
<Position14>
<Filename Value="main.pas"/>
<Caret Line="249" Column="48" TopLine="229"/>
<Caret Line="374" Column="30" TopLine="361"/>
</Position14>
<Position15>
<Filename Value="main.pas"/>
<Caret Line="260" Column="49" TopLine="230"/>
<Caret Line="426" TopLine="411"/>
</Position15>
<Position16>
<Filename Value="main.pas"/>
<Caret Line="256" Column="36" TopLine="231"/>
<Caret Line="422" Column="51" TopLine="411"/>
</Position16>
<Position17>
<Filename Value="main.pas"/>
<Caret Line="267" Column="36" TopLine="232"/>
<Caret Line="475" Column="21" TopLine="445"/>
</Position17>
<Position18>
<Filename Value="main.pas"/>
<Caret Line="278" Column="36" TopLine="241"/>
<Caret Line="439" Column="13" TopLine="420"/>
</Position18>
<Position19>
<Filename Value="main.pas"/>
<Caret Line="273" Column="36" TopLine="241"/>
<Caret Line="427" TopLine="419"/>
</Position19>
<Position20>
<Filename Value="main.pas"/>
<Caret Line="274" Column="36" TopLine="242"/>
<Caret Line="401" Column="12" TopLine="383"/>
</Position20>
<Position21>
<Filename Value="main.pas"/>
<Caret Line="275" Column="36" TopLine="243"/>
<Caret Line="405" Column="30" TopLine="383"/>
</Position21>
<Position22>
<Filename Value="main.pas"/>
<Caret Line="276" Column="36" TopLine="244"/>
<Caret Line="388" Column="3" TopLine="384"/>
</Position22>
<Position23>
<Filename Value="main.pas"/>
<Caret Line="278" Column="36" TopLine="246"/>
<Caret Line="394" Column="3" TopLine="385"/>
</Position23>
<Position24>
<Filename Value="main.pas"/>
<Caret Line="335" TopLine="332"/>
<Caret Line="400" Column="3" TopLine="386"/>
</Position24>
<Position25>
<Filename Value="main.pas"/>
<Caret Line="345" Column="50" TopLine="333"/>
<Caret Line="406" Column="3" TopLine="387"/>
</Position25>
<Position26>
<Filename Value="main.pas"/>
<Caret Line="357" Column="89" TopLine="333"/>
<Caret Line="412" Column="34" TopLine="387"/>
</Position26>
<Position27>
<Filename Value="main.pas"/>
<Caret Line="358" Column="89" TopLine="334"/>
<Caret Line="14" Column="19"/>
</Position27>
<Position28>
<Filename Value="main.pas"/>
<Caret Line="359" Column="89" TopLine="335"/>
<Caret Line="189" Column="36" TopLine="167"/>
</Position28>
<Position29>
<Filename Value="main.pas"/>
<Caret Line="360" Column="89" TopLine="336"/>
<Caret Line="577" Column="80" TopLine="559"/>
</Position29>
<Position30>
<Filename Value="main.pas"/>
<Caret Line="361" Column="89" TopLine="337"/>
<Caret Line="572" Column="23" TopLine="553"/>
</Position30>
</JumpHistory>
<RunParams>