cheat-engine/Cheat Engine/frmFloatingPointPanelUnit.pas

613 lines
16 KiB
ObjectPascal
Executable file

unit frmFloatingPointPanelUnit;
{$MODE Delphi}
{
This window will be used to display the floating point values of a context structure
}
interface
uses
{$ifdef darwin}
macport, math,
{$endif}
{$ifdef windows}
windows,
{$endif}
LCLIntf, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, cefuncproc, ComCtrls, LResources, NewKernelHandler,
commonTypeDefs, betterControls, contexthandler;
resourcestring
rsFPPExtended = 'Extended (default)';
type
{ TfrmFloatingPointPanel }
TfrmFloatingPointPanel = class(TForm)
cbClassicView: TCheckBox;
PageControl1: TPageControl;
sbData: TScrollBox;
TabSheet2: TTabSheet;
Panel1: TPanel;
cbContextSection: TComboBox;
cbDisplayType: TComboBox;
mData: TMemo;
procedure cbClassicViewChange(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure ComboBox1Select(Sender: TObject);
procedure Label4Click(Sender: TObject);
procedure Label6DblClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
context: PContext;
contexthandler: TContextInfo;
loadedFormPosition: boolean;
procedure ValueDoubleClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
public
{ Public declarations }
procedure UpdatedContext;
procedure SetContextPointer(context: pointer);
end;
{$ifdef cpux86_64}
procedure doubletoextended(float64:pointer; outextended:pointer); assembler;
procedure extendedtodouble(float80:pointer;var outdouble:double); assembler;
{$endif}
var frmFloatingPointPanel:TfrmFloatingPointPanel;
implementation
uses MemoryBrowserFormUnit, processhandlerunit, debughelper, DPIHelper, networkInterfaceApi;
{$ifdef cpux86_64}
//coded by mgr.inz.player
procedure extendedtodouble(float80:pointer;var outdouble:double); assembler;
var
oldcw,newcw: word;
_rcx: PtrUInt;
asm
mov _rcx,rcx
fnstcw oldcw
fwait
mov cx,oldcw
or cx,$0c3f
mov newcw,cx
mov rcx,_rcx
fldcw newcw
fld tbyte [float80]
fstp qword [outdouble]
fwait
fldcw oldcw
end;
procedure doubletoextended(float64:pointer; outextended:pointer); assembler;
var
oldcw,newcw: word;
_rcx: PtrUInt;
asm
mov _rcx,rcx
fnstcw oldcw
fwait
mov cx,oldcw
or cx,$0c3f
mov newcw,cx
mov rcx,_rcx
fldcw newcw
fld qword [float64]
fstp tbyte [outextended]
fwait
fldcw oldcw
end;
{$endif}
procedure TfrmFloatingPointPanel.SetContextPointer(context: pointer);
var
oldscrollpos: integer;
oldcontexthandler: TContextInfo;
begin
oldcontexthandler:=contexthandler;
contexthandler:=getBestContextHandler;
self.context:=context;
oldscrollpos:=mData.VertScrollBar.Position;
UpdatedContext;
if mData.VertScrollBar.Range>mData.VertScrollBar.Position then
mData.VertScrollBar.Position:=oldscrollpos;
end;
procedure TfrmFloatingPointPanel.ValueDoubleClick(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
offset: integer;
p: pointer;
pba: pbytearray absolute p;
pb: pbyte absolute p;
pw: pword absolute p;
pd: pdword absolute p;
pq: Puint64 absolute p;
ps: PSingle absolute p;
pss: Pdouble absolute p;
pe: PExtended absolute p;
v: string;
vd: double;
e: PContextElement_register;
begin
p:=nil;
if self<>frmFloatingPointPanel then exit; //readonly for all other panels
if button<>mbLeft then exit;
if (debuggerthread=nil) or (debuggerthread.CurrentThread=nil) then exit;
p:=pointer(tlabel(Sender).tag);
if p=nil then exit;
v:=tlabel(sender).caption;
if inputquery('FPU Edit', 'Enter the new value', v) then
begin
case cbDisplayType.itemindex of
0: pb^:=strtoint('$'+v);
1: pw^:=strtoint('$'+v);
2: pd^:=strtoint('$'+v);
3: pq^:=StrToInt64('$'+v);
4: ps^:=StrToFloat(v);
5: pss^:=StrToFloat(v);
6:
begin
{$ifdef cpux86_64}
vd:=StrToFloat(v);
doubleToExtended(@vd, p);
{$else}
pe^:=StrToFloat(v);
{$endif}
end;
end;
UpdatedContext;
end;
end;
procedure TfrmFloatingPointPanel.UpdatedContext;
{
Called by the debugger and initial display
Will fetch the debuggerthread's context and show the floating point values
}
var i,j: integer;
lastentry: integer;
line, row: integer;
lbl: tlabel;
s: single;
d: double;
center: integer;
temp: integer;
e: extended;
str: string;
tempstr: string;
regname: string;
p: pointer;
pba: pbytearray absolute p;
pwa: pwordarray absolute p;
pda: pdwordarray absolute p;
pqa: Puint64Array absolute p;
psa: PSingleArray absolute p;
pssa: PdoubleArray absolute p;
pea: PextendedArray absolute p;
lw: longword;
max: integer;
bytelength: integer;
oldscrollpos: integer;
classic: boolean;
blocksize: integer;
oldcontexthandler: TContextInfo;
FPUList: PContextElementRegisterList;
altFPUList: PContextElementRegisterList;
procedure newLabel(text: string; contextpointer: pointer);
begin
lbl:=tlabel.create(sbData);
lbl.caption:=text;
lbl.tag:=ptruint(contextpointer);
lbl.parent:=sbData;
if contextpointer<>nil then
begin
//lbl.OnDblClick:=ValueDoubleClick;
lbl.OnMouseDown:=ValueDoubleClick;
end;
end;
begin
if context=nil then exit;
fpulist:=contexthandler.getFloatingPointRegisters;
altFPUList:=contexthandler.getAlternateFloatingPointRegisters;
if altFPUList=nil then
begin
//no alternate, only use the main one
cbContextSection.enabled:=false;
cbContextSection.visible:=false;
cbContextSection.ItemIndex:=1;
end
else
begin
if not cbContextSection.enabled then
cbContextSection.enabled:=true;
if not cbContextSection.visible then
cbContextSection.visible:=true;
end;
mData.lines.BeginUpdate;
sbdata.BeginUpdateBounds;
try
mData.Clear;
while sbdata.ComponentCount>0 do
sbdata.Components[0].Free;
case cbContextSection.ItemIndex of
0: //fpu (old)
begin
if altFPUList=nil then exit;
if altFPUList^[0].size=10 then //extended type
begin
if cbDisplayType.Items.Count=6 then
begin
cbDisplayType.Items.Add(rsFPPExtended); //make it the default selection
cbDisplayType.OnSelect:=nil;
cbDisplayType.itemindex:=6;
cbDisplayType.OnSelect:=ComboBox1Select;
end;
end;
//if extended the other types are really useless, but it's there just in case...
case cbDisplayType.ItemIndex of
0: sbData.ChildSizing.ControlsPerLine:=1+altFPUList^[0].size; //byte
1: sbData.ChildSizing.ControlsPerLine:=1+altFPUList^[0].size div 2; //word
2: sbData.ChildSizing.ControlsPerLine:=1+altFPUList^[0].size div 4; //dword
3: sbData.ChildSizing.ControlsPerLine:=1+altFPUList^[0].size div 8; //8 byte
4: sbData.ChildSizing.ControlsPerLine:=1+altFPUList^[0].size div 4; //single
5: sbData.ChildSizing.ControlsPerLine:=1+altFPUList^[0].size div 8; //double
6: sbData.ChildSizing.ControlsPerLine:=1+1; //extended
end;
for i:=0 to length(altFPUList^)-1 do
begin
newlabel(altFPUList^[i].name+':',nil);
p:=altFPUList^[i].getPointer(context);
str:=altFPUList^[i].name+':';
case cbDisplayType.ItemIndex of
0: //byte
begin
for j:=0 to altFPUList^[i].size-1 do
begin
str:=str+inttohex(pba[j],2);
if j<altFPUList^[i].size-1 then
str:=str+' _ ';
newLabel(inttohex(pba[j],2), pointer(ptruint(p)+j));
end;
mData.Lines.Add(str);
end;
1: //word
begin
lastentry:=(altFPUList^[i].size div 2)-1;
for j:=0 to lastentry do
begin
str:=str+inttohex(pwa[j],2);
if j<lastentry then
str:=str+' _ ';
newLabel(inttohex(pwa[j],4), pointer(ptruint(p)+j*2));
end;
mData.Lines.Add(str);
end;
2: //dword
begin
lastentry:=(altFPUList^[i].size div 4)-1;
for j:=0 to lastentry do
begin
str:=str+inttohex(pda[j],2);
if j<lastentry then
str:=str+' _ ';
newLabel(inttohex(pda[j],8), pointer(ptruint(p)+j*4));
end;
mData.Lines.Add(str);
end;
3: //qword
begin
lastentry:=(altFPUList^[i].size div 8)-1;
for j:=0 to lastentry do
begin
str:=str+inttohex(pqa[j],2);
if j<lastentry then
str:=str+' _ ';
newLabel(inttohex(pqa[j],16), pointer(ptruint(p)+j*8));
end;
mData.Lines.Add(str);
end;
4: //single
begin
lastentry:=(altFPUList^[i].size div 4)-1;
for j:=0 to lastentry do
begin
str:=str+format('%f',[psa[j]]);
if j<lastentry then
str:=str+' _ ';
newLabel(format('%f',[psa[j]]), pointer(ptruint(p)+j*4));
end;
mData.Lines.Add(str);
end;
5: //double
begin
lastentry:=(altFPUList^[i].size div 8)-1;
for j:=0 to lastentry do
begin
str:=str+format('%f',[pssa[j]]);
if j<lastentry then
str:=str+' _ ';
newLabel(format('%f',[pssa[j]]), pointer(ptruint(p)+j*8));
end;
mData.Lines.Add(str);
end;
6:
begin
{$ifdef cpux86_64}
extendedtodouble(p, d);
{$else}
d:=pea[0];
{$endif}
mData.Lines.Add(str+format('%f', [d])); //extended
newLabel(format('%f',[d]), p);
end;
end;
end;
end;
1: //xmm (main)
begin
if fpulist=nil then exit;
if cbDisplayType.Items.Count>6 then //no extended type
begin
if cbDisplayType.ItemIndex=6 then
begin
cbDisplayType.OnSelect:=nil;
cbDisplayType.ItemIndex:=5;
cbDisplayType.OnSelect:=combobox1select;
end;
cbDisplayType.Items.Delete(6);
end;
bytelength:=fpulist^[0].size;
max:=length(fpulist^);
case cbDisplayType.ItemIndex of
0: sbData.ChildSizing.ControlsPerLine:=1+bytelength; //byte
1: sbData.ChildSizing.ControlsPerLine:=1+bytelength div 2; //word
2: sbData.ChildSizing.ControlsPerLine:=1+bytelength div 4; //dword
3: sbData.ChildSizing.ControlsPerLine:=1+bytelength div 8; //8 byte
4: sbData.ChildSizing.ControlsPerLine:=1+bytelength div 4; //single
5: sbData.ChildSizing.ControlsPerLine:=1+bytelength div 8; //double
else
sbData.ChildSizing.ControlsPerLine:=1+bytelength div 8;
end;
for i:=0 to max-1 do
begin
regname:=fpulist^[i].name;
p:=fpulist^[i].getPointer(context);
newLabel(regname+':', nil);
str:=regname+':';
case cbDisplayType.ItemIndex of
0: //byte
begin
lastentry:=bytelength-1;
for j:=0 to lastentry do
begin
str:=str+inttohex(pba[j],2);
if j<lastentry then
str:=str+' _ ';
newLabel(inttohex(pba[j],2), pointer(ptruint(p)+j));
end;
mData.Lines.Add(str);
end;
1: //word
begin
lastentry:=(bytelength div 2)-1;
for j:=0 to lastentry do
begin
str:=str+inttohex(pwa[j],4);
if j<lastentry then
str:=str+' _ ';
newLabel(inttohex(pwa[j],4), pointer(ptruint(p)+j*2));
end;
mData.Lines.Add(str);
end;
2: //dword
begin
lastentry:=(bytelength div 4)-1;
for j:=0 to lastentry do
begin
str:=str+inttohex(pda[j],8);
if j<lastentry then
str:=str+' _ ';
newLabel(inttohex(pda[j],8), pointer(ptruint(p)+j*4));
end;
mData.Lines.Add(str);
end;
3: //8 byte
begin
lastentry:=(bytelength div 8)-1;
for j:=0 to lastentry do
begin
str:=str+inttohex(pqa[j],16);
if j<lastentry then
str:=str+' _ ';
newLabel(inttohex(pqa[j],16), pointer(ptruint(p)+j*8));
end;
mData.Lines.Add(str);
end;
4: //float
begin
lastentry:=(bytelength div 4)-1;
for j:=0 to lastentry do
begin
str:=str+format('%f',[psa[j]]);
if j<lastentry then
str:=str+' _ ';
newLabel(format('%f',[psa[j]]), pointer(ptruint(p)+j*4));
end;
mData.Lines.Add(str);
end;
5: //double
begin
lastentry:=(bytelength div 8)-1;
for j:=0 to lastentry do
begin
str:=str+format('%f',[pssa[j]]);
if j<lastentry then
str:=str+' _ ';
newLabel(format('%f',[pssa[j]]), pointer(ptruint(p)+j*8));
end;
mData.Lines.Add(str);
end;
end;
end;
end;
end;
finally
mData.lines.endupdate;
sbdata.EndUpdateBounds;
end;
end;
procedure TfrmFloatingPointPanel.FormShow(Sender: TObject);
var w: integer;
begin
if self<>frmFloatingPointPanel then //only show the new one on the memview version
begin
cbClassicView.checked:=true;
//cbClassicView.visible:=false;
end;
mData.Font.Height:=GetFontData(font.Handle).Height;
UpdatedContext;
AdjustComboboxSize(cbContextSection, canvas);
AdjustComboboxSize(cbDisplayType, canvas);
w:=max(cbContextSection.Width, cbDisplayType.width)+16;
cbContextSection.width:=w;
cbDisplayType.width:=w;
if loadedFormPosition=false then
width:=max(width, canvas.TextWidth('XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'));
end;
procedure TfrmFloatingPointPanel.FormDestroy(Sender: TObject);
begin
SaveFormPosition(self);
end;
procedure TfrmFloatingPointPanel.cbClassicViewChange(Sender: TObject);
begin
sbData.Visible:=not cbClassicView.checked;
end;
procedure TfrmFloatingPointPanel.ComboBox1Select(Sender: TObject);
begin
UpdatedContext;
end;
procedure TfrmFloatingPointPanel.Label4Click(Sender: TObject);
begin
end;
procedure TfrmFloatingPointPanel.Label6DblClick(Sender: TObject);
begin
end;
procedure TfrmFloatingPointPanel.FormCreate(Sender: TObject);
begin
cbDisplayType.ItemIndex:=4;
loadedFormPosition:=LoadFormPosition(self);
sbdata.font.color:=clWindowtext;
mdata.font.Name:='Courier New';
// mdata.font.size:=;
end;
initialization
{$i frmFloatingPointPanelUnit.lrs}
end.