umain.pas

一个基于不需引擎的文件管理系统,使用了许多界面比较好的控件

    result:=false;
    DecodeDate(Now,Y,M,D);
    DecodeDate(TheTime,Y1,M1,D1);
    if Y1>Y then
    begin
      result:=false;
      exit;
    end;
    OldTime:=DateTimeToTimeStamp(TheTime);
    NewTime:=DateTimeToTimeStamp(Now);
    if ((NewTime.Time-OldTime.Time<=1000*60) and (NewTime.Time-OldTime.Time>=0)) then
    begin
      if Step=0 then
        result:=true
      else if Step=7 then
        result:=(((NewTime.Date-OldTime.Date) mod 6=0) and (NewTime.Date>=OldTime.Date))//((D-D1) mod 6=0)
      else if Step=30 then
        result:=(D=D1) and (M1<=M);
    end;
  end;
begin
  CanRun:=false;
  for i:=0 to TheOprList.TaskList.Count-1 do
  begin
    with PTaskData(TheOprList.TaskList.Items[i])^ do
    begin
      case Circle of
        0://每天
        begin
          if IsEqualNow((Date+Time)) then
            CanRun:=true;
        end;
        1://每周
        begin
          if IsEqualNow((Date+Time),7) then
            CanRun:=true;
        end;
        2://每月
        begin
          if IsEqualNow((Date+Time),30) then
            CanRun:=true;
        end;
        3://一次性
        begin
          if IsEqualNow((Date+Time)) and (Runned<>1) then
            CanRun:=true;
        end;
      end;

      if CanRun then
      begin
        CanRun:=false;
        ExecTask(PTaskData(TheOprList.TaskList.Items[i]));
      end;
    end;
  end;
end;

procedure Tmainfrm.RefreshTaskList;
var
  i:integer;
begin
  SECData.qryHints.Open;
  while not SECData.qryHints.Eof do
  begin
    TheOprList.NewTaskData;
    TheOprList.TaskData^.ID:=SECData.qryHints.fieldbyname('ID').AsInteger;
    TheOprList.TaskData^.Caption:=SECData.qryHints.fieldbyname('Name').AsString;
    TheOprList.TaskData^.AType:=SECData.qryHints.fieldbyname('Type').AsInteger;
    TheOprList.TaskData^.Circle:=SECData.qryHints.fieldbyname('Circle').AsInteger;
    TheOprList.TaskData^.Text:=SECData.qryHints.fieldbyname('Text').AsString;
    TheOprList.TaskData^.Date:=SECData.qryHints.fieldbyname('Date').AsDateTime;
    TheOprList.TaskData^.Time:=SECData.qryHints.fieldbyname('Time').AsDateTime;
    TheOprList.TaskData^.TypeDesc:=SECData.qryHints.fieldbyname('TypeDesc').AsString;
    TheOprList.TaskData^.CircleDesc:=SECData.qryHints.fieldbyname('CircleDesc').AsString;
    TheOprList.TaskData^.Runned:=SECData.qryHints.fieldbyname('Runned').AsInteger;

    TheOprList.TaskList.Add(OprList.TaskData);
    SECData.qryHints.Next;
  end;
  SECData.qryHints.Close;

  for i:=0 to TheOprList.TaskList.Count-1 do
  begin
    if PTaskData(TheOprList.TaskList.Items[i])^.Circle=4 then//启动时
    begin
      ExecTask(PTaskData(TheOprList.TaskList.Items[i]));
    end;
  end;
end;

procedure Tmainfrm.HintPopURLClick(Sender: TObject; URL: String);
begin
  abort;
end;

procedure Tmainfrm.ExecTask(TaskData:PTaskData);
begin
  SECData.UpHints.ParamByName('ID').AsInteger:=TaskData^.ID;
  SECData.UpHints.ExecSQL;
  if TaskData^.AType=0 then
    OprList.ShowHint(TaskData)
  else if TaskData^.AType=1 then
    shellexecute(0,'open',Pchar(TaskData^.Text),nil,nil,SW_SHOWNORMAL);
end;

procedure Tmainfrm.ibAddFriendClick(Sender: TObject);
begin
  TheOprList.Createfrm(nil,cdAdd,fmLinkMan);
  RefreshItemInDllfrm(integer(fmLinkMan),'',false,-5,-1);
end;                     

procedure Tmainfrm.RefreshItemInDllfrm(AfrmType:integer;ACaption:Pchar;UpDateCaption:Boolean;index,parentindex:integer);
var
  DllHandle:THandle;
  Refreshfrm:TRefreshfrm;
begin
  if DllfrmList.DllList.Count<>0 then
  begin
    DLLHandle:=GetModuleHandle('List.dll');
    @Refreshfrm:=GetProcAddress(DllHandle,'Refreshfrm');
    Refreshfrm(AfrmType,ACaption,UpDateCaption,index,parentindex);
  end;

  if DllfrmList.DllTxt.Count<>0 then
  begin
    DLLHandle:=GetModuleHandle('Ft.dll');
    @Refreshfrm:=GetProcAddress(DllHandle,'Refreshfrm');
    if OprList.FolderProperty.Node<>nil then
      Refreshfrm(OprList.FolderProperty.Node.StateIndex,ACaption,True,index,-1)
    else
      Refreshfrm(-1,ACaption,True,index,-1);
  end;
end;

procedure Tmainfrm.RzGroup1Items0Click(Sender: TObject);
begin
  TheOprList.RunListfrm(-(TRzGroupItem(Sender).Index+1),0,TRzGroupItem(Sender).Caption);
end;

procedure Tmainfrm.SpTBXItem54Click(Sender: TObject);
begin
  TheOprList.ViewNode(FolderTree.Selected.StateIndex);
end;

procedure Tmainfrm.FreeTxtDLL(var msg: TMessage);
begin
  if DllfrmList.DllTxt.Count=0 then
  begin
    Screen.ResetFonts; // 这句必须要，Fonts是在dll中被创建，在dll释放之前要把Fonts释放，否则指针会丢失。
    FreeLibrary(GetModuleHandle('ft.dll'));
  end;
  OprList.DeletewMenu(msg.WParam);
end;

procedure Tmainfrm.FolderTreeDblClick(Sender: TObject);
var
  pos:TPoint;
  FNode:TTreeNode;
begin
  pos:=Mouse.CursorPos;
  Pos:=FolderTree.ScreenToClient(Pos);
  FNode:=FolderTree.GetNodeAt(Pos.X,Pos.Y);
  if (FolderTree.Selected<>nil) and (FNode=FolderTree.Selected) then
  begin
    OprList.FolderProperty.Node:=FolderTree.Selected;
    if OprList.FolderProperty.IsFile=1 then
      TheOprList.ViewNode(FolderTree.Selected.StateIndex);
  end;
end;

procedure Tmainfrm.SpTBXItem47Click(Sender: TObject);
begin
  Screen.Cursor:=crHourGlass;
  try
    OprList.OperFrm('SaveText',Application.MainForm.ActiveMDIChild);
  finally
    Screen.Cursor:=crDefault;
  end;
end;

procedure Tmainfrm.SpTBXItem55Click(Sender: TObject);
begin
  Cascade;
end;

procedure Tmainfrm.SpTBXItem56Click(Sender: TObject);
begin
  Tile;
end;

procedure Tmainfrm.SpTBXItem57Click(Sender: TObject);
begin
  ArrangeIcons;
end;

procedure Tmainfrm.SpTBXItem28Click(Sender: TObject);
begin
  OprList.OperFrm('InsPic',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.SpTBXItem6Click(Sender: TObject);
begin
  OprList.OperFrm('InsSymbol',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.SpTBXItem3Click(Sender: TObject);
var
  FHandle:THandle;
begin
  if FolderTree.IsEditing then
  begin
    FHandle:=TreeView_GetEditControl(FolderTree.Selected.Handle);
    sendMessage(FHandle,wm_copy,0,0);
  end
  else
  OprList.OperFrm('CopyText',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.SpTBXItem12Click(Sender: TObject);
var
  FHandle:THandle;
begin
  if FolderTree.IsEditing then
  begin
    FHandle:=TreeView_GetEditControl(FolderTree.Selected.Handle);
    sendMessage(FHandle,wm_cut,0,0);
  end
  else
    OprList.OperFrm('CutText',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.SpTBXItem11Click(Sender: TObject);
var
  FHandle:THandle;
begin
  if FolderTree.IsEditing then
  begin
    FHandle:=TreeView_GetEditControl(FolderTree.Selected.Handle);
    sendMessage(FHandle,wm_paste,0,0);
  end
  else
    OprList.OperFrm('PasteText',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.Closefrm(IDs: array of integer);
var
  DllHandle:THandle;
  Closefrm:TClosefrm;
begin
  if DllfrmList.DllList.Count<>0 then
  begin
    DLLHandle:=GetModuleHandle('List.dll');
    @Closefrm:=GetProcAddress(DllHandle,'Closefrm');
    Closefrm(IDs);
  end;

  if DllfrmList.DllTxt.Count<>0 then
  begin
    DLLHandle:=GetModuleHandle('Ft.dll');
    @Closefrm:=GetProcAddress(DllHandle,'Closefrm');
    Closefrm(IDs);
  end;
end;

procedure Tmainfrm.SpTBXItem26Click(Sender: TObject);
begin
  OprList.OperFrm('SelectAll',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.SpTBXItem23Click(Sender: TObject);
begin
  OprList.OperFrm('Undo',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.SpTBXItem7Click(Sender: TObject);
begin
  OprList.OperFrm('Redo',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.SpTBXItem32Click(Sender: TObject);
begin
  OprList.OperFrm('DeleteSelection',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.SpTBXItem61Click(Sender: TObject);
begin
  OprList.OperFrm('InsertBreak',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.DoOnMenuDllItemClick(sender: TObject);
var
  i:integer;
begin
  LockWindowUpdate(Handle);
  try
    TSpTBXItem(sender).Checked:=true;
    for i:=0 to MDIChildCount-1 do
    begin
      if TDllfrm(MDIChildren[i]).ID=TSpTBXItem(sender).Tag then
      begin
        MDIChildren[i].BringToFront;
        break;
      end
    end;
  finally
    LockWindowUpdate(0);
  end;
end;

procedure Tmainfrm.SpTBXItem60Click(Sender: TObject);
begin
  OprList.OperFrm('InsertFile',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.SpTBXItem20Click(Sender: TObject);
begin
  OprList.OperFrm('SearchText',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.SpTBXItem21Click(Sender: TObject);
begin
  OprList.OperFrm('SearchTextNext',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.SpTBXItem22Click(Sender: TObject);
begin
  OprList.OperFrm('Replace',Application.MainForm.ActiveMDIChild);
end;

procedure Tmainfrm.FolderTreeDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  FNode:TTreeNode;
  TheNode:TTreeNode;
begin
  Accept:=false;
  FNode:=FolderTree.GetNodeAt(X,Y);
  TheNode:=TTreeNode(TTreeView(Sender).Selected);
  if (FNode<>nil) and (TheNode<>nil) then
  begin
    if (TheNode<>FNode) and (TheNode.Parent<>FNode) then
    begin
      OprList.FolderProperty.Node:=FNode;
      Accept:=OprList.FolderProperty.IsFile=0;
    end;
  end;
end;

procedure Tmainfrm.FolderTreeDragDrop(Sender, Source: TObject; X,
  Y: Integer);
var
  NewNode,FNode:TTreeNode;
  TheNode:TTreeNode;
  DoCopy,HasLockNode:Boolean;
  CtrlState:Byte;
  TheText:string;
  function CheckRepeatName(ANode:TTreeNode;AText:string):Boolean;
  var
    j:integer;
  begin
    result:=false;
    for j:=0 to ANode.Count-1 do
    begin
      if ANode.Item[j].Text=AText then
      begin
        result:=true;
        break;
      end;
    end;
  end;

  function NodeIsLock(ANode:TTreeNode;ShowMsg:Boolean):Boolean;
  begin
    result:=false;
    OprList.FolderProperty.Node:=ANode;
    if OprList.FolderProperty.IsLocked then
    begin
      if ShowMsg then
        MessageBox(mainfrm.Handle,pchar('“'+ANode.Text+'”已被加密，'+TheText+'失败！'), '提示', MB_ICONASTERISK or MB_OK);
      result:=true;
    end;
  end;

  procedure NodesHasLock(ANode:TTreeNode;var AHasLockNode:Boolean);
  var
    i:integer;
  begin
    for i:=0 to ANode.Count-1 do
    begin
      if NodeIsLock(ANode.Item[i],false) then
      begin
        AHasLockNode:=NodeIsLock(ANode.Item[i],false);
        exit;
      end;
      if ANode.Item[i].HasChildren then
        NodesHasLock(ANode.Item[i],AHasLockNode);
    end;
  end;

  procedure CopyAllSubNode(AParentNode,ANode:TTreeNode);
  var
    i:integer;
    tmpNode:TTreeNode;
    SubHasLockNode:Boolean;
    s:string;
  begin
    for i:=ANode.Count-1 downto 0 do
    begin
      SubHasLockNode:=false;
      if not NodeIsLock(ANode.Item[i],false) then
      begin
        NodesHasLock(ANode.Item[i],SubHasLockNode);
        s:=ANode.Item[i].Text;
        tmpNode:=CopySingleNode(AParentNode,ANode.Item[i],DoCopy or SubHasLockNode);
        s:=tmpNode.Text;
        if ANode.Item[i].HasChildren then
        begin
          CopyAllSubNode(tmpNode,ANode.Item[i]);
        end;
        if (not SubHasLockNode) and (not DoCopy) then
          ANode.Item[i].Delete;
      end;
    end;
  end;
begin
  DoCopy:=false;
  HasLockNode:=false;
  FNode:=FolderTree.GetNodeAt(X,Y);
  TheNode:=TTreeView(Sender).Selected;
                     
  CtrlState:=GetKeyState(VK_Control);
  if CtrlState and $F0=$80 then
  begin
    DoCopy:=true;
    TheText:='复制';
  end
  else if CtrlState and $F0=$00 then
  begin
    DoCopy:=false;
    TheText:='移动';
  end;

  if (FNode<>nil) and (TheNode<>nil) then
  begin
    if CheckRepeatName(FNode,THeNode.Text) then
    begin