uhintimp.pas

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

                             'set Memo=:Memo'+#13+
                             'where ID=:ID';
    SecData.qryTmp.ParamByName('Memo').LoadFromStream(TMemoryStream(Text),ftBlob);
    SecData.qryTmp.ParamByName('ID').AsInteger:=ID;
    SecData.qryTmp.ExecSQL;
  end
  else
  begin
    if NewFileID=-1 then
    begin
      NewFileID:=GetMaxID('Folders');
      SecData.qryTmp.Close;
      SecData.qryTmp.SQL.Clear;
      SecData.qryTmp.SQL.Text:='insert into folders(ID,UPID,Text,CreateDate,Pro,IsFile,Memo)'+#13+
                               ' values(:ID,:UPID,:Text,:CreateDate,:Pro,1,:Memo)';
      SecData.qryTmp.ParamByName('ID').AsInteger:=NewFileID;
      SecData.qryTmp.ParamByName('UpID').AsInteger:=NewFileParentID;
      SecData.qryTmp.ParamByName('Text').AsString:=NewFileName;
      SecData.qryTmp.ParamByName('Pro').AsInteger:=NewFilePro;
      SecData.qryTmp.ParamByName('CreateDate').AsDateTime:=Now;
      SecData.qryTmp.ParamByName('Memo').LoadFromStream(TMemoryStream(Text),ftBlob);
      SecData.qryTmp.ExecSQL;
      if assigned(FOnSaveAsFile) then
        FOnSaveAsFile(self,NewFileID,NewFileParentID,NewFileName);
    end
    else
    begin
      UpdateFile(Text,NewFileID,ActiveForm); //另存为
    end;

    if ActiveForm<>nil then
    begin
      RefreshwMenu(TDllfrm(ActiveForm).ID,NewFileID,NewFileName);
      TDllfrm(ActiveForm).Caption:=NewFileName;
      TDllfrm(ActiveForm).ID:=NewFileID;
    end;

    NewFileID:=-1;
    NewFileName:='';
    NewFileParentID:=-1;
    NewFilePro:=-1;
  end;
end;

procedure TOprList.ReadFile(Text:TStream;ID: integer);
var
  FText:TStream;
begin
  SecData.qryTmp.Close; 
  SecData.qryTmp.SQL.Clear;
  SecData.qryTmp.SQL.Text:='select Memo from Folders where ID=:ID';
  SecData.qryTmp.ParamByName('ID').AsInteger:=ID;
  SecData.qryTmp.Open;
  FText:=SecData.qryTmp.CreateBlobStream(SECData.qryTmp.Fields[0],bmRead);
  Text.CopyFrom(FText,FText.Size);
  FText.Free;
  SecData.qryTmp.Close;
end;

procedure TOprList.OperFrm(Command: string;frm:TForm);
var
  DllHandle:THandle;
  TheOperFrm:TOperfrm;
begin
  if (frm<>nil) and (TDllfrm(frm).DllType=atext) then
  begin
    DllHandle:=GetModuleHandle('ft.dll');
    if DllHandle<>0 then
    begin
      @TheOperFrm:=GetProcAddress(DllHandle,pchar(Command));
      if @TheOperFrm<>nil then
        TheOperFrm(frm);
    end;
  end;
end;

procedure TOprList.ShowHint(Data:PTaskData);
var
  r: TRect;
  i:integer;
  Cnt:integer;
  procedure SetLabelCaption(AParent:TForm;ALabel: TTBXLabel; ACaption: string);
  var
    s,t:string;
    p:pchar;
    SLen,NewLen:integer;
    i:integer;
    lab:TLabel;
  begin
    lab:=TLabel.Create(AParent);
    lab.Parent:=AParent;
    lab.Font.Assign(ALabel.Font);
    p:=pchar(ACaption); //不能用s:=Acaption,如果Acaption是dll传过来的，很有可能指针会丢失
    s:=strpas(p);
    SLen:=lab.Canvas.TextWidth(s);
    if SLen>Alabel.Width then
    begin
      NewLen:=0;
      i:=1;
      ALabel.Hint:=s;
      ALabel.ShowHint:=true;
      while true do
      begin
        if ByteType(s,i)=mbSingleByte then
        begin
          NewLen:=NewLen+lab.Canvas.TextWidth(s[i]);
          inc(i);
        end
        else if ByteType(s,i)=mbLeadByte then
        begin
          if i<length(s) then
          begin
            t:=s[i]+s[i+1];
            NewLen:=NewLen+lab.Canvas.TextWidth(t);
            inc(i,2);
          end;
        end
        else if ByteType(s,i)=mbTrailByte then
        begin
          if i>0 then
          begin
            t:=s[i-1]+s[i];
            NewLen:=NewLen+lab.Canvas.TextWidth(t);
            inc(i,2);
          end;
        end;

        if NewLen=Alabel.Width-lab.Canvas.TextWidth('...') then
        begin
          break;
        end
        else if NewLen>Alabel.Width-lab.Canvas.TextWidth('...') then
        begin
          dec(i);
          break;
        end;
        if i>length(s) then
          break;
      end;
      s:=copy(s,1,i-1);
      if ByteType(s,length(s))=mbLeadByte then
        s:=copy(s,1,length(s)-1);

      Alabel.caption:=s+'...';
    end
    else
      Alabel.Caption:=s;
    lab.Free;
  end;
  procedure BuildHintfrm(Col,Row: integer);
  var
    frm:TfrmHintPopup;
  begin
    frm:=TfrmHintPopup.Create(nil);
    frm.SetPos;
    frm.Top:=frm.STop-Row*frm.Height+frm.Height;
    frm.Left:=frm.SLeft-Col*frm.Width;
    frm.TBXDockablePanel1.Caption:='提醒（'+Data^.Caption+'）';
    SetLabelCaption(frm,frm.lbCaption,Data^.Text);
    frm.Show; 
    inc(frmCount);
    RowHeight:=frm.Height;
    frm.AutoSize:=false;
    frm.Height:=0;
    frm.ShowFlow;
  end;
begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0);
  if RowHeight<>0 then
    RowMax:=r.Bottom div RowHeight
  else
    RowMax:=-1;

  Cnt:=0;
  for i:=0 to Screen.FormCount-1 do
    if Screen.Forms[i] is TfrmHintPopup then
      inc(Cnt);
  if Cnt=0 then
    frmCount:=0;
  BuildHintfrm(frmCount div RowMax,frmCount mod RowMax);
end;

procedure TOprList.InsAccessories(Bin: TStream; ID, FileID: integer;
  FileName: string);
var
  PFileName:pchar;
begin
  Screen.Cursor:=crHourGlass;
  try
    Mainfrm.Update;
    PFileName:=Pchar(FileName);
    SecData.qryTmp.SQL.Clear;
    SecData.qryTmp.SQL.Text:='insert into Accessories(ID,FileID,FileName,Bin)'+#13+
                             'values(:ID,:FileID,:FileName,:Bin)';
    SecData.qryTmp.ParamByName('ID').AsInteger:=ID;
    SecData.qryTmp.ParamByName('FileID').AsInteger:=FileID;
    SecData.qryTmp.ParamByName('FileName').AsString:=PFileName;
    SecData.qryTmp.ParamByName('Bin').LoadFromStream(TMemoryStream(Bin),ftBlob);
    SecData.qryTmp.ExecSQL;
  finally
    Screen.Cursor:=crDefault;
  end;
end;

function TOprList.ReadAccessoryList(ID: integer): OLEVariant;
begin
  SECData.qryTmp.Close;
  SECData.DP.DataSet:=SECData.qryTmp;
  SECData.qryTmp.SQL.Clear;
  SECData.qryTmp.SQL.Text:='select FileID,FileName from Accessories where ID=:ID';
  SECData.qryTmp.ParamByName('ID').AsInteger:=ID;
  //SECData.qryTmp.Open;
  result:=SECData.DP.Data; 
end;

procedure TOprList.DownLoad(Bin: TStream; ID, FileID: integer);
var
  FBin:TStream;
begin
  Screen.Cursor:=crHourGlass;
  try
    Mainfrm.Update; 
    SECData.qryTmp.Close;
    SECData.qryTmp.SQL.Clear;
    SECData.qryTmp.SQL.Text:='select Bin from Accessories'+#13+
                             'where ID=:ID and FileID=:FileID';
    SECData.qryTmp.ParamByName('ID').AsInteger:=ID;
    SECData.qryTmp.ParamByName('FileID').AsInteger:=FileID;
    SECData.qryTmp.Open;
    FBin:=SecData.qryTmp.CreateBlobStream(SECData.qryTmp.Fields[0],bmRead);
    Bin.CopyFrom(FBin,FBin.Size);
    FBin.Free;
    SECData.qryTmp.Close;
  finally
    Screen.Cursor:=crDefault;
  end;
end;

procedure TOprList.CreatewMenu(AID: integer; Acaption: string);
var
  MenuItem:TSpTBXItem;
  i:integer;
begin
  for i:=3 to mainfrm.mWindow.Count-1 do
  begin
    if (mainfrm.mWindow.Items[i].Tag=AID) and (mainfrm.mWindow.Items[i] is TSpTBXItem) then
    begin
      mainfrm.mWindow.Items[i].Checked:=true;
      exit;
    end;
  end;
  MenuItem:=TSpTBXItem.Create(mainfrm.mWindow);
  MenuItem.Caption:=Acaption;
  MenuItem.Tag:=AID;
  MenuItem.GroupIndex:=1;
  MenuItem.OnClick:=mainfrm.DoOnMenuDllItemClick;
  mainfrm.mWindow.Add(MenuItem);
  MenuItem.Checked:=true;
end;

procedure TOprList.DeletewMenu(AID: integer);
var
  i:integer;
begin
  with mainfrm do
  begin
    for i:=mWindow.Count-1 downto 3 do
    begin
      if (mWindow.Items[i].Tag=AID) and (mWindow.Items[i] is TSpTBXItem) then
      begin
        mWindow.Delete(i);
      end
      else if (ActiveMDIChild<>nil) and (mWindow.Items[i].Tag=TDllfrm(ActiveMDIChild).ID) and (mWindow.Items[i] is TSpTBXItem) then
      begin
        mWindow.Items[i].Checked:=true;
      end;
    end;
  end;
end;

procedure TOprList.RefreshwMenu(AID,ANewID:integer;Acaption:string);
var
  i:integer;
begin
  with mainfrm do
  begin
    for i:=mWindow.Count-1 downto 3 do
    begin
      if (ActiveMDIChild<>nil) and (mWindow.Items[i] is TSpTBXItem) then
      begin
        if (mWindow.Items[i].Tag=TDllfrm(ActiveMDIChild).ID) then
        begin
          mWindow.Items[i].Checked:=true;
        end;

        if (mWindow.Items[i].Tag=AID) then
        begin
          (mWindow.Items[i] as TSpTBXItem).Caption:=Acaption;
          (mWindow.Items[i] as TSpTBXItem).Tag:=ANewID;
        end;
      end;
    end;
  end;
end;

function TOprList.GetFileReadOnly(ID: integer): Boolean;
begin
  SecData.qryTmp.SQL.Clear;
  SecData.qryTmp.SQL.Text:='select ReadOnly from Folders where ID=:ID';
  SecData.qryTmp.ParamByName('ID').AsInteger:=ID;
  SecData.qryTmp.Open;
  result:=SeCData.qryTmp.Fields[0].AsInteger=1;
  SecData.qryTmp.Close;
end;

function TOprList.GetNewFileID:integer;
begin
  result:=FNewFileID;
end;

function TOprList.GetNewFileName:string;
begin
  result:=FNewFileName;
end;

procedure TOprList.SetNewFileID(const Value: integer);
begin
  FNewFileID:=Value;
end;

procedure TOprList.SetNewFileName(const Value: string);
begin
  FNewFileName:=Value;
end;

procedure TOprList.SetNewFileParentID(const Value: integer);
begin
  FNewFileParentID := Value;
end;

procedure TOprList.SetNewFilePro(const Value: integer);
begin
  FNewFilePro := Value;
end;

procedure TOprList.SetOnSaveAsFile(const Value: TSaveAsFileEvent);
begin
  FOnSaveAsFile := Value;
end;

procedure TOprList.DoOnSaveAsFile(sender: TObject; ID, ParentID: integer;
  FileName: string);
var
  FNode:TTreeNode;
begin
  FNode:=FindNode(ParentID);
  if FNode<>nil then
  begin
    with FolderProperty.FolderTree.Items.AddChild(FNode,FileName) do
    begin
      StateIndex:=ID;
      ImageIndex:=2;
      SelectedIndex:=2;
    end;
  end;
  mainfrm.RefreshItemInDllfrm(integer(fmFolder),'',false,ParentID,-1);
end;

procedure TOprList.OpenFile(Opr: IOprList; ID: integer;FormStyle:TFormStyle);
var
  DllHandle:THandle;
  ShowTxtfrm:TShowTxtfrm;
begin
  Screen.Cursor:=crHourGlass;
  LockWindowUpdate(mainfrm.Handle);
  try
    if uDllfrmList.DllfrmList.DllTxt.Count>0 then
      DllHandle:=GetModuleHandle('ft.dll')
    else
      DllHandle:=LoadLibrary('ft.dll');
    if DllHandle<>0 then
    begin
      @ShowTxtfrm:=GetProcAddress(DllHandle,'ShowTxtfrm');
      if @ShowTxtfrm<>nil then
      begin
        if ID>0 then
          FCaption:=FolderProperty.Node.Text
        else
          FCaption:='新建文件';  
        ShowTxtfrm(Opr,ID,FormStyle);
      end;
    end;
  finally
    LockWindowUpdate(0);
    Screen.Cursor:=crDefault;
  end;
end;

function TOprList.ShowSaveDlg:Boolean;
var
  frm:TfrmOpenDlg;
begin
  frm:=TfrmOpenDlg.Create(nil);
  try
    frm.Init;
    frm.OpenModel:=false;
    if frm.ShowModal=mrOk then
    begin
      FNewFileID:=frm.ID;
      FNewFileName:=frm.FileName;
      FNewFileParentID:=frm.ParentID;
      FNewFilePro:=frm.Pro;
      result:=true;
    end
    else
      result:=false;
  finally
    frm.Free;
  end;
end;

function TOprList.GetSecPlugList: TInterfaceList;
begin
  result:=PlugInManager.FPlugs;
end;

procedure TOprList.DelAccessories(ID,FileID: integer);
begin
  Screen.Cursor:=crHourGlass;
  try
    SecData.qryTmp.Close;
    SecData.qryTmp.SQL.Clear;
    SecData.qryTmp.SQL.Text:='delete from Accessories where ID=:ID and FileID=:FileID';
    SecData.qryTmp.ParamByName('ID').AsInteger:=ID;
    SecData.qryTmp.ParamByName('FileID').AsInteger:=FileID;
    SecData.qryTmp.ExecSQL;
  finally
    Screen.Cursor:=crDefault;
  end;
end;

procedure TOprList.SaveFileTextToDB(Text: TStream);
begin
  if Text.Size>0 then
  begin
    SecData.qryTmp.Close;
    SecData.qryTmp.SQL.Clear;
    SecData.qryTmp.SQL.Text:='update TempFileText'+#13+
                             '  set Text=:Text'+#13+
                             '  where FileType=:FileType';
    SecData.qryTmp.ParamByName('FileType').AsInteger:=FileType;
    SecData.qryTmp.ParamByName('Text').LoadFromStream(TMemoryStream(Text),ftBlob);
    SecData.qryTmp.ExecSQL;
  end;
end;

procedure TOprList.ReadFileTextFromDB(Text: TStream);
var
  FText:TStream;
begin
  SecData.qryTmp.Close;
  SecData.qryTmp.SQL.Clear;
  SecData.qryTmp.SQL.Text:='select Text from TempFileText where FileType=:FileType';
  SecData.qryTmp.ParamByName('FileType').AsInteger:=FileType;
  SecData.qryTmp.Open;
  FText:=SecData.qryTmp.CreateBlobStream(SECData.qryTmp.Fields[0],bmRead);
  Text.CopyFrom(FText,FText.Size);
  FText.Free;
  SecData.qryTmp.Close;
end;

function TOprList.GetFileType: integer;
begin
  result:=FFileType;
end;

procedure TOprList.SetFileType(const Value: integer);
begin
  FFileType:=Value;
end;

end.