Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.05.2013, 07:54   #1
dima1257
Пользователь
 
Аватар для dima1257
 
Регистрация: 16.11.2012
Сообщений: 66
По умолчанию закрашивание ячеек в StringGrid. чуть чуть подправить.

Создать программный комплекс, реализующий ввод данных из файла, просмотр входных и выходных данных. Программа запрашивает имя типизированного файла, заполненного целыми случайными числами. Программа заполняет компонентами исходного файла матрицу A(N x N). Программа распечатывает матрицу в виде таблицы, отмечая максимальный элемент главной диагонали матрицы A зеленым цветом. Если максимумов несколько, то программа отмечает зеленым цветом все максимумы.

программу сделал и всё работает, но только 1 раз. проблема в том что когда я снова пере создаю файл и распечатываю его в stringgrid, то старые максимумы по прежнему зеленые.

Код:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);

  private
    Cells : array of TPoint;
    check, b:boolean;

    { Private declarations }
  public

    { Public declarations }
  end;
  type TGridCracker = class(TStringGrid);

var
  Form1: TForm1;
  //Координаты ячейки, которая подверглась редактированию.
  gEditCol : Integer = -1;
  gEditRow : Integer = -1;

implementation

{$R *.dfm}

procedure SetCaretPosition(Grid: TStringGrid; col, row, x_pos: Integer);
begin
  Grid.Col := Col;
  Grid.Row := Row;
  with TGridCracker(Grid) do
  InplaceEditor.SelStart := x_pos;
end;

procedure TForm1.Button1Click(Sender: TObject);
var f:file of integer;
    v, i, j, x, max:integer;
    mass:array of array of integer;
    str:string;
    sg:TStringGrid;
    C:TPoint;
begin // прочитать описание диска из файла

if (Edit1.Text = '') then
  ShowMessage('NO')
  else
  Begin
    Memo1.Clear; // очистить поле ввода
    i:= 1;
    j:= 1;
    x:= StrToInt(Edit1.Text);
    SetLength(mass, x, x);

    with opendialog1 do     
      if Execute then
        begin
          AssignFile(f, FileName); // ассоциировать файл с переменной f
          reset(f);
          while (not EoF(f)) do
          begin

            read(f, v); // построчно прочитать


            if i > x then
            Begin
            j:= j + 1;
              memo1.Lines.add(str); // и записать в поле Memo
              i:= 1;
              str:='';
            end;

            StringGrid1.Cells[i-1,j-1]:= IntToStr(v);

            mass[i-1, j-1]:= v;

            str:= str + IntToStr(v) + '  ';

            i:= i + 1;

          end;
    end;

    max:= mass[0, 0];
    for i:=0 to x-1 do
      for j:=0 to x-1 do
      Begin

        if i = j then
        Begin
          if mass[i,j] > max then
            max:= mass[i,j];

        end;

      end;

             check:=true;
    for i:=0 to x-1 do
      for j:=0 to x-1 do
      Begin
        if (i = j) and (StrToInt(StringGrid1.Cells[i,j]) = max) then
        Begin

          SetLength(Cells, Length(Cells) + 2); //

          C.X := j; C.Y := i;
          Cells[Length(Cells) - 2] := C;
          C.X := j; C.Y := i;
          Cells[Length(Cells) - 1] := C;
        end;
      end;


  end;




  StringGrid1.Invalidate;
    StringGrid1.SetFocus;
    with StringGrid1 do
    SetCaretPosition(StringGrid1, 0, 1, 2);
end;






procedure TForm1.Button2Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Clear;


end;
Выдержка из правил форума: Не стоит отправлять в поиск, не хотите отвечать пройдите мимо. Хотите помочь, пишите конкретный ответ.
dima1257 вне форума Ответить с цитированием
Старый 30.05.2013, 07:54   #2
dima1257
Пользователь
 
Аватар для dima1257
 
Регистрация: 16.11.2012
Сообщений: 66
По умолчанию

Код:
procedure TForm1.Button3Click(Sender: TObject);
var f:file of integer; // файловая переменная для связи с
                       // целочисленным типизированным файлом

    name:string; // переменная для имени файла
    i, j, num:integer; // счетчик и переменная для случайного числа
    m:integer;
    C:TPoint;
    Rect: TRect;
begin

if Edit1.Text = '' then
  ShowMessage('NO')
  else
  Begin
    name:= ExtractFilePath(Application.ExeName) + 'test.txt'; // задать имя файла

    AssignFile(f, name); // связать файловую переменную с именем файла

    Rewrite(f); // пересоздать файл и открыть в режиме записи

    randomize; // инициализировать генератор случайных чисел
    m:= StrToInt(Edit1.Text);

    StringGrid1.RowCount:= m;
    StringGrid1.ColCount:= m;




    for i:=0 to m do
    StringGrid1.Cols[i].Clear;

    for i:= 1 to m*m do
    begin
      num:=random(5);
      Write(f, num);
    end;

    closeFile(f); // закрыть файл

    end;

  end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  i, j : integer;
  change : Boolean;
begin


  if check = true then
  begin
    change := False;
    for i := 0 to Length(Cells) - 1 do
    begin
      if (ACol = Cells[i].X) and (ARow = Cells[i].Y) then
      begin
        Change := true;
        break
      end;
    end;

    if change then
    begin
      StringGrid1.Canvas.Brush.Color := clGreen;
      StringGrid1.Canvas.FillRect(Rect);
      StringGrid1.Canvas.TextOut(Rect.Left, Rect.Top, StringGrid1.Cells[ACol, ARow]);
    end;
  end;

  if check = false then
  begin
    change := true;
    //for i := 0 to Length(Cells) - 1 do
    //begin
      //if (ACol = Cells[i].X) and (ARow = Cells[i].Y) then
      //begin
        Change := true;
        //break
      //end;
    //end;

    if change then
    begin
      for i:=0 to StrToInt(Edit1.Text) do
        for j:=0 to StrToInt(Edit1.Text) do
        begin

        //StringGrid1.Canvas.Brush.Color:=clRed;
        //StringGrid1.Canvas.FillRect(Rect);
        //StringGrid1.canvas.brush.Color := clRed;
      StringGrid1.Canvas.Brush.Color := clGrayText;
      StringGrid1.Canvas.FillRect(Rect);
      StringGrid1.Canvas.TextOut(Rect.Left, Rect.Top, StringGrid1.Cells[ACol, ARow]);
        end;
    end;
  end;


end;

end.
вот программа http://yadi.sk/d/bw8V1IaQ5JYZu
Выдержка из правил форума: Не стоит отправлять в поиск, не хотите отвечать пройдите мимо. Хотите помочь, пишите конкретный ответ.

Последний раз редактировалось dima1257; 30.05.2013 в 07:57.
dima1257 вне форума Ответить с цитированием
Старый 30.05.2013, 08:34   #3
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Цитата:
for i := 0 to Length(Cells) - 1 do
begin
if (ACol = Cells[i].X) and (ARow = Cells[i].Y) then
begin
Change := true;
break
end;
end;
А зачем тут цикл? Вообще программу можно было бы серьезно сократить если бы делать так:
Код:
unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
  StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    StringGrid1: TStringGrid;
    procedure Button1Click(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
      aRect: TRect; aState: TGridDrawState);
  private
    { private declarations }
  public
    { public declarations }
  end;

var max:integer;
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var i,j,k:integer;
begin
  Randomize;
  max:=-MaxInt;
with StringGrid1 do begin
  for i:=0 to RowCount-1 do
   for j:=0 to ColCount-1 do begin
     k:=Random(100);
     Objects[i,j]:=TObject(k);
     Cells[i,j]:=IntToStr(k);
     if  ((i=j) and (max<k))  then max:=k;
   end;
  Repaint;
end;
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; aCol, aRow: Integer;
  aRect: TRect; aState: TGridDrawState);
begin
  with TStringGrid(Sender) do begin
    if (aCol=aRow)and(integer(Objects[aCol,aRow])=max) then Canvas.Brush.Color:=clGreen;
    Canvas.FillRect(aRect);
    Canvas.TextOut(aRect.Left+10,aRect.Top,Cells[aCol,aRow]);
  end;
end;

end.
Это в качестве примера, это не переделка твоего кода.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 30.05.2013, 15:47   #4
dima1257
Пользователь
 
Аватар для dima1257
 
Регистрация: 16.11.2012
Сообщений: 66
По умолчанию

Stilet, спасибо! На очень правильную мысль натолкнул. Всё получилось.
да и код сократился. спасибо.
Выдержка из правил форума: Не стоит отправлять в поиск, не хотите отвечать пройдите мимо. Хотите помочь, пишите конкретный ответ.
dima1257 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Нужно дописать программу, примерно 90% сделано, осталось чуть чуть Xerxes Фриланс 2 31.01.2011 23:27
График функции на паскале, чуть-чуть поправить momentow Помощь студентам 1 28.12.2010 01:28
программа часы,надо чуть-чуть переделать RadioDream Помощь студентам 1 21.10.2010 19:29
нашел поиском нужный макрос, чуть чуть бы доработать zander Microsoft Office Excel 3 30.09.2009 12:19