jclsimdviewform.pas

来自「最新版 JCL+JVCL控件！非常不错的控件资源。包含了所能用到的大部分功能！」· PAS 代码 · 共 956 行 · 第 1/3 页

{**************************************************************************************************}
{                                                                                                  }
{ Project JEDI Code Library (JCL)                                                                  }
{                                                                                                  }
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
{ you may not use this file except in compliance with the License. You may obtain a copy of the    }
{ License at http://www.mozilla.org/MPL/                                                           }
{                                                                                                  }
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF   }
{ ANY KIND, either express or implied. See the License for the specific language governing rights  }
{ and limitations under the License.                                                               }
{                                                                                                  }
{ The Original Code is: JvSIMDViewForm.pas, released on 2004-10-11.                                }
{                                                                                                  }
{ The Initial Developer of the Original Code is Florent Ouchet                                     }
{ [ouchet dott florent att laposte dott net]                                                       }
{ Portions created by Florent Ouchet are Copyright (C) 2004 Florent Ouchet.                        }
{ All Rights Reserved.                                                                             }
{                                                                                                  }
{ You may retrieve the latest version of this file at the Project JEDI's JCL home page,            }
{ located at http://jcl.sourceforge.net                                                            }
{                                                                                                  }
{**************************************************************************************************}
{                                                                                                  }
{ Last modified: $Date:: 2007-11-03 17:15:43 +0100 (sam., 03 nov. 2007)                          $ }
{ Revision:      $Rev:: 2207                                                                     $ }
{ Author:        $Author:: outchy                                                                $ }
{                                                                                                  }
{**************************************************************************************************}

unit JclSIMDViewForm;

{$I jcl.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ToolsApi, Grids, ExtCtrls, Menus, ActnList,
  DockForm,
  JclOtaUtils, JclSysInfo, JclSIMDUtils, JclSIMDModifyForm;

type
  TJclSIMDViewFrm = class(TDockableForm)
    Splitter: TSplitter;
    ListBoxRegs: TListBox;           
    ListBoxMXCSR: TListBox;
    PopupMenuRegs: TPopupMenu;
    PopupMenuMXCSR: TPopupMenu;
    MenuItemComplement: TMenuItem;
    MenuItemBinary: TMenuItem;
    MenuItemSigned: TMenuItem;
    MenuItemUnsigned: TMenuItem;
    MenuItemHexa: TMenuItem;
    MenuItemDisplay: TMenuItem;
    MenuItemFormat: TMenuItem;
    MenuItemBytes: TMenuItem;
    MenuItemWords: TMenuItem;
    MenuItemDWords: TMenuItem;
    MenuItemQWords: TMenuItem;
    MenuItemSeparator1: TMenuItem;
    MenuItemSingles: TMenuItem;
    MenuItemDoubles: TMenuItem;
    MenuItemSeparator2: TMenuItem;
    MenuItemStayOnTop: TMenuItem;
    MenuItemModify: TMenuItem;
    MenuItemCpuInfo: TMenuItem;
    ActionListOptions: TActionList;
    ActionStayOnTop: TAction;
    ActionModify: TAction;
    ActionComplement: TAction;
    ActionEmpty: TAction;
    ActionEmptyAll: TAction;
    MenuItemEmptyMM: TMenuItem;
    MenuItemEmptyAll: TMenuItem;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListBoxMXCSRDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure ListBoxMXCSRMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ListBoxRegsDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure MenuItemFormatClick(Sender: TObject);
    procedure MenuItemDisplayClick(Sender: TObject);
    procedure MenuItemCpuInfoClick(Sender: TObject);
    procedure ActionStayOnTopUpdate(Sender: TObject);
    procedure ActionStayOnTopExecute(Sender: TObject);
    procedure ActionModifyUpdate(Sender: TObject);
    procedure ActionModifyExecute(Sender: TObject);
    procedure ActionComplementExecute(Sender: TObject);
    procedure ActionComplementUpdate(Sender: TObject);
    procedure ActionEmptyUpdate(Sender: TObject);
    procedure ActionEmptyAllUpdate(Sender: TObject);
    procedure ActionEmptyExecute(Sender: TObject);
    procedure ActionEmptyAllExecute(Sender: TObject);
    procedure ListBoxesMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    FDebuggerServices: IOTADebuggerServices;
    FVectorFrame: TJclVectorFrame;
    FDisplay: TJclXMMContentType;
    FFormat: TJclSIMDFormat;
    FCpuInfo: TCpuInfo;
    FSIMDCaption: string;
    FNbMMRegister: Integer;
    FNbXMMRegister: Integer;
    FOldThreadID: LongWord;
    FOldThreadState: TOTAThreadState;
    FModifyForm: TJclSIMDModifyFrm;
    FMXCSRChanged: array [TMXCSRRange] of Boolean;
    FRegisterChanged: array of Boolean;
    FSettings: TJclOtaSettings;
    procedure SetDisplay(const Value: TJclXMMContentType);
    procedure SetFormat(const Value: TJclSIMDFormat);
  protected
    procedure DoClose(var Action: TCloseAction); override;
    procedure UpdateActions; override;
    // not for dockable windows
    //procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent; ADebuggerServices: IOTADebuggerServices;
      ASettings: TJclOtaSettings); reintroduce;
    destructor Destroy; override;
    procedure ThreadEvaluate(const ExprStr, ResultStr: string; ReturnCode: Integer);
    procedure SetThreadValues;
    procedure GetThreadValues;
    property CpuInfo: TCpuInfo read FCpuInfo;
    property Format: TJclSIMDFormat read FFormat write SetFormat;
    property Display: TJclXMMContentType read FDisplay write SetDisplay;
    property SIMDCaption: string read FSIMDCaption write FSIMDCaption;
    property DebuggerServices: IOTADebuggerServices read FDebuggerServices;
    property NbMMRegister: Integer read FNbMMRegister;
    property NbXMMRegister: Integer read FNbXMMRegister;
    property Settings: TJclOtaSettings read FSettings;
  end;

implementation

uses
  TypInfo,
  JclOtaResources, JclOtaConsts,
  JclSIMDCpuInfo;

{$R *.dfm}

constructor TJclSIMDViewFrm.Create(AOwner: TComponent;
  ADebuggerServices: IOTADebuggerServices; ASettings: TJclOTASettings);
var
  I: TMXCSRRange;
  J: Integer;
begin
  inherited Create(AOwner);

  FDebuggerServices := ADebuggerServices;
  FOldThreadID := 0;
  FOldThreadState := tsNone;
  FSettings := ASettings;

  JclSysInfo.GetCpuInfo(FCpuInfo);

  // the behaviour of Delphi and C++Builder overrides all changes made on
  // the floating point context of the debugged thread when it is run
  // (even using step into and step over).
  // to be uncommented as soon as Borland changes this behaviour
  {if CpuInfo.MMX or CPUInfo._3DNow then
    FNbMMRegister := 8
  else
    FNbMMRegister := 0;}

  FNbMMRegister := 0;

  if CpuInfo.SSE = [] then
    FNbXMMRegister := 0
  else
  if CpuInfo.Is64Bits then
    FNbXMMRegister := 17
  else
    FNbXMMRegister := 9;

  ListBoxMXCSR.Items.Clear;
  with CpuInfo do
    for I := Low(TMXCSRRange) to High(TMXCSRRange) do
      ListBoxMXCSR.Items.Add('0');
  ListBoxRegs.Items.Clear;

  SetLength(FRegisterChanged,NbMMRegister + NbXMMRegister);
  for J := 0 to NbMMRegister + NbXMMRegister - 1 do
  // MM registers (MMX) + XMM registers (SSE) + 1 cardinal (MXCSR)
    ListBoxRegs.Items.Add('');

  MenuItemBinary.Tag := Integer(sfBinary);
  MenuItemSigned.Tag := Integer(sfSigned);
  MenuItemUnsigned.Tag := Integer(sfUnsigned);
  MenuItemHexa.Tag := Integer(sfHexa);
  MenuItemBytes.Tag := Integer(xt16Bytes);
  MenuItemWords.Tag := Integer(xt8Words);
  MenuItemDWords.Tag := Integer(xt4DWords);
  MenuItemQWords.Tag := Integer(xt2QWords);
  MenuItemSingles.Tag := Integer(xt4Singles);
  MenuItemDoubles.Tag := Integer(xt2Doubles);

  Format := sfHexa;
  Display := xt8Words;

  GetThreadValues;
end;

// not for dockable windows
{procedure TJclSIMDViewFrm.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);

  // Fixing the Window Ghosting "bug"
  Params.Style := params.Style or WS_POPUP;
  if Assigned(Screen.ActiveForm) then
    Params.WndParent := Screen.ActiveForm.Handle
  else if Assigned (Application.MainForm) then
    Params.WndParent := Application.MainForm.Handle
  else
    Params.WndParent := Application.Handle;
end;}

destructor TJclSIMDViewFrm.Destroy;
begin
  SetLength(FRegisterChanged,0);
  FDebuggerServices := nil;

  inherited Destroy;
end;

procedure TJclSIMDViewFrm.ListBoxMXCSRDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
  try
    with (Control as TListBox), Canvas do
    begin
      if not (odFocused in State) then
      begin
        Pen.Color := Brush.Color;
        if odSelected in State then
          Font.Color := clWindow;
      end;
      Rectangle(Rect);
      TextOut(Rect.Left + 2, Rect.Top, MXCSRBitsDescriptions[Index].ShortName);
      if FMXCSRChanged[Index] then
        Font.Color := clRed;
      TextOut(Rect.Left + 2 + TextExtent(MXCSRBitsDescriptions[Index].ShortName).cx, Rect.Top, Items[Index]);
    end;
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
      raise;
    end;
  end;
end;

procedure TJclSIMDViewFrm.ListBoxMXCSRMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  AIndex: Integer;
  AText: string;
begin
  try
    if Shift <> [] then
      Application.HideHint
    else
      with Sender as TListBox do
      begin
        AIndex := ItemAtPos(Point(X,Y),True);
        if (AIndex >= 0) and (AIndex < Items.Count) then
        begin
          with MXCSRBitsDescriptions[AIndex] do
          begin
            AText := LongName;
            if AndMask = MXCSR_RC then
              case (FVectorFrame.MXCSR and AndMask) shr Shifting of
                0:
                  AText := SysUtils.Format('%s (%s)', [AText, RsRoundToNearest]);
                1:
                  AText := SysUtils.Format('%s (%s)', [AText, RsRoundDown]);
                2:
                  AText := SysUtils.Format('%s (%s)', [AText, RsRoundUp]);
                3:
                  AText := SysUtils.Format('%s (%s)', [AText, RsRoundTowardZero]);
            end;
            if AText <> Hint then
            begin
              Hint := AText;
              Application.HideHint;
              Application.ActivateHint(Point(X, Y));
            end;
          end;
        end
        else
        begin
          Hint := '';
          Application.HideHint;
        end;
      end;
  except
    on ExceptionObj: TObject do
    begin
      JclExpertShowExceptionDialog(ExceptionObj);
      raise;
    end;
  end;
end;

procedure TJclSIMDViewFrm.ListBoxRegsDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  AText: string;
begin
  try
    with (Control as TListBox), Canvas do
    begin
      if not (odFocused in State) then