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

📄 fmailview.pas

📁 siMail, siMail, siMail, siMail
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  msgView.Refresh;
end;

procedure TfrmMailView.actDOJavaUpdate(Sender: TObject);
begin
  if not (DLCTL_NO_JAVA in msgView.DownloadOptions) then
    (Sender as TAction).Checked := True
  else
    (Sender as TAction).Checked := False;
end;

procedure TfrmMailView.actDOActiveXRunExecute(Sender: TObject);
begin
  if (Sender as TAction).Checked then
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_NO_RUNACTIVEXCTLS]
  else
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_NO_RUNACTIVEXCTLS];
  warningUpdate;
  frmMailbox.Profile.Config.WriteBool('frmMailView', 'DLCTL_NO_RUNACTIVEXCTLS',
    (Sender as TAction).Checked);
  msgView.Refresh;
end;

procedure TfrmMailView.actDOActiveXRunUpdate(Sender: TObject);
begin
  if not (DLCTL_NO_RUNACTIVEXCTLS in msgView.DownloadOptions) then
    (Sender as TAction).Checked := True
  else
    (Sender as TAction).Checked := False;
end;

procedure TfrmMailView.loadHtmlOptions;
var i: Integer;
begin
  if frmMailbox.Profile.Config.ReadBool('frmMailView', 'DLCTL_FORCEOFFLINE', True) then
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_FORCEOFFLINE]
  else
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_FORCEOFFLINE];
  if frmMailbox.Profile.Config.ReadBool('frmMailView', 'DLCTL_DLIMAGES', False) then
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_DLIMAGES]
  else
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_DLIMAGES];
  if frmMailbox.Profile.Config.ReadBool('frmMailView', 'DLCTL_BGSOUNDS', False) then
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_BGSOUNDS]
  else
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_BGSOUNDS];
  if frmMailbox.Profile.Config.ReadBool('frmMailView', 'DLCTL_VIDEOS', False) then
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_VIDEOS]
  else
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_VIDEOS];
  if frmMailbox.Profile.Config.ReadBool('frmMailView', 'DLCTL_NO_DLACTIVEXCTLS', False) then
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_NO_DLACTIVEXCTLS]
  else
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_NO_DLACTIVEXCTLS];
  if frmMailbox.Profile.Config.ReadBool('frmMailView', 'DLCTL_NO_SCRIPTS', False) then
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_NO_SCRIPTS]
  else
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_NO_SCRIPTS];
  if frmMailbox.Profile.Config.ReadBool('frmMailView', 'DLCTL_NO_JAVA', False) then
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_NO_JAVA]
  else
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_NO_JAVA];
  if frmMailbox.Profile.Config.ReadBool('frmMailView', 'DLCTL_NO_RUNACTIVEXCTLS', False) then
    msgView.DownloadOptions := msgView.DownloadOptions - [DLCTL_NO_RUNACTIVEXCTLS]
  else
    msgView.DownloadOptions := msgView.DownloadOptions + [DLCTL_NO_RUNACTIVEXCTLS];

  for i := 0 to alMenus.ActionCount - 1 do
    alMenus.Actions[i].Update;
  warningUpdate;
end;

procedure TfrmMailView.hideIE;
begin
  msgView.Visible := False;
  msgView.Align := alNone;
  msgView.Width := 10;
  msgView.Height := 10;
  msgView.Top := -1000;
  msgView.Left := -1000;
end;

procedure TfrmMailView.actDORemoveNonembeddedExecute(Sender: TObject);
begin
//
end;

procedure TfrmMailView.actDORemoveNonembeddedUpdate(Sender: TObject);
begin
//
end;

procedure TfrmMailView.LoadUserSettings;
var cName: String;
begin
  cName := frmMailbox.Profile.Config.ReadString('frmMailView', tbParts.Name + 'Dock', '');
  if cName = '' then
    tbParts.CurrentDock := tbParts.DefaultDock
  else begin
    if cName = dckTop.Name then
      tbParts.CurrentDock := dckTop
    else if cName = dckBottom.Name then
      tbParts.CurrentDock := dckBottom
    else
      tbParts.CurrentDock := tbParts.DefaultDock;
  end;
  chkHtmlAsText.Checked := frmMailbox.Profile.Config.ReadBool('frmMailView', 'HtmlAsText', True);
end;

procedure TfrmMailView.tbPartsDockChanged(Sender: TObject);
begin
  if tbParts.CurrentDock = nil then
    Exit;
  frmMailbox.Profile.Config.WriteString('frmMailView', tbParts.Name + 'Dock', tbParts.CurrentDock.Name);
end;

procedure TfrmMailView.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TfrmMailView.FormConstrainedResize(Sender: TObject; var MinWidth,
  MinHeight, MaxWidth, MaxHeight: Integer);
begin
  if Self.Owner = Application then begin
    MinWidth := 640;
    MinHeight := 480;
  end;
end;

procedure TfrmMailView.actTBCloseExecute(Sender: TObject);
begin
  Self.Close;
end;

procedure TfrmMailView.actTBAddressBookExecute(Sender: TObject);
begin
  frmMain.actTBAddrBook.Execute;
end;

procedure TfrmMailView.FormShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
  if Self.Owner = Application then begin
    if msg.CharCode = 27 then begin
        Self.Close;
        Handled:=True;
    end;
  end;
end;

procedure TfrmMailView.FormHide(Sender: TObject);
begin
  frmMailbox.Profile.Config.WriteControlSettings(Self, 'frmMailView');
end;

procedure TfrmMailView.actTBReplyExecute(Sender: TObject);
var frmNew: TfrmCompose;
begin
  FMessageDescr.status := FMessageDescr.status + [msgReplied];
  Fmbox.ReplaceDescription(FMessageDescr.id, FMessageDescr);
  frmNew := TfrmCompose.Create(nil);
  frmNew.Account := FMessageAccount;
  frmNew.Mailbox := FMessageMailbox;
  frmNew.MessageId := FMessageDescr.id;
  frmNew.EditType := tetReply;
  frmNew.Show;
  frmMaillist.lstMaillist.Repaint;
end;

procedure TfrmMailView.actTBReplyUpdate(Sender: TObject);
begin
  if (FMessageMailbox < 0) or (FMessageAccount < 0) then
    (Sender as TAction).Enabled := False
  else
    (Sender as TAction).Enabled := True;
end;

procedure TfrmMailView.actTBReplyAllExecute(Sender: TObject);
var frmNew: TfrmCompose;
begin
  FMessageDescr.status := FMessageDescr.status + [msgReplied];
  Fmbox.ReplaceDescription(FMessageDescr.id, FMessageDescr);
  frmNew := TfrmCompose.Create(nil);
  frmNew.Account := FMessageAccount;
  frmNew.Mailbox := FMessageMailbox;
  frmNew.MessageId := FMessageDescr.id;
  frmNew.EditType := tetReplyAll;
  frmNew.Show;
  frmMaillist.lstMaillist.Repaint;
end;

procedure TfrmMailView.actTBForwardExecute(Sender: TObject);
var frmNew: TfrmCompose;
begin
  FMessageDescr.status := FMessageDescr.status + [msgForwarded];
  Fmbox.ReplaceDescription(FMessageDescr.id, FMessageDescr);
  frmNew := TfrmCompose.Create(nil);
  frmNew.Account := FMessageAccount;
  frmNew.Mailbox := FMessageMailbox;
  frmNew.MessageId := FMessageDescr.id;
  frmNew.EditType := tetForward;
  frmNew.Show;
  frmMaillist.lstMaillist.Repaint;
end;

procedure TfrmMailView.actTBPrintExecute(Sender: TObject);
begin
  actFilePrintPrint.Execute;
end;

procedure TfrmMailView.actTBPrintUpdate(Sender: TObject);
begin
  actTBPrint.Enabled := actFilePrintPrint.Enabled;
end;

procedure TfrmMailView.actFilePrintPrintUpdate(Sender: TObject);
begin
  if UpperCase(msgView.LocationURL) <>  'ABOUT:BLANK' then
    actFilePrintPrint.Enabled := True
  else
    actFilePrintPrint.Enabled := False;
end;

procedure TfrmMailView.msgViewDownloadComplete(Sender: TObject);
begin
  actFilePrintPrint.Update;
end;

procedure TfrmMailView.actFilePrintPreviewExecute(Sender: TObject);
begin
  doPrintOptions;
  msgView.PrintPreView;
end;

procedure TfrmMailView.actFilePrintPreviewUpdate(Sender: TObject);
begin
  actFilePrintPreview.Enabled := actFilePrintPrint.Enabled;
end;

procedure TfrmMailView.actFilePrintPrintExecute(Sender: TObject);
begin
  doPrintOptions;
  msgView.Print;
end;

procedure TfrmMailView.doPrintOptions;
var Node: PVirtualNode;
var nd: PTreeAttach;
begin

  with msgView.PrintOptions do begin
    Footer := '&b' + _('Page &p of &P');
    Header := Format('si.Mail v.%s - %s', [frmMain.GetFileVersionAsString(
      Application.ExeName), siMailHome]);
    HTMLHeader.Clear;
    HTMLHeader.Add('<html>');
    HTMLHeader.Add('<table>');
    HTMLHeader.Add(Format(_('<tr><td>From:</td><td>%s</td>'), [FMessageDescr.from]));
    HTMLHeader.Add(Format(_('<tr><td>To:</td><td>%s</td>'), ['N/A'(*FMessageDescr.to*)]));
    HTMLHeader.Add(Format(_('<tr><td>Subject:</td><td>%s</td>'), [FMessageDescr.subject]));
    HTMLHeader.Add(Format(_('<tr><td>Date:</td><td>%s</td>'), [DateTimeToStr(FMessageDescr.date)]));
    HTMLHeader.Add(Format(_('<tr><td>Priority:</td><td>%s</td>'), [FPriorityString]));
    Node := msgAttachments.GetFirst;
    while Node <> nil do begin
      nd := msgAttachments.GetNodeData(Node);
      HTMLHeader.Add(Format(_('<tr><td>Attachments:</td><td>%s, (%s)</td>'),
        [nd^.fileName, frmMain.sizeToString(nd^.size)]));
      Node := msgAttachments.GetNext(Node);
    end;
    HTMLHeader.Add('</table>');
    HTMLHeader.Add('<hr />');
    HTMLHeader.Add('</html>');
  end;
  with msgView.PrintOptions.Margins do begin
    Left := 20;
    Top := 20;
    Right := 10;
    Bottom := 10;
  end;
end;

procedure TfrmMailView.actFilePrintSetupExecute(Sender: TObject);
begin
  doPrintOptions;
  msgView.PageSetup(True);
end;

procedure TfrmMailView.actFilePrintSetupUpdate(Sender: TObject);
begin
  actFilePrintSetup.Enabled := actFilePrintPrint.Enabled;
end;

procedure TfrmMailView.Save(FileType: Integer; s: TStream);
var tmpStr: String;
var strm: TFileStream;
begin
  case FileType of
  1: begin //txt
    tmpStr := (msgView.Document as IHTMLDocument2).Body.innerText;
    s.Write(tmpStr[1], Length(tmpStr));
  end;
  2: begin //html
    strm := TFileStream.Create(df.Temp + FdocFileName, fmOpenRead, fmShareDenyNone);
    try
      s.CopyFrom(strm, strm.Size);
    finally
      FreeAndNil(strm);
    end;
  end
  end;
end;

procedure TfrmMailView.buildQuotingStyles;
const cQS = '.quoteStyle%d {' + #13#10 +
    ' color: %s;' + #13#10 +
    ' background-color: %s;' + #13#10 +
    ' border-color: %s;' + #13#10 +
    ' border: %s;' + #13#10 +
    ' border-width: %s;' + #13#10 +
    ' %s' + #13#10 +
    '}' + #13#10;
var s: array[1..6] of String;
var i: Integer;
var tmpStr: String;
begin
  if quotingStyles <> '' then begin
    if frmSettings.QuotingStyleReloadNeeded = False then
      Exit;
  end;

  quotingStyles := '<style type="text/css">' + #13#10;
  with frmMailbox.Profile.Config do begin
    for i := 1 to 8 do begin
      s[1] := ColorToHTML(ReadInteger('quoting', 'textColor' + IntToStr(i), clBlack));
      case i of
      1: tmpStr := '$009191FF';
      2: tmpStr := '$0074ACEB';
      3: tmpStr := '$00C28D58';
      4: tmpStr := '$00E9E9B6';
      5: tmpStr := '$009AE99A';
      6: tmpStr := '$007CCDA7';
      7: tmpStr := '$00E7A5BF';
      8: tmpStr := '$00FC8D91';
      end;
      s[2] := ColorToHTML(ReadInteger('quoting', 'backColor' + IntToStr(i), StrToInt(tmpStr)));
      s[3] := ColorToHTML(ReadInteger('quoting', 'borderColor' + IntToStr(i), clBlack));
      s[4] := ReadString('quoting', 'borderStyle' + IntToStr(i), 'dashed');
      s[5] := ReadString('quoting', 'borderWidth' + IntToStr(i), '1px');
      s[6] := ReadString('quoting', 'additionalStyles' + IntToStr(i), 'margin: 5px;' + #13#10 + 'padding: 5px');
      quotingStyles := quotingStyles + Format(cQS, [i, s[1], s[2], s[3], s[4], s[5], s[6]]);
    end;
  end; //with
  frmSettings.QuotingStyleReloadNeeded := False;
  quotingStyles := quotingStyles + '</style>';
end;

procedure TfrmMailView.cmdShowMenuClick(Sender: TObject);
begin
  popDO.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;

procedure TfrmMailView.chkHtmlAsTextClick(Sender: TObject);
begin
  frmMailbox.Profile.Config.WriteBool('frmMailView', 'HtmlAsText', chkHtmlAsText.Checked);
  if selectedPartButton = nil then Exit;
  tbPartsClick(selectedPartButton);
end;

end.


⌨️ 快捷键说明

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