Форум: "Основная";
Текущий архив: 2005.03.20;
Скачать: [xml.tar.bz2];

Вниз

Проблемы со StringGrid ом! С многострочностью не клеится...   Найти похожие ветки 

← →
syscoder   (2005-03-06 18:56) [0]

Как правильно реализовать многострочность в ячейке StringGrid"а. Перепробовал несколько примеров, а в итоге никакого правильного результата. Приведу пару примеров обработчика OnDrawCell:
[-1-]
Format := DT_LEFT or DT_WORDBREAK;
SGmem.Canvas.FillRect(Rect);
StrPCopy(C, SGmem.Cells[ACol, ARow]);
DrawText(SGmem.Canvas.Handle, C, StrLen(C), Rect, Format);

Во время добавлении строк в таблицу делаю так:
SGmem.Cells[1,indxMemRow] := StrFM_gap.Strings[0];
StrFM_gap.Delete(0);
SGmem.Cells[2,indxMemRow] := SGmem.Cells[2,indxMemRow] + StrFM_gap.Text;
// если кол-во строк в ячейке больше её высоты
if (SGmem.canvas.TextHeight(SGmem.Cells[2,indxMemRow])*2) > SGmem.RowHeights[indxMemRow] then
// то делаем высоту ячейки во столько раз больше, сколько этих строк
SGmem.RowHeights[indxMemRow] := SGmem.canvas.TextHeight(SGmem.Cells[2,indxMemRow])*(StrFM_gap.Count-1)+20;

В этом случае возникает какой-то глюк в обработчике OnDrawCell при добавлении большого количества строк. Прога просто напросто закрывается без всяких ошибок, а в Дельфях пишет AV.
В чём тут дело?

[-2-]
S := SGmem.Cells[ACol,ARow];
if gdSelected in State then
begin
 SGmem.Canvas.Brush.Color := clInactiveCaptionText;
 SGmem.Canvas.FillRect(Rect);
end;
Inc(Rect.Top, 2);
Dec(Rect.Bottom, 2);
Inc(Rect.Left, 2);
Dec(Rect.Right, 2);
DrawText(SGmem.Canvas.Handle, pChar(S), Length(S), Rect, DT_LEFT or DT_WORDBREAK);

Попробовал так, при таком же методе заполнения строк. Работает лучше! НО, никак не могу докумекать до одной фишки. Дело в том, что тект разбивается на строки, но в ячейке получается такая лажа: в первой строке ячейки добавляется вся остальная строка, разбитая ниже на строки, а когда выделяешь ячейку, то она отсекается и становиться всё пучком,... пока не сдвинешь на другую ячейку. Вот так.

Помогите кто шарит в этом деле, срочно нужно, я уже сегодня весь день у компа торчу, уже недумается...

---

← →
ShimON ©   (2005-03-06 19:07) [1]

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow:
 Integer;
 Rect: TRect; State: TGridDrawState);
var
 Format: Word;
 C: array[0..255] of Char;
begin
 Format := DT_LEFT or DT_WORDBREAK;
 (Sender as TStringGrid).Canvas.FillRect(Rect);
 StrPCopy(C, (Sender as TStringGrid).Cells[ACol, ARow]);
 WinProcs.DrawText((Sender as TStringGrid).Canvas.Handle, C,
   StrLen(C), Rect, Format);
end;


---

← →
ShimON ©   (2005-03-06 19:10) [2]

Сперва необходимо установить свойство DefaultDrawing в False. Далее, необходимо вставить следующий код в обработчик события OnDrawCell:

procedure TForm1.StringGrid1DrawCell(Sender: TObject;
 Col, Row: Longint;
 Rect: TRect;
 State: TGridDrawState);
var
 Line1: string;
 Line2: string;
 ptr: integer;
 padding: integer;
 hGrid: TStringGrid;

begin
 hGrid := (Sender as TStringGrid);
 ptr := Pos(";", hGrid.Cells[Col, Row]);
 if ptr > 0 then
 begin
   Line1 := Copy(hGrid.Cells[Col, Row], 1, ptr - 1);
   Line2 := Copy(hGrid.Cells[Col, Row], ptr + 1,
     Length(hGrid1.Cells[Col, Row]) - ptr);
 end
 else
   Line1 := hGrid.Cells[Col, Row];
 hGrid.Canvas.FillRect(Rect);
 hGrid.Canvas.TextOut(Rect.Left, Rect.Top + 2, Line1);
 if ptr > 0 then
   hGrid.Canvas.TextOut(Rect.Left, Rect.Top -
     hGrid.Canvas.Font.Height + 3, Line2);
end;Теперь достаточно для переноса строки вставить в неё точку с запятой. Так же не забудьте изменить высоту строки так, чтобы переносы строки поместились в ячейку:

StringGrid1.RowHeights[0] := StringGrid1.DefaultRowHeight * 2;

---

← →
ShimON ©   (2005-03-06 19:11) [3]

И еще большая куча других, так что если это не подойдет, скажи, дам еще

---

← →
syscoder   (2005-03-06 19:21) [4]

>> ShimON ©   (06.03.05 19:11) [3]
О-О-О-О!! Эти примеры я уже перелопатил. Реализация у них хреновая, да и не работают они. Кстати первый ваш пример аналогичен моему и выдран, наверное, из тех же FAQ. Проблему-то он не решает!!!

---

← →
ShimON ©   (2005-03-06 19:53) [5]

У меня сборник из многих факов,  так что может другие подойдут??

---

← →
syscoder   (2005-03-06 20:03) [6]

>> ShimON ©   (06.03.05 19:53) [5]
У меня сборник из многих факов,  так что может другие подойдут??

Дык у меня тоже не хилый сборничек скопился. Никогда просто с этим гридом не работал, а тут пришлось возиться.
Если не затруднит, то подкинте что-нибудь из вашего, посмотрим...

---

← →
ShimON ©   (2005-03-06 20:09) [7]

procedure TForm1.grid1DrawCell(Sender: TObject; Col, Row: Longint;
  Rect: TRect; State: TGridDrawState);

 var l_oldalign : word;
     l_YPos,l_XPos,i : integer;
     s,s1 : string;
     l_col,l_row :longint;

begin
  l_col := col;
  l_row := row;
  with sender as tstringgrid do
  begin
    if (l_row=0) then
      canvas.font.style:=canvas.font.style+[fsbold];
    if l_row=0 then
    begin
      l_oldalign:=settextalign(canvas.handle,ta_center);
      l_XPos:=rect.left + (rect.right - rect.left) div 2;
      s:=cells[l_col,l_row];
      while s<>"" do
      begin
        if pos(#13,s)<>0 then
        begin
          if pos(#13,s)=1 then
            s1:=""
          else
          begin
            s1:=trim(copy(s,1,pred(pos(#13,s))));
            delete(s,1,pred(pos(#13,s)));
          end;
          delete(s,1,2);
        end
        else
        begin
          s1:=trim(s);
          s:="";
        end;
        l_YPos:=rect.top+2;
        canvas.textrect(rect,l_Xpos,l_YPos,s1);
        inc(rect.top,rowheights[l_row] div 3);
      end;
      settextalign(canvas.handle,l_oldalign);
    end
    else
    begin
       canvas.textrect(rect,rect.left+2,rect.top+2,cells[l_col,l_row]);
    end;

    canvas.font.style:=canvas.font.style-[fsbold];
  end;
end;


---

← →
ShimON ©   (2005-03-06 20:11) [8]

Это тоже может помочь - только для заголовков, на сколько я понял..
TFTVerticalAlignment = (vaTop, vaMiddle, vaBottom);

procedure DrawTextAligned(const Text: string; Canvas: TCanvas; ъ
 var Rect: TRect; Alignment: TAlignment; VerticalAlignment:
 TFTVerticalAlignment; WordWrap: Boolean);
var
 P: array[0..255] of Char;
 H: Integer;
 T: TRect;
 F: Word;
begin
 StrPCopy(P, Text);
 T := Rect;
 with Canvas, Rect do
 begin
   F := DT_CALCRECT or DT_EXPANDTABS or DT_VCENTER or
     TextAlignments[Alignment];
   if WordWrap then
     F := F or DT_WORDBREAK;
   H := DrawText(Handle, P, -1, T, F);
   H := MinInt(H, Rect.Bottom - Rect.Top);
   if VerticalAlignment = vaMiddle then
   begin
     Top := ((Bottom + Top) - H) div 2;
     Bottom := Top + H;
   end
   else if VerticalAlignment = vaBottom then
     Top := Bottom - H - 1;
   F := DT_EXPANDTABS or DT_VCENTER or TextAlignments[Alignment];
   if WordWrap then
     F := F or DT_WORDBREAK;
   DrawText(Handle, P, -1, Rect, F);
 end;
end;


---

← →
KSergey ©   (2005-03-06 20:29) [9]

> [-2-]
> S := SGmem.Cells[ACol,ARow];
> if gdSelected in State then
> begin
>  SGmem.Canvas.Brush.Color := clInactiveCaptionText;
>  SGmem.Canvas.FillRect(Rect);
> end;
...

Почему чистим ячейку только в случае ее выделения?? Может все же правильнее FillRect вынести из if?

---

← →
Юрий Зотов ©   (2005-03-06 20:48) [10]

Может, и я на что сгожусь?

type
 TForm1 = class(TForm)
   Edit1: TEdit;
   AddButton: TButton;
   StringGrid1: TStringGrid;
   procedure FormCreate(Sender: TObject);
   procedure Edit1Change(Sender: TObject);
   procedure Edit1KeyPress(Sender: TObject; var Key: Char);
   procedure AddButtonClick(Sender: TObject);
   procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
     Rect: TRect; State: TGridDrawState);
 private
   FRow: integer;
   FCol: integer;
   procedure AdjustRowHeight;
 end;

procedure TForm1.AdjustRowHeight;
var
 S: string;
 R: TRect;
begin
 with StringGrid1 do
 begin
   S := Cells[FCol, FRow];
   if S = "" then
     S := "!";
   R := CellRect(FCol, FRow);
   InflateRect(R, -2, -2);
   DrawText(Canvas.Handle, PChar(S), Length(S), R, DT_WORDBREAK or DT_CALCRECT);
   RowHeights[FRow] := R.Bottom - R.Top + 2
 end
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 AdjustRowHeight;
 FCol := -1
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
 AddButton.Enabled := Edit1.Text <> ""
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
 if Key = #13 then
 begin
   Key := #0;
   AddButtonClick(Sender)
 end
end;

procedure TForm1.AddButtonClick(Sender: TObject);
begin
 with StringGrid1 do
 begin
   Inc(FCol);
   if FCol = ColCount then
   begin
     RowCount := RowCount + 1;
     FCol := 0;
     FRow := RowCount - 1
   end;
   Cells[FCol, FRow] := Edit1.Text;
   AdjustRowHeight;
   Edit1.SetFocus
 end
end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
 Rect: TRect; State: TGridDrawState);
var
 S: string;
begin
 with StringGrid1, Canvas do
 begin
   if gdSelected in State then
   begin
     Brush.Color := clHighlight;
     Font.Color := clHighlightText;
   end
   else
     begin
       Brush.Color := clWindow;
       Font.Color := clWindowText
     end;
   FillRect(Rect);
   InflateRect(Rect, -2, -2);
   S := Cells[ACol, ARow];
   DrawText(Canvas.Handle, PChar(S), Length(S), Rect, DT_WORDBREAK)
 end
end;


А это файл DFM:

object Form1: TForm1
 Left = 229
 Top = 137
 Width = 699
 Height = 552
 BorderIcons = [biSystemMenu]
 Caption = "Form1"
 Color = clBtnFace
 Font.Charset = DEFAULT_CHARSET
 Font.Color = clWindowText
 Font.Height = -13
 Font.Name = "MS Sans Serif"
 Font.Style = []
 OldCreateOrder = False
 OnCreate = FormCreate
 DesignSize = (
   691
   518)
 PixelsPerInch = 120
 TextHeight = 16
 object Edit1: TEdit
   Left = 0
   Top = 0
   Width = 692
   Height = 24
   Anchors = [akLeft, akTop, akRight]
   TabOrder = 0
   OnChange = Edit1Change
   OnKeyPress = Edit1KeyPress
 end
 object AddButton: TButton
   Left = 8
   Top = 30
   Width = 75
   Height = 25
   Caption = "Add"
   Enabled = False
   TabOrder = 1
   OnClick = AddButtonClick
 end
 object StringGrid1: TStringGrid
   Left = 0
   Top = 60
   Width = 691
   Height = 458
   Anchors = [akLeft, akTop, akRight, akBottom]
   DefaultDrawing = False
   FixedCols = 0
   RowCount = 1
   FixedRows = 0
   Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goColSizing]
   TabOrder = 2
   OnDrawCell = StringGrid1DrawCell
 end
end


---

← →
syscoder   (2005-03-06 21:24) [11]

>> Юрий Зотов ©   (06.03.05 20:48) [10]

Вот это да-а-а-а! Весомый аргумент вы привели. Это уже годится, благодарю вас за помощь.

Также спасибо за свой предложения и критику в мою сторону других участников этой ветки.

Мне кстати посоветовали воспользоваться AdvStringGrid"ом с сайта
www.tmssoftware.com. В этом компоненте, говорят, это реализованно без глюков.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2005.03.20;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.5 MB
Время: 0.05 c