StringGrid

Копирование содержимого TStringGrid в буфер обмена

2017-08-11T19:38:13+07:00

Копирует содержимое ячеек StringGrid в ClipBoard в формате, позволяющем

вставку, например, в Word или Excel. При CopySel=True копирует выделение,

иначе всю таблицу или указанный диапазон (CL- левый столбец и т.д.).

Подробнее...

SetFocus в TStringGrid

2017-08-11T19:33:59+07:00

Code:

Grid.Row := YourRowNumber;

Grid.TopRow := YourFirstVisibleRow;

Grid.LeftCol := YourFirstVisibleColumn;

TStringGrid с фокусом (OnDrawCell)

2017-08-11T19:35:09+07:00

Если вы создаете собственный обработчик компонента TStringGrid OnDrawCell, то вы можете нарисовать все, что вам заблагорассудится. Попробуйте, к примеру, это:

Подробнее...

Фокус ячейки TStringGrid

2017-08-11T19:34:36+07:00

Автор: Simon

Code:

procedure SetGridFocus(SGrid: TStringGrid; r, c: integer);

var

SRect: TGridRect;

begin

with SGrid do

begin

SetFocus; {Передаем фокус сетке}

Row := r; {Устанавливаем Row/Col}

Col := c;

SRect.Top := r; {Определяем выбранную область}

SRect.Left := c;

SRect.Bottom := r;

SRect.Right := c;

Selection := SRect; {Устанавливаем выбор}

end;

//Для вызова процедуры:

SetGridFocus(StringGrid1, 10, 2);

Это всегда срабатывает в случае, если никакая ячейка не выбрана или фокус имеет другой элемент управления.

Tab как Enter в StringGrid

2017-08-11T19:37:12+07:00

Данный код переводит ввод на другую колонку. При достижении конца колонок, ввод перемещается на следующую строку. При достижении самого конца сетки, управление перемещается в ее самое начало - естественно, вы можете изменить это поведение, и передавать управление в этом случае другому элементу управления.

Подробнее...

перехватывать горячие клавиши в StringGrid?

2017-08-11T19:37:37+07:00

Следующий пример демонстрирует перехват сообщения CM_DIALOGCHAR на уровне формы. Это даст нам возможность реагировать на диалоговые комбинации клавишь только, если нажата клавиша Alt, не давая тем самым отработать стандартному обработчику.

Подробнее...

Компонет TWrapGrid, осуществляющий перенос текста в TStringGrid

2017-08-11T19:33:25+07:00

Я наконец нашел время и создал заказной компонент TWrapGrid, функционально идентичный TStringGrid, но умеющий переносить текст в ячейках. Пока это бета-версия, поэтому поэкспериментируйте с ним, и в случае наличия каких-либо замечаний или предложений не забудьте уведомить об этом меня. При использовании компонента не забывайте про RowHeights (или DefaultRowHeight), т.к. при переносе текста потребуется отобразить несколько строк.

Для использования скопируйте код в модуль, сохраните его с именем 'Wrapgrid.PAS' и следуйте за инструкциями, расположенными в верхней части кода.

Присылайте свой комментарии и пожелания. Вот код:

Подробнее...

Многострочность в заголовках колонок StringGrid

2017-08-11T19:32:47+07:00

Автор: Rick Rogers

У меня есть StringGrid, который выглядит очень красивым, за исключением заголовков колонок, где я хотел бы иметь их размер равным 1 ячейке, но с заголовком, размещенным в нескольких строках, например,

Индекс Фондовой Биржи

показывалось бы как

Индекс

Фондовой

Биржи

было бы классно, если можно было этот заголовок размещать еще и по центру.

Рисовать сами ячейки вы можете в обработчике события OnDrawCell. Для определения ячейки (заголовок?), обрабатываемой в текущий момент, используйте параметр GridState.

Я выводил тест с помощью обычных методов рисования (которые хорошо "приживаются" в данном компоненте), с поддержкой вертикального выравнивания, полей и переноса слов. Вот сам код:

Подробнее...

Многострочные ячейки в StringGrid.

2017-08-11T19:32:03+07:00

Code:

Procedure GridRemoveColumn(StrGrid: TStringGrid; DelColumn: Integer);

Var Column: Integer;

begin

If DelColumn <= StrGrid.ColCount then

Begin

For Column := DelColumn To StrGrid.ColCount-1 do

StrGrid.Cols[Column-1].Assign(StrGrid.Cols[Column]);

StrGrid.ColCount := StrGrid.ColCount-1;

End;

end;

Подробнее...

Как перемещать строки и колонки в StringGrid?

2017-08-11T19:07:04+07:00

Пользователь может перемещать строки и колонки StringGrid при помощи мышки. Можно ли это сделать программно? В описании TCustomGrid можно увидеть методы MoveColumn и MoveRow, однако они скрыты в TStringGrid. Но нам ничего не мешает просабклассить TStringGrid и объявить эти методы как public:

Подробнее...

Обмен строк TStringGrid

2017-08-11T19:08:28+07:00

Code:

{ **** UBPFD *********** ****

>> Обмен строк StringGrid

Обмен содержимого указанных строк StringGrid.

Варианты без копирования связанных с ячейками объектов и вместе с ними.

Зависимости: Grids

Автор: Борис Новгородов (MBo), mbo@mail.ru, Новосибирск

***************************************************** }

procedure SGExchangeRows(SG: TStringGrid; Row1, Row2: Integer);

var

TempString: string;

begin

if (Row1 in [0..SG.RowCount - 1]) and (Row2 in [0..SG.RowCount - 1]) then

begin

TempString := SG.Rows[Row1].Text;

SG.Rows[Row1].Assign(SG.Rows[Row2]);

SG.Rows[Row2].Text := TempString;

end;

procedure SGExchRowsWithObj(SG: TStringGrid; Row1, Row2: Integer);

var

TempList: TStringList;

begin

with SG do

if (Row1 in [0..RowCount - 1]) and (Row2 in [0..RowCount - 1]) then

begin

TempList := TStringList.Create;

TempList.Assign(Rows[Row1]);

Rows[Row1].Assign(Rows[Row2]);

Rows[Row2].Assign(TempList);

TempList.Free;

end;

Перетаскиваем колонки и строки в StringGrid мышью

2017-08-11T19:09:09+07:00

Code:

{

The user can move rows and columns of a StringGrid with the mouse.

Can it also be done by code?

In the help for TCustomGrid you can see the methods MoveColumn and MoveRow,

but they are hidden in TStringGrid.

We can make them accessible again by subclassing TStringGrid and

declaring these methods as public:

}

type

TStringGridHack = class(TStringGrid)

public

procedure MoveColumn(FromIndex, ToIndex: Longint);

procedure MoveRow(FromIndex, ToIndex: Longint);

end;

{

The implementation of these methods simply consists of invoking the

corresponding method of the ancestor:

}

procedure TStringGridHack.MoveColumn(FromIndex, ToIndex: Integer);

begin

inherited;

end;

procedure TStringGridHack.MoveRow(FromIndex, ToIndex: Integer);

begin

inherited;

end;

// Example, Beispiel:

procedure TForm1.Button1Click(Sender: TObject);

begin

TStringGridHack(StringGrid1).MoveColumn(1, 3);

end;

Автоматическая ширина колонок в TStringGrid

2017-08-11T19:14:25+07:00

Можно ли сделать так чтобы TStringGrid автоматически изменял ширину колонок, чтобы вместить самую длинную строчку в колонке?

Code:

procedure AutoSizeGridColumn(Grid: TStringGrid; column: integer);

var

i: integer;

temp: integer;

max: integer;

begin

max := 0;

for i := 0 to (Grid.RowCount - 1) do

begin

temp := Grid.Canvas.TextWidth(grid.cells[column, i]);

if temp > max then max := temp;

end;

Grid.ColWidths[column] := Max + Grid.GridLineWidth + 3;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

AutoSizeGridColumn(StringGrid1, 1);

end;

Подробнее...

В StringGrid ширина колонки подгоняется под длину самой длинной строки

2017-08-11T19:14:50+07:00

Поскольку в компоненте StringGrid по умолчанию все столбцы имеют одинаковую ширину - в некоторых ячейках текст обрезается. Чтобы этого избежать, после заполнения StringGrid нужно для каждого столбца находить текст максимальной длины и в соответствии с его длиной устанавливать ширину всего столбца

Подробнее...

Выравнивание колонок StringGrid

2017-08-11T19:18:20+07:00

Автор: Kurt

Организуйте обработчик события сетки OnDrawCell. Создайте код обработчика подобный этому:

Code:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; Col, Row: Longint;

Rect: TRect; State: TGridDrawState);

var

Txt: array[0..255] of Char;

begin

StrPCopy(Txt, StringGrid1.Cells[Col, Row]);

SetTextAlign(StringGrid1.Canvas.Handle,

GetTextAlign(StringGrid1.Canvas.Handle)

and not (TA_LEFT or TA_CENTER) or TA_RIGHT);

ExtTextOut(StringGrid1.Canvas.Handle, Rect.Right - 2, Rect.Top + 2,

ETO_CLIPPED or ETO_OPAQUE, @Rect, Txt, StrLen(Txt), nil);

end;

Подробнее...

Изменение размеров колонок в StringGrid

2017-08-11T19:10:04+07:00

Ниже приведён примен кода, который позволяет автоматически подогнать размер колонки в компененте TStringGrid, под размер самой длинной строки текста в колонке:

Code:

procedure AutoSizeGridColumn(Grid : TStringGrid;

column : integer);

var

i : integer;

temp : integer;

max : integer;

begin

max := 0;

for i := 0 to (Grid.RowCount - 1) do begin

temp := Grid.Canvas.TextWidth(grid.cells[column, i]);

if temp > max then max := temp;

end;

Grid.ColWidths[column] := Max + Grid.GridLineWidth + 3;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

AutoSizeGridColumn(StringGrid1, 1);

end;

Правое выравнивание ячеек TStringGrid

2017-08-11T19:15:08+07:00

Code:

procedure TForm1.GridSumaDrawCell(Sender: TObject; ACol, ARow: Longint;

ARect: TRect; State: TGridDrawState);

var

dx: integer;

begin

with (Sender as TStringGrid).Canvas do

begin

Font := GridSuma.Font;

Pen.Color := clBlack;

if (ACol = 0) or (ARow = 0) then

begin

{ Рисуем заголовок }

Brush.Color := clBtnFace;

FillRect(ARect);

TextOut(ARect.Left, ARect.Top, GridSuma.Cells[ACol, ARow])

end

else

begin

{ Рисуем ячейку с правым выравниванием }

Brush.Color := clWhite;

FillRect(ARect);

dx := TextWidth(GridSuma.Cells[ACol, ARow]) + 2;

TextOut(ARect.Right - dx, ARect.Top, GridSuma.Cells[ACol, ARow])

end

end;

Увеличение ячейки TStringGrid при увеличении числа строк

2017-08-11T19:15:28+07:00

Автор: Пётр Соболь

Code:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow:

Integer; Rect: TRect; State: TGridDrawState);

var

Format: Word;

C: array[0..255] of Char;

r: integer;

begin

C := '';

Format := DT_LEFT or DT_WORDBREAK;

(Sender as TStringGrid).Canvas.FillRect(Rect);

StrPCopy(C, (Sender as TStringGrid).Cells[ACol, ARow]);

if c <> '' then //если есть значения

begin

r := WinProcs.DrawText((Sender as TStringGrid).Canvas.Handle, C,

StrLen(C), Rect, Format);

if r > (Sender as TStringGrid).RowHeights[Arow] then

//если высота колонки меньше

(Sender as TStringGrid).RowHeights[Arow] := r;

end;

OnColumnClick из TListView для TStringGrid

2017-08-11T20:58:01+07:00

Code:

{

There are two routines to implement the OnColumnClick Methods for a TStringGrid.

Set the first row as fixed and the Defaultdrawing to True.

}

type

TForm1 = class(TForm)

StringGrid1: TStringGrid;

procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

private

zelle: TRect; // cell

acol, arow: Integer;

public

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

Text: string;

begin

with stringgrid1 do

begin

MouseRoCell(x, y, acol, arow);

if (arow = 0) and (button = mbleft) then

case acol of

0..2:

begin

// Draws a 3D Effect (Push)

// Zeichnet 3D-Effekt (Push)

zelle := CellRect(acol, arow);

Text := Cells[acol, arow];

Canvas.Font := Font;

Canvas.Brush.Color := clBtnFace;

Canvas.FillRect(zelle);

Canvas.TextRect(zelle, zelle.Left + 2, zelle.Top + 2, Text);

DrawEdge(Canvas.Handle, zelle, 10, 2 or 4 or 8);

DrawEdge(Canvas.Handle, zelle, 2 or 4, 1);

end;

procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

Text: string;

begin

with StringGrid1 do

begin

// Draws a 3D-Effect (Up)

// Zeichnet 3D-Effekt (Up)

Text := Cells[acol, arow];

if arow = 0 then

begin

Canvas.Font := Font;

Canvas.Brush.Color := clBtnFace;

Canvas.FillRect(zelle);

Canvas.TextRect(zelle, zelle.Left + 2, zelle.Top + 2, Text);

DrawEdge(Canvas.Handle, zelle, 4, 4 or 8);

DrawEdge(Canvas.Handle, zelle, 4, 1 or 2);

MouseToCell(zelle.Left, zelle.Top, acol, arow);

end;

if (arow = 0) and (Button = mbleft) then

case acol of

0..2:

begin

// Code to be executed...

// Programmcode der ausgefuhrt werden soll

ShowMessage('Column ' + IntToStr(acol));

zelle := stringgrid1.CellRect(1, 1);

end;

end.

StringGrid как DBGrid

2017-08-11T20:54:16+07:00

Ну это может выглядеть приблизительно так (возможно нужна некоторая доработка, написал от руки, не проверяя):

Code:

table.first;

row := 0;

grid.rowcount := table.recordCount;

while not table.eof do

begin

for i := 0 to table.fieldCount-1 do

grid.cells[i,row] := table.fields[i].asString;

inc (row);

table.next;

end;

Подробнее...

StringGrid, Печать в ячейку

2017-08-11T20:53:36+07:00

Code:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Grids;

type

TForm1 = class(TForm)

StringGrid: TStringGrid;

procedure FormCreate(Sender: TObject);

procedure StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var

C, R: Integer;

begin

for C := 0 to StringGrid.ColCount - 1 do

for R := 0 to StringGrid.RowCount - 1 do

StringGrid.Cells[C, R] := 'A very very very long string';

end;

procedure TForm1.StringGridDrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

begin

if not (Sender is TStringGrid) then Exit;

with TStringGrid(Sender) do

begin

Canvas.FillRect(Rect);

DrawText(Canvas.Handle, PChar(Cells[ACol, ARow]), -1, Rect, DT_WORDBREAK);

end;

end.

Вывести номер строки и столбца TStringGrid

2017-08-11T20:54:42+07:00

Автор: Дмитрий Карагеур

Например, у нас есть таблица с некоторыми данными, и нам необходимо какую-либо запись отредактировать/удалить и т.п. Чтобы не считать, какой это столбец или строка используем следующее: создаем popup menu, прописываем его в форме и создаем соответствующие обработчики событий - это все в файле. На самой таблице жмем правым кликом и edit и перед нами номер строки и столбца. Эти данные пригодятся для создания более интерактивного и дружественного интерфейса ваших приложений.

Подробнее...

Как сделать различные подсказки для каждой ячейки в StringGrid?

2017-08-11T20:51:49+07:00

Следующий пример демонстрирует отслеживаение движения мышки в компоненте TStringGrid. Если мышка переместится на другую ячейку в гриде, то будет показано новое окно подсказки с номером колонки и строки данной ячейки:

Подробнее...

Можно ли обратиться к колонке или строке grid'а по заголовку?

2017-08-11T20:52:14+07:00

В следующем примере приведены две функции: GetGridColumnByName() и GetGridRowByName(), которые возвращают колонку или строку, имеющую заданный заголовок (caption).

Подробнее...

Отображаются ли полосы прокрутки для TStringGrid?

2017-08-11T20:55:00+07:00

Code:

if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_VSCROLL) <> 0 then

ShowMessage('Vertical scrollbar is visible!');

if (GetWindowlong(Stringgrid1.Handle, GWL_STYLE) and WS_HSCROLL) <> 0 then

ShowMessage('Horizontal scrollbar is visible!');

Перевернуть текст в TStringGrid на 90 градусов

2017-08-11T20:55:23+07:00

Code:

uses

{...} Grids;

type

TForm1 = class(TForm)

StringGrid1: TStringGrid;

procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

end;

{...}

implementation

{...}

// Display text vertically in StringGrid cells

// Vertikale Textausgabe in den Zellen eines StringGrid

procedure StringGridRotateTextOut(Grid: TStringGrid; ARow, ACol: Integer; Rect: TRect;

Schriftart: string; Size: Integer; Color: TColor; Alignment: TAlignment);

var

lf: TLogFont;

tf: TFont;

begin

// if the font is to big, resize it

// wenn Schrift zu gro? dann anpassen

if (Size > Grid.ColWidths[ACol] div 2) then

Size := Grid.ColWidths[ACol] div 2;

with Grid.Canvas do

begin

// Replace the font

// Font setzen

Font.Name := Schriftart;

Font.Size := Size;

Font.Color := Color;

tf := TFont.Create;

try

tf.Assign(Font);

GetObject(tf.Handle, SizeOf(lf), @lf);

lf.lfEscapement := 900;

lf.lfOrientation := 0;

tf.Handle := CreateFontIndirect(lf);

Font.Assign(tf);

finally

tf.Free;

end;

// fill the rectangle

// Rechteck fullen

FillRect(Rect);

// Align text and write it

// Text nach Ausrichtung ausgeben

if Alignment = taLeftJustify then

TextRect(Rect, Rect.Left + 2,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);

if Alignment = taCenter then

TextRect(Rect, Rect.Left + Grid.ColWidths[ACol] div 2 - Size +

Size div 3,Rect.Bottom - 2,Grid.Cells[ACol, ARow]);

if Alignment = taRightJustify then

TextRect(Rect, Rect.Right - Size - Size div 2 - 2,Rect.Bottom -

2,Grid.Cells[ACol, ARow]);

end;

// 2. Alternative: Display text vertically in StringGrid cells

// 2. Variante: Vertikale Textausgabe in den Zellen eines StringGrid

procedure StringGridRotateTextOut2(Grid:TStringGrid;ARow,ACol:Integer;Rect:TRect;

Schriftart:String;Size:Integer;Color:TColor;Alignment:TAlignment);

var

NewFont, OldFont : Integer;

FontStyle, FontItalic, FontUnderline, FontStrikeout: Integer;

begin

// if the font is to big, resize it

// wenn Schrift zu gro? dann anpassen

If (Size > Grid.ColWidths[ACol] DIV 2) Then

Size := Grid.ColWidths[ACol] DIV 2;

with Grid.Canvas do

begin

// Set font

// Font setzen

If (fsBold IN Font.Style) Then

FontStyle := FW_BOLD

Else

FontStyle := FW_NORMAL;

If (fsItalic IN Font.Style) Then

FontItalic := 1

Else

FontItalic := 0;

If (fsUnderline IN Font.Style) Then

FontUnderline := 1

Else

FontUnderline := 0;

If (fsStrikeOut IN Font.Style) Then

FontStrikeout:=1

Else

FontStrikeout:=0;

Font.Color := Color;

NewFont := CreateFont(Size, 0, 900, 0, FontStyle, FontItalic,

FontUnderline, FontStrikeout, DEFAULT_CHARSET,

OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,

DEFAULT_PITCH, PChar(Schriftart));

OldFont := SelectObject(Handle, NewFont);

// fill the rectangle

// Rechteck fullen

FillRect(Rect);

// Write text depending on the alignment

// Text nach Ausrichtung ausgeben

If Alignment = taLeftJustify Then

TextRect(Rect,Rect.Left+2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);

If Alignment = taCenter Then

TextRect(Rect,Rect.Left+Grid.ColWidths[ACol] DIV 2 - Size + Size DIV 3,

Rect.Bottom-2,Grid.Cells[ACol,ARow]);

If Alignment = taRightJustify Then

TextRect(Rect,Rect.Right-Size - Size DIV 2 - 2,Rect.Bottom-2,Grid.Cells[ACol,ARow]);

// Recreate reference to the old font

// Referenz auf alten Font wiederherstellen

SelectObject(Handle, OldFont);

// Recreate reference to the new font

// Referenz auf neuen Font loschen

DeleteObject(NewFont);

end;

// Call the method in OnDrawCell

// Methode im OnDrawCell aufrufen

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol,

ARow: Integer; Rect: TRect; State: TGridDrawState);

begin

// In the second column: Rotate Text by 90° and left align the text

// Text um 90°gedreht ausgeben, linksbundig in der zweiten Spalte

if ACol = 1 then

StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL',

12,clRed, taLeftJustify);

// In the third column: Center the text

// Ausgabe zentriert in der dritten Spalte

if ACol = 2 then

StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12, clBlue, taCenter);

// In all other columns third row: right align the text

// Ausgabe rechtsbundig in den restlichen Spalten

if ACol > 2 then

StringGridRotateTextOut(StringGrid1, ARow, ACol, Rect, 'ARIAL', 12,clGreen,

taRightJustify);

end;

end.

Печать TStringGrid

2017-08-11T20:53:14+07:00

Code:

procedure TForm1.Button1Click(Sender: TObject);

var K: Double;

begin

Printer.BeginDoc;

K := Printer.Canvas.Font.PixelsPerInch / Canvas.Font.PixelsPerInch*1.2;

PrintStringGrid(StrGrid,

K, // Коэффициент

200, // отступ от края листа в пихелах по Х

200, // --"-- по Y

200 // отступ снизу

);

Printer.EndDoc;

end;

{----------------------------------------------------------}

unit GrdPrn3;

interface

uses

Windows, Classes, Graphics, Grids, Printers, SysUtils;

const

OrdinaryLineWidth: Integer = 2;

BoldLineWidth: Integer = 4;

procedure PrintStringGrid(Grid: TStringGrid; Scale: Double; LeftMargin,

TopMargin, BottomMargin:

Integer);

function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow,

LeftMargin, TopMargin, Yfloor: Integer; DestCanvas: TCanvas): Integer;

// возвращает номер строки, которая не поместилась до Y = Yfloor

// не проверяет, вылезает ли общая длина таблицы за пределы страницы

// Слишком длинное слово обрежется

implementation

procedure PrintStringGrid(Grid: TStringGrid; Scale: Double; LeftMargin,

TopMargin, BottomMargin: Integer);

var NextRow: Integer;

begin

//Printer.BeginDoc;

if not Printer.Printing then raise Exception.Create('function

PrintStringGrid must be called between Printer.BeginDoc

and Printer.EndDoc');

NextRow := 0;

repeat

NextRow := DrawStringGridEx(Grid, Scale, NextRow, LeftMargin, TopMargin,

Printer.PageHeight - BottomMargin, Printer.Canvas);

if NextRow <> -1 then Printer.NewPage;

until NextRow = -1;

//Printer.EndDoc;

end;

function DrawStringGridEx(Grid: TStringGrid; Scale: Double; FromRow,

LeftMargin, TopMargin, Yfloor: Integer; DestCanvas: TCanvas): Integer;

// возвращает номер строки, которая не поместилась до Y = Yfloor

var

i, j, d, TotalPrevH, TotalPrevW, CellH, CellW, LineWidth: Integer;

R: TRect;

s: string;

procedure CorrectCellHeight(ARow: Integer);

// вычисление правильной высоты ячейки с учетом многострочного текста

// Текст рабивается только по словам слишком длинное слово обрубается

var

i, H: Integer;

R: TRect;

s: string;

begin

R := Rect(0, 0, CellH*2, CellH);

s := ':)'; // Одинарная высота строки

CellH := DrawText(DestCanvas.Handle, PChar(s), Length(s), R,

DT_LEFT or DT_TOP or DT_WORDBREAK or DT_SINGLELINE or

DT_NOPREFIX or DT_CALCRECT) + 3*d;

for i := 0 to Grid.ColCount-1 do

begin

CellW := Round(Grid.ColWidths[i]*Scale);

R := Rect(0, 0, CellW, CellH);

//InflateRect(R, -d, -d);

R.Left := R.Left+d;

R.Top := R.Top + d;

s := Grid.Cells[i, ARow];

// Вычисление ширины и высоты

H := DrawText(DestCanvas.Handle, PChar(s), Length(s), R,

DT_LEFT or DT_TOP or DT_WORDBREAK or DT_NOPREFIX or DT_CALCRECT);

текста

if CellH < H + 2*d then CellH := H + 2*d;

// if CellW < R.Right - R.Left then Слишком длинное слово -

// не помещается в одну строку; Перенос слов не поддерживается

end;

begin

Result := -1; // все строки уместились между TopMargin и Yfloor

if (FromRow < 0)or(FromRow >= Grid.RowCount) then Exit;

DestCanvas.Brush.Style := bsClear;

DestCanvas.Font := Grid.Font;

// DestCanvas.Font.Height := Round(Grid.Font.Height*Scale);

DestCanvas.Font.Size := 10;

Grid.Canvas.Font := Grid.Font;

Scale := DestCanvas.TextWidth('test')/Grid.Canvas.TextWidth('test');

d := Round(2*Scale);

TotalPrevH := 0;

for j := 0 to Grid.RowCount-1 do

begin

if (j >= Grid.FixedRows) and (j < FromRow) then Continue;

// Fixed Rows рисуются на каждой странице

TotalPrevW := 0;

CellH := Round(Grid.RowHeights[j]*Scale);

CorrectCellHeight(j);

if TopMargin + TotalPrevH + CellH > YFloor then

begin

Result := j; // j-я строка не помещается в заданный диапазон

if Result < Grid.FixedRows then Result := -1;

// если фиксированные строки не влезают на страницу -

// это тяж?лый случай...

Exit;

end;

for i := 0 to Grid.ColCount-1 do

begin

CellW := Round(Grid.ColWidths[i]*Scale);

R := Rect(TotalPrevW, TotalPrevH, TotalPrevW + CellW,

otalPrevH + CellH);

OffSetRect(R, LeftMargin, TopMargin);

if (i < Grid.FixedCols)or(j < Grid.FixedRows) then

LineWidth := BoldLineWidth

else

LineWidth := OrdinaryLineWidth;

DestCanvas.Pen.Width := LineWidth;

if LineWidth > 0 then

DestCanvas.Rectangle(R.Left, R.Top, R.Right+1, R.Bottom+1);

//InflateRect(R, -d, -d);

R.Left := R.Left+d;

R.Top := R.Top + d;

s := Grid.Cells[i, j];

DrawText(DestCanvas.Handle, PChar(s), Length(s), R,

DT_LEFT or DT_TOP or DT_WORDBREAK or DT_NOPREFIX);

TotalPrevW := TotalPrevW + CellW; // Общая ширина всех предыдущих колонок

end;

TotalPrevH := TotalPrevH + CellH; // Общая высота всех предыдущих строк

end;

end.

Подробнее...

Пример TDrawGrid Drawcell

2017-08-11T20:56:56+07:00

Автор: Neil

Code:

procedure TForm1.DrawGrid1DrawCell(Sender: TObject; Col, Row: Longint;

Rect: TRect; State: TGridDrawState);

var

vRow, vCol: LongInt;

begin

vRow := Row;

vCol := Col;

with Sender as TDrawGrid, Canvas do

begin

if (vRow = 0) or (vCol = 0) then

Font.Color := clBlack

else

Font.Color := clRed;

TextRect(Rect, Rect.Left, Rect.Top, Format('(%d,%d)', [vRow, vCol]));

end;

Подробнее...

Пропорциональное отображение в TScrollBar или TStringGrid

2017-08-11T20:57:38+07:00

Code:

// Getting a TScrollbar control to Show a proportional thumb:

procedure TForm1.Button1Click(Sender: TObject);

var

info: TScrollInfo;

begin

FillChar(info, SizeOf(info), 0);

with info do

begin

cbsize := SizeOf(info);

fmask := SIF_PAGE;

nPage := ScrollBar1.LargeChange;

end;

SetScrollInfo(ScrollBar1.Handle, SB_CTL, info, True);

end;

// Same for a TStringGrid

procedure TForm1.Button1Click(Sender: TObject);

var

info: TScrollInfo;

begin

FillChar(info, SizeOf(info), 0);

with info do

begin

cbsize := SizeOf(info);

fmask := SIF_ALL;

GetScrollInfo(StringGrid1.Handle, SB_VERT, info);

fmask := fmask or SIF_PAGE;

nPage := 5 * (nmax - nmin) div StringGrid1.RowCount;

// whatever number of cells you consider a "page"

end;

SetScrollInfo(StringGrid1.Handle, SB_VERT, info, True);

end;

Сортировка StringGrid

2017-08-11T20:51:26+07:00

Code:

Procedure GridSort(StrGrid: TStringGrid; NoColumn: Integer);

Var Line, PosActual: Integer;

Row: TStrings;

begin

Renglon := TStringList.Create;

For Line := 1 to StrGrid.RowCount-1 do

Begin

PosActual := Line;

Row.Assign(TStringlist(StrGrid.Rows[PosActual]));

While True do

Begin

If (PosActual = 0) Or (StrToInt(Row.Strings[NoColumn-1]) >=

StrToInt(StrGrid.Cells[NoColumn-1,PosActual-1])) then

Break;

StrGrid.Rows[PosActual] := StrGrid.Rows[PosActual-1];

Dec(PosActual);

End;

If StrToInt(Row.Strings[NoColumn-1]) < StrToInt(StrGrid.Cells[NoColumn-1,PosActual]) then

StrGrid.Rows[PosActual] := Row;

End;

Renglon.Free;

end;

Подробнее...

TStringGrid --> HTML

2017-08-11T19:02:50+07:00

Code:

procedure SGridToHtml(SG: TStringgrid; Dest: TMemo; BorderSize: Integer);

var

i, p: integer;

SStyle1, SStyle2, Text: string;

begin

Dest.Clear;

Dest.Lines.Add('<html>');

Dest.Lines.Add('<body>');

Dest.Lines.Add(' <table border="' + IntToStr(BorderSize) + '" width="' +

IntToStr(SG.Width) + '" height="' + IntToStr(SG.Width) + '">');

for i := 0 to SG.RowCount - 1 do

begin

Dest.Lines.Add(' <tr>');

for p := 0 to SG.ColCount - 1 do

begin

SStyle1 := '';

SStyle2 := '';

if fsbold in SG.Font.Style then

begin

SStyle1 := SStyle1 + '<b>';

SStyle2 := SStyle2 + '</b>';

end;

if fsitalic in SG.Font.Style then

begin

SStyle1 := SStyle1 + '<i>';

SStyle2 := SStyle2 + '</i>';

end;

if fsunderline in SG.Font.Style then

begin

SStyle1 := SStyle1 + '<u>';

SStyle2 := SStyle2 + '</u>';

end;

Text := sg.Cells[p, i];

if Text = '' then Text := ' ';

Dest.Lines.Add(' <td width="' + IntToStr(sg.ColWidths[p]) +

'" height="' + IntToStr(sg.RowHeights[p]) +

'"><font color="#' + IntToHex(sg.Font.Color, 6) +

'" face="' + SG.Font.Name + '">' + SStyle1 +

Text + SStyle2 + '</font></td>');

end;

Dest.Lines.Add(' </tr>');

end;

Dest.Lines.Add(' </table>');

Dest.Lines.Add('</body>');;

Dest.Lines.Add('</html>');

end;

// Example, Beispiel

procedure TFormCSVInport.Button6Click(Sender: TObject);

begin

SGridToHtml(StringGrid1, Memo1, 1);

Memo1.Lines.SaveToFile('c:\test.html');

end;

Подробнее...

TStringGrid и файловый поток

2017-08-11T19:01:55+07:00

Какое наилучшее решение для сохранения экземпляра TStringGrid (150x10)?

Если вы хотите сохранить это на диске:

Подробнее...

XLS ---> TStringGrid

2017-08-11T18:57:14+07:00

Code:

function Xls_To_StringGrid(AGrid: TStringGrid; AXLSFile: string): Boolean;

const

xlCellTypeLastCell = $0000000B;

var

XLApp, Sheet: OLEVariant;

RangeMatrix: Variant;

x, y, k, r: Integer;

begin

Screen.Cursor:=crAppStart;

Result := False;

XLApp := CreateOleObject('Excel.Application');

try

XLApp.Visible := False;

XLApp.Workbooks.Open(AXLSFile);

Sheet := XLApp.Workbooks[ExtractFileName(AXLSFile)].WorkSheets[1];

Sheet.Cells.SpecialCells(xlCellTypeLastCell, EmptyParam).Activate;

x := XLApp.ActiveCell.Row;

y := XLApp.ActiveCell.Column;

AGrid.RowCount := x;

AGrid.ColCount := y;

RangeMatrix := XLApp.Range['A1', XLApp.Cells.Item[X, Y]].Value;

k := 1;

repeat

for r := 1 to y do

AGrid.Cells[(r - 1), (k - 1)] := RangeMatrix[K, R];

Inc(k, 1);

AGrid.RowCount := k + 1;

until k > x;

RangeMatrix := Unassigned;

finally

if not VarIsEmpty(XLApp) then

begin

XLApp.Quit;

XLAPP := Unassigned;

Sheet := Unassigned;

Result := True;

end;

Screen.Cursor:=crDefault;

end;

Получить содержимое TStringGrid или TDrawGrid в виде строки

2017-08-11T19:03:29+07:00

Code:

{

This copies the contents of a TstringGrid/TDrawGrid (only Text!!) into a string.

Tabs are inserted between the columns, CR+LF between rows.

}

use

Grids;

{...}

{ we need this Cracker Class because the Col/RowCount property

is not public in TCustomGrid }

type

TGridHack = class(TCustomGrid);

function GetstringGridText(_Grid: TCustomGrid): string;

var

Grid: TGridHack;

Row, Col: Integer;

s: string;

begin

// Cast the paramter to a TGridHack, so we can access protected properties

Grid := TGridHack(_Grid);

Result := '';

// for all rows, then for all columns

for Row := 0 to Grid.RowCount - 1 do

begin

for Col := 0 to Grid.ColCount - 1 do

begin

// the first column does not need the tab

if Col > 0 then

Result := Result + #9;

Result := Result + Grid.GetEditText(Col, Row);

end;

Result := Result + #13#10;

end;

Сохранение и чтение TStringGrid

2017-08-11T19:04:26+07:00

Code:

procedure SaveGrid;

var

f: textfile;

x, y: integer;

begin

assignfile(f, 'Filename');

rewrite(f);

writeln(f, stringgrid.colcount);

writeln(f, stringgrid.rowcount);

for X := 0 to stringgrid.colcount - 1 do

for y := 0 to stringgrid.rowcount - 1 do

writeln(F, stringgrid.cells[x, y]);

closefile(f);

end;

Подробнее...

Экспорт StringGrid в исполняемый файл *.EXE

2017-08-11T19:01:04+07:00

Экспорт StringGrid в исполняемый файл *.EXE

Как-то раз мне понадобилось из моей программы извлекать все содержимое StringGrid'a в exe-файл. В данном случае можно конечно писать свой собственный компилятор, но, согласитесь, это лишнее. Гораздо проще заранее написать exe-файл и поместить его в ресурсы нашей программы. А потом извлекать его оттуда, и записывать в его ресурсы содержимое StringGrid'a. Заманчиво звучит, правда? Тогда перейдем к реализации.

1. Создание exe-файла, в который поместим в конце содержимое StringGrid'a.

Так как данная статья посвящена языку Делфи, то и писать этот exe-файл я рекомендую на Делфи. Запускаем Делфи, создаем новый проект, и на форму кидаем StringGrid. Это обязательный набор, но вы можете добавить все что угодно, все, что вы хотели бы видеть, после того как сделаете экспорт из StringGrid'a в исполняемый файл.
Ниже представлен код процедуры загрузки содержимого из ресурсов в StringGrid:

Подробнее...

Экспорт TStringGrid в Excel

2017-08-11T19:05:43+07:00

Code:

{ With OLE Automation }

uses

ComObj;

function RefToCell(ARow, ACol: Integer): string;

begin

Result := Chr(Ord('A') + ACol - 1) + IntToStr(ARow);

end;

function SaveAsExcelFile(AGrid: TStringGrid; ASheetName, AFileName: string): Boolean;

const

xlWBATWorksheet = -4167;

var

Row, Col: Integer;

GridPrevFile: string;

XLApp, Sheet, Data: OLEVariant;

i, j: Integer;

begin

// Prepare Data

Data := VarArrayCreate([1, AGrid.RowCount, 1, AGrid.ColCount], varVariant);

for i := 0 to AGrid.ColCount - 1 do

for j := 0 to AGrid.RowCount - 1 do

Data[j + 1, i + 1] := AGrid.Cells[i, j];

// Create Excel-OLE Object

Result := False;

XLApp := CreateOleObject('Excel.Application');

try

// Hide Excel

XLApp.Visible := False;

// Add new Workbook

XLApp.Workbooks.Add(xlWBatWorkSheet);

Sheet := XLApp.Workbooks[1].WorkSheets[1];

Sheet.Name := ASheetName;

// Fill up the sheet

Sheet.Range[RefToCell(1, 1), RefToCell(AGrid.RowCount,

AGrid.ColCount)].Value := Data;

// Save Excel Worksheet

try

XLApp.Workbooks[1].SaveAs(AFileName);

Result := True;

except

// Error ?

end;

finally

// Quit Excel

if not VarIsEmpty(XLApp) then

begin

XLApp.DisplayAlerts := False;

XLApp.Quit;

XLAPP := Unassigned;

Sheet := Unassigned;

end;

// Example:

procedure TForm1.Button1Click(Sender: TObject);

begin

if SaveAsExcelFile(stringGrid1, 'My Stringgrid Data', 'c:\MyExcelFile.xls') then

ShowMessage('StringGrid saved!');

end;

Подробнее...

Манипуляция словами в TStringGrid

2017-08-11T19:36:28+07:00

Code:

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);

var

s: string;

c: Byte;

begin

with StringGrid1 do

s := Cells[Col, Row];

if Length(s) = 0 then

begin

if Key in ['a'..'z'] then

begin

c := Ord(Key) - 32;

Key := Chr(c);

end;

exit;

end;

if s[Length(s)] = ' ' then

if Key in ['a'..'z'] then

begin

c := Ord(Key) - 32;

Key := Chr(c);

end;

//В обработчике события onKeyPress сделайте следующее:

if length(field.text) = 0 then

key := upCase (key);

Ограничение длины поля TStringGrid

2017-08-11T19:35:51+07:00

Вероятно, это не очень эффективное решение, но оно будет работать: поместите следующий код в обработчик события onKeyPress:

Подробнее...

Текст в ячейке StringGrid если не помещается переносится на следующую ячейку

2017-08-11T19:36:09+07:00

Code:

//Сначала нужно обработать событие OnDrawCell компонента TStringGrid:

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

var

i, x, y: Integer;

begin

if gdFixed in State then

Exit;

if ARow > 1 then

Exit;

{Draw row 1 with text from cell 1,1 spanning all cells in the row}

with sender as TStringGrid do

begin

{Extend rect to include grid line on right, if not last cell in row}

if aCol < Pred(ColCount) then

Rect.Right := Rect.Right + GridlineWidth;

{Figure out where the text of the first cell would start

relative to the current cells rect}

y := Rect.Top + 2;

x := Rect.Left + 2;

for i:= 1 to aCol - 1 do

x := x - ColWidths[i] - GridlineWidth;

{Paint cell pale yellow}

Canvas.Brush.Color := $7FFFFF;

Canvas.Brush.Style := bsSolid;

Canvas.FillRect( Rect );

{Paint text of cell 1,1 clipped to current cell}

Canvas.TextRect( Rect, x, y, Cells[1, 1] );

end;

//По созданию окна изобразим следующее

procedure TForm1.FormCreate(Sender: TObject);

var

i, k: Integer;

begin

with StringGrid1 do

begin

cells[1, 1] := 'A rather long line which will span cells';

for i:= 1 to colcount-1 do

for k:= 2 to rowcount -1 do

cells[i,k] := Format( 'Cell[%d, %d]', [i, k]);

end;

Назначение цвета для каждой строки

2017-08-11T19:20:09+07:00

Code:

procedure TFormHistory.ListHistoryDrawCell(Sender: TObject; Col, Row: Integer;

Rect: TRect; State: TGridDrawState);

var

S: string;

DrawRect: TRect;

CurrentColor: TColor;

begin

// Определяем цвет строки в зависимости типа Imcoming

if (Sender as TStrinGgrid).Cells[COLUMN_INCOMING , Row ] = '1' then

CurrentColor:=clBlue

else

CurrentColor:=clMaroon;

if (Sender as TStrinGgrid).Row = Row then

CurrentColor := clHighlightText;

(Sender as TStrinGgrid).Canvas.font.color := CurrentColor;

S:= (Sender as TStrinGgrid).Cells[ Col, Row ];

if (Col = COLUMN_MESSAGE ) and (Row <> ROW_HEADER) then

begin

if Length(S) > 0 then

begin

DrawRect:=Rect;

DrawText((Sender as TStrinGgrid).Canvas.Handle, Pchar(S), Length(S),

DrawRect, dt_calcrect or dt_wordbreak or dt_left );

if (DrawRect.bottom - DrawRect.top) > (Sender as TStrinGgrid).RowHeights[Row] then

(Sender as TStrinGgrid).RowHeights[row] :=(DrawRect.bottom - DrawRect.top)

else

begin

DrawRect.Right:=Rect.Right;

(Sender as TStrinGgrid).Canvas.FillRect( DrawRect );

DrawText((Sender as TStrinGgrid).Canvas.Handle, Pchar(S),

Length(S), DrawRect, dt_wordbreak or dt_left);

end;

end

else

if Row <> ROW_HEADER then

(Sender as TStrinGgrid).Canvas.Textout(rect.left+3, rect.top+3 , S );

end;

Покрашенный StringGrid

2017-08-11T19:20:57+07:00

...вы можете попробовать использовать StringGrid. У него имеется свойство Objects, через которое вы можете назначать объекты. Создайте объект, содержащий переменную типа TColor, и назначьте это Objects[col,row], что позволит иметь к нему доступ в любое время. Назначьте событие OnDrawCell StringGrid, позволяющее рисовать текст ячейки правильного цвета. Чтобы убедиться, что ячейка выбрана, воспользуйтесь свойством Selection, содержащим то, что выбрал пользователь. Все это должно выглядеть приблизительно так:

Подробнее...

Символы разного цвета в StringGrid

2017-08-11T19:21:48+07:00

Ниже представлен юнит, который позволяет поместить текст в String Grid с символами различного цвета:

Подробнее...

Цвет неактивной ячейки StringGrid

2017-08-11T19:21:24+07:00

Автор: Neil J. Rubenking

...если я щелкаю на любой ячейке StringGrid2, последняя выбранная ячейка в StringGrid1 становится синей...

Создайте обработчик (если он отсутствует) события сетки OnDrawCell и включите в него следующий код:

Подробнее...

Цветные ячейки в StringGrid / DBGrid?

2017-08-11T19:19:46+07:00

Автор: Alex Schlecht

StringGrids / DBGrids с цветными ячейками смотрятся очень красиво, и Вы можете информировать пользователя о важных данных внутри Grid.

Совместимость: все версии Delphi

К сожалению, невозможно применить один и тот же метод к StringGrids и к DBGrids. Итак сперва рассмотрим как это сделать в StringGrid:

1. StringGrid

=============

Для раскрашивания будем использовать событие "OnDrawCell". Следующий код показывает, как сделать в Grid красный бэкраунд. Бэкграунд второй колонки будет зелёным.

Подробнее...

Вставка и удаление строк в StringGrid

2017-08-11T18:43:01+07:00

Автор: Dennis Passmore

Поскольку свойство Cols[x] компонента TStringGrid реально является компонентом TStrings, все методы TStrings применимы также и к Cols[x].

Недавно в интернете я нашел реализацию расширенных функций TStringGrid:

Подробнее...

Вставка строки в TStringGrid

2017-08-11T18:44:33+07:00

Code:

procedure SGInsertRow(SG: TStringGrid; NewRow: Integer);

var

i: Integer;

begin

if NewRow < 0 then

NewRow := 0; // либо 1, задайте нужное вам поведение

with SG do

begin

RowCount := RowCount + 1;

if NewRow < RowCount - 1 then

begin

for i := RowCount - 1 downto NewRow + 1 do

Rows[i].Assign(Rows[i - 1]);

end;

Rows[NewRow].Clear;

end;

Добавление колонки в StringGrid

2017-08-11T18:41:49+07:00

Code:

Procedure GridAddColumn(StrGrid: TStringGrid; NewColumn: Integer);

Var Column: Integer;

begin

StrGrid.ColCount := StrGrid.ColCount+1;

For Column := StrGrid.ColCount-1 downto NewColumn do

StrGrid.Cols[Column].Assign(StrGrid.Cols[Column-1]);

StrGrid.Cols[NewColumn-1].Text := '';

end;

Подробнее...

Как удалить строку в StringGrid в run-time?

2017-08-11T18:39:18+07:00

Можно сделать наследника от TCustomGrid. А у последнего есть метод - DeleteRow.

Автор: Song

Например удаление текущей строки:

Code:

Type TFakeGrid=class(TCustomGrid);

®Vit (Vitaly Nevzorov) - nevzorov@yahoo.com}

procedure TForm1.MyDelete(Sender: TObject);

begin

TFakeGrid(Grid).DeleteRow(Grid.row);

end;

Подробнее...

Очистить ячейки в TStringGrid

2017-08-11T18:44:54+07:00

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

i, k: Integer;

begin

with StringGrid1 do

for i := 0 to ColCount - 1 do

for k := 0 to RowCount - 1 do

Cells[i, k] := '';

end;

Подробнее...

Удаление колонки в StringGrid

2017-08-11T18:40:33+07:00

Code:

Procedure GridRemoveColumn(StrGrid: TStringGrid; DelColumn: Integer);

Var Column: Integer;

begin

If DelColumn <= StrGrid.ColCount then

Begin

For Column := DelColumn To StrGrid.ColCount-1 do

StrGrid.Cols[Column-1].Assign(StrGrid.Cols[Column]);

StrGrid.ColCount := StrGrid.ColCount-1;

End;

end;

Подробнее...

Bitmap в StringGrid ячейке

2017-08-11T18:34:42+07:00

В обработчике события OnDrawCell элемента StringGrid поместите следующий код:

Code:

with (Sender as TStringGrid) do

with Canvas do

begin

{...}

Draw(Rect.Left, Rect.Top, Image1.Picture.Graphic);

{...}

end;

Используйте метод Draw() или StretchDraw() класса TCanvas. Image1 - это TImage с предварительно загруженным в него bitmap-ом.

CheckBox в StringGrid

2017-08-11T18:35:25+07:00

Code:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

Grids, StdCtrls;

type

TForm1 = class(TForm)

StringGrid1: TStringGrid;

procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

cell_x = 2;

cell_y = 2;

var

Form1: TForm1;

CheckBox1: TCheckBox;

implementation

{$R *.DFM}

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

var

r:trect;

begin

if(cell_x>=StringGrid1.LeftCol) and

(cell_x<=StringGrid1.LeftCol+StringGrid1.VisibleColCount) and

(cell_y>=StringGrid1.TopRow) and

(cell_x<=StringGrid1.TopRow+StringGrid1.VisibleRowCount) then

CheckBox1.Visible:=true

else

CheckBox1.Visible:=false;

if (acol=cell_x) and (arow=cell_y) then

begin

r:=stringgrid1.CellRect(cell_x,cell_y);

r.Left:=r.left+stringgrid1.left+2;

r.right:=r.right+stringgrid1.left+2;

r.top:=r.top+stringgrid1.top+2;

r.bottom:=r.bottom+stringgrid1.top+2;

CheckBox1.BoundsRect:=r;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

CheckBox1:=TCheckBox.Create(form1);

CheckBox1.parent:=form1;

CheckBox1.Caption:='proba';

end;

end.

Подробнее...

Встроенный редактор ComboBox в ячейке StringGrid

2017-08-11T18:35:51+07:00

Code:

procedure TForm1.FormCreate(Sender: TObject);

begin

{Высоту combobox'а не изменишь, так что вместо combobox'а

будем изменять высоту строки grid'а !}

StringGrid1.DefaultRowHeight := ComboBox1.Height; {Спрятать combobox}

ComboBox1.Visible := False; ComboBox1.Items.Add('Delphi Kingdom');

ComboBox1.Items.Add('Королевство Дельфи');

end;

procedure TForm1.ComboBox1Change(Sender: TObject);

begin

{Перебросим выбранное в значение из ComboBox в grid}

StringGrid1.Cells[StringGrid1.Col,

StringGrid1.Row] := ComboBox1.Items[ComboBox1.ItemIndex];

ComboBox1.Visible := False; StringGrid1.SetFocus;

end;

procedure TForm1.ComboBox1Exit(Sender: TObject);

begin

{Перебросим выбранное в значение из ComboBox в grid}

StringGrid1.Cells[StringGrid1.Col,

StringGrid1.Row] := ComboBox1.Items[ComboBox1.ItemIndex];

ComboBox1.Visible := False; StringGrid1.SetFocus;

end;

procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol,

ARow: Integer; var CanSelect: Boolean);

var

R: TRect;

begin

if ((ACol = 3) and (ARow <> 0)) then

begin

{Ширина и положение ComboBox должно соответствовать ячейке StringGrid}

R := StringGrid1.CellRect(ACol, ARow); R.Left := R.Left + StringGrid1.Left;

R.Right := R.Right + StringGrid1.Left; R.Top := R.Top + StringGrid1.Top;

R.Bottom := R.Bottom + StringGrid1.Top; ComboBox1.Left := R.Left + 1;

ComboBox1.Top := R.Top + 1; ComboBox1.Width := (R.Right + 1) - R.Left;

ComboBox1.Height := (R.Bottom + 1) - R.Top; {Покажем combobox}

ComboBox1.Visible := True; ComboBox1.SetFocus;

end;

CanSelect := True;

end;

Обновление картинки в ячейке

2017-08-11T18:36:16+07:00

Автор: SottNick

Если в таблице вы используете событие OnDrawCell для помещения в ячейку рисунка, причем различного, в зависимости, например, от соответствующего значения в двумерном массиве, и вам надо, чтобы после изменения значения в массиве обновилось изображение (Refresh не подходит, т.к. будет мелькать), то измените значение у ячейки (DrawGrid не годится):

Code:

StringGrid1.Cells[i,j]:='';

или

Code:

StringGrid1.Cells[i,j]:=StringGrid1.Cells[i,j];

если там что-то хранится

StringGrid без выделенной ячейки

2017-08-11T18:51:57+07:00

Автор: Jeff Fisher

Я пытаюсь показать StringGrid без выделенной ячейки. Первая нефиксированная ячейка всегда имеет состояние "инвертированного" цвета. Я не хочу позволить пользователю редактировать сетку, но эта выделенная ячейка производит впечатление того, что сетка имеет возможность редактирования...

Вам необходимо создать обработчик события OnDrawCell. Это легче чем вы думаете. Вот образец кода, который сделает вас счастливым:

Подробнее...

StringGrid, выделить фиксированные строки

2017-08-11T18:53:09+07:00

Code:

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Grids;

type

TForm1 = class(TForm)

StringGrid1: TStringGrid;

procedure FormCreate(Sender: TObject);

procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

var

C, R: Integer;

begin

for C := 0 to StringGrid1.ColCount - 1 do

begin

for R := 0 to StringGrid1.RowCount - 1 do

begin

if (C < StringGrid1.FixedCols) or

(R < StringGrid1.FixedRows) then

StringGrid1.Cells[C, R] := Format('Fixed Cell (%dx%xd)', [C, R])

else

StringGrid1.Cells[C, R] := Format('Cell (%dx%d)', [C, R]);

end;

procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;

Rect: TRect; State: TGridDrawState);

var

I: Integer;

begin

with StringGrid1 do

if gdFixed in State then

begin

Canvas.FillRect(Rect);

InflateRect(Rect, -2, 0);

if (ACol = Col) or (ARow = Row) then

Canvas.Font.Style := [fsBold]

else

Canvas.Font.Style := [];

DrawText(Canvas.Handle,

PChar(Cells[ACol, ARow]), -1, Rect,

DT_SINGLELINE or DT_VCENTER);

end else begin

Rect := CellRect(ACol, 0);

for I := 1 to FixedRows - 1 do

with CellRect(ACol, I) do

Inc(Rect.Bottom, Bottom - Top);

InvalidateRect(Handle, @Rect, True);

Rect := CellRect(0, ARow);

for I := 1 to FixedCols - 1 do

with CellRect(I, ARow) do

Inc(Rect.Right, Right - Left);

InvalidateRect(Handle, @Rect, True);

end;

end.

Выбор строки или колонки компонента TStringGrid

2017-08-11T18:54:06+07:00

Автор: Neil J. Rubenking

Вот функция, выбирающая при нажатии на кнопку первую строку сетки. Это работает независимо от размера сетки и количества фиксированных строк/колонок.

Подробнее...

Как снять выделение в StringGrid?

2017-08-11T18:48:20+07:00

Если Вы хотете избавиться от выделенных ячеек TStringGrid, которые не имеют фокуса либо используются только для отображения данных, то попробуйте воспользоваться следующей небольшой процедурой.

Подробнее...

Множественный выбор в TStringGrid

2017-08-11T18:54:52+07:00

То же самое я проделывал и с DBGrid. (Пока не реализован Shift-MouseDown, только Ctrl-MouseDown).

Для TStringGrid вам нужно выполнить следующие шаги:

Заполните сетку, связывая Objects[0, ARow] с некоторым логическим объектом типа:

Подробнее...

Проверить, выделена ли ячейка TStringGrid

2017-08-11T18:55:26+07:00

Code:

function IsCellSelected(StringGrid: TStringGrid; X, Y: Longint): Boolean;

begin

Result := False;

try

if (X >= StringGrid.Selection.Left) and (X <= StringGrid.Selection.Right) and

(Y >= StringGrid.Selection.Top) and (Y <= StringGrid.Selection.Bottom) then

Result := True;

except

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

if IsCellSelected(stringgrid1, 2, 2) then

ShowMessage('Cell (2,2) is selected.');

end;