📄 datagrid.pas
字号:
LogBrush: TLOGBRUSH;
Index: Integer;
Points: TIntArray;
StopMajor, StartMinor, StopMinor, StopIndex: Integer;
LineIncr: Integer;
begin
with Canvas, AxisInfo do
begin
if EffectiveLineWidth <> 0 then
begin
Pen.Width := GridLineWidth;
if UseOnColor then
Pen.Color := OnColor
else
Pen.Color := OffColor;
if Pen.Width > 1 then
begin
LogBrush.lbStyle := BS_Solid;
LogBrush.lbColor := Pen.Color;
LogBrush.lbHatch := 0;
Pen.Handle := ExtCreatePen(FlatPenStyle, Pen.Width, LogBrush, 0, nil);
end;
Points := PointsList;
Line := CellBounds[MajorIndex] + EffectiveLineWidth shr 1 +
GetExtent(Cell);
//!!! ??? Line needs to be incremented for RightToLeftAlignment ???
if UseRightToLeftAlignment and (MajorIndex = 0) then Inc(Line);
StartMinor := CellBounds[MajorIndex xor 1];
StopMinor := CellBounds[2 + (MajorIndex xor 1)];
StopMajor := CellBounds[2 + MajorIndex] + EffectiveLineWidth;
StopIndex := MaxStroke * 4;
Index := 0;
repeat
Points[Index + MajorIndex] := Line; { MoveTo }
Points[Index + (MajorIndex xor 1)] := StartMinor;
Inc(Index, 2);
Points[Index + MajorIndex] := Line; { LineTo }
Points[Index + (MajorIndex xor 1)] := StopMinor;
Inc(Index, 2);
// Skip hidden columns/rows. We don't have stroke slots for them
// A column/row with an extent of -EffectiveLineWidth is hidden
repeat
Inc(Cell);
LineIncr := GetExtent(Cell) + EffectiveLineWidth;
until (LineIncr > 0) or (Cell > LastFullVisibleCell);
Inc(Line, LineIncr);
until (Line > StopMajor) or (Cell > LastFullVisibleCell) or (Index > StopIndex);
{ 2 integers per point, 2 points per line -> Index div 4 }
PolyPolyLine(Canvas.Handle, Pointer(Points)^, Pointer(StrokeList)^, Index shr 2);
end;
end;
end;
begin
if (CellBounds[0] = CellBounds[2]) or (CellBounds[1] = CellBounds[3]) then Exit;
if not DoHorz then
begin
DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
end
else
begin
DrawAxisLines(DrawInfo.Horz, Col, 0, DoVert);
DrawAxisLines(DrawInfo.Vert, Row, 1, DoHorz);
end;
end;
function PointInGridRect(Col, Row: Longint; const Rect: TGridRect): Boolean;
begin
Result := (Col >= Rect.Left) and (Col <= Rect.Right) and (Row >= Rect.Top)
and (Row <= Rect.Bottom);
end;
procedure DrawCells(ACol, ARow: Longint; StartX, StartY, StopX, StopY: Integer;
Color: TColor; IncludeDrawState: TGridDrawState);
var
CurCol, CurRow: Longint;
AWhere, Where, TempRect: TRect;
DrawState: TGridDrawState;
Focused: Boolean;
begin
CurRow := ARow;
Where.Top := StartY;
while (Where.Top < StopY) and (CurRow < RowCount) do
begin
CurCol := ACol;
Where.Left := StartX;
Where.Bottom := Where.Top + RowHeights[CurRow];
while (Where.Left < StopX) and (CurCol < ColCount) do
begin
Where.Right := Where.Left + ColWidths[CurCol];
if (Where.Right > Where.Left) and RectVisible(Canvas.Handle, Where) then
begin
DrawState := IncludeDrawState;
Focused := IsActiveControl;
if Focused and (CurRow = Row) and (CurCol = Col) then
Include(DrawState, gdFocused);
if PointInGridRect(CurCol, CurRow, Sel) then
Include(DrawState, gdSelected);
if not (gdFocused in DrawState) or not (goEditing in Options) or
not EditorMode or (csDesigning in ComponentState) then
begin
if DefaultDrawing or (csDesigning in ComponentState) then
with Canvas do
begin
Font := Self.Font;
if (gdSelected in DrawState) and
(not (gdFocused in DrawState) or
([goDrawFocusSelected, goRowSelect] * Options <> [])) then
begin
Brush.Color := clHighlight;
Font.Color := clHighlightText;
end
else
Brush.Color := Color;
FillRect(Where);
end;
DrawCell(CurCol, CurRow, Where, DrawState);
if DefaultDrawing and (gdFixed in DrawState) and Ctl3D and
((FrameFlags1 or FrameFlags2) <> 0) then
begin
TempRect := Where;
if (FrameFlags1 and BF_RIGHT) = 0 then
Inc(TempRect.Right, DrawInfo.Horz.EffectiveLineWidth)
else if (FrameFlags1 and BF_BOTTOM) = 0 then
Inc(TempRect.Bottom, DrawInfo.Vert.EffectiveLineWidth);
DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags1);
DrawEdge(Canvas.Handle, TempRect, BDR_RAISEDINNER, FrameFlags2);
end;
if DefaultDrawing and not (csDesigning in ComponentState) and
(gdFocused in DrawState) and
([goEditing, goAlwaysShowEditor] * Options <>
[goEditing, goAlwaysShowEditor])
and not (goRowSelect in Options) then
begin
if not UseRightToLeftAlignment then
DrawFocusRect(Canvas.Handle, Where)
else
begin
AWhere := Where;
AWhere.Left := Where.Right;
AWhere.Right := Where.Left;
DrawFocusRect(Canvas.Handle, AWhere);
end;
end;
end;
end;
Where.Left := Where.Right + DrawInfo.Horz.EffectiveLineWidth;
Inc(CurCol);
end;
Where.Top := Where.Bottom + DrawInfo.Vert.EffectiveLineWidth;
Inc(CurRow);
end;
end;
begin
if UseRightToLeftAlignment then ChangeGridOrientation(True);
if Flat then
FixedLineColor := clBtnShadow
else
FixedLineColor := clBlack;
UpdateRect := Canvas.ClipRect;
CalcDrawInfo(DrawInfo);
with DrawInfo do
begin
if (Horz.EffectiveLineWidth > 0) or (Vert.EffectiveLineWidth > 0) then
begin
{ Draw the grid line in the four areas (fixed, fixed), (variable, fixed),
(fixed, variable) and (variable, variable) }
LineColor := clSilver;
MaxStroke := Max(Horz.LastFullVisibleCell - LeftCol + FixedCols,
Vert.LastFullVisibleCell - TopRow + FixedRows) + 3;
SetLength(PointsList, MaxStroke * 2 * 2);
SetLength(StrokeList, MaxStroke);
for I := 0 to MaxStroke - 1 do
StrokeList[I] := 2;
if ColorToRGB(Color) = clSilver then LineColor := clGray;
DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
0, 0, [0, 0, Horz.FixedBoundary, Vert.FixedBoundary], FixedLineColor, FixedColor);
DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
LeftCol, 0, [Horz.FixedBoundary, 0, Horz.GridBoundary,
Vert.FixedBoundary], FixedLineColor, FixedColor);
DrawLines(goFixedHorzLine in Options, goFixedVertLine in Options,
0, TopRow, [0, Vert.FixedBoundary, Horz.FixedBoundary,
Vert.GridBoundary], FixedLineColor, FixedColor);
DrawLines(goHorzLine in Options, goVertLine in Options, LeftCol,
TopRow, [Horz.FixedBoundary, Vert.FixedBoundary, Horz.GridBoundary,
Vert.GridBoundary], LineColor, Color);
SetLength(StrokeList, 0);
SetLength(PointsList, 0);
end;
{ Draw the cells in the four areas }
Sel := Selection;
FrameFlags1 := 0;
FrameFlags2 := 0;
if goFixedVertLine in Options then
begin
if not Flat then FrameFlags1 := BF_RIGHT;
FrameFlags2 := BF_LEFT;
end;
if goFixedHorzLine in Options then
begin
if not Flat then FrameFlags1 := FrameFlags1 or BF_BOTTOM;
FrameFlags2 := FrameFlags2 or BF_TOP;
end;
DrawCells(0, 0, 0, 0, Horz.FixedBoundary, Vert.FixedBoundary, FixedColor,
[gdFixed]);
DrawCells(LeftCol, 0, Horz.FixedBoundary {- FColOffset}, 0, Horz.GridBoundary, //!! clip
Vert.FixedBoundary, FixedColor, [gdFixed]);
DrawCells(0, TopRow, 0, Vert.FixedBoundary, Horz.FixedBoundary,
Vert.GridBoundary, FixedColor, [gdFixed]);
DrawCells(LeftCol, TopRow, Horz.FixedBoundary {- FColOffset}, //!! clip
Vert.FixedBoundary, Horz.GridBoundary, Vert.GridBoundary, Color, []);
if not (csDesigning in ComponentState) and
(goRowSelect in Options) and DefaultDrawing and Focused then
begin
// GridRectToScreenRect(GetSelection, FocRect, False);
with Selection do
FocRect := BoxRect(Left, Top, Right, Bottom);
if not UseRightToLeftAlignment then
Canvas.DrawFocusRect(FocRect)
else
begin
AFocRect := FocRect;
AFocRect.Left := FocRect.Right;
AFocRect.Right := FocRect.Left;
DrawFocusRect(Canvas.Handle, AFocRect);
end;
end;
{ Fill in area not occupied by cells }
if Horz.GridBoundary < Horz.GridExtent then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(Rect(Horz.GridBoundary, 0, Horz.GridExtent, Vert.GridBoundary));
end;
if Vert.GridBoundary < Vert.GridExtent then
begin
Canvas.Brush.Color := Color;
Canvas.FillRect(Rect(0, Vert.GridBoundary, Horz.GridExtent, Vert.GridExtent));
end;
end;
if UseRightToLeftAlignment then ChangeGridOrientation(False);
end;
procedure TDataGrid.SetData(Data: TRowDataList);
begin
if Data <> nil then
begin
if FRows <> nil then FRows.Free;
FRows := Data;
Self.ColCount := FRows.FieldCount + 1;
if FRows.Data.Count = 0 then
Self.RowCount := 2
else
Self.RowCount := FRows.Data.Count + 1;
Self.ColWidths[0] := 25;
Self.FixedCols := 1;
Self.FixedRows := 1;
AdjustColumns;
end
else
begin
Self.FixedCols := 0;
Self.FixedRows := 0;
Self.RowCount := 1;
Self.ColCount := 1;
end;
end;
procedure TDataGrid.SetFlat(const Value: Boolean);
begin
if FFlat <> Value then
begin
FFlat := Value;
RecreateWnd();
end;
end;
procedure TDataGrid.TopLeftChanged;
begin
inherited;
UpdateIndicator;
end;
procedure TDataGrid.UpdateIndicator;
var
BottomRow, w: Integer;
begin
if FOldTopRow <> TopRow then
begin
FOldTopRow := TopRow;
BottomRow := FOldTopRow + Self.VisibleRowCount;
w := Canvas.TextWidth(IntToStr(BottomRow));
Inc(W, 5);
if w < 25 then w := 25;
Self.ColWidths[0] := w;
end;
end;
procedure TDataGrid.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
inherited;
with Message.CalcSize_Params^ do
InflateRect(rgrc[0], -FBorderWidth, -FBorderWidth);
end;
procedure TDataGrid.WMNCPaint(var Message: TWMNCPaint);
begin
inherited;
DrawBorder;
end;
initialization
Variants.NullStrictConvert := False;
// Variants.NullAsStringValue := 'NULL';
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -