generalabilitiesdemo.pas

来自「本系统前端界面采用WINDOWS 窗口风格」· PAS 代码 · 共 532 行 · 第 1/2 页

        Data := Sender.GetNodeData(Node);
        Ghosted := Node.Index = 1;
        case Column of
          -1, // general case
          0:  // main column
            Index := Data.Level + 7;
          1: // image only column
            if Sender.FocusedNode = Node then
              Index := 6;
        end;
      end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.VST2InitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);

// The tree is set to 5 levels a 5 children (~4000 nodes).

var
  Data: PNodeData2;
  
begin
  Data := Sender.GetNodeData(Node);
  if Data.Level < 4 then
    ChildCount := 5;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.VST2NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
  Text: WideString);

// The caption of a node has been changed, keep this in the node record.

var
  Data: PNodeData2;

begin
  Data := Sender.GetNodeData(Node);
  Data.Caption := Text;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.BitBtn1Click(Sender: TObject);

begin
  with FontDialog1 do
  begin
    Font := VST2.Font;
    if Execute then
      VST2.Font := Font;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.CheckMarkComboChange(Sender: TObject);

begin
  VST2.CheckImageKind := TCheckImageKind(CheckMarkCombo.ItemIndex);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.MainColumnUpDownChanging(Sender: TObject; var AllowChange: Boolean);

begin
  VST2.Header.MainColumn := MainColumnUpDown.Position;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.VST2GetPopupMenu(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
  const P: TPoint; var AskParent: Boolean; var PopupMenu: TPopupMenu);

begin
  case Column of
    0:
      PopupMenu := PopupMenu1
  else
    PopupMenu := nil;
  end;                       
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.VST2KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

begin
  if ssCtrl in Shift then
    case Key of
      Ord('C'):
        VST2.CopyToClipboard;
      Ord('X'):
        VST2.CutToClipboard;
    end
  else
    case Key of
      VK_DELETE:
        if Assigned(VST2.FocusedNode) then
          VST2.DeleteNode(VST2.FocusedNode);
      VK_INSERT:
        if Assigned(VST2.FocusedNode) then
          VST2.AddChild(VST2.FocusedNode);
    end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.RadioGroup1Click(Sender: TObject);

begin
  with Sender as TRadioGroup do
    if ItemIndex = 0 then
    begin
      VST2.TreeOptions.PaintOptions := VST2.TreeOptions.PaintOptions + [toShowTreeLines];
      VST2.ButtonStyle := bsRectangle;
    end
    else
    begin
      VST2.TreeOptions.PaintOptions := VST2.TreeOptions.PaintOptions - [toShowTreeLines];
      VST2.ButtonStyle := bsTriangle;
    end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.VST2FocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn,
  NewColumn: TColumnIndex; var Allowed: Boolean);

begin
  Allowed := NewColumn in [0, 2];
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.RadioGroup2Click(Sender: TObject);

begin                                     
  with Sender as TRadioGroup do
    if ItemIndex = 0 then
    begin
      VST2.DrawSelectionMode := smDottedRectangle;
    end
    else
    begin
      VST2.DrawSelectionMode := smBlendedRectangle;
    end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.ThemeRadioGroupClick(Sender: TObject);

begin
  with VST2.TreeOptions do
    if ThemeRadioGroup.ItemIndex = 0 then
      PaintOptions := PaintOptions + [toThemeAware]
    else
      PaintOptions := PaintOptions - [toThemeAware];

  RadioGroup1.Enabled := ThemeRadioGroup.ItemIndex = 1;
  RadioGroup2.Enabled := ThemeRadioGroup.ItemIndex = 1;
  Label18.Enabled := ThemeRadioGroup.ItemIndex = 1;
  CheckMarkCombo.Enabled := ThemeRadioGroup.ItemIndex = 1;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.SaveButtonClick(Sender: TObject);

const
  HTMLHead = '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN">'#13#10 +
    '<html>'#13#10 +
    '  <head>'#13#10 +
    '    <meta http-equiv="Content-Type" content="text/html; charset=utf-8">'#13#10 +
    '    <title>Virtual Treeview export</title>'#13#10 +
    '  </head>'#13#10 +
    '<body>'#13#10;

var
  S: string;
  WS: WideString;
  Data: Pointer;
  DataSize: Cardinal;
  TargetName: string;

begin
  with SaveDialog do
  begin
    if Execute then
    begin
      TargetName := FileName;
      case FilterIndex of
        1: // HTML
          begin
            if Pos('.', TargetName) = 0 then
              TargetName := TargetName + '.html';
            S := HTMLHead + VST2.ContentToHTML(tstVisible) + '</body></html>';
            Data := PChar(S);
            DataSize := Length(S);
          end;
        2: // Unicode UTF-16 text file
          begin
            TargetName := ChangeFileExt(TargetName, '.uni');
            WS := VST2.ContentToUnicode(tstVisible, #9);
            Data := PWideChar(WS);
            DataSize := 2 * Length(WS);
          end;
        3: // Rich text UTF-16 file
          begin
            TargetName := ChangeFileExt(TargetName, '.rtf');
            S := VST2.ContentToRTF(tstVisible);
            Data := PChar(S);
            DataSize := Length(S);
          end;
        4: // Comma separated values ANSI text file
          begin
            TargetName := ChangeFileExt(TargetName, '.csv');
            S := VST2.ContentToText(tstVisible, ListSeparator);
            Data := PChar(S);
            DataSize := Length(S);
          end;
      else
        // Plain text file
        TargetName := ChangeFileExt(TargetName, '.txt');
        S := VST2.ContentToText(tstVisible, #9);
        Data := PChar(S);
        DataSize := Length(S);
      end;

      with TFileStream.Create(TargetName, fmCreate) do
      try
        WriteBuffer(Data^, DataSize);
      finally
        Free;
      end;
    end;
  end;
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.VST2StateChange(Sender: TBaseVirtualTree; Enter, Leave: TVirtualTreeStates);

begin
  if not (csDestroying in ComponentState) then
    UpdateStateDisplay(Sender.TreeStates, Enter, Leave);
end;

//----------------------------------------------------------------------------------------------------------------------

procedure TGeneralForm.VST2DragOver(Sender: TBaseVirtualTree; Source: TObject; Shift: TShiftState; State: TDragState;
  Pt: TPoint; Mode: TDropMode; var Effect: Integer; var Accept: Boolean);

begin
  Accept := True;
end;

//----------------------------------------------------------------------------------------------------------------------

end.