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

📄 mainf.pas

📁 极具实用价值的文件管理系统
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    except
      if dmMain.adcSystem.InTransaction then
        dmMain.adcSystem.RollbackTrans;
    end;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: DeleteDocuments
  Purpose:   Delete Documents
  Arguments: None
  Result:    Boolean
  Author:    Cyclone
  History:   2004-6-15 22:17:35

-----------------------------------------------------------------------------}
function TfmMain.DeleteDocuments: Boolean;
var
  i: Integer;
begin
  Result := False;
  Screen.Cursor := crHourGlass;
  lsvDocuments.OnSelectItem := nil;
  try
    with lsvDocuments.Items do
    begin
      for i := Count - 1 downto 0 do
      begin
        if Item[i].Selected and (PListItemObj(Item[i].Data)^.ItemType = itDocument) then
        begin
          if not DeleteADocument(Item[i]) then
            Exit;
        end;
        Application.ProcessMessages;
      end;
    end;
    actDeleteDocument.Enabled := GetSelectedDocumentCount > 0;
    actEditDocument.Enabled := (lsvDocuments.SelCount = 1) and (PListItemObj(lsvDocuments.Selected.Data)^.ItemType = itDocument);
    actExportDocument.Enabled := actEditDocument.Enabled;
  finally
    lsvDocuments.OnSelectItem := lsvDocumentsSelectItem;
    Screen.Cursor := crDefault;
  end;
  Result := True;
end;

procedure TfmMain.lsvDocumentsCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if TListView(Sender).ViewStyle = vsReport then
  begin
    with Sender.Canvas do
    begin         
      if cdsHot in State then
        Font.Color := clMaroon
      else
        Font.Color := clBlue;
      if Item.Index mod 2 = 0 then
        Brush.Color := $00E1FFE1
      else
        Brush.Color := $00F5DFFD;
    end;
  end;
  DefaultDraw := True;
end;

{-----------------------------------------------------------------------------
  Procedure: InitViewStyle
  Purpose:   Initialize View Style
  Arguments: None
  Result:    None
  Author:    Cyclone
  History:   2004-6-15 23:39:23

-----------------------------------------------------------------------------}
procedure TfmMain.InitViewStyle;
begin
  actIcon.Checked := False;
  actSmallIcon.Checked := False;
  actList.Checked := False;
  actReport.Checked := False;
  actThumbnails.Checked := False;
end;

procedure TfmMain.lsvDocumentsSelectItem(Sender: TObject; Item: TListItem;
  Selected: Boolean);
var
  SelOneItem: Boolean;
  DrawFiled: Boolean;
begin
//  if not Self.Visible then
//    Exit;
  DeleteHistoryFiles(HistoryFileNameList);
  IsAutoFit := False;
  SelOneItem := lsvDocuments.SelCount = 1;
  imgPreview.Visible := SelOneItem;
  SetItemInformationStatus(SelOneItem);
  try
    actDeleteDocument.Enabled := GetSelectedDocumentCount > 0;
    actEditDocument.Enabled := SelOneItem and (PListItemObj(Item.Data)^.ItemType = itDocument);
    actExportDocument.Enabled := actEditDocument.Enabled;
    RefreshSelectedItemsInfo(lsvDocuments);
    if SelOneItem then
    begin
      if pnlSearchTitle.Visible then
        RefershItemInformatoin(Item);
      DrawFiled := DrawFile(pnlPreview, imgPreview, imgFolder, imgWarning, PListItemObj(Item.Data));
      IsAutoFit := IsImage(Item) and DrawFiled;
      if IsAutoFit then
        FitImage(pnlPreview, imgPreview, ftAutoFit)
      else
        AlignCenter(pnlPreview, imgPreview);
      Item.Focused := True;
    end;
  except
    ; //why raise a exception
  end;
end;

procedure TfmMain.trvCategoryMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  ANode: TTreeNode;
  APoint: TPoint;
begin
  inherited;
  if Button = mbRight then
  begin
    ANode := trvCategory.GetNodeAt(X, Y);
    if (ANode <> nil) and (trvCategory.Selected <> ANode) then
    begin
      ANode.Selected := True;
      trvCategory.OnChange(Sender, ANode)
    end;
    GetCursorPos(APoint);
    mnuTreeView.Popup(APoint.X, APoint.Y);
  end;
end;

procedure TfmMain.trvCategoryCustomDrawItem(Sender: TCustomTreeView;
  Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  inherited;

  if Node.Selected then
  begin
    Node.ImageIndex := 0;
    Node.SelectedIndex := 0;
    Node.StateIndex := 0;
  end
  else
  begin
    Node.ImageIndex := 1;
    Node.SelectedIndex := 1;
    Node.StateIndex := 1;
  end;
  DefaultDraw := True;
end;

{-----------------------------------------------------------------------------
  Procedure: WMDropFiles
  Purpose:   WMDropFiles
  Arguments: var Message: TMessage
  Result:    None
  Author:    Cyclone
  History:   2004-7-8 23:43:57

-----------------------------------------------------------------------------}
procedure TfmMain.WMDropFiles(var Message: TMessage);
var
  AFileName: array[0..255] of char;
begin
  if (trvCategory.Selected = nil) or (trvCategory.Selected.AbsoluteIndex = 0) then
    Exit;
  if DragQueryFile(Message.WParam , $ffffffff, nil, 0) = 1 then
  begin
    DragQueryFile(Message.WParam, 0, AFileName, 256);
    if DirectoryExists(StrPas(AFileName)) then //Import From Folder
      ImportFromAFolder(StrPas(AFileName))
    else if FileExists(StrPas(AFileName)) then
      AddADocument(StrPas(AFileName));
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: AddADocument
  Purpose:   Add A Document
  Arguments: const FileName: String
  Result:    None
  Author:    Cyclone
  History:   2004-6-26 12:08:11

-----------------------------------------------------------------------------}
procedure TfmMain.AddADocument(const FileName: String);
var
  CurrentListItemObj: PListItemObj;
  CurrentListItem: TListItem;
begin
  OpenDocuments('');
  fmDocuments := TfmDocuments.Create(Application);
  fmDocuments.OperType := otInsert;
  fmDocuments.CategoryCode := PTreeNodeObj(trvCategory.Selected.Data)^.CategoryCode;
  fmDocuments.CategoryName := dmMain.GetCategoryName(fmDocuments.CategoryCode);
  fmDocuments.FileName := FileName;
  try
    if fmDocuments.ShowModal = mrOK then
    begin
      with dmMain.dsDocuments do
      begin
        CurrentListItem := lsvDocuments.Items.Add;
        CurrentListItem.Caption := FieldByName('DocName').AsString;
        CurrentListItem.SubItems.Add(FieldByName('FileName').AsString);
        CurrentListItem.SubItems.Add(FieldByName('Version').AsString);
        CurrentListItem.SubItems.Add(FieldByName('Creator').AsString);
        CurrentListItem.SubItems.Add(FieldByName('CreateDate').AsString);
        CurrentListItemObj := CreateListItemObj(itDocument, FieldByName('DocNo').AsString,
          FieldByName('DocType').AsString, FieldByName('DocName').AsString,
          FieldByName('FileName').AsString, FieldByName('OriginalExtName').AsString,
          FieldByName('Version').AsString, FieldByName('Remarks').AsString,
          FieldByName('Creator').AsString,
          FieldByName('LastModifier').AsString, FieldByName('CreateDate').AsDateTime,
          FieldByName('LastModifyDate').AsDateTime, FieldByName('ModifyTimes').AsInteger,
          FieldByName('FileSize').AsFloat);
        CurrentListItem.Data := CurrentListItemObj;
        //CurrentListItem.ImageIndex := DocumentIndex;
        CurrentListItem.ImageIndex := GetIconIndex(FieldByName('OriginalExtName').AsString);
      end;
    end;
  finally
    fmDocuments.Free;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: TfmMain.AppOnMessage
  Purpose:   Application Message Process Procedure
  Arguments: var Msg: TMsg; var Handled: Boolean
  Result:    None
  Author:    Cyclone
  History:   2004-6-26 14:20:37

-----------------------------------------------------------------------------}
procedure TfmMain.AppOnMessage(var Msg: TMsg; var Handled: Boolean);
var
  DropFilesMsg: TMessage;
begin
  if Msg.message = WM_DROPFILES then
  begin
    MessageBeep(0);
    DropFilesMsg.Msg    := Msg.message;
    DropFilesMsg.WParam := Msg.wParam;
    DropFilesMsg.LParam := Msg.lParam;
    DropFilesMsg.Result := 0;
    WMDropFiles(DropFilesMsg);
    Handled := True;
  end;
end;

procedure TfmMain.actSystemOptionsExecute(Sender: TObject);
begin
  fmSystemOptions := TfmSystemOptions.Create(Application);
  try
    fmSystemOptions.ShowModal;
    LockWindowUpdate(Handle);
    SkinData1.Active := pUseSkin;
  finally
    fmSystemOptions.Free;
    LockWindowUpdate(0);
  end;
end;

procedure TfmMain.Splitter1Moved(Sender: TObject);
begin
  if imgPreview.Visible then
  begin
    if IsAutoFit then
      FitImage(pnlPreview, imgPreview, ftAutoFit)
    else
      AlignCenter(pnlPreview, imgPreview);
  end;
end;

procedure TfmMain.lsvDocumentsKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  if Key = VK_RETURN then
    lsvDocuments.OnDblClick(Sender)
  else if (Shift = [ssCtrl]) and ((Key = 65) or (Key = 96)) then
  begin
    lsvDocuments.OnSelectItem := nil;
    try
      lsvDocuments.SelectAll;
      actDeleteDocument.Enabled := GetSelectedDocumentCount > 0;
      actEditDocument.Enabled := (lsvDocuments.SelCount = 1) and (PListItemObj(lsvDocuments.Selected.Data)^.ItemType = itDocument);
      actExportDocument.Enabled := actEditDocument.Enabled;
    finally
      lsvDocuments.OnSelectItem := lsvDocumentsSelectItem;
    end;
  end;
end;

{-----------------------------------------------------------------------------
  Procedure: ShellOpenFile
  Purpose:   Shell Open File
  Arguments: AItem: TListItem
  Result:    None
  Author:    Cyclone
  History:   2004-11-29 22:03:57

-----------------------------------------------------------------------------}
procedure TfmMain.ShellOpenFile(AItem: TListItem);
var
  FullFileName,
  TempFileName: String;
begin
  FullFileName := pRootPath + PListItemObj(AItem.Data)^.FileName;
  if not FileExists(FullFileName) then
  begin
    ShowError('Cannot find file: ' + FullFileName);
    Exit;
  end;
  TempFileName := GetSystemTempFileName(GetSystemTempPath, 'Cyc', 10);
  TempFileName := ChangeFileExt(TempFileName, PListItemObj(AItem.Data)^.OriginalExtName);
  DecryptFile(FullFileName, TempFileName, PubFuns.PasswordKey);
  SetFileAttributes(PChar(TempFileName), FILE_ATTRIBUTE_HIDDEN);
  ShellExecute(Handle, 'OPEN', PChar(TempFileName), '', '', SW_SHOWMAXIMIZED);
  HistoryFileNameList.Add(TempFileName);
end;

{-----------------------------------------------------------------------------
  Procedure: TfmMain.SetPanelStatus
  Purpose:   Set Panel Status
  Arguments: const PanelStatus: TPanelStatus
  Result:    None
  Author:    Cyclone
  History:   2004-12-2 22:55:45

-----------------------------------------------------------------------------}
procedure TfmMain.SetPanelStatus(const PanelStatus: TPanelStatus);
begin
  if PanelStatus = psCategory then
  begin
    actCategory.Checked := True;
    actFindDocument.Checked := False;
    pnlSearch.Visible := False;
    trvCategory.Visible := True;
    trvCategory.Align := alClient;
  end
  else
  begin
    actCategory.Checked := False;
    actFindDocument.Checked := True;
    trvCategory.Visible := False;
    pnlSearch.Visible := True;
    pnlSearch.Align := alClient;
    edtDocNo.SetFocus;
  end;
end;

procedure TfmMain.actFindDocumentExecute(Sender: TObject);
begin
  if actFindDocument.Checked then
    SetPanelStatus(psCategory)
  else
    SetPanelStatus(psSearch);
end;

procedure TfmMain.actCategoryExecute(Sender: TObject);
begin
  if actCategory.Checked then
    SetPanelStatus(psSearch)
  else
    SetPanelStatus(psCategory);
end;

{-----------------------------------------------------------------------------
  Procedure: TfmMain.SearchDocuments
  Purpose:   Search Documents
  Arguments: AListView: TListView;
  Result:    None
  Author:    Cyclone
  History:   2004-12-2 23:59:08

-----------------------------------------------------------------------------}
procedure TfmMain.SearchDocuments(AListView: TListView);
var
  CurrentListItem: TListItem;

⌨️ 快捷键说明

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