main.pas

Delphi7数据库开发教程,包含该书21套实例

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, StdCtrls, ToolWin, ShlObj, ImgList, Menus, OleCtrls, SHDocVw,
  ExtCtrls, XPStyleActnCtrls, ActnList, ActnMan, ActnCtrls, ActnMenus,
  StdActns, DateUtils, BandActn;

type
  PDirItem = ^TDirItem;
  TDirItem = record
    ID:Integer;
    CreateDate:TDateTime;
    CreateUser:String;
  end;

  PFileItem = ^TFileItem;
  TFileItem = record
    DirID:PDirItem;
    ID: Integer;
    FileName:String;
    CreateDate: TDateTime;
    CreateUser:String;
    FileType: string;
    FileSize: Integer;
    Password:String;
    OriginalFolder:String;
  end;
  
  TfrmMain = class(TForm)
    CoolBar1: TCoolBar;
    ActionManager1: TActionManager;
    TV: TTreeView;
    Splitter1: TSplitter;
    Panel1: TPanel;
    ListView: TListView;
    StatusBar1: TStatusBar;
    ActionMainMenuBar1: TActionMainMenuBar;
    ActionFileExit: TFileExit;
    MenuImages: TImageList;
    ActionNewDir: TAction;
    ActionDeleteDir: TAction;
    ActionUpLevel: TAction;
    ActionToolBar2: TActionToolBar;
    ActionLargeIcon: TAction;
    ActionSmallIcon: TAction;
    ActionList: TAction;
    ActionReport: TAction;
    CustomizeActionBars1: TCustomizeActionBars;
    ActionCheckIn: TAction;
    SaveDialog1: TSaveDialog;
    OpenDialog1: TOpenDialog;
    ActionDeleteFiles: TAction;
    ActionSave: TAction;
    ActionSaveAs: TAction;
    procedure ListViewKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure Form1Close(Sender: TObject; var Action: TCloseAction);
    procedure ActionNewDirExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure TVEdited(Sender: TObject; Node: TTreeNode; var S: String);
    procedure ActionDeleteDirExecute(Sender: TObject);
    procedure TVChange(Sender: TObject; Node: TTreeNode);
    procedure ActionUpLevelExecute(Sender: TObject);
    procedure ActionLargeIconExecute(Sender: TObject);
    procedure TVKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ActionCheckInExecute(Sender: TObject);
    procedure ActionDeleteFilesExecute(Sender: TObject);
    procedure ActionSaveExecute(Sender: TObject);
    procedure ActionSaveAsExecute(Sender: TObject);
    procedure TVDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TVDragDrop(Sender, Source: TObject; X, Y: Integer);
  private
    FUserName:String;
    procedure DisplayHint(Sender: TObject);   //显示提示信息
    procedure UpdateAbsoluteIndex;
    procedure LoadDirectory;
    procedure DeleteDir(node:TTreeNode);
    procedure DeleteFiles(DirectoryID:Integer);
    procedure ClearListView;
    procedure LoadFileItems(pfi:PFileItem);
    procedure DeleteSelectedFiles;
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

uses ShellAPI, StrUtils, DataModule, DB;

{TForm1}

//GENERAL FORM METHODS

//当创建窗口时触发，用于初始化系统
procedure TfrmMain.FormCreate(Sender: TObject);
begin
  //当触发OnHint事件时，执行DisplayHint方法
  Application.OnHint := DisplayHint;
end;

//当在列表中按下键时触发，用于处理键盘响应
procedure TfrmMain.ListViewKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_BACK:
      ActionUpLevelExecute(Sender);     //当按下退格键时，返回上级目录
    VK_DELETE:
      DeleteSelectedFiles;              //删除选中的文件
  end;
end;

//当窗口关闭时触发，释放创建的内存空间
procedure TfrmMain.Form1Close(Sender: TObject; var Action: TCloseAction);
var
  i:integer;
begin
  UpdateAbsoluteIndex;
  Application.OnHint := nil;
  //释放节点关联的属性所占内存
  for i := 0 to TV.Items.Count - 1 do
    if TV.Items[i].Data <> nil then
       Dispose(TV.Items[i].Data);

  //释放列表视图中的属性所占内存
  ClearListView;
end;

//创建新节点
procedure TfrmMain.ActionNewDirExecute(Sender: TObject);
var
  newnode:TTreeNode;
  pdi: PDirItem;
begin
  newnode := nil;
  With TV do
  begin
    ActiveControl := TV;
    if Selected <> nil then
    begin
      //当选中了某个目录时，就在该目录下创建子目录
      newnode := Items.AddChild(Selected, '新建目录');
      Selected.Expand(false);
    end
    else
      //如果没有选中某个目录，并且没有根节点则创建根节点
      if items.GetFirstNode = nil then
         newnode := Items.Add(nil, '新建目录');

    if newnode = nil then exit;
    //保存创建的新节点
    With DM.adotblDirectory do
    begin
      if not Active then
         Active := True;
      Append;
      //将目录的属性赋值给节点
      FieldByName('Text').AsString :=  '新建目录';
      FieldByName('DirLevel').AsInteger := newnode.Level;
      FieldByName('CreateDate').AsDateTime := now;
      FieldByName('CreateUser').AsString := FUserName;
      Post;

      //更新节点信息
      New(pdi);
      pdi^.ID := FieldByName('ID').AsInteger;
      pdi^.CreateDate := FieldByName('CreateDate').AsDateTime;
      pdi^.CreateUser := FUserName;
      newnode.data := pdi;
    end;
    UpdateAbsoluteIndex;
    //选中创建的节点，并进入编辑状态
    Select(newnode);
    newnode.EditText;
  end;
end;

procedure TfrmMain.FormShow(Sender: TObject);
const  MAX_SIZE =50;
var
  buf: array[0..MAX_SIZE] of char;
  size: Cardinal;
begin
  //显示当前的日前
  Statusbar1.Panels[0].Text := '当前日期：' + DateTimeToStr(Today);
  //显示当前的登陆用户
  size := MAX_SIZE;
  //PAnsiChar^ := buf;
  GetUserName(@buf, size);
  FUserName := LeftStr(buf, size-1);
  Statusbar1.Panels[1].Text := '当前用户：' + FUserName;

  //从数据库中装载目录信息
  TV.Items.BeginUpdate;
  LoadDirectory;
  TV.Items.EndUpdate;
end;

//当鼠标指向对象时，在状态栏中显示该对象的提示信息
procedure TfrmMain.DisplayHint(Sender: TObject);
begin
  StatusBar1.Panels[2].Text := GetLongHint(Application.Hint);
end;

//保存目录的AbsoluteIndex属性和Level属性
procedure TfrmMain.UpdateAbsoluteIndex;
var
  node:TTreeNode;
  i:integer;
begin
  with DM.adoqryDirectory do
  begin
    Close;
    SQL.Clear;
    SQL.Add('UPDATE directory ');
    SQL.Add('SET AbsoluteIndex = :AbsoluteIndex, ');
    SQL.Add('DirLevel = :DirLevel');
    SQL.Add('WHERE ID = :ID');
  end;

  //循环更新TreeView中的每个节点的AbsoluteIndex和Level属性
  for i := 0 to TV.Items.Count -1 do
  begin
    node := TV.Items[i];
    with DM.adoqryDirectory do
    begin
      Parameters.ParamByName('AbsoluteIndex').Value := node.AbsoluteIndex;
      Parameters.ParamByName('DirLevel').Value := node.Level;
      Parameters.ParamByName('ID').Value := PDirItem(node.data)^.ID;
      Prepared := True;
      ExecSQL;
    end;
  end;
end;

//当修改完目录的名字后，自动保存
procedure TfrmMain.TVEdited(Sender: TObject; Node: TTreeNode; var S: String);
begin
  with DM.adoqryDirectory do
  begin
    Close;
    SQL.Clear;
    SQL.Add('UPDATE directory');
    SQL.Add('SET Text = :Text');
    SQL.Add('WHERE ID = :ID');
    Parameters.ParamByName('Text').Value := S;
    Parameters.ParamByName('ID').Value := PDirItem(node.data)^.ID;
    Prepared := True;
    ExecSQL;
  end;
end;

//从数据库中装载目录
procedure TfrmMain.LoadDirectory;
var
  node:TTreeNode;
  pdi: PDirItem;
  level:integer;
  text:string;
begin
  node := nil;
  with DM.adoqryDirectory do
  begin
    Close;
    SQL.Clear ;
    SQL.Add('SELECT * from directory order by AbsoluteIndex');
    Open;

    //遍历每条记录，更据Level和AbsoluteIndex创建目录节点
    first;
    while not eof do
    begin
      //读取目录信息
      New(pdi);
      pdi^.ID := FieldByName('ID').AsInteger ;
      pdi^.CreateDate := FieldByName('CreateDate').AsDateTime;
      pdi^.CreateUser := Trim(FieldByName('CreateUser').AsString) ;
      level := FieldByName('DirLevel').AsInteger ;
      text := Trim(FieldByName('Text').AsString);

      //创建目录节点
      if (TV.Items.Count < 1) or (Level = 0) then
      begin
         //当是第一个目录或者根目录时
         node := TV.Items.AddChildFirst(nil, text);
         node.Data := pdi;
      end
      else
        if node <> nil then
        begin
          if Level > node.Level then
             //子目录
             node := TV.Items.AddChild(node, text)
          else if Level = node.Level then
             //兄弟目录
             node := TV.Items.Add(node, text)
          else
          begin
             //上级目录
             while node.Level <> Level do
               node := node.Parent ;
             node := TV.Items.Add(node, text);
          end;
          node.Data := pdi;
        end;
      next;
    end;
  end;

  //选中根目录，并展开显示根目录中内容
  if TV.Items.GetFirstNode <> nil then
  begin
    TV.Select(TV.Items.GetFirstNode);
    TV.Items.GetFirstNode.Expand(false);
  end;
end;

//删除选中的目录
procedure TfrmMain.ActionDeleteDirExecute(Sender: TObject);
begin
  if TV.Selected <> nil then