u_form1.pas

很好地delphi书籍源码

unit U_Form1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ImgList, DB, IBCustomDataSet, IBTable, IBDatabase,
  OleCtnrs, ExtCtrls, ToolWin;

type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    TreeView1: TTreeView;
    Splitter1: TSplitter;
    OleContainer1: TOleContainer;
    IBDatabase1: TIBDatabase;
    IBTable1: TIBTable;
    ImageList1: TImageList;
    AddTButton: TToolButton;
    DelTButton: TToolButton;
    ExitTButton: TToolButton;
    StatusBar1: TStatusBar;
    IBTransaction1: TIBTransaction;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Click(Sender: TObject);
    procedure AddTButtonClick(Sender: TObject);
    procedure DelTButtonClick(Sender: TObject);
    procedure ExitTButtonClick(Sender: TObject);
  private
    { Private declarations }
    Node:array[1..5] of TTreeNode;
    procedure LoadDataToTree;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
const MyFType:array[1..5] of string=('文档资料','音像资料','图片资料',
                                     '压缩文件','其它文件');

procedure TForm1.LoadDataToTree;
var
  Loc_Node:TTreeNode;
  i:byte;
  Loc_FType,Loc_FName:string;
begin
   with IBTable1 do
   begin
     Open;
     while not Eof do
     begin
       Loc_FType:=trim(FieldByName('FType').AsString);
       Loc_FName:=trim(FieldByName('FName').AsString);
       for i:=1 to 5 do
         if Loc_FType=MyFType[i] then
         begin
           Loc_Node:=TreeView1.Items.AddChild(Node[i],Loc_FName);
           Loc_Node.ImageIndex:=6;
           Loc_Node.SelectedIndex:=6;
         end;
       next;
     end;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Node0: TTreeNode;
  i:byte;
begin
  with TreeView1.Items do
  begin
    Clear; { 清除树上原有节点 }
    Node0 := Addfirst(nil, '我的流资源数据库');//增加第1个根节点
    Node0.ImageIndex:=0;
    Node0.SelectedIndex:=0;
    for i:=1 to 5 do
    begin
      Node[i]:= AddChild(Node0, MyFType[i]);//增加第1个根节点
      Node[i].ImageIndex:=i ;
      Node[i].SelectedIndex:=i;
    end;
    TreeView1.FullExpand; //展开树结构
  end;
  LoadDataToTree;
end;

procedure TForm1.TreeView1Click(Sender: TObject);
var
  Node:TTreeNode;
  ID:integer;
  ST:TStream;
  procedure Menu(Add,Del:boolean);
  begin
    AddTButton.Enabled:=Add ;
    DelTButton.Enabled:=Del ;
  end;
begin
  if TreeView1.Selected=nil then exit
  else Node:=TreeView1.Selected ;
  if Node.SelectedIndex=0 then
    Menu(false,false)
  else if (Node.SelectedIndex>=1) and (Node.SelectedIndex<=5) then
    Menu(true,false)
  else if Node.SelectedIndex=6 then
  begin
    with IBTable1  do
      if not IsEmpty then
      begin
        Locate('FType;FName',VarArrayOf([Node.Parent.Text,Node.Text]),[loPartialKey]);
        ID:=FieldByName('Code').AsInteger;
        ST:=CreateBlobStream(FieldByName('Detail'),bmRead);
        OleContainer1.LoadFromStream(ST);
        ST.Free;
      end;
    Menu(false,true);
    StatusBar1.SimpleText:='该资料存入时间是:'+ DateTimeToStr(ID/50000) ;
  end;
end;



procedure TForm1.AddTButtonClick(Sender: TObject);
var
  ST:TStream;
  fn: string;
  Date:TDateTime;
  ID:  Longint;
  Node:TTreeNode;
begin
  Date:=now;
  ID:=StrToInt(format('%10.0f',[50000*Date]));
  if OpenDialog1.Execute then
  begin //打开文件
    fn := ExtractFileName(OpenDialog1.FileName);
    with IBTable1 do
    begin
      Open;
      if State <>dsEdit then Edit;
      Append;
      FieldByName('Code').AsInteger:=ID;
      FieldByName('FType').AsString:=TreeView1.Selected.Text;
      FieldByName('FName').AsString:=fn;
      ST:=CreateBlobStream(FieldByName('Detail'),bmWrite);
      OleContainer1.CreateObjectFromFile(OpenDialog1.FileName, False); //创建OLE对象
      OleContainer1.SaveToStream(ST);  //将OLE数据存入数据库
      ST.Free;
      Post;
    end;
    Node:=TreeView1.Items.AddChild(TreeView1.Selected,fn);
    Node.ImageIndex:=6;
    Node.SelectedIndex:=6;
  end;
  AddTButton.Enabled:=false;
end;

procedure TForm1.DelTButtonClick(Sender: TObject);
begin
  if Application.MessageBox('确实需要删除记录吗!',
       '提示',MB_YesNo+MB_IconExclamation+MB_SystemModal)=IDYES then
  begin
    IBTable1.Delete;
    TreeView1.Selected.Delete;
  end;
end;

procedure TForm1.ExitTButtonClick(Sender: TObject);
begin
  Application.Terminate;
end;

end.