main.pas

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

          SetString(Data.Caption, Head, Tail - Head);
        end;
        // skip line separators
        if Tail^ = #13 then
          Inc(Tail);
        if Tail^ = #10 then
          Inc(Tail);
        Head := Tail;
      end;
    finally
      Target.EndUpdate;
    end;
  end;
end;

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

function TMainForm.FindCPFormatDescription(CPFormat: Word): string;

var
  Buffer: array[0..2048] of Char;

begin
  // Try the formats support the by Virtual Treeview first.
  Result := GetVTClipboardFormatDescription(CPFormat);

  // Retrieve additional formats from system.
  if Length(Result) = 0 then
  begin
    if GetClipboardFormatName(CPFormat, @Buffer, 2048) > 0 then
      Result := '  - ' + Buffer
    else
      Result := Format('  - unknown format (%d)', [CPFormat]);
  end
  else
    Result := '  - ' + Result;
end;

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

procedure TMainForm.TreeDragDrop(Sender: TBaseVirtualTree; Source: TObject; DataObject: IDataObject;
  Formats: TFormatArray; Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);

  //--------------- local function --------------------------------------------

  procedure DetermineEffect;

  // Determine the drop effect to use if the source is a Virtual Treeview.

  begin
    // In the case the source is a Virtual Treeview we know 'move' is the default if dragging within
    // the same tree and copy if dragging to another tree. Set Effect accordingly.
    if Shift = [] then
    begin
      // No modifier key, so use standard action.
      if Source = Sender then
        Effect := DROPEFFECT_MOVE
      else
        Effect := DROPEFFECT_COPY;     
    end
    else
    begin
      // A modifier key is pressed, hence use this to determine action.
      if (Shift = [ssAlt]) or (Shift = [ssCtrl, ssAlt]) then
        Effect := DROPEFFECT_LINK
      else
        if Shift = [ssCtrl] then
          Effect := DROPEFFECT_COPY
        else
          Effect := DROPEFFECT_MOVE;
    end;
  end;

  //--------------- end local function ----------------------------------------

var
  S: string;
  Attachmode: TVTNodeAttachMode;
  Nodes: TNodeArray;
  I: Integer;

begin
  Nodes := nil;
  
  if LogListBox.Items.Count > 0 then
    LogListBox.Items.Add('');
  if Sender = Tree1 then
    LogListBox.Items.Add('----- Tree 1')
  else
    LogListBox.Items.Add('----- Tree 2');
    
  if DataObject = nil then
    LogListBox.Items.Add('VCL drop arrived')
  else
    LogListBox.Items.Add('OLE drop arrived');

  S := 'Drop actions allowed:';
  if Boolean(DROPEFFECT_COPY and Effect) then
    S := S + ' copy';
  if Boolean(DROPEFFECT_MOVE and Effect) then
    S := S + ' move';
  if Boolean(DROPEFFECT_LINK and Effect) then
    S := S + ' link'; 
  LogListBox.Items.Add(S);

  S := 'Drop mode: ' + GetEnumName(TypeInfo(TDropMode), Ord(Mode));
  LogListBox.Items.Add(S);

  // Translate the drop position into an node attach mode.
  case Mode of
    dmAbove:
      AttachMode := amInsertBefore;
    dmOnNode:
      AttachMode := amAddChildLast;
    dmBelow:
      AttachMode := amInsertAfter;
  else
    AttachMode := amNowhere;
  end;

  if DataObject = nil then
  begin
    // VCL drag'n drop. Handling this requires detailed knowledge about the sender and its data. This is one reason
    // why it was a bad decision by Borland to implement something own instead using the system's way.
    // In this demo we have two known sources of VCL dd data: Tree2 and LogListBox. 
    if Source = Tree2 then
    begin
      // Since we know this is a Virtual Treeview we can ignore the drop event entirely and use VT mechanisms.
      DetermineEffect;
      Nodes := Tree2.GetSortedSelection(True);
      if Effect = DROPEFFECT_COPY then
      begin
        for I := 0 to High(Nodes) do
          Tree2.CopyTo(Nodes[I], Sender.DropTargetNode, AttachMode, False);
      end
      else
        for I := 0 to High(Nodes) do
          Tree2.MoveTo(Nodes[I], Sender.DropTargetNode, AttachMode, False);
    end
    else
    begin
      // One long string (one node) is added, containing all text currently in the list box.
      AddVCLText(Sender as TVirtualStringTree, LogListBox.Items.CommaText, AttachMode);
      LogListBox.Items.Add('List box data accepted as string.');
    end;
  end
  else
  begin
    // OLE drag'n drop. Perform full processing.
    
    LogListBox.Items.Add('There are ' + IntToStr(Length(Formats)) + ' formats available:');

    // Determine action in advance even if we don't use the dropped data.
    // Note: The Effect parameter is a variable which must be set to the action we
    //       will actually take, to notify the sender of the drag operation about remaining actions.
    //       This value determines what the caller will do after the method returns,
    //       e.g. if DROPEFFECT_MOVE is returned then the source data will be deleted.
    if Source is TBaseVirtualTree then
    begin
      DetermineEffect;
    end
    else
      // Prefer copy if allowed for every other drag source. Alone from Effect you cannot determine the standard action
      // of the sender, but we assume if copy is allowed then it is also the standard action
      // (e.g. as in TRichEdit).
      if Boolean(Effect and DROPEFFECT_COPY) then
        Effect := DROPEFFECT_COPY
      else
        Effect := DROPEFFECT_MOVE;

    InsertData(Sender as TVirtualStringTree, DataObject, Formats, Effect, AttachMode);
  end;

  // scroll last added entry into view
  LogListBox.ItemIndex := LogListBox.Items.Count - 1;
end;

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

procedure TMainForm.Button2Click(Sender: TObject);

begin
  LogListBox.Clear;
end;

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

procedure TMainForm.TreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode;
  var InitialStates: TVirtualNodeInitStates);

var
  Data: PNodeData;

begin
  Data := Sender.GetNodeData(Node);
  // set a generic caption only if there is not already one (e.g. from drag operations)
  if Length(Data.Caption) = 0 then
    Data.Caption := Format('Node Index %d', [Node.Index]);
end;

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

procedure TMainForm.Tree1NewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; Text: WideString);

var
  Data: PNodeData;

// Tree1 as well as Tree2 use the soSaveCaptions StringOption which enables automatic caption store action
// when tree data is serialized into memory (e.g. for drag'n drop). Restoring the caption is done by triggering
// this event for each loaded node.
// This mechanism frees us from implementing a SaveNode and LoadNode event since we have only the caption to store.

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

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

procedure TMainForm.Button3Click(Sender: TObject);

begin
  with FontDialog do
  begin
    Font := Tree1.Font;
    if Execute then
    begin
      Tree1.Font := Font;
      Tree2.Font := Font;
    end;
  end;
end;

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

procedure TMainForm.Tree2DragAllowed(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);

// Tree 2 uses manual drag start to tell which node might be dragged.
 
begin
  Allowed := Odd(Node.Index);
end;

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

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

begin
  Accept := True;
end;

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

procedure TMainForm.Tree2BeforeItemErase(Sender: TBaseVirtualTree; Canvas: TCanvas; Node: PVirtualNode; ItemRect: TRect;
  var ItemColor: TColor; var EraseAction: TItemEraseAction);

// The second tree uses manual drag and we want to show the lines which are allowed to start a drag operation by
// a colored background.

begin
  if Odd(Node.Index) then
  begin
    ItemColor := $FFEEEE;
    EraseAction := eaColor;
  end;
end;

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

procedure TMainForm.InsertData(Sender: TVirtualStringTree; DataObject: IDataObject; Formats: TFormatArray;
  Effect: Integer; Mode: TVTNodeAttachMode);

var
  FormatAccepted: Boolean;
  I: Integer;
  
begin
  // Go through each available format and see if we can make sense of it.
  FormatAccepted := False;
  for I := 0 to High(Formats) do
  begin
    case Formats[I] of
      // standard clipboard formats
      CF_UNICODETEXT:
        begin
          LogListBox.Items.Add('  - Unicode text');

          // As demonstration for non-tree data here an implementation for Unicode text.
          // Formats are placed in preferred order in the formats parameter. Hence if
          // there is native tree data involved in this drop operation then it has been
          // caught earlier in the loop and FormatAccepted is already True.
          if not FormatAccepted then
          begin
            // Unicode text data was dropped (e.g. from RichEdit1) add this line by line
            // as new nodes.
            AddUnicodeText(DataObject, Sender as TVirtualStringTree, Mode);
            LogListBox.Items.Add('+ Unicode accepted');
            FormatAccepted := True;
          end;
        end;
    else
      if Formats[I] = CF_VIRTUALTREE then
      begin
        // this is our native tree format
        LogListBox.Items.Add('  - native Virtual Treeview data');

        if not FormatAccepted then
        begin
          Sender.ProcessDrop(DataObject, Sender.DropTargetNode, Effect, Mode);
          LogListBox.Items.Add('+ native Virtual Treeview data accepted');
          // Indicate that we found a format we accepted so the data is not used twice.
          FormatAccepted := True;
        end;
      end
      else
        if Formats[I] = CF_VTREFERENCE then
          LogListBox.Items.Add('  - Virtual Treeview reference')
        else
        begin
          // Predefined, shell specific, MIME specific or application specific clipboard data.
          LogListBox.Items.Add(FindCPFormatDescription(Formats[I]));
        end;
    end;
  end;
end;

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

end.