unit HexGrid;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, Menus;

const
  MaxdataCount = MaxListSize;
  SIndexOutOfRange ='Index Out Of Range';
  STooManyDeleted ='Too Many Deleted';
  SGridTooLarge ='Grid Too Large';



type
  EInvalidGridOperation = class(Exception);

  TViewMode = (vmHEX,vmBIN,vmDEC,vmASCII);
  TDataSize = (dsByte, dsWord);

  PDataBuf = ^TDataBuf;
  TDataBuf = record
    Count:Cardinal;
    data:array[0..MaxdataCount] of Byte;
  end;


  TGetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; var Value: string) of object;
  TSetEditEvent = procedure (Sender: TObject; ACol, ARow: Longint; const Value: string) of object;



  THexGrid = class(TCustomGrid)
  private
    FOnDrawCell: TDrawCellEvent;
    FOnGetEditMask: TGetEditEvent;
    FOnGetEditText: TGetEditEvent;
    FOnSelectCell: TSelectCellEvent;
    FOnSetEditText: TSetEditEvent;
    FOnTopLeftChanged: TNotifyEvent;
    FDataArray:Pointer;
    FDataCount:Longint;
    FBegAddr:Cardinal;
    FViewMode:TViewMode;
    FDefaultData:Word;
    FDataSize: TDataSize;
    procedure SetFixColWidth(value:Longint);
    function GetFixColWidth:Longint;
//    procedure ChangeGridOrientation(RightToLeftOrientation: Boolean);
  protected
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
    function  GetEditMask(ACol, ARow: Longint): string; override;
    function  GetEditText(ACol, ARow: Longint): string; override;
    function  SelectCell(ACol, ARow: Longint): Boolean; override;
    procedure SetEditText(ACol, ARow: Longint; const Value: string); override;
    procedure TopLeftChanged; override;
    function  GetAData(Index: Longint): Byte;
    procedure SetAData(Index: Longint; Value: Byte);
    procedure SetDataCount(Value: Longint);
    procedure SetColCount(Value: Longint);
    function  GetColCount: Integer;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
                      X, Y: Integer); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
                      X, Y: Integer); override;
    function  FormatDataStr(Data:Word):string;

    procedure SetViewMode(Value: TViewMode);

    procedure SetDefaultData(Value: Word);
    procedure SetBegAddr(Value: Cardinal);
    procedure SetDataSize(Value: TDataSize);
    procedure DrawViewModeMenuItem(Sender: TObject; ACanvas: TCanvas;
              ARect: TRect; Selected: Boolean);

    procedure AdjustRowCount;
  public
    function  GetDataIndex(ACol, ARow:Longint):Integer;
    property AData[Index: Longint]: Byte read GetAData write SetAData;
    property DataBufer: Pointer read FDataArray;
    function CellRect(ACol, ARow: Longint): TRect;
    procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
    property Canvas;
    property Col;
    property ColWidths;
    property EditorMode;
    property GridHeight;
    property GridWidth;
    property LeftCol;
    property Selection;
    property Row;
    property RowHeights;
    property TabStops;
    property TopRow;
//    property ColCount;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SizeCellToFit;
    procedure AssignDataBuf(Buf:Pointer);
  published
    property Align;
    property Anchors;
    property BegAddr: Cardinal read FBegAddr write SetBegAddr ;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property GridColCount: Longint read GetColCount write SetColCount ;
    property Constraints;
    property Ctl3D;
    property DataCount: Longint read FDataCount write SetDataCount ;
    property DataSize: TDataSize read FDataSize write SetDataSize ;
    property DefaultColWidth;
    property DefaultData: Word read FDefaultData write SetDefaultData ;
    property DefaultRowHeight;
    property DefaultDrawing;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FixedColor;
    property FixColWidth: Longint read GetFixColWidth write SetFixColWidth; 
 //   property FixedCols;
 //   property RowCount;
 //   property FixedRows;
    property Font;
    property GridLineWidth;
    property Options;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ScrollBars;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property ViewMode: TViewMode read FViewMode write SetViewMode ;
    property Visible;
    property VisibleColCount;
    property VisibleRowCount;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawCell: TDrawCellEvent read FOnDrawCell write FOnDrawCell;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetEditMask: TGetEditEvent read FOnGetEditMask write FOnGetEditMask;
    property OnGetEditText: TGetEditEvent read FOnGetEditText write FOnGetEditText;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnSelectCell: TSelectCellEvent read FOnSelectCell write FOnSelectCell;
    property OnSetEditText: TSetEditEvent read FOnSetEditText write FOnSetEditText;
    property OnStartDock;
    property OnStartDrag;
    property OnTopLeftChanged: TNotifyEvent read FOnTopLeftChanged write FOnTopLeftChanged;
  end;





procedure Register;
procedure UpdateDataArray(var DataBuf: Pointer; NewSize: Longint;Default: Word);
procedure ModifyDataArray(var DataBuf: Pointer; Index, Amount: Longint;Default: Word);





implementation



procedure InvalidOp(const id: string);
begin
  raise EInvalidGridOperation.Create(id);
end;

constructor THexGrid.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FixedCols := 1;
  FixedRows := 1;
  FViewMode:=vmHEX;
  FDefaultData:=$FFFF;
  FDataSize:=dsByte;
  FDataCount:=255;
  UpdateDataArray(FDataArray,FDataCount,FDefaultData);
//-  FColumnAutoFit:=true;
  Options:=Options+[goColSizing,goRowSizing,goRangeSelect,goThumbTracking];
end;

destructor THexGrid.Destroy;
begin
  inherited Destroy;
  FreeMem(FDataArray);
end;

procedure THexGrid.SetViewMode(Value: TViewMode);
begin
  FViewMode:=Value;
{  if FColumnAutoFit then
    SizeCellToFit
  else
}
    Invalidate;
end;
procedure THexGrid.SetDefaultData(Value: Word);
begin
  FDefaultData:=Value;
  UpdateDataArray(FDataArray, DataCount, FDefaultData );
  Invalidate;
end;

procedure THexGrid.SetBegAddr(Value: cardinal);
begin
  FBegAddr:=Value;
  Invalidate;
end;

procedure THexGrid.SetDataSize(Value: TDataSize);
begin
  FDataSize:=Value;
  AdjustRowCount;
  Invalidate;
end;

Function THexGrid.FormatDataStr(Data:Word):string;
var DataStr:string;
    i:integer;
    b:integer;
begin
  case FdataSize of
  dsByte:
    case FViewMode of
      vmHEX:
        begin
          FormatDataStr:=Format('%.2x',[Data]);
        end;
      vmBIN:
        begin
          DataStr:='';
          b:=Data;
          for i:=1 to 8 do
          begin
            if (b and 1)=1 then DataStr:='1'+DataStr
                           else DataStr:='0'+DataStr;
            b:=b shr 1;
          end;
          FormatDataStr:=DataStr;
        end;
      vmDEC:
        begin
          FormatDataStr:=Format('%.3d',[Data]);
        end;
      vmASCII:
        begin
          FormatDataStr:=Format('%s',[Chr(Byte(Data))]);
        end;
    end;  {case FViewMode}
  dsWord:
    case FViewMode of
      vmHEX:
        begin
          FormatDataStr:=Format('%.4x',[Data]);
        end;
      vmBIN:
        begin
          DataStr:='';
          b:=Data;
          for i:=1 to 16 do
          begin
            if (b and 1)=1 then DataStr:='1'+DataStr
                           else DataStr:='0'+DataStr;
            b:=b shr 1;
          end;
          FormatDataStr:=DataStr;
        end;
      vmDEC:
        begin
          FormatDataStr:=Format('%.5d',[Data]);
        end;
      vmASCII:
        begin
          FormatDataStr:=Format('%s',[Chr(LoByte(Data))+Chr(HiByte(Data))]);
        end;
    end;  {case FViewMode}
  end; {case FDataSize}
end;


function THexGrid.CellRect(ACol, ARow: Longint): TRect;
begin
  Result := inherited CellRect(ACol, ARow);
end;

procedure THexGrid.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
var
  Coord: TGridCoord;
begin
  Coord := MouseCoord(X, Y);
  ACol := Coord.X;
  ARow := Coord.Y;
end;


function THexGrid.GetEditMask(ACol, ARow: Longint): string;
begin
  Result := '';
  if Assigned(FOnGetEditMask) then FOnGetEditMask(Self, ACol, ARow, Result);
end;

function THexGrid.GetEditText(ACol, ARow: Longint): string;
var index:integer;
begin
  Result:='';
  index:=GetDataIndex(ACol,Arow);
  if FDataSize=dsByte then
    Result := FormatDataStr(AData[index])
  else
    Result := FormatDataStr(AData[index]*256+AData[index+1]);
  if Assigned(FOnGetEditText) then FOnGetEditText(Self, ACol, ARow, Result);
end;

procedure THexGrid.SetEditText(ACol, ARow: Longint; const Value: string);
var index,b,i:integer;
begin
  if Value='' then exit;
  index:=GetDataIndex(ACol,ARow);
  if FDataSize=dsByte then begin
    case FViewMode of
      vmHEX:
        begin
          AData[index]:=StrToInt('$'+Value);
        end;
      vmBIN:
        begin
          b:=0;
          for i:=1 to Length(Value) do
          begin
            case Value[i] of
            '0': begin
                   b:=b shl 1
                 end;
            '1': begin
                   b:=b shl 1;
                   b:=b+1;
                 end;
            end;
          end;
          AData[index]:=b;
        end;
      vmDEC:
        begin
          AData[index]:=StrToInt(Value);
        end;
      vmASCII:
        begin
          AData[index]:=Ord(Value[1])
        end;
    end;  {case}
  end
  else   {if FDataSize}
  begin
    case FViewMode of
      vmHEX:
        begin
          AData[index]:=Byte(StrToInt('$'+Value) div 256);
          AData[index+1]:=Byte(StrToInt('$'+Value) mod 256);
        end;
      vmBIN:
        begin
          b:=0;
          for i:=1 to Length(Value) do
          begin
            case Value[i] of
            '0': begin
                   b:=b shl 1
                 end;
            '1': begin
                   b:=b shl 1;
                   b:=b+1;
                 end;
            end;
            b:=word(b);
          end;
          AData[index]:=Byte(b div 256);
          AData[index+1]:=Byte(b mod 256);
        end;
      vmDEC:
        begin
          AData[index]:=Byte(StrToInt(Value)div 256);
          AData[index+1]:=Byte(StrToInt(Value)mod 256);
        end;
      vmASCII:
        begin
          if Length(value)<2 then begin
            AData[index]:=Ord(Value[1]);
            AData[index+1]:=Ord(' ');
          end
          else
          begin
            AData[index]:=Ord(Value[1]);
            AData[index+1]:=Ord(Value[2]);
          end;
        end;
    end;  {case}
  end;   {if FDataSize }
  if Assigned(FOnSetEditText) then FOnSetEditText(Self, ACol, ARow, Value);
end;


function THexGrid.SelectCell(ACol, ARow: Longint): Boolean;
begin
  Result := True;
  if Assigned(FOnSelectCell) then FOnSelectCell(Self, ACol, ARow, Result);
end;

{
procedure THexGrid.ChangeGridOrientation(RightToLeftOrientation: Boolean);
var
  Org: TPoint;
  Ext: TPoint;
begin
  if RightToLeftOrientation then
  begin
    Org := Point(ClientWidth,0);
    Ext := Point(-1,1);
    SetMapMode(Canvas.Handle, mm_Anisotropic);
    SetWindowOrgEx(Canvas.Handle, Org.X, Org.Y, nil);
    SetViewportExtEx(Canvas.Handle, ClientWidth, ClientHeight, nil);
    SetWindowExtEx(Canvas.Handle, Ext.X*ClientWidth, Ext.Y*ClientHeight, nil);
  end
  else
  begin
    Org := Point(0,0);
    Ext := Point(1,1);
    SetMapMode(Canvas.Handle, mm_Anisotropic);
    SetWindowOrgEx(Canvas.Handle, Org.X, Org.Y, nil);
    SetViewportExtEx(Canvas.Handle, ClientWidth, ClientHeight, nil);
    SetWindowExtEx(Canvas.Handle, Ext.X*ClientWidth, Ext.Y*ClientHeight, nil);
  end;
end;
}


function THexGrid.GetDataIndex(ACol, ARow: Longint):integer;
begin

  if FDataSize=dsByte then
    result:= (ACol-FixedCols)+ (ARow-FixedRows)*(ColCount-FixedCols)
  else
    result:= 2*((ACol-FixedCols)+ (ARow-FixedRows)*(ColCount-FixedCols));
end;



procedure THexGrid.DrawCell(ACol, ARow: Longint; ARect: TRect;
  AState: TGridDrawState);
var
//  Hold: Integer;
  index:Integer;
  DataStr:String;
begin
  if  gdFixed in AState then
  begin
    if (ACol=0) and (ARow<>0) then
    begin
      // Вывод адресов строк
      DataStr:=Format('%.6x',[FBegAddr+Cardinal((ARow-FixedRows)*(GridColCount))]);
      Canvas.TextRect(ARect, ARect.Left+2, ARect.Top+2,DataStr );
    end;
    if (ARow=0) and (ACol<>0) then
    begin
      // DВывод адресов столбцов
      DataStr:=Format('%.2x', [(ACol-FixedCols)]);
      Canvas.TextRect(ARect, ARect.Left+2, ARect.Top+2,DataStr );
    end;


  end;

  if not  (gdFixed in AState) then
  begin
    index:=GetDataIndex(ACol, ARow);
    if FDataSize=dsByte then
      DataStr:=FormatDataStr(AData[index])
    else
      DataStr:=FormatDataStr(AData[index]*256+AData[index+1]);
  
    if gdSelected in AState then Canvas.Brush.Color:=clBlue;
    Canvas.TextRect(ARect, ARect.Left+2, ARect.Top+2,DataStr );
  end;


  if Assigned(FOnDrawCell) then
  begin
{*    if UseRightToLeftAlignment then
    begin
      ARect.Left := ClientWidth - ARect.Left;
      ARect.Right := ClientWidth - ARect.Right;
      Hold := ARect.Left;
      ARect.Left := ARect.Right;
      ARect.Right := Hold;
      ChangeGridOrientation(False);
    end;
}    FOnDrawCell(Self, ACol, ARow, ARect, AState);
{*    if UseRightToLeftAlignment then ChangeGridOrientation(True);
}  end;
end;

procedure THexGrid.TopLeftChanged;
begin
  inherited TopLeftChanged;
  if Assigned(FOnTopLeftChanged) then FOnTopLeftChanged(Self);
end;

function THexGrid.GetAData(Index: Longint): Byte;
begin
  if (FDataArray = nil) or (Index >= DataCount) then
    Result := FDefaultData
  else
    Result := PDataBuf(FDataArray)^.data[Index];
end;

procedure THexGrid.SetAData(Index: Longint; Value: Byte);
begin
  if FDataArray = nil then
    UpdateDataArray(FDataArray, DataCount, FDefaultData);
  if Index >= DataCount then  exit;
  //InvalidOp(SIndexOutOfRange);
  PDataBuf(FdataArray)^.data[Index] := Value;
end;

procedure THexGrid.SetDataCount(Value: Longint);
begin
  if FDataCount <> Value then
  begin
    if Value < 1 then
    begin
     Value := 1;
     UpdateDataArray(FDataArray, 0, FDefaultData);
    end;
    FDataCount:=Value;
    AdjustRowCount;
    UpdateDataArray(FDataArray, DataCount, FDefaultData);
    Invalidate;
  end;
end;

Procedure  THexGrid.AdjustRowCount;
var Dcnt,cnt:Longint;
begin
  if FDataSize=dsByte then   { Если данные 16-и битные то,    }
    Dcnt:=FDataCount         { уменьшить в двое число столбцов}
  else begin
    Dcnt:=FdataCount div 2;
    if (FdataCount mod 2) <>0 then Inc(Dcnt);
  end;
  cnt:=(Dcnt div (ColCount-FixedCols))+ FixedRows;
  if (Dcnt mod (ColCount-FixedCols))<> 0 then
    RowCount:=cnt+1
  else
    RowCount:=cnt;
end;


procedure THexGrid.SetColCount(Value: Longint);
begin
  if Value<1 then Value:=1;
  ColCount:=Value+1;
  AdjustRowCount;
  Invalidate;
end;

function THexGrid.GetColCount: Integer;
begin
  Result := ColCount-FixedCols;
end;

{procedure THexGrid.SetColumnAutoFit(value :boolean);
begin
  if not value then
    FColumnAutoFit:=false
  else begin
    FColumnAutoFit:=true;
    SizeCellToFit;
  end;
end;
}
procedure THexGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  Inherited MouseDown(Button,Shift,X,Y);
end;

procedure THexGrid.DrawViewModeMenuItem(Sender: TObject; ACanvas: TCanvas;
              ARect: TRect; Selected: Boolean);
begin
//

end;


procedure THexGrid.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseUp(Button,Shift,X, Y);
end;

Procedure THexGrid.SizeCellToFit;
var s:string;
begin
  if FDataSize=dsByte then
    case FViewMode of
    vmDEC: s:='WWW';
    vmHEX: s:='WW' ;
    vmBIN: s:='WWWWWWWW';
    vmASCII: s:='WW';
    end
  else
    case FViewMode of
    vmDEC: s:='WWWWW';
    vmHEX: s:='WWWW' ;
    vmBIN: s:='WWWWWWWWWWWWWWWW';
    vmASCII: s:='WW';
    end;

  DefaultColWidth:=Canvas.TextWidth(s)+4;
  DefaultRowHeight:=Canvas.TextHeight(s)+4;
  ColWidths[0]:=Canvas.TextWidth('WWWWWW')+4;
  RowHeights[0]:=Canvas.TextHeight('WWWWWW')+4;
end;

function THexGrid.GetFixColWidth:Longint;
begin
  Result:=ColWidths[0];

end;

procedure THexGrid.SetFixColWidth(value:Longint);
begin
  ColWidths[0]:=value
end;

procedure THexGrid.AssignDataBuf(Buf:Pointer);
begin
  if not Assigned(FDataArray) then
    FreeMem(FdataArray,SizeOf(PDataBuf(FdataArray)^.count)+ PDataBuf(FdataArray)^.count);
  FdataArray:=Buf;
  FDataCount:=PDataBuf(FdataArray)^.count;
  AdjustRowCount;
  Invalidate;
end;

procedure UpdateDataArray(var DataBuf: Pointer; NewSize: Longint;
  Default: Word);
var
  OldSize: Integer;
begin
  OldSize := 0;
  if Assigned(DataBuf) then OldSize := PDataBuf(DataBuf)^.Count;
  ModifyDataArray(DataBuf, OldSize, NewSize - OldSize, Default);
end;

procedure ModifyDataArray(var DataBuf: Pointer; Index, Amount: Longint;
  Default: Word);
var
  LongSize, OldSize: LongInt;
  NewSize: Integer;
  I: Integer;
begin
  if Amount <> 0 then
  begin
    if not Assigned(DataBuf) then OldSize := 0
    else OldSize := PDataBuf(DataBuf)^.count;
    if (Index < 0) or (OldSize < Index) then InvalidOp(SIndexOutOfRange);
    LongSize := OldSize + Amount;
    if LongSize < 0 then InvalidOp(STooManyDeleted)
    else if LongSize >= MaxDataCount - 1 then InvalidOp(SGridTooLarge);
    NewSize := Cardinal(LongSize);
    ReallocMem(DataBuf, NewSize * SizeOf(Integer));
    if Assigned(DataBuf) then
    begin
      I := Index;

//      if  FDataSize=dsWord then
      while I < NewSize do
      begin
        if (I and 1)=1 then
          PDataBuf(DataBuf)^.data[I] := Default and $FF
        else
          PDataBuf(DataBuf)^.data[I] := Default shr 8;
        Inc(I);
      end;
{
      else
        while I < NewSize do
        begin
          PDataBuf(DataBuf)^.data[I] := Default and $FF;
          Inc(I);
        end;
}

      PDataBuf(DataBuf)^.count := NewSize;
    end;
  end;
end;




procedure Register;
begin
  RegisterComponents('Samples', [THexGrid]);
end;

end.
