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

📄 maillist.pas

📁 siMail, siMail, siMail, siMail
💻 PAS
📖 第 1 页 / 共 3 页
字号:
procedure TfrmMaillist.lstMailListCompareNodes(Sender: TBaseVirtualTree;
  Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var nd1, nd2: PTreeMaillist;
begin
  nd1 := lstMaillist.GetNodeData(Node1);
  nd2 := lstMaillist.GetNodeData(Node2);

  case Column of
    0:
    begin //annotation
      if Length(nd1.comment) > 0 then Result := -1
      else if (Length(nd1.comment) > 0) and (Length(nd2.comment) > 0) then Result := 0
      else Result := 1;
    end;
    1:
    begin //message label
      if nd1.markId > nd2.markId then Result := -1
      else if nd1.markId = nd2.markId then Result := 0
      else Result := 1;
    end;
    2:
    begin //priority
      if nd1.priority > nd2.priority then Result := -1
      else if nd1.priority = nd2.priority then Result := 0
      else Result := 1;
    end;
    3:
    begin //attachment
      if (msgAttachmentOutside in nd1^.status) or
        ((msgAttachmentInside in nd1^.status)) >
        (msgAttachmentOutside in nd2^.status) or
        ((msgAttachmentInside in nd2^.status))
      then Result := -1
      else if (msgAttachmentOutside in nd1^.status) or
        ((msgAttachmentInside in nd1^.status)) =
        (msgAttachmentOutside in nd2^.status) or
        ((msgAttachmentInside in nd2^.status)) then Result := 0
      else Result := 1;
    end;
    5:
    begin //subject
      Result := WideCompareText(nd1.subject, nd2.subject);
    end;
    6:
    begin //from
      Result := WideCompareText(nd1.from, nd2.from);
    end;
    7:
    begin //date
      if nd1.date > nd2.date then Result := -1
      else if nd1.date = nd2.date then Result := 0
      else Result := 1;
    end;
    8:
    begin //size
      if nd1.size > nd2.size then Result := -1
      else if nd1.size = nd2.size then Result := 0
      else Result := 1;
    end
  end;
end;

procedure TfrmMaillist.lstMailListChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
begin
  if Node = nil then exit;
  if lstMaillist.SelectedCount > 1 then exit;

  openMessage(Node);
end;

procedure TfrmMaillist.actMessageContinueEditUpdate(Sender: TObject);
begin
  if lstMaillist.RootNodeCount = 0 then exit;
  if (Fmbox.id = -Integer(mboxUnfinished)) or (Fmbox.id = -Integer(mboxUnsent)) then
    actMessageContinueEdit.Enabled := True
  else actMessageContinueEdit.Enabled := False;
end;

procedure TfrmMaillist.actMessageContinueEditExecute(Sender: TObject);
var nd: PTreeMaillist;
var frmNew: TfrmCompose;
begin
  if actMessageContinueEdit.Enabled = False then exit;
  nd := PTreeMaillist(lstMaillist.GetNodeData(lstMaillist.GetFirstSelected));

  frmNew := TfrmCompose.Create(nil);
  frmNew.Account := frmMailbox.SelectedAccount;
  frmNew.Mailbox := frmMailbox.SelectedMailbox;
  frmNew.MessageId := nd^.id;
  frmNew.EditType := tetContinue;
  frmNew.Show;

end;

function TfrmMaillist.actMaillistDeleteF: Boolean;
var Node: PVirtualNode;
var nd: PTreeMaillist;
var mbox: TMailbox;
var wasShift: Boolean;
var ask: Boolean;
begin
  if lstMaillist.SelectedCount = 0 then Exit;
  Result := False;
  wasShift := (ssShift in KeyboardStateToShiftState);
  ask := frmMailbox.Profile.Config.ReadBool(Self.Name, 'askBeforeDeleting', True);
  if ask then
    if MessageDlg(_('Do you really want to delete selected messages?'),
      mtConfirmation, [mbYes, mbNo], 0) = mrNo then begin
        Result := True;
        Exit;
    end;
  //unload current document
  frmMailView.UnloadDoc;
  //message is deleted if malibox type = mboxTrash or mboxJunk or Shift Key is pressed
  if (Fmbox.id = -Integer(mboxTrash)) or (Fmbox.id = -Integer(mboxJunk)) or wasShift then begin
    lstMaillist.BeginUpdate;
    Node := lstMaillist.GetFirstSelected;
    while True do begin
      nd := lstMaillist.GetNodeData(Node);
            //decrement total message count
      Fmbox.RemoveMessage(nd.id);
      if lstMailList.GetNextSelected(Node) <> nil then begin
        lstMaillist.DeleteNode(Node);
        Node := lstMaillist.GetFirstSelected;
      end
      else begin //select first after deleted
        if lstMailList.GetNext(Node) <> nil then
          lstMailList.Selected[lstMailList.GetNext(Node)] := True
        else if lstMailList.GetPrevious(Node) <> nil then
          lstMailList.Selected[lstMailList.GetPrevious(Node)] := True;
        lstMaillist.DeleteNode(Node);
        Break;
      end;
    end;
    lstMaillist.EndUpdate;
    frmMailbox.trMailbox.Repaint;
  end
    //and moved to trash if malibox type <> mboxJunk
  else begin
    mbox := frmMailbox.findMailbox(frmMailbox.SelectedAccount, -Integer(mboxTrash));
    MoveToMailbox(mbox, True);
  end;
  frmMailbox.actAccountRefreshTot.Execute; //refresh unread/total msg count
  Result := True;
end;

procedure TfrmMaillist.actMaillistDeleteUpdate;
begin
  if lstMaillist.SelectedCount > 0 then frmMain.actDelete.Enabled := True
  else frmMain.actDelete.Enabled := False;
end;

procedure TfrmMaillist.lstMailListGetPopupMenu(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; const P: TPoint;
  var AskParent: Boolean; var PopupMenu: TPopupMenu);
begin
  lstMaillist.SetFocus;
    //show popup
  PopupMenu := popMenu;
end;

procedure TfrmMaillist.lstMailListMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if lstMaillist.SelectedCount > 0 then exit;
    //just select node
  if Button = mbRight then begin
    try
      lstMaillist.Selected[lstMaillist.GetNodeAt(x, y)] := True;
    except
      on EAccessViolation do Exit;
    end;
  end;
end;

procedure TfrmMaillist.lstMailListGetImageIndex(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
  var Ghosted: Boolean; var ImageIndex: Integer);
begin
    //return correct folder image
  with PTreeMaillist((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
    if (Kind in [ikNormal, ikSelected]) then begin
      case Column of
        0:
        begin //annotation
          if comment <> '' then ImageIndex := imgComment;
        end;
        1:
        begin //label
          if markId <> 0 then
            ImageIndex := imgMsgFlag - 1 + markId;
        end;
        2:
        begin // priority
          case priority of
            1:
              ImageIndex := imgPriority0;
            2:
              ImageIndex := imgPriority1;
            3:
              ImageIndex := imgPriority2;
            4:
              ImageIndex := imgPriority3;
            5:
              ImageIndex := imgPriority4;
          end;
        end;
        3:
        begin //attachment
          if (msgAttachmentOutside in status) or ((msgAttachmentInside in status))
          then ImageIndex := imgAttachment;
        end;
        4:
        begin //security status
        end;
        5:
        begin // subject
          if msgRead in status then ImageIndex := imgRead;
          if msgReplied in status then ImageIndex := imgReplyed;
          if msgForwarded in status then ImageIndex := imgForwarded;
          if (msgReplied in status) and (msgForwarded in status) then ImageIndex := imgReFwd;
          if ImageIndex = -1 then ImageIndex := imgUnread;
        end;
      end;
    end;
  end;

end;

procedure TfrmMaillist.tmrMarkTimer(Sender: TObject);
begin
  tmrMark.Enabled := False;

  if lstMaillist.SelectedCount = 1 then
    actMessageMarkAsReadExecute(actMessageMarkAsRead);
end;

procedure TfrmMaillist.actMessageAnnotateExecute(Sender: TObject);
var nd: PTreeMaillist;
begin
  tmrMark.Enabled := False;
  nd := lstMaillist.GetNodeData(lstMaillist.GetFirstSelected);
  if nd <> nil then begin //mark message as read
    nd.comment := InputComment(_('Annotate message'), _('' +
      'Write message annotation to field below.'), nd.comment);
    Fmbox.ReplaceDescription(nd.id, nd^);
    lstMaillist.RepaintNode(lstMaillist.GetFirstSelected);
  end;
end;

procedure TfrmMaillist.lstMailListGetHint(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var nd: PTreeMaillist;
begin
  nd := lstMaillist.GetNodeData(Node);
  if nd <> nil then begin //mark message as read
    case Column of
      0:
        if nd.comment <> '' then CellText := nd.comment; //annotation
      1:
      begin //label
        if nd.markId <> 0 then
          CellText := popLabel.Items[nd.markId - 1].Caption;
      end;
      2:
      begin //priority
        case nd.priority of
          1:
            CellText := _('Lowest priority');
          2:
            CellText := _('Low priority');
          3:
            CellText := _('Normal priority');
          4:
            CellText := _('High priority');
          5:
            CellText := _('Highest priority');
        end;
      end;
      3:
      begin //attachment
        if (msgAttachmentInside in nd.status) or
          (msgAttachmentOutside in nd.status) then
          CellText := _('Attachment present');
      end;
    end;
  end
end;

procedure TfrmMaillist.lstMailListClick(Sender: TObject);
var hi: THitInfo;
var curPos1, curPos2: TPoint;
begin
    //if columns are annotation or label then we display pop-up
  curPos1 := Mouse.CursorPos;
  curPos2 := lstMaillist.ScreenToClient(curPos1);
  lstMaillist.GetHitTestInfoAt(curPos2.X, curPos2.Y, False, hi);

  if hi.HitNode <> nil then begin
    case hi.HitColumn of
      0:
        popAnnotate.Popup(curPos1.X, curPos1.Y);
      1:
        popLabel.Popup(curPos1.X, curPos1.Y);
    end;
  end;

end;

procedure TfrmMaillist.actMessageLabelExecute(Sender: TObject);
var Node: PVirtualNode;
var nd: PTreeMaillist;
begin
  if lstMaillist.SelectedCount = 0 then Exit;
  if not (Sender is TAction) then Exit;

  Node := lstMaillist.GetFirstSelected;
  while Node <> nil do begin
    nd := lstMaillist.GetNodeData(Node);
    nd.markId := (Sender as TAction).Tag;
    Fmbox.ReplaceDescription(nd.id, nd^);
    Node := lstMaillist.GetNextSelected(Node);
  end;
  lstMaillist.Repaint;
end;

procedure TfrmMaillist.actMessageMarkAsReadExecute(Sender: TObject);
var Node: PVirtualNode;
var nd: PTreeMaillist;
begin
  if lstMaillist.SelectedCount = 0 then Exit;
  if not (Sender is TAction) then Exit;

  Node := lstMaillist.GetFirstSelected;
  while Node <> nil do begin
    nd := lstMaillist.GetNodeData(Node);
    if not (msgRead in nd.status) then begin
      nd.status := nd.status + [msgRead];
    end;
    Fmbox.ReplaceDescription(nd.id, nd^);
    Node := lstMaillist.GetNextSelected(Node);
  end;
  lstMaillist.Repaint;
  frmMailbox.trMailbox.Repaint;
  frmMailbox.actAccountRefreshTot.Execute; //refresh unread/total msg count
end;

procedure TfrmMaillist.actMessageMarkAsUnreadExecute(Sender: TObject);
var Node: PVirtualNode;
var nd: PTreeMaillist;
begin
  if lstMaillist.SelectedCount = 0 then Exit;
  if not (Sender is TAction) then Exit;

  Node := lstMaillist.GetFirstSelected;
  while Node <> nil do begin
    nd := lstMaillist.GetNodeData(Node);
    if (msgRead in nd.status) then begin
      nd.status := nd.status - [msgRead];
    end;
    Fmbox.ReplaceDescription(nd.id, nd^);
    Node := lstMaillist.GetNextSelected(Node);
  end;
  lstMaillist.Repaint;
  frmMailbox.trMailbox.Repaint;
  frmMailbox.actAccountRefreshTot.Execute; //refresh unread/total msg count    
end;

procedure TfrmMaillist.actMessageAnnotateUpdate(Sender: TObject);
begin
  if lstMaillist.SelectedCount = 1 then (Sender as TAction).Enabled := True
  else (Sender as TAction).Enabled := False;
end;

procedure TfrmMaillist.actMessageNewExecute(Sender: TObject);
var frmNew: TfrmCompose;
begin
  frmNew := TfrmCompose.Create(Application);
  if frmMailbox.SelectedAccount > 0 then
    frmNew.Account := frmMailbox.SelectedAccount
  else
    frmNew.Account := 0;
  frmNew.MessageId := -1;
  frmNew.EditType := tetNew;
  frmNew.Show;
  FLastCompose := frmNew;
end;

procedure TfrmMaillist.Minimize;
begin
  if not Minimized then begin
    TBXToolWindow1.Visible := False;
    Minimized := True;
  end;
end;

procedure TfrmMaillist.Restore;
begin
  if Minimized then begin
    TBXToolWindow1.Visible := True;
    Minimized := False;
  end;
end;

procedure TfrmMaillist.actMessagePropertiesExecute(Sender: TObject);
begin
  with frmMessageInfo do begin
    lblFrom.Caption := frmMailView.From;
    lblCC.Caption := '';
    //lblSubject.Caption := frmMailView.Subject;
    lblDate.Caption := frmMailView.Date;
    //lblAccount.Caption := '';
    lblPriority.Caption := frmMailView.PriorityString;
    lblSize.Caption := frmMain.SizeToString(frmMailView.MessageSize);
    txtHeaders.Lines.Assign(frmMailview.Headers);
    ShowModal;
  end;
end;

procedure TfrmMaillist.Clear;
begin
  frmMailView.UnloadDoc;
  lstMailList.Clear;
end;

procedure TfrmMaillist.actMessageNewUpdate(Sender: TObject);
begin
  if frmMailbox.Profile = nil then
    Exit;
  if frmMailbox.Profile.Accounts.Count >= 1 then begin
    actMessageNew.Enabled := True;
    frmMain.actTBMessageNew.Enabled := True;
  end
  else begin
    actMessageNew.Enabled := False;
    frmMain.actTBMessageNew.Enabled := False;
  end;
end;

procedure TfrmMaillist.actMessageMarkAsUnreadUpdate(Sender: TObject);
begin
  if lstMaillist.SelectedCount >= 1 then (Sender as TAction).Enabled := True
  else (Sender as TAction).Enabled := False;
end;

procedure TfrmMaillist.lstMailListPaintText(Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;

⌨️ 快捷键说明

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