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

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

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

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

Ответ
 
Опции темы Поиск в этой теме
Старый 11.06.2010, 07:38   #1
megachuhancer
Форумчанин
 
Регистрация: 16.04.2009
Сообщений: 247
Сообщение Row/Col sizing в TStringGrid

Столкнулся с такой проблемой: не могу разрешить пользователю изменять высоту/ширину строк и колонок в stringgrid'е.

Св-ва:
Options = [goFixedVertLine,goFixedHorzLine,goV ertLine,goHorzLine,goRowSizing,goCo lSizing]
DefaultDrawing = False

В принципе, если так и оставить, то высоту/ширину изменять можно, только вот после выполнения какого-то количества кода, такая возможность теряется. Из-за чего это может быть? Просто я вообще без понятия: от DefaultDrawing это вроде не зависит... Или всегда, когда что-то отрисовывается, возможность менять размер строк/колонок теряется?.. Я пробовал исключать различные куски кода, но так и не нашёл причину, хотя меня не оставляет чувство, что она проста.

Вот весь код, в котором вообще упоминается grid:
Код:
...
Grid: TStringGrid;
...
procedure TfrmSchedule.AccCells(a: TCellsAction);
var
  i, j: Integer;
begin
  with Grid do
    for i := 1 to RowCount - 1 do
      for j := 1 to ColCount - 1 do
        case a of
          acCreate: Objects[j, i] := TCellInfo.Create;
          acFree: begin Objects[j, i].Free; Objects[j, i] := nil; end;
        end;
end;
...
procedure TfrmSchedule.btnApplyClick(Sender: TObject);
...
begin
...
InitGrid;
...
Grid.Objects[0, 0].Free;
Grid.Objects[0, 0] := TLineInfo.Create;
...
 //-------------------------------------------------------
  while not IBDataSet1.Eof do begin
    li := GetLineInfo(IBDataSet1);
    Grid.RowCount := Grid.RowCount + 1;
    Grid.Objects[0, Grid.RowCount - 1].Free;
    Grid.Objects[0, Grid.RowCount - 1] := li;
    IBDataSet1.Next;
  end;
  //-------------------------------------------------------
  while not IBDataSet2.Eof do begin
    li := GetLineInfo(IBDataSet2);
    Grid.ColCount := Grid.ColCount + 1;
    Grid.Objects[Grid.ColCount - 1, 0].Free;
    Grid.Objects[Grid.ColCount - 1, 0] := li;
    IBDataSet2.Next;
  end;
...
  AccCells(acFree);
  AccCells(acCreate);
  FillCells;
...
end;
...
procedure TfrmSchedule.chkFieldNamesClick(Sender: TObject);
begin
  Grid.Repaint;
end;
...
procedure TfrmSchedule.FillCells;
...
begin
...
(Grid.Objects[hp, vp] as TCellInfo).AddItem(Arr);
...
end;
...
procedure TfrmSchedule.InitGrid;
begin
  Grid.RowCount := 1;
  Grid.ColCount := 1;
  Grid.DefaultColWidth := 175;
  Grid.DefaultRowHeight := 55;
end;
...
procedure TfrmSchedule.GridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  ci: TCellInfo;
  i, j, tw: Integer;
  s1, s2: string;
  r: TRect;
begin
  {if gdSelected in State then begin
    Canvas.Brush.Style := bsSolid;
    Canvas.Pen.Color := clNavy;
    Canvas.Pen.Width := 5;
    r := Rect;
    InflateRect(r, -5, -5);
    Canvas.Rectangle(r);
  end;}
  with Grid do begin
    if Objects[ACol, ARow] is TLineInfo then begin
      Canvas.Font.Style := [];
      Canvas.Brush.Style := bsSolid;
      Canvas.Brush.Color := clBtnFace;
      r := Rect;
      InflateRect(r, -1, -1);
      Canvas.TextRect(r, r.Left + 1, r.Top + 1,
        (Objects[ACol, ARow] as TLineInfo).Caption);
    end;
    if Objects[ACol, ARow] is TCellInfo then begin
      ci := Objects[ACol, ARow] as TCellInfo;
      with Canvas do begin
        r := Rect;
        InflateRect(r, -1, -1);
        Brush.Style := bsSolid;
        Brush.Color := clWhite;
        Rectangle(r);
        if ci.Count = 0 then begin
          Brush.Style := bsBDiagonal;
          Brush.Color := clBlack;
          Rectangle(r);
        end;
        Brush.Style := bsClear;
        for i := 0 to ci.Count - 1 do
          for j := 0 to High(ci.Items[i]) do begin
            s1 := '';
            if chkFieldNames.Checked then s1 := ci.Items[i][j].Key + ': ';
            s2 := ci.Items[i][j].Val;
             Font.Style := [fsBold];
             TextRect(r, r.Left + 1,
               r.Top + j * TextHeight(s2) + i * (8 * TextHeight(s2)) + 1,
                 s1);
             tw := TextWidth(s1);
             Font.Style := [];
             TextRect(r, r.Left + tw + 1,
               r.Top + j * TextHeight(s2) + i * (8 * TextHeight(s2)) + 1,
                 s2);
          end;
      end;
    end;
  end;
end;
...
megachuhancer вне форума Ответить с цитированием
Старый 11.06.2010, 08:40   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

А если заремить все что в DrawCell?
просто ради интереса.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 11.06.2010, 09:02   #3
megachuhancer
Форумчанин
 
Регистрация: 16.04.2009
Сообщений: 247
По умолчанию

Пробовал я.

А вообще, я наверное поспешил здесь спрашивать, потому что разобрался сам.

Проблема здесь была:
Код:
Grid.RowCount := 1;
Grid.ColCount := 1;
Здесь FixedCols и FixedRows автоматом устанавливаются в 0. А изменять без них размер рядов не получится. Я не заметил их отсутствия сразу, потому что отрисовка у меня полностью своя, и проверяю я тип ячейки не по параметру State, а по типу связанного объекта:
Код:
if Objects[ACol, ARow] is TLineInfo then begin
Бывает же...
megachuhancer вне форума Ответить с цитированием
Старый 11.06.2010, 09:08   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Цитата:
Я не заметил их отсутствия сразу,
Понимаю. У меня тоже с отрисовкой иногда мозк кипит, а очевидного не замечаю
I'm learning to live...
Stilet вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
не работает цикл while ($row = mssql_fetch_row($result)) zvezda_t PHP 2 25.01.2010 12:33
DataGridView next row MAcK Общие вопросы .NET 3 10.03.2009 15:25
TStringGrid MyQwErTy Помощь студентам 7 26.02.2009 13:13
TStringGrid mrandrey Компоненты Delphi 2 06.07.2007 15:24