formmainunit.pas

duiwenjiandechuli fangbianguanli.

            Tree.Items.AddChild(TmpNode, 'n/a');
            TmpNode.ImageIndex := 0;
            TmpNode.SelectedIndex := 1;
          end;
          Next;
        end;
      close;
    except
      application.MessageBox('初始化分类树失败!', '系统提示', mb_ok or
        mb_IconError);
    end;
  end;

end;

procedure TFormMain.FormShow(Sender: TObject);
begin
  FormMain.Show;
  initTypeTree(TypeTree, nil, -1);
  InitMbList;
  readMostToTree;
  richEdit.Modified := false;
  DeleteTmpFile;
  if richEdit.CanFocus then
    richEdit.SetFocus
  else if TypeTree.CanFocus then
    TypeTree.SetFocus
  else
    FontName.SetFocus;

end;

procedure TFormMain.TypeTreeExpanding(Sender: TObject; Node: TTreeNode;
  var AllowExpansion: Boolean);
begin
  if Node = nil then
    Exit;
  ExpandTypeTree(TypeTree, Node);
end;

procedure TFormMain.TypeTreeClick(Sender: TObject);
begin
  if TypeTree.Selected = nil then
    Exit;
  New(NodeInfos);
  NodeInfos := TypeTree.Selected.Data;
  DisplayText(TypeTree.Selected);
  DisplayFileList(self.InfoID);
  StatusBar1.Panels[3].Text := TypeTree.Selected.Text;
  if fileList.items.Count > 0 then
  begin
    CountTotalCpt.Caption := format('总数:%d', [fileList.items.count]);

  end;
  Panel2.Visible := true;
  Splitter2.Visible := true;
end;

procedure TFormMain.SubMenu_TypeDelClick(Sender: TObject);
var
  InAutoID          : string;

  procedure findNodeAndExpand(Node: TTreeNode);
  var
    i               : Integer;
  begin
    if node <> nil then
      for i := 0 to Node.Count - 1 do
      begin
        node.Item[i].Expanded := TRUE;
        new(NodeInfos);
        NodeInfos := Node.Item[i].Data;
        InAutoID := InAutoID + IntToStr(NodeInfos^.AutoID) + ',';
        findNodeAndExpand(node.Item[i]);
      end;
  end;

begin

  if TypeTree.Selected = nil then
    Exit;
  if Application.MessageBox(PChar('[警告]' + #13#10 +
    '确定删除该分类吗？该操作将删除该分类的文章和所有文件！'), '系统提示',
    MB_YESNO or MB_ICONWARNING) = IDYES then
  begin
    TypeTree.Selected.Expanded := TRUE;
    new(NodeInfos);
    NodeInfos := TypeTree.Selected.Data;
    InAutoID := IntToStr(NodeInfos^.AutoID) + ',';
    findNodeAndExpand(TypeTree.Selected);
    if Copy(InAutoID, length(InAutoID), length(InAutoID)) = ',' then
      InAutoID := Copy(InAutoID, 1, Length(InAutoID) - 1);
    with TypeQuery do
    begin
      try
        Close;
        SQL.Text :=
          format('delete from InfoFile where InfoID in (select InfoContent.AutoID from InfoContent where clsID in (%s)) ', [InAutoID]);
        ExecSQL;
        Close;
        SQL.Text :=
          format('delete from InfoContent where clsID in (%s) ', [InAutoID]);
        ExecSQL;
        Close;
        SQL.text :=
          format('delete from InfoType where AutoID in (%s) ', [InAutoID]);
        ExecSQL;
        Close;
        Application.MessageBox('删除完毕！', '提示', mb_ok or
          mb_IconInformation);
        TypeTree.Selected.DeleteChildren;
        TypeTree.Selected.Delete;
        Richedit.Clear;
        Richedit.Modified := false;
        FileList.Items.Clear;
      except
        Application.MessageBox('删除操作错误！', '提示', mb_ok or
          mb_IconError);
      end;
    end;
  end;

end;

procedure TFormMain.SubMenu_TypeAddClick(Sender: TObject);
begin
  if TypeTree.Selected <> nil then      //修复增加子分类显示n/a 节点的问题
    TypeTree.Selected.Expanded := TRUE; //先展开激发Expanding 事件，让事件过程读取相应节点信息后在执行增加
  AddTypeNode(TypeTree, false);
end;

procedure TFormMain.SubMenu_TreeAddRootClick(Sender: TObject);
begin
  AddTypeNode(TypeTree, true);
end;

procedure TFormMain.SubMenu_TreeExpandAllClick(Sender: TObject);
begin
  if TypeTree.Selected = nil then
    exit;
  TypeTree.Selected.Expanded := TRUE;
  NodeExpandAll(TypeTree.Selected);
end;

procedure TFormMain.TypeTreeEdited(Sender: TObject; Node: TTreeNode;
  var S: string);
begin
  if Node = nil then
    exit;
  new(NodeInfos);
  NodeInfos := Node.Data;
  with TypeQuery do
  begin
    Close;
    SQL.Text :=
      'update InfoType set InfoTypeName=:InfoTypeName where AutoID=:AutoID';
    Parameters.ParamByName('InfoTypeName').DataType := ftString;
    Parameters.ParamByName('InfoTypeName').Value := S;
    Parameters.ParamByName('AutoID').DataType := ftInteger;
    Parameters.ParamByName('AutoID').Value := NodeInfos^.AutoID;
    Prepared;
    try
      ExecSQL;
      Close;
      NodeInfos^.InfoTypeName := S;
    except
      Application.MessageBox('更改分类名失败!', '提示', mb_ok or
        mb_IconInformation);
    end;
  end;
end;

procedure TFormMain.SubMenu_TreeEditClick(Sender: TObject);
begin
  if TypeTree.Selected <> nil then
    SendMessage(TypeTree.Selected.Handle, TVM_EDITLABEL, 0,
      Longint(TypeTree.Selected.ItemId));
end;

procedure TFormMain.menu_ExitClick(Sender: TObject);
begin
  if Application.MessageBox('结束程序？', '提示', mb_ok or mb_YESNO
    or Mb_IconInformation) = IDYES then
  begin
    richEdit.AllowObjects := false;     //退出ole 模式
    Self.ADOConnection1.Close;
    self.Close;
    Application.Terminate;
  end;
end;

procedure TFormMain.SubMenu_TreeCloseNodeClick(Sender: TObject);
begin
  if TypeTree.Selected = nil then
    exit;
  TypeTree.Selected.Expanded := FALSE;
  NodeColAdd(TypeTree.Selected);
end;

procedure TFormMain.menu_AboutClick(Sender: TObject);
begin
  ShellAbout(handle, 'InfoBase', PAnsiChar('程序设计:黄少华' + #13#10
    ), Application.Icon.Handle); //'程序完成:N/A'
end;

procedure TFormMain.SubMenu_EditSaveClick(Sender: TObject);
var
  fileTxt           : string;
  tmpTls            : TStrings;
begin
  //获取所得的节点AutoID写入Content 表
  if TypeTree.Selected = nil then
    Exit;
  New(NodeInfos);
  NodeInfos := TypeTree.Selected.Data;

  RichEdit.Lines.SaveToFile(GetExePath + 'Files\tmp.rtf');
  compressstream(GetExePath + 'Files\tmp.rtf');
  //  tmpTls := TStringList.Create;
  //  tmpTls.LoadFromFile(GetExePath + 'Files\tmp.rtf');
  //  try
  //    fileTxt := tmpTls.Text;
  //    DeleteFile(GetExePath + 'Files\tmp.rtf');
  //  finally
  //    tmpTls.Free;
  //  end;
  with TypeQuery do
  begin
    Close;
    if Self.InfoID > 0 then
      SQL.Text :=
        'Update InfoContent set InfoContentEx=:InfoContentEx,PostTime=:PostTime,RColor=:RColor where AutoID=:AutoID'
    else
      SQL.Text :=
        'Insert Into InfoContent(InfoContentEx,PostTime,Rcolor,clsID)values(:InfoContentEx,:PostTime,:RColor,:clsID)';
    {    Parameters.ParamByName('InfoContent').DataType := ftString;
        Parameters.ParamByName('InfoContent').Value := fileTxt;   }
    Parameters.ParamByName('InfoContentEx').LoadFromFile(GetExePath +
      'Files\tmp.rtf', ftBlob);
    Parameters.ParamByName('PostTime').DataType := ftDateTime;
    Parameters.ParamByName('PostTime').Value := Now();
    Parameters.ParamByName('RColor').DataType := ftString;
    Parameters.ParamByName('RColor').Value := inttostr(richEdit.Color);
    if Self.InfoID > 0 then
    begin
      Parameters.ParamByName('AutoID').DataType := ftInteger;
      Parameters.ParamByName('AutoID').Value := self.InfoID;
    end
    else
    begin
      Parameters.ParamByName('clsID').DataType := ftInteger;
      Parameters.ParamByName('clsID').Value := NodeInfos^.AutoID;
    end;
    Prepared;
    try
      ExecSQL;
      close;
      RichEdit.Modified := false;
    except
      Application.MessageBox('操作文本失败!', '提示', mb_ok or mb_IconError);
    end;
  end;
end;

procedure TFormMain.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
begin
  if Msg.message = WM_LBUTTONUP then    //窗体有鼠标左键点击事件时执行
  begin
  end;
end;

procedure TFormMain.SubMenu_EditCopyClick(Sender: TObject);
begin
  Richedit.CopyToClipboard;
end;

procedure TFormMain.SubMenu_EditCutClick(Sender: TObject);
begin
  RichEdit.CutToClipboard;
end;

procedure TFormMain.SubMenu_EditPasteClick(Sender: TObject);
begin
  RichEdit.PasteFromClipboard;
end;

procedure TFormMain.SubMenu_EditSaveASClick(Sender: TObject);
begin
  SaveDialog1.Filter := '富文本格式|*.rtf|纯文本格式|*.txt|任意文件|*.*';
  if SaveDialog1.Execute then
  begin
    RichEdit.Lines.SaveToFile(SaveDialog1.FileName);
  end;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Self.Caption := 'InfoBase Version ' + Cnt_Version;
  Self.StatusBar1.Panels[1].Text := Cnt_Version;
  AdoConnection1.Close;
  AdoConnection1.LoginPrompt := false;
  AdoConnection1.ConnectionString :=
    'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
    GetExePath
    + 'Data\Infobase.mdb' + ';Persist Security Info=False';
  AdoConnection1.Open();
  SaveDialog1.InitialDir := GetExePath + 'files';
  GetFontNames;
  FontName.Text := Richedit.Font.Name;
  RxTrayIcon1.Icon.Handle := application.Icon.Handle;
  FontColor.ColorValue := richEdit.Font.Color;
end;

procedure TFormMain.FontNameChange(Sender: TObject);
begin
  if RichEdit.SelLength > 0 then
  begin
    RichEdit.SelAttributes.Name := FontName.Items[FontName.ItemIndex];
  end
  else
  begin
    RichEdit.DefAttributes.Name := FontName.Items[FontName.ItemIndex];
  end;
end;

procedure TFormMain.FontSizeChange(Sender: TObject);
begin
  if RichEdit.SelLength > 0 then
  begin
    RichEdit.SelAttributes.Size := StrToInt(FontSize.Text);
  end
  else
  begin
    RichEdit.DefAttributes.Size := StrToInt(FontSize.Text);
  end;
end;

procedure TFormMain.BoldButtonClick(Sender: TObject);
begin
  if RichEdit.SelLength > 0 then
  begin
    if BoldButton.Down then
      RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsBold]
    else
      RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsBold];
  end
  else
  begin
    if BoldButton.Down then
      RichEdit.DefAttributes.Style := RichEdit.DefAttributes.Style + [fsBold]
    else
      RichEdit.DefAttributes.Style := RichEdit.DefAttributes.Style - [fsBold];
  end;
end;

procedure TFormMain.ItalicButtonClick(Sender: TObject);
begin
  if RichEdit.SelLength > 0 then
  begin
    if ItalicButton.Down then
      RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style + [fsItalic]
    else
      RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style - [fsItalic];
  end
  else
  begin
    if ItalicButton.Down then
      RichEdit.DefAttributes.Style := RichEdit.DefAttributes.Style + [fsItalic]
    else
      RichEdit.DefAttributes.Style := RichEdit.DefAttributes.Style - [fsItalic];
  end;
end;

procedure TFormMain.UnderlineButtonClick(Sender: TObject);
begin
  if RichEdit.SelLength > 0 then
  begin
    if UnderlineButton.Down then
      RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style +
        [fsUnderline]
    else
      RichEdit.SelAttributes.Style := RichEdit.SelAttributes.Style -
        [fsUnderline];
  end
  else
  begin
    if UnderlineButton.Down then
      RichEdit.DefAttributes.Style := RichEdit.DefAttributes.Style +
        [fsUnderline]
    else
      RichEdit.DefAttributes.Style := RichEdit.DefAttributes.Style -
        [fsUnderline];
  end;
end;

procedure TFormMain.LeftAlignClick(Sender: TObject);
begin
  RichEdit.Paragraph.Alignment := TParaAlignment(TControl(Sender).Tag);
end;

procedure TFormMain.CenterAlignClick(Sender: TObject);
begin
  RichEdit.Paragraph.Alignment := TParaAlignment(TControl(Sender).Tag);
end;

procedure TFormMain.RightAlignClick(Sender: TObject);
begin
  RichEdit.Paragraph.Alignment := TParaAlignment(TControl(Sender).Tag);
end;

procedure TFormMain.BulletsButtonClick(Sender: TObject);
begin
  RichEdit.Paragraph.NumberingStyle := TRxNumberingStyle(BulletsButton.Down);
end;