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

📄 fcompose.pas

📁 siMail, siMail, siMail, siMail
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  askForSave := False;
end;


procedure TfrmCompose.actFileSendNowExecute(Sender: TObject);
var id: Integer;
begin
  id := buildMessage;
  if id < 0 then
    Exit;

  frmTasks.TaskAdd(FAccount, id, ttSend);
  if (frmMailbox.Profile.Config.ReadBool('frmTasks', 'showMe', True)) then
    frmTasks.Show;
  askForSave := False;
  Self.Close;
end;

procedure TfrmCompose.actFileSendLaterExecute(Sender: TObject);
var id: Integer;
begin
  id := buildMessage;
  if id < 0 then
    Exit;

  askForSave := False;
  Self.Close;
end;

procedure TfrmCompose.actFileFinishLaterExecute(Sender: TObject);
begin
  buildMessage(True);
  Self.Close;
end;

procedure TfrmCompose.actTBSendNowExecute(Sender: TObject);
begin
  actFileSendNow.Execute;
end;

procedure TfrmCompose.deleteAttachments;
var Node: PVirtualNode;
begin
  Node := lstAttachments.GetFirstSelected;
  while Node <> nil do begin
    lstAttachments.DeleteNode(Node);
    Node := lstAttachments.GetNextSelected(Node);
  end;

  updateAttachmentsSize;
end;

procedure TfrmCompose.addAddress(type1: TAddrType; mail1: String);
begin
  with PTreeAddresses(lstAddresses.GetNodeData(lstAddresses.AddChild(nil)))^ do begin
    type_ := type1;
    mail := mail1;
  end;
  askForSave := True;
end;

procedure TfrmCompose.selectCorrectSignature;
begin
  with frmMailbox.Profile.Accounts[FAccount] do begin
    if LastSignature = '' then begin
      if DefaultSignature = '' then
        cmboxSignature.ItemIndex := 0
      else
        cmboxSignature.ItemIndex := cmboxSignature.Items.IndexOf(DefaultSignature);
    end
    else
      cmboxSignature.ItemIndex := cmboxSignature.Items.IndexOf(LastSignature);
  end;

  if cmboxSignature.ItemIndex = -1 then
    cmboxSignature.ItemIndex := 0;
  cmboxSignatureChange(Self);
end;

procedure TfrmCompose.lstAddressesPaintText(Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType);
begin
  if vsSelected in Node.States then Exit;

  if column = 0 then TargetCanvas.Font.Color := clGreen
  else TargetCanvas.Font.Color := clWindowText;
end;

procedure TfrmCompose.loadSignatures;
var i: Integer;
begin
  cmboxSignature.Clear;
  cmboxSignature.Items.AddObject(_('<none>'), Pointer( -1));

  with frmMailbox.Profile.Accounts[FAccount] do begin
    cmboxSignature.Clear;
    cmboxSignature.Items.AddObject(_('<none>'), Pointer( -1));
    for i := 0 to frmMailbox.Profile.Signatures.Count - 1 do begin
      cmboxSignature.Items.AddObject(
        frmMailbox.Profile.Signatures.Signature[i].name, Pointer(i));
    end;
  end;
end;

procedure TfrmCompose.txtMailButtonClick(Sender: TObject);
var replyTo: String;
begin
  frmAddrBk.Mode := abkSelect;
  replyTo := loadAddresses; //add currentyl written addresses to lists
  frmAddrBk.BorderStyle := bsDialog;
  frmAddrBk.ShowModal;
  frmAddrBk.BorderStyle := bsSizeable;
  if not frmAddrBk.Cancled then begin
    moveAddresses; //copy addresses from lists to lstAddresses
    if replyTo <> '' then
      addAddress(tatReplyTo, replyTo);
  end;
end;

procedure TfrmCompose.pnlSubjectEnter(Sender: TObject);
begin
  txtSubject.SetFocus;
end;

//this procedure loads addresses in frmAddrBk when mode is abkSelect
function TfrmCompose.loadAddresses: String;
var Node: PVirtualNode;
var nd: PTreeAddresses;
begin
  Result := '';

  frmAddrBk.lstTo.Clear;
  frmAddrBk.lstCC.Clear;
  frmAddrBk.lstBcc.Clear;

  Node := lstAddresses.GetFirst;
  while Node <> nil do begin
    nd := PTreeAddresses(lstAddresses.GetNodeData(node));
    case nd.type_ of
      tatTo:
      begin
        //build list just in case if user entred more than one address per field
        buildEmailList(nd.mail, frmAddrBk.lstTo.Items);
      end;
      tatCC:
      begin
        //build list just in case if user entred more than one address per field
        buildEmailList(nd.mail, frmAddrBk.lstCC.Items);
      end;
      tatBCC:
      begin
        //build list just in case if user entred more than one address per field
        buildEmailList(nd.mail, frmAddrBk.lstBcc.Items);
      end;
      tatReplyTo: Result := nd.mail;
    end;
    node := lstAddresses.GetNext(node);
  end;
end;

//this procedure moves addresses from frmAddrBk to lstAddresses
procedure TfrmCompose.moveAddresses;
var i: Integer;
begin
  lstAddresses.Clear;

  for i := 0 to frmAddrBk.lstTo.Count - 1 do begin
    addAddress(tatTo, frmAddrBk.lstTo.Items[i]);
  end;

  for i := 0 to frmAddrBk.lstCC.Count - 1 do begin
    addAddress(tatCC, frmAddrBk.lstCC.Items[i]);
  end;

  for i := 0 to frmAddrBk.lstBCC.Count - 1 do begin
    addAddress(tatBCC, frmAddrBk.lstBCC.Items[i]);
  end;
end;

procedure TfrmCompose.lstAttachmentsDblClick(Sender: TObject);
begin
  actInsertAttachment.Execute;
end;

procedure TfrmCompose.updateAttachmentsSize;
var Node: PVirtualNode;
var sze: Int64;
begin
  //update attachment size
  sze := 0;
  Node := lstAttachments.GetFirst;
  while Node <> nil do begin
    sze := sze + PTreeAttach(lstAttachments.GetNodeData(Node))^.size;
    Node := lstAttachments.GetNext(Node);
  end;

  sb.Panels[1].Caption := Format(_('Attachments details: (Count: %d. RAW size: %s. Estimated e-mail size: %s)'),
    [lstAttachments.RootNodeCount, frmMain.sizeToString(sze), frmMain.sizeToString(Trunc(sze * 4/3))]);

  askForSave := True;
end;

procedure TfrmCompose.lstAttachmentsCompareNodes(Sender: TBaseVirtualTree;
  Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var nd1, nd2: PTreeAttach;
begin
  nd1 := Sender.GetNodeData(Node1);
  nd2 := Sender.GetNodeData(Node2);

  case Column of
  0: Result := CompareText(nd1.fileName, nd2.fileName);
  1: 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 TfrmCompose.lstAttachmentsHeaderClick(Sender: TVTHeader;
  Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  //if same column then just reverse sorting
  if Sender.SortColumn = Column then begin
    if Sender.SortDirection = sdAscending then
      Sender.SortDirection := sdDescending
    else Sender.SortDirection := sdAscending;
  end
  else Sender.SortColumn := Column;
end;

procedure TfrmCompose.CreateMessage(msg, subject, sendTo, sendCc, sendBcc: String; attachments: TStringList);
var lst: TStringList;
var i: Integer;
begin
  txtMessage.Text := msg;
  txtSubject.Text := subject;
  lst := TStringList.Create;

  lstAddresses.Clear;
  lst.Clear;
  buildEmailList(sendTo, lst);
  for i := 0 to lst.Count - 1 do begin
    addAddress(tatTo, lst.Strings[i]);
  end;

  lst.Clear;
  buildEmailList(sendCc, lst);
  for i := 0 to lst.Count - 1 do begin
    addAddress(tatCC, lst.Strings[i]);
  end;

  lst.Clear;
  buildEmailList(sendBcc, lst);
  for i := 0 to lst.Count - 1 do begin
    addAddress(tatBCC, lst.Strings[i]);
  end;

  if attachments <> nil then
    frmMailView.loadAttachments(lstAttachments, ilFiles, attachments, False);
  updateAttachmentsSize;
  selectCorrectSignature;
  FreeAndNil(lst);
end;

procedure TfrmCompose.CreateMessage(msg, subject, sendTo: String; attachments: TStringList);
begin
  txtMessage.Text := msg;
  txtSubject.Text := subject;
  addAddress(tatTo, sendTo);
  if attachments <> nil then
    frmMailView.loadAttachments(lstAttachments, ilFiles, attachments, False);
  updateAttachmentsSize;
  selectCorrectSignature;
end;

procedure TfrmCompose.actEditCutExecute(Sender: TObject);
begin
  SendMessage(GetFocus, WM_CUT, 0, 0);
end;

procedure TfrmCompose.actEditCopyExecute(Sender: TObject);
begin
  SendMessage(GetFocus, WM_COPY, 0, 0);
end;

procedure TfrmCompose.actEditPasteExecute(Sender: TObject);
begin
  SendMessage(GetFocus, WM_PASTE, 0, 0);
end;

procedure TfrmCompose.actEditPasteQuotedExecute(Sender: TObject);
var str: TStringList;
var i, sl: Integer;
begin
  str := TStringList.Create;
  sl := SendMessage(txtMessage.Handle, EM_LINEFROMCHAR, txtMessage.SelStart, 0);
  try
    str.Text := Clipboard.AsText;
    for i := 0 to str.Count - 1 do
      txtMessage.Lines.Insert(i + sl, '>' + str.Strings[i]);

  finally
    FreeAndNil(str);
  end;
end;

procedure TfrmCompose.actEditSelectAllExecute(Sender: TObject);
begin
  SendMessage(GetFocus, EM_SETSEL, 0, -1);
end;

procedure TfrmCompose.actTBAddressBookUpdate(Sender: TObject);
begin
  actTBAddressBook.Enabled := frmMain.actToolsAddressBook.Enabled;
end;

procedure TfrmCompose.actTBAddressBookExecute(Sender: TObject);
begin
  frmMain.actToolsAddressBook.Execute;
end;

procedure TfrmCompose.txtSubjectChange(Sender: TObject);
begin
  if txtSubject.Text <> '' then
    Self.Caption := FCaption + ' - [' + txtSubject.Text + ']'
  else
    Self.Caption := FCaption;

  askForSave := True;
end;

procedure TfrmCompose.JvDragDrop1Drop(Sender: TObject; Pos: TPoint; Value: TStrings);
var i: Integer;
var Node:PVirtualNode;
begin
  //check if file is already on list and remove it from this list
  Node := lstAttachments.GetFirst;
  while Node <> nil do begin
    i := Value.IndexOf(PTreeAttach(lstAttachments.GetNodeData(Node))^.fileName);
    if i >= 0 then
      Value.Delete(i);
    Node := lstAttachments.GetNext(Node);
  end;

  frmMailView.loadAttachments(lstAttachments, ilFiles, TStringList(Value), False);
  updateAttachmentsSize;
end;

procedure TfrmCompose.actEditFindExecute(Sender: TObject);
begin
  txtMessage.SetFocus;
  diFindAndReplace.Find;
end;

procedure TfrmCompose.actEditFindNextExecute(Sender: TObject);
begin
  diFindAndReplace.FindAgain;
end;

procedure TfrmCompose.actEditReplaceExecute(Sender: TObject);
begin
  txtMessage.SetFocus;
  diFindAndReplace.Replace;
end;

procedure TfrmCompose.actInsertTextFileExecute(Sender: TObject);
var str: TStringList;
var i, sl: Integer;
begin
  if not diOpenText.Execute then
    Exit;

  str := TStringList.Create;
  sl := SendMessage(txtMessage.Handle, EM_LINEFROMCHAR, txtMessage.SelStart, 0);
  try
    str.LoadFromFile(diOpenText.FileName);
    for i := 0 to str.Count - 1 do
      txtMessage.Lines.Insert(i + sl, str.Strings[i]);
  finally
    FreeAndNil(str);
  end;
end;

procedure TfrmCompose.actInsertDateExecute(Sender: TObject);
begin
  txtMessage.SelLength := 0;
  txtMessage.SelText := FormatDateTime(FormatSettings.LongDateFormat, Now) + ' ';
end;

procedure TfrmCompose.actInsertTimeExecute(Sender: TObject);
begin
  txtMessage.SelLength := 0;
  txtMessage.SelText := FormatDateTime(FormatSettings.LongTimeFormat, Now) + ' ';
end;

procedure TfrmCompose.actInsertDateTimeExecute(Sender: TObject);
begin
  actInsertDate.Execute;
  actInsertTime.Execute;

⌨️ 快捷键说明

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