Нужен DBGrid с переносом слов в ячейках

[asnik]

Здравствуйте!

Нужно на базе стандартного dbgrid сделать отображение текстовых полей до 255 символов в ячейках dbgrid с переносом слов и автоматической подстройкой высоты ячейки при показе на форме (и при изменении ширины столбца). БД FireBird + использую IBX.
Это срочно.

Готов рассмотреть предложения о помощи (сроки/бюджет).
asnik900 [собакин] yandex.ru

ps Пробовал Rx и KDBGrid. Не понравилось.

Добавлено спустя 1 час 37 секунд:
Срочно, это в течение 3-5 дней))

Добавлено спустя 1 минуту 52 секунды:
Еще весьма желательно сортировку по столбцам по клику на названии колонки.

[sign]

VirtualTreeView вам в помощь.
Вот пример, делается в секунду на коленке.
Компонент рассчитан на все дельфы и лазарусы.
Пример на дельфе.

Код: Выделить всё

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, VirtualTrees;

type
  TForm1 = class(TForm)
    vTree: TVirtualStringTree;
    procedure vTreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
    procedure FormCreate(Sender: TObject);
    procedure vTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: string);
    procedure vTreeMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode;
      var NodeHeight: Integer);
    procedure vTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
      var InitialStates: TVirtualNodeInitStates);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  PRec = ^TRec;
  TRec = record
    P1: AnsiString;
    P2, P3: Integer;
    P4: AnsiString;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var Data: PRec;
    Node: PVirtualNode;
    i: Integer;
begin
  for i := 0 to 10 do begin
    Node := vTree.AddChild(nil);
    Data := vTree.GetNodeData(Node);
    Data.P1 := 'Очень длинная строка, которая гарантированно не влазит в одну строчку, потому должна быть с переносом';
    Data.P2 := i;
    Data.P3 := i*i;
    Data.P4 := Format('i=%d, i^2=%d', [i, i*i]);
  end;
end;

procedure TForm1.vTreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
begin
  NodeDataSize := SizeOf(TRec);
end;

procedure TForm1.vTreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var Data: PRec;
begin
  Data := vTree.GetNodeData(Node);
  case Column of
    0: CellText := Data.P1;
    1: CellText := IntToStr(Data.P2);
    2: CellText := IntToStr(Data.P3);
    3: CellText := Data.P4;
  end;
end;

procedure TForm1.vTreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
begin
  Include(InitialStates, ivsMultiline);
end;

procedure TForm1.vTreeMeasureItem(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer);
begin
if Sender.MultiLine[Node] then begin
    TargetCanvas.Font := Sender.Font;
    NodeHeight := vTree.ComputeNodeHeight(TargetCanvas, Node, 0) + 10;
 end;
end;

end.

dfm

Код: Выделить всё

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 294
  ClientWidth = 679
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 16
  object vTree: TVirtualStringTree
    Left = 0
    Top = 0
    Width = 679
    Height = 225
    Align = alTop
    Header.AutoSizeIndex = 0
    Header.DefaultHeight = 17
    Header.Font.Charset = DEFAULT_CHARSET
    Header.Font.Color = clWindowText
    Header.Font.Height = -11
    Header.Font.Name = 'Tahoma'
    Header.Font.Style = []
    Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoHotTrack, hoShowSortGlyphs, hoVisible]
    TabOrder = 0
    TreeOptions.MiscOptions = [toAcceptOLEDrop, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toNodeHeightResize, toEditOnClick]
    TreeOptions.PaintOptions = [toHotTrack, toShowButtons, toShowDropmark, toShowHorzGridLines, toShowVertGridLines, toThemeAware, toUseBlendedImages]
    TreeOptions.SelectionOptions = [toExtendedFocus]
    OnGetText = vTreeGetText
    OnGetNodeDataSize = vTreeGetNodeDataSize
    OnInitNode = vTreeInitNode
    OnMeasureItem = vTreeMeasureItem
    ExplicitWidth = 562
    Columns = <
      item
        Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coSmartResize, coAllowFocus, coWrapCaption, coUseCaptionAlignment]
        Position = 0
        Width = 325
        WideText = #1055#1077#1088#1074#1099#1081
      end
      item
        Position = 1
        WideText = #1042#1090#1086#1088#1086#1081
      end
      item
        Position = 2
        Width = 100
        WideText = #1058#1088#1077#1090#1080#1081
      end
      item
        Position = 3
        Width = 200
        WideText = #1063#1077#1090#1074#1077#1088#1090#1099#1081
      end>
  end
end

[asnik]

Спасибо! Хороший компонент, не знал) Но его надо еще прикручивать к БД, не успею((
Кроме того в Лазаре не нашел свойств колонок (Дельфи нет, чтобы Ваш пример вживую посмотреть):
Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coSmartResize, coAllowFocus, coWrapCaption, coUseCaptionAlignment]
Пока вопрос остается актуальным.

Добавлено спустя 2 минуты 51 секунду:
ps пакет 4.8.7 последний под Лазарус.
Читал, что в Дельфи штатный dbgrid имеет свойство wordbreak.

[sign]

Опции штатного грида:

Код: Выделить всё

TDBGridOption = (dgEditing, dgAlwaysShowEditor, dgTitles, dgIndicator,
    dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,
    dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgMultiSelect,
    dgTitleClick, dgTitleHotTrack);