Tema: Histograma!
Ver Mensaje Individual
  #4  
Antiguo 24-11-2012
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
Coltlac,

Cita:
Empezado por Coltlac Ver Mensaje
tengo que hacer un programa que abra y lea un archivo de texto y posteriormente con esa informacion debe crear un histograma de barras con la frecuencia con la cual aparecen las letras en el archivo
Revisa este código:
Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, TeeProcs, TeEngine, Chart, Series, TypInfo;

type
  TForm1 = class(TForm)
    Chart1: TChart;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Series1: TBarSeries;
    BitBtn3: TBitBtn;
    ComboBox1: TComboBox;
    BitBtn4: TBitBtn;
    BitBtn5: TBitBtn;
    CheckBox1: TCheckBox;
    Label1: TLabel;
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure BitBtn5Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TNameSeries = (Bar,HorizBar,Line,Area,Point,Pie);

const
   LMin : String = 'abcdefghijklmnñopqrstuvwxyz';
   LMay : String = 'ABCDEFGHIJKLMNÑOPQRSTUVWXYZ';

var
  Form1: TForm1;
  F : TStringList;
  CountLMin : Array[1..27] of Integer;
  CountLMay : Array[1..27] of Integer;
  FileProcess : Boolean;

implementation

{$R *.dfm}

// Reset de Gráfico
procedure Reset;
begin
   FileProcess := False;
   FillChar(CountLMin,SizeOf(CountLMin),0);
   FillChar(CountLMay,SizeOf(CountLMin),0);
   with form1 do
   begin
      Series1.Clear;
      ComboBox1.Text := ComboBox1.Items.Strings[0];
   end;
end;

// Procesa Archivo TXT (Instancia, Lee y Sumariza por Letras el Archivo de Texto Seleccionado)
Procedure ReadTextFile(FileName : String);
var
  i,j : Integer;
  P : Integer;
  C : String;
begin
   FileProcess := False;
   Reset;
   F := TStringList.Create;
   try
      F.LoadFromFile(FileName);
   except
      MessageDlg('Error de I/O', mtinformation, [mbok], 0);
      F.Free;
      Exit;
   end;
   for i := 0 to F.Count-1 do
   begin
     for j := 1 to Length(F.Strings[i]) do
     begin
        C := Copy(F.Strings[i],j,1);
        P := Pos(C,LMin);
        if (P > 0) then
          Inc(CountLMin[P]);
        P := Pos(C,LMay);
        if (P > 0) then
          Inc(CountLMay[P]);
     end;
   end ;
   FileProcess := True;
   F.Free;
end;

// Selección de Archivo a Graficar
procedure TForm1.BitBtn2Click(Sender: TObject);
var
  openDialog : TOpenDialog;
begin

  openDialog := TOpenDialog.Create(self);
  openDialog.InitialDir := GetCurrentDir;
  openDialog.Options := [ofFileMustExist];
  openDialog.Filter := 'Archivo de Texto a Graficar|*.txt';
  openDialog.FilterIndex := 1;

  if openDialog.Execute then
     ReadTextFile(openDialog.FileName)
  else
     MessageDlg('No Se Proceso Ningún Archivo de Texto',mtinformation,[mbok],0);

  openDialog.Free;

end;

// Histograma de Letras Minúsculas
procedure TForm1.BitBtn1Click(Sender: TObject);
var
   C : String;
   i : Integer;
begin

   if not FileProcess then
   begin
      MessageDlg('Seleccione un Archivo de Texto',mtinformation,[mbok],0);
      Exit;
   end;

   with Series1 do
   begin
      Clear;
      for i := 1 to High(CountLMin) do
      begin
         C := Copy(LMin,i,1);
         Add(CountLMin[i], C, clBlue);
      end
   end;
end;

// Histograma de Letras Mayúsculas
procedure TForm1.BitBtn3Click(Sender: TObject);
var
   C : String;
   i : Integer;
begin

   if not FileProcess then
   begin
      MessageDlg('Seleccione un Archivo de Texto',mtinformation,[mbok],0);
      Exit;
   end;

   with Series1 do
   begin
      Clear;
      for i := 1 to High(CountLMay) do
      begin
         C := Copy(LMay,i,1);
         Add(CountLMay[i], C, clRed);
      end
   end;
end;

// Histograma de Letras Mayúsculas y Minúsculas
procedure TForm1.BitBtn4Click(Sender: TObject);
var
   C : String;
   i : Integer;
begin

   if not FileProcess then
   begin
      MessageDlg('Seleccione un Archivo de Texto',mtinformation,[mbok],0);
      Exit;
   end;

   with Series1 do
   begin
      Clear;
      for i := 1 to High(CountLMay) do
      begin
         C := Copy(LMay,i,1);
         Add(CountLMay[i]+CountLMin[i], C, clGreen);
      end
   end;
end;

// Carga el ComboBox con los tipos de Gráficos
procedure TForm1.FormCreate(Sender: TObject);
var
   NameSeries : String;
   CountSeries : TNameSeries;
begin
   for CountSeries := Low(TNameSeries) to High(TNameSeries) do
   begin
      NameSeries := GetEnumName(TypeInfo(TNameSeries),Integer(CountSeries));
      ComboBox1.Items.Add(NameSeries);
   end;
   ComboBox1.Text := ComboBox1.Items.Strings[0];
   CheckBox1.State := cbChecked;
end;

// Cambia el tipo de Gráfico
procedure TForm1.ComboBox1Change(Sender: TObject);
var
   NameSeries : TNameSeries;
begin

   NameSeries := TNameSeries(GetEnumValue(TypeInfo(TNameSeries),ComboBox1.Text));

   Case NameSeries of
      Bar : ChangeSeriesType(TChartSeries(Series1),TBarSeries);
      HorizBar : ChangeSeriesType(TChartSeries(Series1),THorizBarSeries);
      Line : ChangeSeriesType(TChartSeries(Series1),TLineSeries);
      Area : ChangeSeriesType(TChartSeries(Series1),TAreaSeries);
      Point : ChangeSeriesType(TChartSeries(Series1),TPointSeries);
      Pie : ChangeSeriesType(TChartSeries(Series1),TPieSeries);
   end;

end;

// Reset Gráfico
procedure TForm1.BitBtn5Click(Sender: TObject);
begin
   Reset;
end;

// Cambia el Modo Gráfico 2D <-> 3D
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
   Chart1.View3D:=CheckBox1.Checked;
end;

end.
El código anterior hace un Histograma de las Letras contenidas en un archivo de texto con algunas opciones gráficas adicionales por medio del Componente TeeChart.

La aplicación esta en el link: http://terawiki.clubdelphi.com/Delph...n+TeeChart.rar

Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 24-11-2012 a las 22:28:59.
Responder Con Cita