Разные вопросы

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;

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