Консультации Портала - Консультация #178176

Задать вопрос Консультации Пользователи Форум

Задать вопрос экспертам

Консультация № 178176

03.05.2010, 04:24

42.16 руб.

0 6 2

Компьютеры Программирование

Уважаемые эксперты. Помогите в написании программы. Delphi 7. Программа: https://rfpro.ru/upload/2261
Данные из StringGrid1 должны сохраняться в файле типа *.dat (StringGrid.dat).

Приложение:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, Grids, StdCtrls, ExtCtrls, ComCtrls;

type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
Panel1: TPanel;
ListBox1: TListBox;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
StringGrid1: TStringGrid;
OpenDialog2: TOpenDialog;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
StatusBar1: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N7Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
str=string[30];
sotrudnik=record
Familiya:str;
Zarplata:real;
end;
massiv=array of sotrudnik;
var
mas:massiv;
n:word;
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[0,0]:='Фамилия';
StringGrid1.Cells[1,0]:='Зарплата';
ListBox1.Clear;
Label1.Caption:='Средний заработок';
Label2.Caption:='Сведения о сотрудниках';
Label3.Caption:='Cписок сотрудников';
end;

procedure TForm1.N3Click(Sender: TObject);
var i:integer;
begin
i:=1;
setlength(mas,1);
while StringGrid1.Cells[0,i]<>'' do
begin
mas[i-1].Familiya:=StringGrid1.Cells[0,i];
mas[i-1].zarplata:=StrToInt(StringGrid1.Cells[1,i]);
i:=i+1;
Setlength(mas,i);
end;
end;

procedure TForm1.N2Click(Sender: TObject);
var
i, j, y: word;
f: TextFile;
begin
y:= 0;
AssignFile(f, 'stringdrid.dat');
Rewrite(f);
with StringGrid1 do
begin
for i:= 0 to RowCount - 1 do
if Cells[0, i] <> '' then
inc(y);
Writeln(f, ColCount);
Writeln(f, y);
for i:= 0 to ColCount - 1 do
for j:= 0 to y - 1 do
Writeln(F, Cells[i, j]);
end;
CloseFile(F);
end;

function Count(var s:massiv):real;
var i:integer;
p:real;
begin
p:=0;
for i:=0 to n-1 do
with s[i] do
p:=p+s[i].Zarplata;
result:=p/n;
end;

procedure TForm1.N6Click(Sender: TObject);
var
f: TextFile;
x, i, j: Integer;
str: String;
k:real;
list: TStringList;
begin
StringGriD1.Font.Color:= clGreen;
if not Fileexists('stringdrid.dat') then
begin
ShowMessage('Файла не существует');
exit;
end;
AssignFile(f, {OpenDialog1.FileName}'stringdrid.dat');
Reset(f);
with StringGrid1 do
begin
Readln(f, x);
ColCount:= x;
Readln(f, x);
RowCount:= x;
for i:= 0 to ColCount - 1 do
for j:= 0 to RowCount - 1 do
begin
Readln(f, str);
Cells[i, j]:= str;
end;
begin
i:=1;
setlength(mas,1);
while StringGrid1.Cells[0,i]<>'' do
begin
mas[i-1].Familiya:= stringgrid1.Cells[0,i];
mas[i-1].Zarplata:= StrToFloat(StringGrid1.Cells[1,i]);
i:= i + 1;
setlength(mas, i);
end;
n:= i - 1;
k:= count(mas);
Edit1.Text:= FloattostrF(k, ffFixed, 8, 4);
ListBox1.Clear;
List:= TStringList.Create;
for i:= 1 to StringGrid1.RowCount do
if StringGrid1.Cells[0, i] <> '' then
List.Add(StringGrid1.Cells[0, i]);
List.Sort;
ListBox1.Items.AddStrings(List);
List.Free;
end;
StatusBar1.Panels[0].Text:= 'n = ' + IntToStr(StringGrid1.RowCount - 1);
StatusBar1.Panels[1].Text:= ExtractFilePath(ParamStr(0)) + 'stringdrid.txt';
CloseFile(f)
end;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
Close;
end;

end.

Обсуждение

Неизвестный

03.05.2010, 08:31

общий

Спиридонов Данил Сергеевич:
Вид файла: типизированный, текстовый? Вам нужно только сохранение/чтение в/из файл/а сделать?

Неизвестный

03.05.2010, 09:26

общий

это ответ

Здравствуйте, Спиридонов Данил Сергеевич.

Приложение:
procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
f: TextFile;
i, k: Integer;

begin
AssignFile(f, FileName);
Rewrite(f);
with StringGrid do
begin
// Write number of Columns/Rows
Writeln(f, ColCount);
Writeln(f, RowCount);
// loop through cells
for i := 0 to ColCount - 1 do
for k := 0 to RowCount - 1 do
Writeln(F, Cells[i, k]);
end;
CloseFile(F);

end;

// Load a TStringGrid from a file

procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);
var
f: TextFile;
iTmp, i, k: Integer;
strTemp: String;
begin

AssignFile(f, FileName);
Reset(f);
with StringGrid do
begin
// Get number of columns
Readln(f, iTmp);
ColCount := iTmp;
// Get number of rows
Readln(f, iTmp);
RowCount := iTmp;
// loop through cells & fill in values
for i := 0 to ColCount - 1 do
for k := 0 to RowCount - 1 do
begin
Readln(f, strTemp);
Cells[i, k] := strTemp;
end;
end;
CloseFile(f);

end;

давно

Евгений/Genia007/

Профессионал
153662
1070

03.05.2010, 09:50

общий

Спиридонов Данил Сергеевич:
А чем Вас не устраивает Ваш проект, он вполне нормально работает?

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

давно

Евгений/Genia007/

Профессионал
153662
1070

03.05.2010, 16:52

общий

Спиридонов Данил Сергеевич:
Вот мой вариант решения задачи:
Сохранение в файл

Код:

procedure TForm1.N3Click(Sender: TObject);
var
  i, j: word;
begin
  i:= 1;
  while StringGrid1.Cells[0, i] <> '' do
    begin
      Setlength(mas, i);
      mas[i - 1].Familiya:= StringGrid1.Cells[0, i];
      mas[i - 1].zarplata:= StrToFloat(StringGrid1.Cells[1, i]);
      inc(i);
    end;
  dec(i, 2);
  AssignFile(FileData, 'stringdrid.dat');
  Rewrite(FileData);
  for j:= 0 to i do
    Write(FileData, mas[j]);
  CloseFile(FileData);
end;

Чтение из файла

Код:

procedure TForm1.N4Click(Sender: TObject);
var
  i, j: integer;
begin
  i:= 0;
  AssignFile(FileData, 'stringdrid.dat');
  Reset(FileData);
  while not eof(FileData) do
  begin
    inc(i);
    SetLength(mas, i);
    Read(FileData, mas[i - 1]);
  end;
  CloseFile(FileData);
  j:= i;
  for i:= 0 to j - 1 do
    begin
      StringGrid1.Cells[0, i + 1]:= mas[i].Familiya;
      StringGrid1.Cells[1, i + 1]:= FloatToStr(mas[i].Zarplata);
    end;
end;

Ну и переделал объявление типа сотрудник

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, Grids, StdCtrls, ExtCtrls, ComCtrls;

type sotrudnik = record
       Familiya: string[30];
       Zarplata: real;
     end;
       massiv = array of sotrudnik;
       fl = File Of sotrudnik;
type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Panel1: TPanel;
    ListBox1: TListBox;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    StringGrid1: TStringGrid;
    OpenDialog2: TOpenDialog;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  FileData: fl;
  mas: massiv;
  n: word;
  Form1: TForm1;

implementation

{$R *.dfm}

Получаемый файл нельзя прочитать текстовым редактором.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

давно

Евгений/Genia007/

Профессионал
153662
1070

03.05.2010, 17:12

общий

Ну и вот весь исходник исправленный с учётом задания

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, Grids, StdCtrls, ExtCtrls, ComCtrls;

type sotrudnik = record
      Familiya: string[30];
      Zarplata: real;
     end;
       massiv = array of sotrudnik;
       fl = File Of sotrudnik;
type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Panel1: TPanel;
    ListBox1: TListBox;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    StringGrid1: TStringGrid;
    OpenDialog2: TOpenDialog;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  FileData: fl;
  mas: massiv;
  n: word;
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  StringGrid1.Cells[0,0]:='Фамилия';
  StringGrid1.Cells[1,0]:='Зарплата';
  ListBox1.Clear;
  Label1.Caption:='Средний заработок';
  Label2.Caption:='Сведения о сотрудниках';
  Label3.Caption:='Cписок сотрудников';
end;

procedure TForm1.N2Click(Sender: TObject);
var i:integer;
begin
  i:= 1;
  setlength(mas, 1);
  while StringGrid1.Cells[0,i] <> '' do
    begin
      mas[i - 1].Familiya:= StringGrid1.Cells[0, i];
      mas[i - 1].zarplata:= StrToFloat(StringGrid1.Cells[1, i]);
      inc(i);
      Setlength(mas, i);
    end;
  n:= i - 1;
end;

procedure TForm1.N3Click(Sender: TObject);
var
  i, j: word;
begin
  i:= 1;
  while StringGrid1.Cells[0, i] <> '' do
    begin
      Setlength(mas, i);
      mas[i - 1].Familiya:= StringGrid1.Cells[0, i];
      mas[i - 1].zarplata:= StrToFloat(StringGrid1.Cells[1, i]);
      inc(i);
    end;
  dec(i, 2);
  n:= i + 1;
  AssignFile(FileData, 'stringdrid.dat');
  Rewrite(FileData);
  for j:= 0 to i do
    Write(FileData, mas[j]);
  CloseFile(FileData);
end;

function Count(var s: massiv): real;
var
  i: integer;
  p: real;
begin
  p:= 0;
  for i:= 0 to n - 1 do
  with s[i] do
  p:= p + s[i].Zarplata;
  result:= p / n;
end;

procedure TForm1.N6Click(Sender: TObject);
var
  i: Integer;
  k: real;
  list: TStringList;
begin
  k:= count(mas);
  Edit1.Text:= FloattostrF(k, ffFixed, 8, 4);
  ListBox1.Clear;
  List:= TStringList.Create;
  for i:= 1 to StringGrid1.RowCount do
    if StringGrid1.Cells[0, i] <> '' then
      List.Add(StringGrid1.Cells[0, i]);
  List.Sort;
  ListBox1.Items.AddStrings(List);
  List.Free;
end;

procedure TForm1.N7Click(Sender: TObject);
begin
Close;
end;

procedure TForm1.N4Click(Sender: TObject);
var
  i: integer;
begin
  i:= 0;
  AssignFile(FileData, 'stringdrid.dat');
  Reset(FileData);
  while not eof(FileData) do
  begin
    inc(i);
    SetLength(mas, i);
    Read(FileData, mas[i - 1]);
  end;
  CloseFile(FileData);
  n:= i;
  StringGriD1.Font.Color:= clGreen;
  for i:= 0 to n - 1 do
    begin
      StringGrid1.Cells[0, i + 1]:= mas[i].Familiya;
      StringGrid1.Cells[1, i + 1]:= FloatToStr(mas[i].Zarplata);
    end;
  StatusBar1.Panels[0].Text:= 'n = ' + IntToStr(n);
  StatusBar1.Panels[1].Text:= ExtractFilePath(ParamStr(0)) + 'stringdrid.dat';
end;

end.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

давно

Евгений/Genia007/

Профессионал
153662
1070

06.05.2010, 09:55

общий

это ответ

Здравствуйте, Спиридонов Данил Сергеевич.
Предлагаю свой вариант решения задачи:
1. Сохранение в файл

Код:

procedure TForm1.N3Click(Sender: TObject);  //  Процедура сохранения сетки в файл
var
  i, j: word;
begin
  i:= 1;
  while StringGrid1.Cells[0, i] <> '' do
    begin  //  Запись данных о сотрудниках в массив
      Setlength(mas, i);
      mas[i - 1].Familiya:= StringGrid1.Cells[0, i];
      mas[i - 1].zarplata:= StrToFloat(StringGrid1.Cells[1, i]);
      inc(i);
    end;
  dec(i, 2);
  n:= i + 1;
  AssignFile(FileData, 'stringdrid.dat');  //  Связали файловую переменную с файлом
  Rewrite(FileData);  //  Открыли файл для перезаписи
  for j:= 0 to i do
    Write(FileData, mas[j]);  //  Записали данные в файл
  CloseFile(FileData);  //  Закрыли файл
end;

2. Чтение из файла

Код:

procedure TForm1.N4Click(Sender: TObject);  //  Процедура чтения сетки из файла
var
  i: integer;
begin
  i:= 0;
  If not FileExists('stringdrid.dat') then  //  Проверяем существует или нет файл
    begin
      StatusBar1.Panels[1].Text:= 'Файла ' + ExtractFilePath(ParamStr(0)) + 'stringdrid.dat' + ' не существует';  //  Выводим путь до файла
      exit;
    end;
  AssignFile(FileData, 'stringdrid.dat');  //  Связали файловую переменную с файлом
  Reset(FileData);  //  Встали на начало файла
  while not eof(FileData) do
  begin  //  Делаем пока не дойдём до конца файла
    inc(i);
    SetLength(mas, i);  //  Устанавливаем новый размер массива
    Read(FileData, mas[i - 1]);  //  Читаем данные из файла в массив
  end;
  CloseFile(FileData);  //  Закрыли файл
  n:= i;
  StringGriD1.Font.Color:= clGreen;  //  Сделали цвет шрифта сетки зелённым
  for i:= 0 to n - 1 do
    begin  //  Заполняем сетку данными
      StringGrid1.Cells[0, i + 1]:= mas[i].Familiya;
      StringGrid1.Cells[1, i + 1]:= FloatToStr(mas[i].Zarplata);
    end;
  StatusBar1.Panels[0].Text:= 'n = ' + IntToStr(n);  //  Выводим информацию количестве записей в сетке
  StatusBar1.Panels[1].Text:= ExtractFilePath(ParamStr(0)) + 'stringdrid.dat';  //  Выводим путь до файла
end;

3. Немного переделал объявление записи сотрудник

Код:

type sotrudnik = record
      Familiya: string[30];
      Zarplata: real;
     end;
       massiv = array of sotrudnik;
       fl = File Of sotrudnik;

  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  FileData: fl;
  mas: massiv;
  n: word;
  Form1: TForm1;

Весь проект.

Спасибо!

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Форма ответа

Отправка постов/ответов доступна только зарегистрированным и подтвержденным пользователям.

Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.