Текущий архив: 2005.03.20;
Скачать: CL | DM;
Вниз
Проблемы со 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;
Скачать: CL | DM;
Память: 0.51 MB
Время: 0.027 c
