📄 fpreview.pas
字号:
(*
# (C) Copyright 2003
# Miha Vrhovnik, miha.vrhovnik@cordia.si
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
#
# The Initial Developer of the Original Code is Miha Vrhovnik (Slovenia).
# Portions created by Miha Vrhovnik are Copyright (c)2003.
# All Rights Reserved.
#==============================================================================
# Contributor(s):
#==============================================================================
# History: see whats new.txt from distribution package
#==============================================================================
*)
unit fPreview;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, XPMenu, VirtualTrees, StdCtrls, MFEdit, VSTEdit, gnugettext,
task, ImgList, defFldrs, TB2Item, TBX, TB2Dock, TB2Toolbar, ActnList;
//tree type data
type TTreePreview = record
id: Integer; //message id
doWhat: TDoWhat;
subject: WideString;
from: WideString;
size: Integer;
date: TDateTime;
accountID: Integer;
end;
type
TfrmPreview = class(TForm)
cmdOK: TButton;
cmdCancel: TButton;
lstPreview: TVirtualStringTree;
cmdHelp: TButton;
cmboxDoWhat: TMFComboEdit;
editor: TVSTEditor;
lblStatus: TLabel;
popSelection: TTBXPopupMenu;
Selectall1: TTBXItem;
Invertselection1: TTBXItem;
Markselected1: TTBXItem;
Getandleaveonserver1: TTBXItem;
Getanddeleteonserver1: TTBXItem;
Deleteonserver1: TTBXItem;
Ignore1: TTBXItem;
TBXDock1: TTBXDock;
TBXToolbar1: TTBXToolbar;
TBXItem2: TTBXItem;
TBXItem3: TTBXItem;
TBXItem4: TTBXItem;
TBXItem5: TTBXItem;
ActionList1: TActionList;
actPreviewSelectAll: TAction;
actPreviewInvertSelection: TAction;
actPreviewGetAndLeave: TAction;
actPreviewGetAndDelete: TAction;
actPreviewDelete: TAction;
actPreviewIgnore: TAction;
procedure cmdCancelClick(Sender: TObject);
procedure lstPreviewGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure lstPreviewGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
procedure lstPreviewCreateEditor(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
procedure lstPreviewEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
procedure lstPreviewClick(Sender: TObject);
procedure lstPreviewEdited(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
procedure FormResize(Sender: TObject);
procedure lstPreviewCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
procedure lstPreviewHeaderClick(Sender: TVTHeader;
Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
procedure lstPreviewGetPopupMenu(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; const P: TPoint;
var AskParent: Boolean; var PopupMenu: TPopupMenu);
procedure lstPreviewPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType);
procedure FormShow(Sender: TObject);
procedure FormHide(Sender: TObject);
procedure cmdOKClick(Sender: TObject);
procedure cmdHelpClick(Sender: TObject);
procedure actPreviewUpdate(Sender: TObject);
procedure actPreviewInvertSelectionExecute(Sender: TObject);
procedure actPreviewExecute(Sender: TObject);
procedure actPreviewSelectAllExecute(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
function GetMessageCount: Integer;
function GetStatus: String;
procedure SetStatus(const Value: String);
{ Private declarations }
public
{ Public declarations }
procedure Clear;
procedure AddMessage(msg: TTreePreview);
procedure CreateParams(var Params: TCreateParams); override;
function MessagesDoWhat(var doWhat: array of TDoWhat; getSize: Boolean): Integer;
published
property MessageCount: Integer read GetMessageCount;
property Status: String read GetStatus write SetStatus;
end;
var
frmPreview: TfrmPreview;
implementation
uses fMain, tasks, mailBox, dImages;
{$R *.dfm}
//tree type data
type PTreePreview = ^TTreePreview;
procedure TfrmPreview.AddMessage(msg: TTreePreview);
begin
PTreePreview(lstPreview.GetNodeData(lstPreview.AddChild(nil)))^ := msg;
end;
procedure TfrmPreview.Clear;
begin
lstPreview.Clear;
end;
procedure TfrmPreview.cmdCancelClick(Sender: TObject);
begin
cmdCancel.SetFocus;
Self.Close;
end;
function TfrmPreview.GetMessageCount: Integer;
begin
Result := lstPreview.RootNodeCount;
end;
procedure TfrmPreview.lstPreviewGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := sizeOf(TTreePreview);
end;
procedure TfrmPreview.lstPreviewGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
begin
//return each column's text
with PTreePreview((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
case Column of
0:
CellText := cmboxDoWhat.Items.Strings[Integer(doWhat)];
1:
CellText := subject;
2:
CellText := from;
3:
CellText := DateTimeToStr(date);
4:
CellText := frmMain.SizeToString(size);
end;
end;
end;
procedure TfrmPreview.lstPreviewCreateEditor(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
begin
editor.LinkComboEditor(EditLink, '');
cmboxDoWhat.ItemIndex := Integer(PTreePreview(
(Sender as TVirtualStringTree).GetNodeData(Node))^.doWhat);
end;
procedure TfrmPreview.lstPreviewEditing(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
if Column = 0 then Allowed := True
else Allowed := False;
end;
procedure TfrmPreview.lstPreviewClick(Sender: TObject);
begin
//automatically edit if column = 0
if lstPreview.FocusedNode = nil then Exit;
if lstPreview.FocusedColumn = 0 then begin
lstPreview.EditNode(lstPreview.FocusedNode, lstPreview.FocusedColumn)
end;
end;
procedure TfrmPreview.lstPreviewEdited(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
begin
with PTreePreview((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
doWhat := TDoWhat(cmboxDoWhat.ItemIndex);
end;
end;
procedure TfrmPreview.FormResize(Sender: TObject);
begin
lstPreview.Width := Self.ClientWidth - 16;
lstPreview.Height := Self.ClientHeight - 16 - lstPreview.Top -
(Self.ClientHeight - cmdOk.Top);
end;
procedure TfrmPreview.lstPreviewCompareNodes(Sender: TBaseVirtualTree;
Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var nd1, nd2: PTreePreview;
begin
nd1 := lstPreview.GetNodeData(Node1);
nd2 := lstPreview.GetNodeData(Node2);
case Column of
0:
begin //do what
if nd1.doWhat > nd2.doWhat then Result := -1
else if nd1.doWhat = nd2.doWhat then Result := 0
else Result := 1;
end;
1:
begin //subject
Result := WideCompareText(nd1.subject, nd2.subject);
end;
2:
begin //from
Result := WideCompareText(nd1.from, nd2.from);
end;
3:
begin //date
if nd1.date > nd2.date then Result := -1
else if nd1.date = nd2.date then Result := 0
else Result := 1;
end;
4:
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 TfrmPreview.lstPreviewHeaderClick(Sender: TVTHeader;
Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
//if same column then just reverse sorting
if lstPreview.Header.SortColumn = Column then begin
if lstPreview.Header.SortDirection = sdAscending then
lstPreview.Header.SortDirection := sdDescending
else lstPreview.Header.SortDirection := sdAscending;
end
else lstPreview.Header.SortColumn := Column;
end;
procedure TfrmPreview.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle or WS_EX_APPWINDOW;
end;
procedure TfrmPreview.lstPreviewGetPopupMenu(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; const P: TPoint;
var AskParent: Boolean; var PopupMenu: TPopupMenu);
begin
PopupMenu := popSelection;
end;
procedure TfrmPreview.lstPreviewPaintText(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;
function TfrmPreview.GetStatus: String;
begin
Result := lblStatus.Caption;
end;
procedure TfrmPreview.SetStatus(const Value: String);
begin
lblStatus.Caption := Value;
end;
procedure TfrmPreview.FormShow(Sender: TObject);
begin
//translate me
TranslateComponent(Self);
//read self position & size
frmMailbox.Profile.Config.ReadControlSettings(Self);
end;
procedure TfrmPreview.FormHide(Sender: TObject);
begin
//write self position & size
frmMailbox.Profile.Config.WriteControlSettings(Self);
end;
procedure TfrmPreview.cmdOKClick(Sender: TObject);
var accID: Integer;
begin
cmdOK.SetFocus;
if lstPreview.RootNodeCount > 0 then begin
accID := PTreePreview(lstPreview.GetNodeData(lstPreview.GetFirst))^.accountID;
frmTasks.TaskAdd(accID, [], ttFetchFromPreview);
if (not frmTasks.Visible) and (frmMailbox.Profile.Config.ReadBool('frmTasks', 'showMe', True)) then
frmTasks.Show;
end;
Self.Close;
end;
function TfrmPreview.MessagesDoWhat(var doWhat: array of TDoWhat; getSize: Boolean): Integer;
var node: PVirtualNode;
var nd: PTreePreview;
var i: Integer;
begin
i := 0;
if getSize then begin
node := lstPreview.GetFirst;
//get largest msg No
while node <> nil do begin
nd := PTreePreview(lstPreview.GetNodeData(node));
if nd.id > i then
i := nd.id;
node := lstPreview.GetNext(node);
end;
Result := i;
exit;
end
else begin
for i := 0 to High(doWhat) do begin
doWhat[i] := tdwIgnore;
end;
node := lstPreview.GetFirst;
while node <> nil do begin
nd := PTreePreview(lstPreview.GetNodeData(node));
doWhat[nd.id - 1] := nd.doWhat;
node := lstPreview.GetNext(node);
end;
end;
end;
procedure TfrmPreview.cmdHelpClick(Sender: TObject);
begin
cmdHelp.SetFocus;
Application.HelpContext(Self.HelpContext);
end;
procedure TfrmPreview.actPreviewUpdate(Sender: TObject);
begin
if lstPreview.SelectedCount > 0 then
(Sender as TAction).Enabled := True
else
(Sender as TAction).Enabled := False;
end;
procedure TfrmPreview.actPreviewInvertSelectionExecute(Sender: TObject);
var node: PVirtualNode;
begin
node := lstPreview.GetFirst;
while node <> nil do begin
lstPreview.Selected[node] := not lstPreview.Selected[node];
node := lstPreview.GetNext(node);
end;
end;
procedure TfrmPreview.actPreviewExecute(Sender: TObject);
var node: PVirtualNode;
begin
//all selected nodes get do what based on menu.tag
node := lstPreview.GetFirstSelected;
while node <> nil do begin
PTreePreview(lstPreview.GetNodeData(node))^.doWhat :=
TDoWhat((Sender as TAction).Tag);
node := lstPreview.GetNextSelected(node);
end;
lstPreview.Repaint;
end;
procedure TfrmPreview.actPreviewSelectAllExecute(Sender: TObject);
var node: PVirtualNode;
begin
node := lstPreview.GetFirst;
while node <> nil do begin
lstPreview.Selected[node] := True;
node := lstPreview.GetNext(node);
end;
end;
procedure TfrmPreview.FormCreate(Sender: TObject);
begin
//form: Server mailbox view, control: whast to do with messages on server
cmboxDoWhat.Items.Text := _('Get and leave on server' + #13#10 +
'Get and delete on server' + #13#10 +
'Delete on server' + #13#10 +
'Ignore');
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -