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

📄 fpreview.pas

📁 siMail, siMail, siMail, siMail
💻 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 + -