formmainunit.pas

duiwenjiandechuli fangbianguanli.

      fileList.items.EndUpdate;
    end;
  end;

end;

procedure TFormMain.DisplayFileList(IID: integer);
begin
  FileList.Items.Clear;
  fileList.items.BeginUpdate;
  with TypeQuery do
  begin
    close;
    sql.Clear;
    sql.add('select AutoID,FileName,FileSize from InfoFile where infoID = :InfoID');
    Parameters.ParamByName('InfoID').DataType := ftInteger;
    Parameters.ParamByName('InfoID').Value := IID;
    TypeQuery.Prepared;
    try
      open;
      while not eof do
      begin
        with fileList.Items.Add do
        begin
          Caption := fieldbyname('fileName').asString;
          subitems.Add(fieldbyname('fileSize').asString);
          subItems.add(IntToStr(fieldbyname('autoID').asInteger));
        end;
        next;
      end;
    finally
      close;
      fileList.items.EndUpdate;
    end;
  end;
  CountTotalCpt.Caption := format('总数:%d', [fileList.items.count]);
end;

procedure TFormMain.ExecPrintText;
var
  printarea         : TRect;
  richedit_outputarea: TRect;
  printresX, printresY: Integer;
  fmtRange          : TFormatRange;
  nextChar          : Integer;
  S                 : string;
begin
  Printer.BeginDoc;
  try
    with Printer.Canvas do
    begin
      printresX := GetDeviceCaps(Handle, LOGPIXELSX);
      printresY := GetDeviceCaps(Handle, LOGPIXELSY);
      printarea :=
        Rect(printresX,
        printresY * 3 div 2,
        Printer.PageWidth - printresX,
        Printer.PageHeight - printresY * 3 div 2);
      richedit_outputarea :=
        Rect(printarea.Left * 1440 div printresX,
        printarea.Top * 1440 div printresY,
        printarea.Right * 1440 div printresX,
        printarea.Bottom * 1440 div printresY);

      fmtRange.hDC := Handle;
      fmtRange.hdcTarget := Handle;
      fmtRange.rc := richedit_outputarea;
      fmtRange.rcPage := Rect(0, 0,
        Printer.PageWidth * 1440 div printresX,
        Printer.PageHeight * 1440 div printresY);
      fmtRange.chrg.cpMin := richEdit.selstart;
      fmtRange.chrg.cpMax := richEdit.selStart + richEdit.sellength - 1;

      S := richEdit.SelText;
      while (fmtRange.chrg.cpMax > 0) and
        (S[fmtRange.chrg.cpMax] <= ' ') do
        Dec(fmtRange.chrg.cpMax);

      repeat
        nextChar := richEdit.Perform(EM_FORMATRANGE, 1, Longint(@fmtRange));
        if nextchar < fmtRange.chrg.cpMax then
        begin
          printer.newPage;
          fmtRange.chrg.cpMin := nextChar;
        end;                            { If }
      until nextchar >= fmtRange.chrg.cpMax;

      richEdit.Perform(EM_FORMATRANGE, 0, 0);
    end;
  finally
    Printer.EndDoc;
  end;
end;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;

procedure TFormMain.GetFontNames;
var
  DC                : HDC;
begin
  DC := GetDC(0);
  EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
  ReleaseDC(0, DC);
  FontName.Sorted := True;
end;

procedure TFormMain.DisplayText(Node: Tobject);
var
  tmpTls            : TStrings;
  clsID             : integer;
  bStm              : TADOBlobStream;
  fStm              : TFileStream;
begin

  if node = nil then
    Exit;

  if RichEdit.Modified then
  begin
    case Application.MessageBox('内容已被更改，是否保存？', '系统提示',
      MB_YESNOCANCEL or MB_ICONINFORMATION) of
      IDYES:
        begin
          RichEdit.Modified := false;   //保存修改
          SubMenu_EditSaveClick(nil);
        end;
      IDCANCEL: Exit;                   //取消则退出，不读取下一记录
    else
    end;
  end;
  if Node is TTreeNode then
  begin
    New(NodeInfos);
    NodeInfos := TTreeNode(node).Data;
    clsID := NodeInfos^.AutoID;
  end
  else
    clsID := StrToInt((Node as TlistItem).subItems.Strings[1]);

  Self.InfoID := 0;
  RichEdit.Clear;
  RichEdit.Color := clWhite;
  with TypeQuery do
  begin
    close;
    SQL.text :=
      'select InfoContent.AutoID,InfoContent.InfoContentEx,InfoContent.PostTime,InfoContent.RColor,infoType.infoTypeName from InfoContent left join infoType on InfoContent.clsID=infoType.autoid where clsID=:clsID';
    Parameters.ParamByName('clsID').DataType := ftInteger;
    Parameters.ParamByName('clsID').Value := clsID;
    Prepared;

    try
      Open;
      if not eof then
      begin
        try
          bStm := TADOBlobStream.Create(fieldbyname('InfoContentEx') as
            TBlobField,
            bmRead);
          fStm := TFileStream.Create(GetExePath + 'Files\tmp.rtf', fmCreate);
          fStm.CopyFrom(bStm, bStm.Size);
          fStm.Free;
          //解压缩文件
          decompressstream(GetExePath + 'Files\tmp.rtf');
          Richedit.StreamFormat := sfRichText;
          RichEdit.Lines.LoadFromFile(GetExePath +
            'Files\tmp.rtf');
          DeleteFile(GetExePath + 'Files\tmp.rtf');
          if not fieldbyname('rColor').IsNull then
            RichEdit.Color := TColor(StrToInt(fieldbyname('RColor').asString));
        finally
          bStm.Free;
        end;

        {        tmpTls := TStringList.Create;
                try
                  tmpTls.Text := fieldbyname('InfoContent').AsString;
                  tmpTls.SaveToFile(GetExePath + 'Files\tmp.rtf');
                  //解压
                  decompressstream(GetExePath + 'Files\tmp.rtf');
                  Richedit.StreamFormat := sfRichText;
                  RichEdit.Lines.LoadFromFile(GetExePath +
                    'Files\tmp.rtf');
                  DeleteFile(GetExePath + 'Files\tmp.rtf');
                  if not fieldbyname('rColor').IsNull then
                    RichEdit.Color := TColor(StrToInt(fieldbyname('RColor').asString));
                finally
                  tmpTls.Free;
                end;
        }
        RichEdit.Modified := false;
        Self.InfoID := fieldbyname('AutoID').asInteger;
        Self.InfoTitle := fieldbyname('infoTypeName').asString;
      end
      else if not (Node is TTreeNode) then
        Application.MessageBox('无法定位，文章可能已经被删除！', '提示', mb_ok
          or
          mb_IconInformation);
      Close;
    except
    end;

    FileList.Items.Clear;
    close;
    SQL.Text :=
      'select AutoID,fileName,fileSize from InfoFile where InfoID=:InfoID';
    Parameters.ParamByName('InfoID').DataType := ftInteger;
    Parameters.ParamByName('InfoID').Value := Self.InfoID;
    Prepared;
    try
      open;
      if not eof then
        while not eof do
        begin
          with FileList.Items.Add do
          begin
            Caption := fieldbyname('fileName').asString;
            SubItems.Add(FormatFloat('#,##0',
              fieldbyname('fileSize').AsInteger));
            SubItems.Add(IntToStr(fieldbyname('autoID').asInteger));
          end;
          next;
        end;
      close;
    except
    end;
  end;
end;

procedure TFormMain.NodeColAdd(Node: TTreeNode);
var
  i                 : Integer;
begin
  if node <> nil then
    for i := 0 to Node.Count - 1 do
    begin
      node.Item[i].Expanded := FALSE;
      NodeExpandAll(node.Item[i]);
    end;
end;

procedure TFormMain.NodeExpandAll(Node: TTreeNode);
var
  i                 : Integer;
begin
  if node <> nil then
    for i := 0 to Node.Count - 1 do
    begin
      node.Item[i].Expanded := TRUE;
      NodeExpandAll(node.Item[i]);
    end;
end;

procedure TFormMain.AddTypeNode(Sender: TObject; isRoot: boolean);
var
  NodeName          : string;
  ParentID          : Integer;
  AutoID            : Integer;
  Node              : TTreeNode;
begin
  NodeName := '';

  FormInputDialogs := TFormInputDialogs.Create(nil);
  if FormInputDialogs.ShowModal = mrOK then
    NodeName := FormInputDialogs.NewInfoTypeName;
  FormInputDialogs.Free;

  if Sender = nil then
    ParentID := -1
  else if (Sender as TTreeView).Selected = nil then
    ParentID := -1
  else
  begin
    New(NodeInfos);
    NodeInfos := (Sender as TTreeView).Selected.Data;
    ParentID := NodeInfos^.AutoID;
  end;

  if isRoot then
    ParentID := -1;

  with TypeQuery do
  begin
    Close;
    SQL.text :=
      'Insert Into InfoType (InfoTypeName,ParentID)values(:InfoTypeName,:ParentID)';
    Parameters.ParamByName('InfoTypeName').DataType := ftString;
    Parameters.ParamByName('InfoTypeName').Value := NodeName;
    Parameters.ParamByName('ParentID').DataType := ftInteger;
    Parameters.ParamByName('ParentID').Value := ParentID;
    Prepared;
    try
      ExecSQL;
      Close;

      // 添加到当前树型
      SQL.text := 'select Max(autoID) as Exp1 from InfoType';
      Prepared;
      try
        open;
        AutoID := fieldbyname('exp1').asInteger;
        close;

        New(NodeInfos);
        NodeInfos^.AutoID := AutoID;
        NodeInfos^.ParentID := ParentID;
        NodeInfos^.InfoTypeName := nodeName;
        if ((Sender as TTreeView).Selected = nil) or (isRoot) then
          Node := (Sender as TTreeView).Items.Add(nil, NodeInfos^.InfoTypeName)
        else
        begin
          Node := (Sender as TTreeView).Items.AddChild(TypeTree.Selected,
            NodeInfos^.InfoTypeName);
          TypeTree.Selected.ImageIndex := 0;
          TypeTree.Selected.SelectedIndex := 1;
        end;
        Node.ImageIndex := 2;
        Node.SelectedIndex := 3;
        Node.Data := NodeInfos;
        Node.Selected := TRUE;
      except
        Application.MessageBox('建立节点错误,请关闭程序重新运行！', '错误提示',
          mb_ok or mb_IConError);
      end;
    except
      Application.MessageBox('保存分类名错误', '提示', mb_ok or mb_IconError);
    end;
  end;
end;

procedure TFormMain.ExpandTypeTree(Tree: TTreeView; node: TTreeNode);  //展开分类树的节点
begin
  if (node.Count = 1) and (node.Item[0].Text = 'n/a') then
    Node.DeleteChildren
  else
    Exit;

  New(NodeInfos);
  NodeInfos := Node.Data;
  initTypeTree(Tree, Node, NodeInfos^.AutoID);
end;

function TFormMain.searchChildNode(ParentID: integer): boolean;  //搜索其下是否存在子节点
var
  TQ                : TADOQuery;
begin
  result := false;
  TQ := TADOQuery.Create(nil);
  TQ.CursorLocation := clUseServer;
  TQ.Connection := FormMain.ADOConnection1;
  with TQ do
  begin
    Close;
    SQL.Text :=
      'SELECT Count(*) as Exp1 from InfoType where ParentID = :ParentID';
    Parameters.ParamByName('ParentID').DataType := ftInteger;
    Parameters.ParamByName('ParentID').Value := ParentID;
    TQ.Prepared;
    try
      try
        open;
        result := fieldbyname('exp1').asInteger > 0;
        close;
      except
      end;
    finally
      free;
    end;
  end;
end;

procedure TFormMain.initTypeTree(Tree: TTreeView; Node: TTreeNode; ParentID:
  Integer);                             //初始化分类树
var
  TmpNode           : TTreeNode;
begin
  if ParentID = -1 then
    Tree.Items.Clear; //如果传递的是查找层一的节点则先清空树型原节点
  with TypeQuery do
  begin
    close;
    SQL.Text :=
      'SELECT AutoID,ParentID,InfoTypeName from InfoType where ParentID=:ParentID order by AutoID asc';  //默认第一层的父节点编号为 -1;
    Parameters.ParamByName('ParentID').DataType := ftInteger;
    Parameters.ParamByName('ParentID').Value := ParentID;

    TypeQuery.Prepared;
    try
      Open;
      if not Eof then
        while not eof do
        begin
          new(NodeInfos);               //给指针类型分配内存
          NodeInfos^.AutoID := fieldbyname('AutoID').AsInteger;
          NodeInfos^.ParentID := fieldbyname('ParentID').asInteger;
          NodeInfos^.InfoTypeName :=
            string(fieldbyname('InfoTypeName').asVariant);

          //增加节点;
          if Node <> nil then
            TmpNode := Tree.Items.AddChild(Node, NodeInfos^.InfoTypeName)
          else
            TmpNode := Tree.Items.Add(nil, NodeInfos^.InfoTypeName);

          TmpNode.Data := NodeInfos;
          TmpNode.ImageIndex := 2;
          TmpNode.SelectedIndex := 3;

          if searchChildNode(NodeInfos^.AutoID) then
          begin