📄 fmailview.pas
字号:
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 + -