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

📄 uhintimp.pas

📁 一个基于不需引擎的文件管理系统,使用了许多界面比较好的控件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit uHintImp;

interface

uses
  SysUtils, Windows, Messages, Classes,uIHintInf,Controls,uDllfrmList,DB,ufrmHintPopup,
  Forms,uHintsfrm,uBasefrm,uCustom,uPDA,TBX,SpTBXItem,TB2Dock,TB2Item,TBXDkPanels,uPlugInManager,
  SpTBXDkPanels,Dialogs,ExtCtrls,uLinkMan,uProperty,uFolderProperty,ComCtrls,StdCtrls;

type
  TOpenFileEvent=procedure(sender:TObject;ID:integer;FormStyle:TFormStyle) of object;
  TSaveAsFileEvent=procedure(sender:TObject;ID,ParentID:integer;FileName:string) of object;

  TOprList = class(TInterfacedObject,IOprList)
  private
    FCaption:string;
    FApplication:TApplication;
    FScreen:TScreen;
    FHintWindow:THintWindowClass;
    FDllfrmList:TDllfrmList;
    FTaskData: PTaskData;
    FTaskList:TList;
    FLargeImageList:TImageList;
    FNewFileID:integer;
    FNewFileName:string;
    FFileType:integer;
    FOwnerfrm: TForm;
    FOnOpenFile: TOpenFileEvent;
    FNewFileParentID: integer;
    FNewFilePro: integer;
    FOnSaveAsFile: TSaveAsFileEvent;

    procedure SetOwnerfrm(const Value: TForm);
    procedure SetOnOpenFile(const Value: TOpenFileEvent);
    procedure SetNewFileName(const Value: string);
    procedure SetNewFileID(const value:integer);
    function GetNewFileID:integer;
    function GetNewFileName:string;
    procedure SetNewFileParentID(const Value: integer);
    procedure SetNewFilePro(const Value: integer);
    procedure SetOnSaveAsFile(const Value: TSaveAsFileEvent);
  protected
    function GetCaption:string;stdcall;
    function GetApplication:TApplication;stdcall;
    function GetScreen:TScreen;stdcall;
    function GetHintWindow:THintWindowClass;stdcall;
    function GetDllfrmList:TDllfrmList;stdcall;
    function GetTaskData:PTaskData;stdcall;
    procedure SetTaskData(const value:PTaskData);stdcall;
    function GetTaskList:TList;stdcall;
    function GetImageList: TImageList;stdcall;
    procedure SetImageList(const Value: TImageList);stdcall;
    procedure DoOnOpenFile(sender:TObject;ID:integer;FormStyle:TFormStyle);
    procedure DoOnSaveAsFile(sender:TObject;ID,ParentID:integer;FileName:string);
  public
    Mp3Bar:TTBXToolbar;
    FolderProperty:TFolderProperty;
    PlugInManager:TPlugInManager;

    constructor create;
    destructor destroy;override;

    function GetMaxID(TableName:string):integer;
    procedure OperFrm(Command:string;frm:TForm);

    function GetData(AfrmType:frmType;params:variant):OLEVariant;stdcall;
    function Createfrm(AData:Pointer;AcmdType:cmdType;AfrmType:frmType):Boolean;stdcall;
    function GetSecPlugList:TInterfaceList;stdcall;
    function DelNode(ID:integer;AfrmType:frmType):Boolean;stdcall;
    function AddNode(ID:integer;IsFile:byte):TTreeNode;stdcall;
    function FindNode(ID:integer):TTreeNode;stdcall;
    procedure CreatewMenu(AID:integer;Acaption:string);stdcall;
    procedure DeletewMenu(AID:integer);stdcall;
    procedure RefreshwMenu(AID,ANewID:integer;Acaption:string);stdcall;
    procedure ViewNode(ID:integer);stdcall;
    procedure UpdateFile(Text:TStream;ID:integer;const ActiveForm:TComponent);stdcall;
    procedure ReadFile(Text:TStream;ID:integer);stdcall;
    function ShowSaveDlg:Boolean;stdcall;
    procedure OpenFile(Opr:IOprList;ID:integer;FormStyle:TFormStyle);
    function GetFileReadOnly(ID:integer):Boolean;stdcall;
    procedure InsAccessories(Bin:TStream;ID,FileID:integer;FileName:string);stdcall;
    procedure DelAccessories(ID,FileID:integer);stdcall;
    function ReadAccessoryList(ID:integer):OLEVariant;stdcall;
    procedure DownLoad(Bin:TStream;ID,FileID:integer);stdcall;
    procedure SaveFileTextToDB(Text:TStream);stdcall;
    procedure ReadFileTextFromDB(Text:TStream);stdcall;
    function GetFileType:integer;stdcall;
    procedure SetFileType(const Value:integer);stdcall;    
    function GetDllListHandle:THandle;
    procedure RunListfrm(index,FoldersID:integer;caption:string);stdcall;
    procedure NewTaskData;stdcall;
    procedure ShowHint(Data:PTaskData);stdcall;
    property Application:TApplication read GetApplication write FApplication;
    property Screen:TScreen read GetScreen write FScreen;
    property Caption:string read GetCaption write FCaption;
    property DllfrmList:TDllfrmList read GetDllfrmList write FDllfrmList;
    property HintWindow:THintWindowClass read GetHintWindow write FHintWindow;
    property TaskData:PTaskData read GetTaskData write SetTaskData;
    property TaskList:TList read GetTaskList write FTaskList;
    property LargeImageList:TImageList read GetImageList write SetImageList;
    property Ownerfrm:TForm read FOwnerfrm write SetOwnerfrm;
    property OnOpenFile:TOpenFileEvent read FOnOpenFile write SetOnOpenFile;
    property OnSaveAsFile:TSaveAsFileEvent read FOnSaveAsFile write SetOnSaveAsFile;
    property NewFileID:integer read GetNewFileID write SetNewFileID;
    property NewFileName:string read GetNewFileName write SetNewFileName;
    property NewFileParentID:integer read FNewFileParentID write SetNewFileParentID;
    property NewFilePro:integer read FNewFilePro write SetNewFilePro;
    property FileType:integer read GetFileType write SetFileType;
  end;

type
  TShowListfrm=procedure(index:integer;OprList:IOprList;FoldersID:integer);stdcall;
  TShowTxtfrm=procedure(OprList:IOprList;FoldersID:integer;FormStyle:TFormStyle);stdcall;
  TOperFrm=procedure(frm:TForm);stdcall;

implementation

uses uSECData,uMain, uOpenfrm;

{ TOprHint }

function TOprList.Createfrm(AData:Pointer;Acmdtype:cmdType;AfrmType:frmType):Boolean;
var
  frm:TBaseForm;
begin
  Screen.Cursor:=crHourGlass;
  try
    case AfrmType of
      fmPDA:
        frm:=TPDAfrm.Create(nil);
      fmTask:
        frm:=TfrmHint.Create(nil);
      fmWebLink,fmMp3,fmImage:
        frm:=TCustomfrm.Create(nil);
      fmLinkMan:
        frm:=TLinkManfrm.Create(nil);
      fmFolder:
      begin
        frm:=TfrmProperty.Create(nil);
        TfrmProperty(frm).FolderProperty:=FolderProperty;
        if AData<>nil then
          TfrmProperty(frm).FolderProperty.Node:=FindNode(PFolderData(AData)^.ID);
      end;
    end;
    frm.Data:=AData;
    frm.TheCmd:=Acmdtype;
    frm.TheForm:=AfrmType;
  finally
    Screen.Cursor:=crDefault;
  end;
  if frm.ShowModal= mrok then
    result:=true
  else
    result:=false;
  freeandnil(frm);
end;

function TOprList.DelNode(ID:integer;AfrmType:frmType): Boolean;
var
  i:integer;
  //index,parentindex:integer;
begin
  if AfrmType=fmFolder then
  begin
    FolderProperty.FindNodeByID(ID);
    if FolderProperty.IsLocked then
    begin
      MessageBox(Application.Handle,pchar('“'+FolderProperty.Node.Text+'”'+'已加密,不能删除。'), '提示', MB_ICONINFORMATION or MB_OK);
      result:=false;
      exit;
    end;
    //index:=FolderProperty.Node.StateIndex;
    result:=FolderProperty.DelFolder(FolderProperty.Node);
    exit;
  end;

  with SECData do
  begin
    if qryTmp.Active then
      qryTmp.Close;
    qryTmp.SQL.Clear;
    case AfrmType of
      fmPDA:
        qryTmp.SQL.Text:='delete from PDAApp'+#13+
                         'where ID=:ID';
      fmTask:
        qryTmp.SQL.Text:='delete from Hints'+#13+
                         'where ID=:ID';
      fmWebLink:
        qryTmp.SQL.Text:='delete from WebLink'+#13+
                         'where ID=:ID';
      fmMp3:
        qryTmp.SQL.Text:='delete from Mp3List'+#13+
                         'where ID=:ID';
      fmImage:
        qryTmp.SQL.Text:='delete from PicList'+#13+
                         'where ID=:ID';
      fmLinkMan:
        qryTmp.SQL.Text:='delete from LinkMan'+#13+
                         'where ID=:ID';
    end;
    qryTmp.ParamByName('ID').AsInteger:=ID;
    try
      qryTmp.ExecSQL;
      if AfrmType=fmTask then
      begin
        for i:=0 to FTaskList.Count-1 do
          if PTaskData(FTaskList.Items[i])^.ID=ID then
          begin
            FTaskList.Delete(i);
            break;
          end;
      end;
      result:=true;
    except
      result:=false;
    end;
  end;
end;

function TOprList.GetApplication: TApplication;
begin
  result:=FApplication;
end;

function TOprList.GetCaption: string;
begin
  result:=FCaption;
end;

function TOprList.GetDllfrmList: TDllfrmList;
begin
  result:=FDllfrmList;
end;

function TOprList.GetData(AfrmType:frmType;Params:variant): OLEVariant;
var
  i:integer;
begin
  SECData.qryTmp.Close;
  SECData.DP.DataSet:=SECData.qryTmp;
  SECData.qryTmp.SQL.Clear;
  case AfrmType of
    fmPDA:
      SECData.qryTmp.SQL.Text:='select * from PDAApp order by Name';
    fmTask:
      SECData.qryTmp.SQL.Text:='select * from Hints order by Name';
    fmWebLink:
      SECData.qryTmp.SQL.Text:='select * from WebLink order by Name';
    fmMp3:
      SECData.qryTmp.SQL.Text:='select * from Mp3List order by Name';
    fmImage:
      SECData.qryTmp.SQL.Text:='select * from PicList order by Name';
    fmLinkMan:
      SECData.qryTmp.SQL.Text:='select ID,Name,Address,Phone,Fax,EMail from LinkMan order by Name';
    fmFolder:
      SECData.qryTmp.SQL.Text:='select ID,Text,CreateDate,Pro,Locked,IsFile from Folders '+#13+
                               'where UPID=:UpID '+#13+
                               'order by IsFile Asc,Locked Asc,Text Asc';
  end;
  for i:=0 to SECData.qryTmp.ParamCount-1 do
    SECData.qryTmp.Params[i].Value:=Params[i];
  //SECData.qryTmp.Open;
  result:=SECData.DP.Data;
end;

function TOprList.GetHintWindow: THintWindowClass;
begin
  Result := FHintWindow;
end;

function TOprList.GetScreen: TScreen;
begin
  result:=FScreen;
end;

function TOprList.GetTaskData: PTaskData;
begin
  result:=FTaskData;
end;

procedure TOprList.NewTaskData;
begin
  new(FTaskData);
end;

function TOprList.GetTaskList: TList;
begin
  result:=FTaskList;
end;

constructor TOprList.create;
begin
  FTaskList:=TList.Create;
  FolderProperty:=TFolderProperty.Create;
  OnOpenFile:=DoOnOpenFile;
  OnSaveAsFile:=DoOnSaveAsFile;

  PlugInManager:=TPlugInManager.create;
  PlugInManager.LoadMainPlugIn; 
end;

destructor TOprList.destroy;
begin
  FTaskList.Free;
  FolderProperty.Free; 
  inherited destroy;
end;

procedure TOprList.SetTaskData(const value: PTaskData);
begin
  FTaskData:=Value;
end;

function TOprList.GetImageList: TImageList;
begin
  result:=FLargeImageList;
end;

procedure TOprList.SetImageList(const Value: TImageList);
begin
  FLargeImageList:=value;
end;

procedure TOprList.SetOwnerfrm(const Value: TForm);
begin
  FOwnerfrm := Value;
end;

function TOprList.AddNode(ID: integer;IsFile:Byte):TTreeNode;
var
  FNode:TTreeNode;
  NodeID:integer;
  FolderName:string;
  UpID,Level:integer;
begin
  FNode:=self.FindNode(ID);
  if FNode<>nil then
  begin
    UpID:=FNode.StateIndex;
    Level:=FNode.Level+1;
  end
  else
  begin
    UpID:=-1;
    Level:=0;
  end;
  NodeID:=GetMaxID('Folders');
  FolderName:=FolderProperty.SetFolderName(FNode,IsFile);
  SECData.InsTree.ParamByName('ID').AsInteger :=NodeID;
  SECData.InsTree.ParamByName('UPID').AsInteger :=UpID;
  SECData.InsTree.ParamByName('Text').AsString :=FolderName;
  SECData.InsTree.ParamByName('CreateDate').AsDateTime :=Now;
  SECData.InsTree.ParamByName('Pro').AsInteger:=Level;
  SECData.InsTree.ParamByName('IsFile').AsInteger:=IsFile;
  SECData.InsTree.ExecSQL;

  result:=FolderProperty.FolderTree.Items.AddChild(FNode,FolderName);
  with result do
  begin
    StateIndex:=NodeID;
    ImageIndex:=2*IsFile;
    SelectedIndex:=2*IsFile;
  end;
end;

function TOprList.GetMaxID(TableName: string): integer;
var
  s:string;
begin
  s:='select Max(ID)+1 from %s';
  SECData.qryGetMaxID.SQL.Text :=format(s,[TableName]);
  SECData.qryGetMaxID.Open;
  result:=SECData.qryGetMaxID.Fields[0].AsInteger;
  SECData.qryGetMaxID.Close;
end;

function TOprList.FindNode(ID: integer): TTreeNode;
var
  i:integer;
begin
  result:=nil;
  for i:=0 to FolderProperty.FolderTree.Items.Count-1 do
    if FolderProperty.FolderTree.Items.item[i].stateindex=ID then
    begin
      result:=FolderProperty.FolderTree.Items.item[i];
      break;
    end;
end;

procedure TOprList.ViewNode(ID :integer);
var
  Node:TTreeNode;
  i:integer;
begin
  for i:=0 to mainfrm.MDIChildCount-1 do
  begin
    if ID=TDllfrm(mainfrm.MDIChildren[i]).ID then
    begin
      mainfrm.MDIChildren[i].BringToFront;
      exit;
    end;
  end;

  Node:=FindNode(ID);
  if Node<>nil then
  begin
    FolderProperty.Node:=Node;
    if FolderProperty.IsFile=1 then
    begin
      if (FolderProperty.IsLocked) then
        if not FolderProperty.EnterFolder then
          exit;
      if assigned(FOnOpenFile) then
        FOnOpenFile(self,ID,fsMDIChild);
    end
    else
    begin
      if (FolderProperty.IsLocked) then
        if (not FolderProperty.Node.Expanded) then
          if (not FolderProperty.EnterFolder) then
            exit;
      RunListfrm(0,ID,FolderProperty.Node.Text);
    end;
  end;
end;

function TOprList.GetDllListHandle: THandle;
var
  DLLHandle:THandle;
begin
  if uDllfrmList.DllfrmList.DllList.Count=0 then
  begin
    DLLHandle := LoadLibrary('List.dll');
  end
  else
    DLLHandle:=GetModuleHandle('List.dll');
  result:=DllHandle;
end;

procedure TOprList.RunListfrm(index, FoldersID: integer;caption:string);
var
  ShowListfrm:TShowListfrm;
  DLLHandle:THandle;
begin
  DllHandle:=GetDllListHandle;
  Screen.Cursor:=crHourGlass;
  LockWindowUpdate(mainfrm.Handle);
  try
    if DLLHandle<>0 then
    begin
      begin
        FCaption:=caption;
        @ShowListfrm:=GetProcAddress(DllHandle,'ShowListfrm');
        if @ShowListfrm<>nil then
        begin
          ShowListfrm(index,self,FoldersID);
        end;
      end;
    end;
  finally
    LockWindowUpdate(0);
    Screen.Cursor:=crDefault;
  end;
end;

procedure TOprList.SetOnOpenFile(const Value: TOpenFileEvent);
begin
  FOnOpenFile := Value;
end;

procedure TOprList.DoOnOpenFile(sender: TObject; ID: integer;FormStyle:TFormStyle);
begin
  self.OpenFile(self,ID,FormStyle);
end;

procedure TOprList.UpdateFile(Text:TStream;ID:integer;const ActiveForm:TComponent);
begin
  if ID>0 then
  begin
    SecData.qryTmp.Close;
    SecData.qryTmp.SQL.Clear;
    SecData.qryTmp.SQL.Text:='update Folders'+#13+

⌨️ 快捷键说明

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