Форум программистов [Powered by Invision Power Board]

Код

unit BaseEditor1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VirtualTrees, StdCtrls, math, ComCtrls,ExtCtrls,Mask;

type
  {редактор для VT}
  PRegexNode = ^TRegexNode;
  TRegexNode = record
    color,
    typeDtrmn,
    regular,
    extansion,
    groups,
    SimbolsCount,
    depth,
    nodeId: wideString;
    brashcolor:integer;
  end;


  TVTCustomEditor = class(TInterfacedObject, IVTEditLink)
  private
    FEdit: TWinControl;        // Базовый класс для каждого типа редактора
    FTree: TVirtualStringTree; // Ссылка на дерево, вызвавшее редактирование
    FNode: PVirtualNode;       // Редактируемый узел
    FColumn: Integer;          // Его колонка, в которой оно происходит
  protected
    procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  public
    destructor Destroy; override;

    function BeginEdit: Boolean; stdcall;
    function CancelEdit: Boolean; stdcall;
    function EndEdit: Boolean; stdcall;
    function GetBounds: TRect; stdcall;
    function PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex): Boolean; stdcall;
    procedure ProcessMessage(var Message: TMessage); stdcall;
    procedure SetBounds(R: TRect); stdcall;
  end;


  TBaseEditor = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Button3: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    VT: TVirtualStringTree;
    Button1: TButton;
    ColorDialog1: TColorDialog;
    procedure Button1Click(Sender: TObject);
    procedure VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure FormCreate(Sender: TObject);
    procedure VTCompareNodes(Sender: TBaseVirtualTree; Node1,
      Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
    procedure VTHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo);
    procedure VTIncrementalSearch(Sender: TBaseVirtualTree;
      Node: PVirtualNode; const SearchText: WideString;
      var Result: Integer);
    procedure VTPaintText(Sender: TBaseVirtualTree;
      const TargetCanvas: TCanvas; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType);
    procedure VTBeforeCellPaint(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
      CellPaintMode: TVTCellPaintMode; CellRect: TRect;
      var ContentRect: TRect);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure VTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; NewText: WideString);
    procedure VTCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; out EditLink: IVTEditLink);
    procedure VTEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; var Allowed: Boolean);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  var
  BaseEditor: TBaseEditor;
  VBrashColor:Integer; //цвет фона
implementation

{$R *.dfm}

//---------------------------------------------------------------------------
{* * * * * * * * * * * * * * * * TVTCustomEditor * * * * * * * * * * * * * *}
//---------------------------------------------------------------------------
destructor TVTCustomEditor.Destroy;
begin
  FreeAndNil(FEdit);
  inherited;
end;

//---------------------------------------------------------------------------
// Для обработки нажатий с клавиатуры.
// Отмена редактирования по Escape, завершение редактирования по Enter,
// и переход между узлами по Up/Down, если список элементов у комбо бокса или
// редактора даты не выпущен.
//---------------------------------------------------------------------------
procedure TVTCustomEditor.EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  CanContinue: Boolean;
begin
  CanContinue := True;
  case Key of
    VK_ESCAPE: // Нажали Escape
      if CanContinue then
      begin
        FTree.CancelEditNode;
        Key := 0;
      end;
    VK_RETURN: // Нажали Enter
      if CanContinue then
      begin
        // Если Ctrl для TMemo не зажат, то завершаем редактирование
        // Сделаем так, чтобы можно было по Ctrl+Enter вставлять в Memo
        // новую линию.
        if (FEdit is TMemo) and (Shift = []) then
          FTree.EndEditNode
        else if not(FEdit is TMemo) then
          FTree.EndEditNode;
        Key := 0;
      end;
    VK_UP, VK_DOWN:
      begin
        // Проверить, не идёт ли работа с редактором. Если идёт, то запретить
        // активность дерева, если нет, то передать нажатие дереву.
        CanContinue := Shift = [];
        if FEdit is TComboBox then
          CanContinue := CanContinue and not TComboBox(FEdit).DroppedDown;
        if FEdit is TDateTimePicker then
          CanContinue := CanContinue and not TDateTimePicker(FEdit).DroppedDown;
        if CanContinue then
        begin
          // Передача клавиши дереву
          PostMessage(FTree.Handle, WM_KEYDOWN, Key, 0);
          Key := 0;
        end;
      end;
  end;
end;

//---------------------------------------------------------------------------
// Началось редактирование, нужно показать редактор и установить ему фокус
//---------------------------------------------------------------------------
function TVTCustomEditor.BeginEdit: Boolean;
begin
  Result := True;
  with FEdit do
  begin
    Show;
    SetFocus;
  end;
end;

//---------------------------------------------------------------------------
// Отменилось, прячем редактор
//---------------------------------------------------------------------------
function TVTCustomEditor.CancelEdit: Boolean;
begin
  Result := True;
  //fedit.Destroy;
  FEdit.Hide;
end;

//---------------------------------------------------------------------------
// Успешно завершилось, прячем редактор, обновляем данные узла и возвращаем
// фокус дереву
//---------------------------------------------------------------------------
function TVTCustomEditor.EndEdit: Boolean;
var
  Txt: String;
begin
  Result := True;                            //ТУТ НАДО УБРАТЬ
  if FEdit is TEdit then                     //ЛИШНИЕ СРАВНЕНИЯ!!!!!
    Txt := TEdit(FEdit).Text
  else if FEdit is TMemo then
    Txt := TEdit(FEdit).Text
  else if FEdit is TComboBox then
    Txt := TComboBox(FEdit).Text
  else if FEdit is TColorBox then
    Txt := TColorBox(FEdit).Items[TColorBox(FEdit).ItemIndex]
  else if FEdit is TDateTimePicker then
  begin
    Txt := DateToStr(TDateTimePicker(FEdit).DateTime);
  end
  else if FEdit is TMaskEdit then
    Txt := TMaskEdit(FEdit).Text
  else if FEdit is TProgressBar then
    Txt := IntToStr(TProgressBar(FEdit).Position) + ' %';
  // Изменяем текст узла (поле Value у TVTEditNode) через событие OnNewText
  // у дерева
  FTree.Text[FNode, FColumn] := Txt;
  FEdit.Hide;
  FTree.SetFocus;
end;

//---------------------------------------------------------------------------
// Возвращаем границы редактора
//---------------------------------------------------------------------------
function TVTCustomEditor.GetBounds: TRect;
begin
  Result := FEdit.BoundsRect;
end;

//---------------------------------------------------------------------------
// В подготовке к редактированию мы должны создать экземпляр TWinControl
// нужного класса потомка в соответствии с полем Kind у TVTEditNode
//---------------------------------------------------------------------------
function TVTCustomEditor.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex): Boolean;
var
  //VTEditNode: PVTEditNode;
  rn:PRegexNode;
begin
  Result := True;
  FTree := Tree as TVirtualStringTree;
  FNode := Node;
  FColumn := Column;
  FreeAndNil(FEdit);
  rn:=FTree.GetNodeData(Node);
  case column of
    0:
    begin
      FEdit := TColorBox.Create(nil);
      with FEdit as TColorBox do
      begin
        Visible := False;
        Parent := Tree;
        Clear;
        OnKeyDown := EditKeyDown;
      end;
    end;
    1:
    begin
      FEdit := TEdit.Create(nil);
      with FEdit as TEdit do
      begin
        AutoSize := False;
        Visible := False;
        Parent := Tree;
        Text := rn^.typeDtrmn;
        OnKeyDown := EditKeyDown;
      end;
    end;
    2:
    begin
      FEdit := TMemo.Create(nil);
      with FEdit as TMemo do
      begin
        Visible := False;
        Parent := Tree;
        ScrollBars := ssVertical;
        Text := rn.regular;
        OnKeyDown := EditKeyDown;
      end;
    end;
    3:
    begin
      FEdit := TEdit.Create(nil);
      with FEdit as TEdit do
      begin
        AutoSize := False;
        Visible := False;
        Parent := Tree;
        Text := rn^.extansion;
        OnKeyDown := EditKeyDown;
      end;
    end;
    4:
    begin
      FEdit := TComboBox.Create(nil);
      with FEdit as TComboBox do
      begin
        Visible := False;
        Parent := Tree;
        Text := rn^.groups;
        OnKeyDown := EditKeyDown;
      end;
    end
  else
    Result := False;
  end;
end;

//---------------------------------------------------------------------------
// Обработка сообщений Windows для редактора
//---------------------------------------------------------------------------
procedure TVTCustomEditor.ProcessMessage(var Message: TMessage);
begin
  FEdit.WindowProc(Message);
end;

//---------------------------------------------------------------------------
// Устанавливает границы редактора в соответствии с шириной и высотой колонки
//---------------------------------------------------------------------------
procedure TVTCustomEditor.SetBounds(R: TRect);
var
  Dummy: Integer;
begin
  FTree.Header.Columns.GetColumnBounds(FColumn, Dummy, R.Right);
  FEdit.BoundsRect := R;
  if FEdit is TMemo then
    FEdit.Height := 80;
end;
///////////////////
//////////////////
///////////////////// Редактор закончился
//////////////////////
///////////////////
////////////////


procedure TBaseEditor.VTHeaderClick(Sender: TVTHeader;
  HitInfo: TVTHeaderHitInfo);
begin
  if HitInfo.Button = mbLeft then
  begin
    // Меняем индекс сортирующей колонки на индекс колонки,
    // которая была нажата.
    VT.Header.SortColumn := HitInfo.Column;
    // Сортируем всё дерево относительно этой колонки
    // и изменяем порядок сортировки на противополжный
    if VT.Header.SortDirection = sdAscending then
    begin
      VT.Header.SortDirection := sdDescending;
      VT.SortTree(HitInfo.Column, VT.Header.SortDirection);
    end
    else begin
      VT.Header.SortDirection := sdAscending;
      VT.SortTree(HitInfo.Column, VT.Header.SortDirection);
    end;
  end;
end;

procedure TBaseEditor.Button1Click(Sender: TObject);
begin
 showmessage('смайл');
end;

procedure TBaseEditor.VTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
var
  VTEditNode: PRegexNode;
begin
  case Column of
    0:
    begin
      VTEditNode := Sender.GetNodeData(Node);
      CellText := VTEditNode^.color;
    end;
    1:
    begin
      VTEditNode := Sender.GetNodeData(Node);
      CellText := VTEditNode^.typeDtrmn;
    end;
    2:
    begin
      VTEditNode := Sender.GetNodeData(Node);
      CellText := VTEditNode^.regular;
    end;
    3:
    begin
      VTEditNode := Sender.GetNodeData(Node);
      CellText := VTEditNode^.extansion;
    end;
    4:
    begin
      VTEditNode := Sender.GetNodeData(Node);
      CellText := VTEditNode^.groups;
    end;
    5:
    begin
      VTEditNode := Sender.GetNodeData(Node);
      CellText := VTEditNode^.SimbolsCount;
    end;
    6:
    begin
      VTEditNode := Sender.GetNodeData(Node);
      CellText := VTEditNode^.depth;
    end;
    7:
    begin
      VTEditNode := Sender.GetNodeData(Node);
      CellText := VTEditNode^.nodeId;
    end;

  end;
end;

procedure TBaseEditor.FormCreate(Sender: TObject);
begin
  VT.NodeDataSize := SizeOf(TRegexNode);
end;

procedure TBaseEditor.VTCompareNodes(Sender: TBaseVirtualTree; Node1,
  Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var
  Data1, Data2: PRegexNode; //для сортировку по числам
begin
  case column of
  1,2,3,4:
  {сортировка по алфавиту}
  Result := WideCompareStr(VT.Text[Node1, Column], VT.Text[Node2, Column]);
  0:
  begin
  {cортировка по числам}
    Data1 := Sender.GetNodeData(Node1);
    Data2 := Sender.GetNodeData(Node2);
    if StrToInt('$0'+Data1^.color) > StrToInt('$0'+Data2^.color) then
      Result := 1
    else if StrToInt('$0'+Data1^.color) < StrToInt('$0'+Data2^.color) then
      Result := -1
    else if StrToInt('$0'+Data1^.color) = StrToInt('$0'+Data2^.color) then
      Result := 0;
  end;
  5:
  begin
  {cортировка по числам}
    Data1 := Sender.GetNodeData(Node1);
    Data2 := Sender.GetNodeData(Node2);
    if StrToInt(Data1^.SimbolsCount) > StrToInt(Data2^.SimbolsCount) then
      Result := 1
    else if StrToInt(Data1^.SimbolsCount) < StrToInt(Data2^.SimbolsCount) then
      Result := -1
    else if StrToInt(Data1^.SimbolsCount) = StrToInt(Data2^.SimbolsCount) then
      Result := 0;
  end;
  6:  ;
  7:
  begin
  {cортировка по числам}
    Data1 := Sender.GetNodeData(Node1);
    Data2 := Sender.GetNodeData(Node2);
    if StrToInt(Data1^.nodeId) > StrToInt(Data2^.nodeId) then
      Result := 1
    else if StrToInt(Data1^.nodeId) < StrToInt(Data2^.nodeId) then
      Result := -1
    else if StrToInt(Data1^.nodeId) = StrToInt(Data2^.nodeId) then
      Result := 0;
  end;
  end;

end;

procedure TBaseEditor.VTIncrementalSearch(Sender: TBaseVirtualTree;
  Node: PVirtualNode; const SearchText: WideString; var Result: Integer);
var
  RegexNode: PRegexNode;
begin
  Result := 0;
  RegexNode := VT.GetNodeData(Node);
  if Assigned(RegexNode) then
  begin
    // Используя StrLIComp, мы можем указать длину сравнения.
    // Таким образом, мы сможем найти узлы, совпадающие частично.
    Result := StrLIComp(PAnsiChar(AnsiString(SearchText)),
      PAnsiChar(AnsiString(RegexNode^.groups)),
       Min(Length(SearchText), Length(RegexNode^.groups)));
  end;
end;
procedure TBaseEditor.VTPaintText(Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType);
var
  RegexNode: PRegexNode;
begin
  {RegexNode := VT.GetNodeData(Node);
  if Assigned(RegexNode) then
    TargetCanvas.Font.Color := StrToInt('$0'+RevRGB(RegexNode^.Color));
  if (vsSelected in Node.States) and (Sender.Focused) then
    TargetCanvas.Font.Color := clHighlightText;   }
end;

{окрашивает фон таблицы (построчно)}
procedure TBaseEditor.VTBeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect;
  var ContentRect: TRect);
var
  RegexNode: PRegexNode;
begin
  {RegexNode := VT.GetNodeData(Node);
  if Assigned(RegexNode) then
    with TargetCanvas do
    begin
      Brush.Color := strToInt(RegexNode^.brashcolor);
      FillRect(CellRect);
    end;    }
end;

{удаление текущей строки}
{При удалении надо запоминать ID удаляемых элементов}
procedure TBaseEditor.Button2Click(Sender: TObject);
var
  rNode:PregexNode;
begin
  rNode:=VT.GetNodeData(VT.FocusedNode);
  if rNode<>nil then begin
    //showmessage('смайл');
    VT.DeleteNode(VT.FocusedNode);
  end;
end;

procedure TBaseEditor.Button3Click(Sender: TObject);

begin
  //OpenDialog1.Filter:='Base.d*';
  if OpenDialog1.Execute then begin
    showmessage('смайл');
  end;
end;

procedure TBaseEditor.VTNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; NewText: WideString);
var
  regexNode: PRegexNode;
begin
  regexNode := VT.GetNodeData(Node);
  if Assigned(regexNode) then
  begin
    case Column of
      0:
      begin
        regexNode^.color := NewText;
      end;
      1:
      begin
        regexNode^.typeDtrmn := NewText;
      end;
      2:
      begin
        fillChar(regexNode^.regular,SizeOf(regexNode^.regular),#0);
        RegexNode^.regular:=NewText;
        {необходимо вызвать процедуру подсчета длины строки}
        fillChar(regexNode^.SimbolsCount,SizeOf(regexNode^.SimbolsCount),#0);
        //GetLengthRegularInNode(regexNode); - процедура в мое   библе
      end;
      3:
      begin
        fillChar(regexNode^.extansion,SizeOf(regexNode^.extansion),#0);
        RegexNode^.extansion:=NewText;
      end;
      4:
      begin
        fillChar(regexNode^.groups,SizeOf(regexNode^.groups),#0);
        RegexNode^.groups:=NewText;
      end;
    end;
  end;
end;

procedure TBaseEditor.VTCreateEditor(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
begin
  EditLink := TVTCustomEditor.Create;
end;

{ПРОЦЕДУРА РАЗРЕШАЕТ РЕДАКТИРОВАНИЕ VT}
procedure TBaseEditor.VTEditing(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; var Allowed: Boolean);
begin
  Allowed := TRUE;
end;

procedure TBaseEditor.FormActivate(Sender: TObject);
var
  NewNode: PVirtualNode;
  NewRegex: PRegexNode;
  i:integer;
begin
  vbrashColor:=clWhite;


  {заполним VT}
  for i:=0 to 3 do begin
    NewNode := VT.AddChild(nil);
    NewRegex := VT.GetNodeData(NewNode);
    if Assigned(NewRegex) then
      with NewRegex^ do
      begin
        color:='00ff00';
        typeDtrmn:='b';
        regular:='sdfsdfsdfsdfsdf';
        extansion:='sdf';
        groups:='ccvv';
        SimbolsCount:='20';
        //Depth:='1024';
        nodeId:='1';
        //brashcolor:=vbrashcolor;
      end;
  end;
end;

end.