⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unt_frmmenudesign.pas

📁 一个DELPHI下的菜单构件
💻 PAS
📖 第 1 页 / 共 3 页
字号:
var
  CurNode, TempNode: TTreeNode;
  P_Node: PMNData;
begin
  if ExamShortCut then Exit; //查找有无重复注册的快捷键

  New(P_Node);
  View2PMNData(P_Node);
  CurNode := TrvMenu.Selected;
  if CurNode = nil then
    TempNode := TrvMenu.Items.AddChildObject(TrvMenu.Items[0], P_Node.mCaption, P_Node)
  else
    if CurNode = TrvMenu.Items[0] then
    begin
      StrGrdInspector.Cells[1, 4] := '新菜单项';
      P_Node.mCaption := '新菜单项';
      TempNode := TrvMenu.Items.AddChildObject(CurNode, P_Node.mCaption, P_Node);
    end else
      TempNode := TrvMenu.Items.AddChildObject(CurNode.Parent, P_Node.mCaption, P_Node);
  isEdited := False;
  if TempNode <> nil then TempNode.Selected := True;
  isModifed := True;
end;

procedure TFrmMenuDesign.I1Click(Sender: TObject);
var
  CurNode, TempNode: TTreeNode;
  P_Node: PMNData;
begin
  if ExamShortCut then Exit; //查找有无重复注册的快捷键

  New(P_Node);
  View2PMNData(P_Node);
  CurNode := TrvMenu.Selected;
  if CurNode = nil then
    TempNode := TrvMenu.Items.AddChildObject(TrvMenu.Items[0], P_Node.mCaption, P_Node)
  else
  begin
    if CurNode = TrvMenu.Items[0] then
    begin
      StrGrdInspector.Cells[1, 4] := '新菜单项';
      P_Node.mCaption := '新菜单项';
      if TrvMenu.Items[0].Item[0] <> nil then
        TempNode := TrvMenu.Items.InsertObject(TrvMenu.Items[0].Item[0], P_Node.mCaption, P_Node)
      else
        TempNode := TrvMenu.Items.AddChildObject(TrvMenu.Items[0], P_Node.mCaption, P_Node);
    end else
      TempNode := TrvMenu.Items.InsertObject(CurNode, P_Node.mCaption, P_Node);
  end;
  isEdited := False;
  if TempNode <> nil then TempNode.Selected := True;
  isModifed := True;
end;

procedure TFrmMenuDesign.Sub1Click(Sender: TObject);
var
  CurNode, TempNode: TTreeNode;
  P_Node: PMNData;
begin
  if ExamShortCut then Exit; //查找有无重复注册的快捷键

  New(P_Node);
  View2PMNData(P_Node);
  CurNode := TrvMenu.Selected;
  if CurNode = nil then
  begin
    TempNode := TrvMenu.Items.AddChildObject(TrvMenu.Items[0], P_Node.mCaption, P_Node);
  end else
  begin
    if CurNode = TrvMenu.Items[0] then
    begin
      StrGrdInspector.Cells[1, 4] := '新菜单项';
      P_Node.mCaption := '新菜单项';
    end;
    TempNode := TrvMenu.Items.AddChildObject(CurNode, P_Node.mCaption, P_Node);
  end;
  isEdited := False;
  if TempNode <> nil then TempNode.Selected := True;
  isModifed := True;
end;

procedure TFrmMenuDesign.Delete1Click(Sender: TObject);
begin
  if MessageDlg('确认删除该节点吗?', mtConfirmation, [mbOK, mbCancel], 0) = mrOK then
  begin
    isEdited := False;
    if DeleteNode(TrvMenu.Selected) then
    begin
      TrvMenu.Selected.Delete;
      isModifed := True;
    end else
      MessageDlg('删除该节点时发生错误!', mtConfirmation, [mbOK], 0);
  end;
end;

procedure TFrmMenuDesign.Preview1Click(Sender: TObject);
begin
  SbtnSaveModClick(Sender);
  RefreshXMLDoc(TempXMLDoc); //更新XML文件
  FrmPreview := TFrmPreview.Create(nil);
  try
    FrmPreview.MainMenu1.Images := ImageList1;

    //wangji 20030606:
    if (Tag <> 0) then
      TMenuDesign(Tag).XML2Menu(FrmPreview.MainMenu1, TempXMLDoc)
    else begin
      with TMenuDesign.Create(nil) do
      begin
        XML2Menu(FrmPreview.MainMenu1, TempXMLDoc);
        Free;
      end;
    end;

    FrmPreview.ShowModal;
  finally
    FrmPreview.Free;
  end;
end;

procedure TFrmMenuDesign.Save1Click(Sender: TObject);
var
  CurNode: TTreeNode;
  TempName: string;
  isSaveAs: Boolean;
begin
  if CurXMLFile <> '' then
  begin //已经存在文件名
    if FileExists(CurXMLFile) then
    begin //文件存在
      if MessageDlg('覆盖文件'+CurXMLFile+'吗?', mtConfirmation, [mbOK, mbCancel], 0) = mrOK then
        isSaveAs := False
      else
        Exit;
    end else
    begin //文件不存在
      isSaveAs := True;
    end;
  end else
  begin
    isSaveAs := True;
  end;
  if isSaveAs then
  begin
    if SaveDialog1.Execute then
    begin
      CurNode := TrvMenu.Items[0];
      TempName := SaveDialog1.FileName;
      CurNode.Text := ExtractFileName(TempName);
      PMNData(CurNode.Data).mCaption := CurNode.Text;
      CurXMLFile := SaveDialog1.FileName;
    end else
      Exit;
  end;
  RefreshXMLDoc(TempXMLDoc); //更新XML文件
  TempXMLDoc.SaveToFile(CurXMLFile);
  isModifed := False;
end;

procedure TFrmMenuDesign.Open1Click(Sender: TObject);
begin
  if isModifed then
    Save1Click(Sender);
  if OpenDialog1.Execute then
  begin
    OpenXMLMenuFile(OpenDialog1.FileName);
  end;
end;

procedure TFrmMenuDesign.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TFrmMenuDesign.SbtnSaveModClick(Sender: TObject);
var
  P_Node: PMNData;
begin
  if TrvMenu.Selected <> nil then
  begin
    P_Node := PMNData(TrvMenu.Selected.Data);
    View2PMNData(P_Node);
    TrvMenu.Selected.Text := P_Node.mCaption;
    isModifed := True;
    isEdited := True;
  end
end;

procedure TFrmMenuDesign.N3Click(Sender: TObject);
begin
  FreePMNData;
  InitXMLMenu;
end;

procedure TFrmMenuDesign.TrvMenuDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var 
  VL_Node, VL_tmpNode: TTreeNode;
  VL_I: integer; 
begin 
  if (TrvMenu.Selected <> nil) and (TrvMenu.Selected.level > 0) then
  begin 
    VL_Node := TrvMenu.GetNodeAt(X, Y); 
    if VL_Node <> nil then 
    begin 
      if TrvMenu.Selected.Parent = VL_Node then Exit; 
      if TrvMenu.Selected = VL_Node then Exit; 
      if TrvMenu.Selected.Level < VL_Node.Level then 
      begin
        VL_tmpNode := VL_Node;
        for VL_I := 0 to VL_Node.Level - TrvMenu.Selected.Level - 1 do 
        begin 
          VL_tmpNode := VL_tmpNode.Parent; 
        end; 
        if TrvMenu.Selected = VL_tmpNode then Exit; 
      end; 
      TrvMenu.Selected.MoveTo(VL_Node, naADDChild);
    end; 
  end; 
end;

procedure TFrmMenuDesign.TrvMenuDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := True;
end;

procedure TFrmMenuDesign.TrvMenuKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  CurNode, TempNode: TTreeNode;
begin
  if ssCtrl in Shift then
  begin
    if TrvMenu.Selected = nil then Exit;
    CurNode := TrvMenu.Selected; 
    case Key of
      38: //向上
      begin
        TempNode := CurNode.getPrevSibling;
        if TempNode <> nil then
          CurNode.MoveTo(TempNode, naInsert);
      end;
      40: //向下
      begin
        TempNode := CurNode.getNextSibling;
        if TempNode <> nil then
          TempNode.MoveTo(CurNode, naInsert);
      end;
    end;
  end;
end;

procedure TFrmMenuDesign.FormShow(Sender: TObject);
begin
  InitNewItem;
  InitView;
  if not FileExists(CurXMLFile) then CurXMLFile := '';
  if CurXMLFile = '' then
    InitXMLMenu(CurXMLFile)
  else
    OpenXMLMenuFile(CurXMLFile);
  InitImageList;
end;

procedure TFrmMenuDesign.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var
  mResult: Integer;
begin
  CanClose := True;
  if isModifed then
  begin
    mResult := MessageDlg('是否保存对菜单文件的改动?', mtConfirmation, [mbYes, mbNo, mbCancel], 0);
    case mResult of
      mrYes: Save1Click(Sender);
      mrCancel: CanClose := False;
    end;
  end;
end;

procedure TFrmMenuDesign.CmbImageIndexExit(Sender: TObject);
begin
  if CmbImageIndex.Text <> '' then
  begin
    if CmbImageIndex.Items.IndexOf(CmbImageIndex.Text) < 0 then
      CmbImageIndex.Text := '-1';
    StrGrdInspector.Cells[1, StrGrdInspector.Row] := CmbImageIndex.Text;
  end;
  CmbImageIndex.Visible := False;
end;

procedure TFrmMenuDesign.CmbImageIndexChange(Sender: TObject);
begin
  if CmbImageIndex.Text <> '' then
  begin
    if CmbImageIndex.Items.IndexOf(CmbImageIndex.Text) < 0 then
      CmbImageIndex.Text := '-1';
    StrGrdInspector.Cells[1, StrGrdInspector.Row] := CmbImageIndex.Text;
    isEdited := True;
  end;
end;

procedure TFrmMenuDesign.CmbAutoCheckChange(Sender: TObject);
begin
  if TComboBox(Sender).Text <> '' then
  begin
    if TComboBox(Sender).Items.IndexOf(TComboBox(Sender).Text) < 0 then
      TComboBox(Sender).Text := TComboBox(Sender).Items.Strings[0];
    StrGrdInspector.Cells[1, StrGrdInspector.Row] := TComboBox(Sender).Text;
    isEdited := True;
  end;
end;

procedure TFrmMenuDesign.CmbAutoCheckDblClick(Sender: TObject);
var
  TempIndex: Integer;
begin
  TempIndex := TComboBox(Sender).ItemIndex;
  if TempIndex = TComboBox(Sender).Items.Count - 1 then
    TComboBox(Sender).ItemIndex := 0
  else
    TComboBox(Sender).ItemIndex := TempIndex + 1;
  CmbAutoCheckChange(Sender);
end;

procedure TFrmMenuDesign.CmbImageIndexDblClick(Sender: TObject);
var
  TempIndex: Integer;
begin
  TempIndex := CmbImageIndex.ItemIndex;
  if TempIndex = CmbImageIndex.Items.Count - 1 then
    CmbImageIndex.ItemIndex := 0
  else
    CmbImageIndex.ItemIndex := TempIndex + 1;
  CmbImageIndexChange(Sender);
end;

procedure TFrmMenuDesign.StrGrdInspectorSetEditText(Sender: TObject; ACol,
  ARow: Integer; const Value: String);
begin
  if (ACol = 1) and (ARow = 14) and (Trim(Value) <> '') then
  begin
    try
      StrToInt(Value);
    except
      StrGrdInspector.Cells[ACol, ARow] := '-1';
    end;
  end else
    isEdited := StrGrdInspector.Cells[ACol, ARow] = Value;
end;

procedure TFrmMenuDesign.TrvMenuChanging(Sender: TObject; Node: TTreeNode;
  var AllowChange: Boolean);
var
  P_Node: PMNData;
begin
  if isEdited then
  begin
    AllowChange := False;
    if TrvMenu.Selected <> nil then
    begin
      P_Node := PMNData(TrvMenu.Selected.Data);
      View2PMNData(P_Node);
      TrvMenu.Selected.Text := P_Node.mCaption;
    end;
    isModifed := True;
    isEdited := False;
    AllowChange := True;
  end;
end;

procedure TFrmMenuDesign.CmbEvntParamChange(Sender: TObject);
begin
  if CmbEvntParam.Text <> '' then
  begin
    if CmbEvntParam.Items.IndexOf(CmbEvntParam.Text) < 0 then
      CmbEvntParam.Text := '-1';
    try
      StrGrdInspector.Cells[1, StrGrdInspector.Row] := IntToStr(CmbEvntParam.ItemIndex);
    except
      StrGrdInspector.Cells[1, StrGrdInspector.Row] := '-1';
    end;
    isEdited := True;
  end;
end;

procedure TFrmMenuDesign.CmbEvntParamDblClick(Sender: TObject);
var
  TempIndex: Integer;
begin
  TempIndex := CmbEvntParam.ItemIndex;
  if TempIndex = CmbEvntParam.Items.Count - 1 then
    CmbEvntParam.ItemIndex := 0
  else
    CmbEvntParam.ItemIndex := TempIndex + 1;
  CmbEvntParamChange(Sender);
end;

procedure TFrmMenuDesign.CmbEvntParamExit(Sender: TObject);
begin
  if CmbEvntParam.Text <> '' then
  begin
    if CmbEvntParam.Items.IndexOf(CmbEvntParam.Text) < 0 then
      CmbEvntParam.Text := '-1';
    try
      StrGrdInspector.Cells[1, StrGrdInspector.Row] := IntToStr(CmbEvntParam.ItemIndex);
    except
      StrGrdInspector.Cells[1, StrGrdInspector.Row] := '-1';
    end;
  end;
  CmbEvntParam.Visible := False;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -