Ver Mensaje Individual
  #11  
Antiguo 07-05-2014
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
elmago00,

Cita:
Empezado por elmago00
...solo detallen las propiedades que tiene este código pero en FireMonkey...
Revisa este código:
Código Delphi [-]
unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
  System.Variants, System.UIConsts, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
  FMX.StdCtrls, FMX.ListBox, FMX.Layouts, FMX.Grid;

type

  TColumnAccess = class(TColumn)
  end;

  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    ComboBox1: TComboBox;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure DumpFile(aFileName:TFileName; SG: TStringGrid; const BPF: Word);
var
  c, i, r: Integer;
  Ascii: String;
  Aux: Byte;
  Col, Row: Integer;
  CellCtrl: TStyledControl;

begin

  with TMemoryStream.Create do
  try

    LoadFromFile(aFileName);

    // Configurar StringGrid

    SG.ShowHeader := False;
    SG.ShowHorzLines := False;
    SG.ShowVertLines := False;

    for i := 1 to BPF + 2 do
       SG.AddObject(TStringColumn.Create(nil));

    SG.RowCount:= Size div BPF;

    for Row := 0 to SG.RowCount - 1 do
    begin
       for Col := 0 to SG.ColumnCount - 1 do
       begin

          Application.ProcessMessages;

          CellCtrl := TColumnAccess(SG.Columns[Col]).CellControlByRow(Row);
          if ( CellCtrl <> nil ) and (CellCtrl is TTextCell) then
          begin

             TTextCell(CellCtrl).StyledSettings := [];
             TTextCell(CellCtrl).Font.Family := 'Courrier New';
             TTextCell(CellCtrl).Font.Size := 10;
             TTextCell(CellCtrl).FontColor := claBlack;
             TTextCell(CellCtrl).Font.Style := [];
             TTextCell(CellCtrl).TextAlign := TTextAlign.taCenter;

             if (Col = 0) then
                SG.Columns[Col].Width := 80;

             if (Col <> SG.ColumnCount - 1) and (Col <> 0) then
                SG.Columns[Col].Width := 30;

             if (Col = SG.ColumnCount - 1) then
                SG.Columns[Col].Width := SG.Canvas.TextWidth('X') * BPF;

          end;
       end;
    end;

    SG.Cells[0,0]:= 'Offset(h)';
    SG.Cells[SG.ColumnCount-1,0]:= 'ASCII';

    for i:= 0 to BPF-1 do
    begin
      SG.Cells[i+1,0]:= IntToHex(i,2);
    end;

    // Cargar StringGrid

    Seek(0, soBeginning);
    c:= 0;
    r:= 1;
    while c < Size do
    begin
      SG.Cells[0, r]:= Format('%s',[IntToHex(c, 8)]);
      Ascii:= EmptyStr;
      i:= 0;
      while (i < BPF)and(i+c < Size) do
      begin
        Read(Aux, SizeOf(Byte));
        SG.Cells[i+1,r]:= IntToHex(Aux,2);
        if Aux = 0 then Aux := 46;
        Ascii:= Ascii + Chr(Aux);
        Inc(i);
      end;
      SG.Cells[SG.ColumnCount-1,r]:= Format('%s',[Ascii]);
      Inc(c, BPF);
      Inc(r);
    end;
  finally
    Free;
  end;
end;

// Salvar StringGrig a Archivo TXT
procedure SaveDump(aFileName:TFileName; SG: TStringGrid);
var
  c,r: Integer;
  s: String;
begin
  with TStringList.Create do
  try
    for r:= 0 to SG.RowCount-1 do
    begin
      s:= '';
      for c:= 0 to SG.ColumnCount-1 do s:= s + SG.Cells[c,r] + ' ';
      SetLength(s,Length(s)-1);
      Add(s);
    end;
    SaveToFile(aFileName);
  finally
    Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ComboBox1.Items.CommaText:= '8,10,16,24,32,48,64,128,255';
  ComboBox1.ItemIndex:= 2;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  with OpenDialog1 do
  begin
    Filter:= '*.*';
    if Execute then
    begin
      Caption:= FileName;
      DumpFile(FileName, StringGrid1,
        StrToInt(ComboBox1.Items[ComboBox1.ItemIndex]) );
    end;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  with SaveDialog1 do
  begin
    Filter:= '*.txt';
    DefaultExt:= '*.txt';
    if Execute then
      SaveDump(FileName, StringGrid1);
  end;
end;

end.
El código anterior en Delphi XE4 bajo Windows 7 Professional x32, es la implementación del código del Msg #1 en FireMonkey HD, como se muestra en la siguiente imagen:



Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 07-05-2014 a las 08:11:55.
Responder Con Cita