datagrid.pas

mssql查询分析器

// 网络控件.
// penal@delphibbs
unit DataGrid;

interface
uses Windows, Messages, Classes, SysUtils, Controls, Forms, Graphics, Grids,
    Variants, RowData;

type
  TDataGrid = class(TCustomDrawGrid)
  private
    FRows: TRowDataList;
    FFlat: Boolean;
    FBorderWidth: Integer;
    FOldTopRow: Integer;
    FDefaultMaxColumnWidth: Integer;
    
    function GetString(ACol, ARow: Integer): string;
    function IsActiveControl: Boolean;
    procedure SetFlat(const Value: Boolean);

    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    function GetDataRowCount: Integer;
    procedure UpdateIndicator;
    procedure AdjustColumns;
    procedure AdjustColumn(ACol: Integer);
    function GetSelectionText: string;
  protected
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect;
      AState: TGridDrawState); override;
    procedure Paint; override;
    procedure TopLeftChanged; override;
    procedure DrawBorder; virtual;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    // 数据行个数.
    property DataRowCount: Integer read GetDataRowCount;
    // 选中的文本. 字段之间用TAB分隔, 行之间用CRLF分隔.
    property SelectionText: string read GetSelectionText;

    // 设置数据.
    procedure SetData(Data: TRowDataList);
  published
    property Align;
    property Anchors;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FixedColor;
    property Flat: Boolean read FFlat write SetFlat;
    property Font;
    property GridLineWidth;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ScrollBars;
    property ShowHint;
    property TabOrder;
    property Visible;

    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
    property OnSelectCell;
    property OnStartDock;
    property OnStartDrag;
    property OnTopLeftChanged;
  end;

implementation
uses Math;

{ TDataGrid }

procedure TDataGrid.AdjustColumn(ACol: Integer);
var
  R, R2, I, W1, W2, ColIndex: Integer;
  s: string;
begin
  if (ACol < 1) or (ACol > Self.ColCount) then Exit;

  // 设置列宽.
  R := Self.TopRow;
  R2 := R + Self.VisibleRowCount + 10;
  ColIndex := ACol - 1;

  W1 := 0;
  for I := R - 1 to R2 - 1 do
  begin
    if I >= FRows.Data.Count then Break;

    s := GetString(ColIndex, I);
    W2 := Canvas.TextWidth(s) + 5;
    if W2 > FDefaultMaxColumnWidth then
    begin
      W1 := FDefaultMaxColumnWidth;
      Break;
    end;

    W1 := Max(W1, W2);
  end;
  W2 := Canvas.TextWidth(FRows.FieldName[ColIndex]) + 5;
  Self.ColWidths[ACol] := Max(W1, W2);
end;

procedure TDataGrid.AdjustColumns;
var
  I: Integer;
begin
  Canvas.Font.Assign(Self.Font);
  for I := 1 to Self.ColCount-1 do
    AdjustColumn(I);
end;

constructor TDataGrid.Create(AOwner: TComponent);
begin
  inherited;

  Self.DefaultRowHeight := 18;
  Self.ColCount := 2;
  Self.RowCount := 2;
  Self.FixedRows := 1;
  Self.FixedCols := 1;
  Self.Options := Self.Options + [goColSizing, goThumbTracking, goDrawFocusSelected];

  FRows := TRowDataList.Create;
  FDefaultMaxColumnWidth := 400;
end;

procedure TDataGrid.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    if Flat {and (Ctl3D = True)} then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
      if (BorderStyle = bsSingle) then
        FBorderWidth := 1 else FBorderWidth := 0;
    end else
      FBorderWidth := 0;
    Style := Style or WS_CLIPCHILDREN; //To avoid black box in Inplace editor When BufferedPaint.
  end;
end;

destructor TDataGrid.Destroy;
begin
  FRows.Free;

  inherited;
end;

procedure TDataGrid.DrawBorder;
var
  DC: HDC;
  R: TRect;
begin
  if Flat and (BorderStyle = bsSingle) then
  begin
    DC := GetWindowDC(Handle);
    try
      GetWindowRect(Handle, R);
      OffsetRect(R, -R.Left, -R.Top);
      //DrawEdge(DC, R,BDR_SUNKENOUTER, BF_TOPLEFT);
      //DrawEdge(DC, R,BDR_SUNKENOUTER, BF_BOTTOMRIGHT);
      DrawEdge(DC, R, BDR_SUNKENOUTER, BF_RECT);
    finally
      ReleaseDC(Handle, DC);
    end;
  end;
end;

procedure TDataGrid.DrawCell(ACol, ARow: Integer; ARect: TRect;
  AState: TGridDrawState);
var
  I, J: Integer;
  S: string;
begin
  Inc(ARect.Left, 3);

  if (ARow = 0) and (ACol > 0) then
  begin
    // 标题.
    I := ACol - 1;
    if I < FRows.FieldCount then
      S := FRows.FieldName[I]
    else
    begin
      inherited;
      Exit;
    end;
  end
  else if (ACol = 0) and (ARow > 0) and (FRows.Data.Count > 0) then
  begin
    // Indicator.
    S := IntToStr(ARow);
  end
  else
  begin
    J := ARow - 1;
    I := ACol - 1;
    if (J < 0) or (I < 0) or (J >= FRows.Data.Count) or (I >= FRows.FieldCount) then
    begin
      inherited;
      Exit;
    end;
    S := GetString(I, J);
  end;

  DrawText(Canvas.Handle, PChar(S), Length(S), ARect,
            DT_VCENTER or DT_SINGLELINE or DT_LEFT);
end;

function TDataGrid.GetDataRowCount: Integer;
begin
  Result := FRows.Data.Count;
end;

function TDataGrid.GetSelectionText: string;
var
  GridRect: TGridRect;
  R, C: Integer;
  S: string;
begin
  GridRect := Self.Selection;
  for R := GridRect.Top - 1 to GridRect.Bottom - 1 do
  begin
    for C := GridRect.Left - 1 to GridRect.Right - 1 do
    begin
      if C >= GridRect.Left then S := S + #9;
      S := S + GetString(C, R);
    end;
    S := S + #13#10;
  end;
  Result := S;
end;

function TDataGrid.GetString(ACol, ARow: Integer): string;
var
  Row: PRowData;
begin
  Row := FRows.Data[ARow];
  Result := Row[ACol];
end;

function TDataGrid.IsActiveControl: Boolean;
var
  H: Hwnd;
  ParentForm: TCustomForm;
begin
  Result := False;
  ParentForm := GetParentForm(Self);
  if Assigned(ParentForm) then
  begin
    if (ParentForm.ActiveControl = Self) then
      Result := True
  end
  else
  begin
    H := GetFocus;
    while IsWindow(H) and (Result = False) do
    begin
      if H = WindowHandle then
        Result := True
      else
        H := GetParent(H);
    end;
  end;
end;

procedure TDataGrid.Paint;
type
//  TPointArray = array of TPoint;
  TIntArray = array of Integer;
var
  LineColor: TColor;
  DrawInfo: TGridDrawInfo;
  Sel: TGridRect;
  UpdateRect: TRect;
  AFocRect, FocRect: TRect;
  PointsList: TIntArray;
  StrokeList: TIntArray;
  I: Integer;
  MaxStroke: Integer;
  FrameFlags1, FrameFlags2: DWORD;
  FixedLineColor: TColor;

  procedure DrawLines(DoHorz, DoVert: Boolean; Col, Row: Longint;
    const CellBounds: array of Integer; OnColor, OffColor: TColor);

  { Cellbounds is 4 integers: StartX, StartY, StopX, StopY
    Horizontal lines:  MajorIndex = 0
    Vertical lines:    MajorIndex = 1 }

  const
    FlatPenStyle = PS_Geometric or PS_Solid or PS_EndCap_Flat or PS_Join_Miter;

    procedure DrawAxisLines(const AxisInfo: TGridAxisDrawInfo;
      Cell, MajorIndex: Integer; UseOnColor: Boolean);
    var
      Line: Integer;