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

📄 mainunit.pas

📁 一个简单的管理系统
💻 PAS
📖 第 1 页 / 共 5 页
字号:
unit mainUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ToolWin, StdCtrls, ExtCtrls, DB, ADODB,Comobj,
  ImgList,JPEG, ExtDlgs,ShellAPI,Registry,Clipbrd,FileCtrl;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    F1: TMenuItem;
    PassMenu: TMenuItem;
    N1: TMenuItem;
    PrintMenu: TMenuItem;
    N2: TMenuItem;
    ExitMenu: TMenuItem;
    E1: TMenuItem;
    T1: TMenuItem;
    H1: TMenuItem;
    StatusBar1: TStatusBar;
    HelpMenu: TMenuItem;
    N3: TMenuItem;
    AboutMenu: TMenuItem;
    E2: TMenuItem;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    Panel1: TPanel;
    Splitter1: TSplitter;
    PageControl1: TPageControl;
    TreeTab: TTabSheet;
    BMarkTab: TTabSheet;
    SearchTab: TTabSheet;
    TreeView1: TTreeView;
    TreeView2: TTreeView;
    TreeView3: TTreeView;
    Panel2: TPanel;
    Panel3: TPanel;
    Label1: TLabel;
    Panel4: TPanel;
    Edit1: TEdit;
    Button1: TButton;
    Label2: TLabel;
    CompressDataMenu: TMenuItem;
    Panel5: TPanel;
    Panel6: TPanel;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    Memo1: TMemo;
    Panel7: TPanel;
    Label3: TLabel;
    ADOConnection1: TADOConnection;
    PFolderMenu: TMenuItem;
    SFolderMenu: TMenuItem;
    N6: TMenuItem;
    AddPicMenu: TMenuItem;
    InFolderMenu: TMenuItem;
    N7: TMenuItem;
    DelMenu: TMenuItem;
    RenameMenu: TMenuItem;
    N5: TMenuItem;
    NoteMenu: TMenuItem;
    VFmenu: TMenuItem;
    BMarkMenu: TMenuItem;
    SearchMenu: TMenuItem;
    N8: TMenuItem;
    SaveAsMenu: TMenuItem;
    ZoomOutMenu: TMenuItem;
    ZoomInMenu: TMenuItem;
    N11: TMenuItem;
    Timer1: TTimer;
    N4: TMenuItem;
    SetPassMenu: TMenuItem;
    ImageList1: TImageList;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    Image2: TImage;
    OldSizeMenu: TMenuItem;
    Splitter2: TSplitter;
    N9: TMenuItem;
    ShowNoteMenu: TMenuItem;
    ModifyPicMenu: TMenuItem;
    ImageList2: TImageList;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    N10: TMenuItem;
    CopyMenu: TMenuItem;
    PasteMenu: TMenuItem;
    N14: TMenuItem;
    RunMenu: TMenuItem;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    ToolButton19: TToolButton;
    ToolButton20: TToolButton;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    ToolButton21: TToolButton;
    CutMenu: TMenuItem;
    N12: TMenuItem;
    AddBookMarkMenu: TMenuItem;
    BMarkPopupMenj: TPopupMenu;
    DelPMenu: TMenuItem;
    AllDelPMenu: TMenuItem;
    N13: TMenuItem;
    ToTreeTabPMenu: TMenuItem;
    SearchPopupMenu: TPopupMenu;
    SearchToTreeTabPMenu: TMenuItem;
    SearchToBMpmenu: TMenuItem;
    N22: TMenuItem;
    TreePopupMenu: TPopupMenu;
    ImagePopupMenu: TPopupMenu;
    N20: TMenuItem;
    N21: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    N29: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    N32: TMenuItem;
    N33: TMenuItem;
    N34: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    NewMLPopupMenu: TMenuItem;
    NewSpMenu: TMenuItem;
    MLPassPMenu: TMenuItem;
    N39: TMenuItem;
    BMPMenu: TMenuItem;
    DelPopupMenu: TMenuItem;
    ReNPMenu: TMenuItem;
    NotePopupMenu: TMenuItem;
    SaveASPMenu: TMenuItem;
    AddPicPMenu: TMenuItem;
    ImportPMenu: TMenuItem;
    N47: TMenuItem;
    N48: TMenuItem;
    procedure Splitter1Moved(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure PageControl1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ExitMenuClick(Sender: TObject);
    procedure HelpMenuClick(Sender: TObject);
    procedure AboutMenuClick(Sender: TObject);
    procedure VFmenuClick(Sender: TObject);
    procedure BMarkMenuClick(Sender: TObject);
    procedure SearchMenuClick(Sender: TObject);
    procedure CompressDataMenuClick(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure SaveAsMenuClick(Sender: TObject);
    procedure PFolderMenuClick(Sender: TObject);
    procedure SFolderMenuClick(Sender: TObject);
    procedure AddPicMenuClick(Sender: TObject);
    procedure DelMenuClick(Sender: TObject);
    procedure TreeView2Change(Sender: TObject; Node: TTreeNode);
    procedure TreeView3Change(Sender: TObject; Node: TTreeNode);
    procedure Image1DblClick(Sender: TObject);
    procedure OldSizeMenuClick(Sender: TObject);
    procedure ZoomOutMenuClick(Sender: TObject);
    procedure ZoomInMenuClick(Sender: TObject);
    procedure RenameMenuClick(Sender: TObject);
    procedure NoteMenuClick(Sender: TObject);
    procedure ShowNoteMenuClick(Sender: TObject);
    procedure Splitter2Moved(Sender: TObject);
    procedure SetPassMenuClick(Sender: TObject);
    procedure TreeView1Expanding(Sender: TObject; Node: TTreeNode;
      var AllowExpansion: Boolean);
    procedure PassMenuClick(Sender: TObject);
    procedure RunMenuClick(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure CutMenuClick(Sender: TObject);
    procedure CopyMenuClick(Sender: TObject);
    procedure PasteMenuClick(Sender: TObject);
    procedure InFolderMenuClick(Sender: TObject);
    procedure AddBookMarkMenuClick(Sender: TObject);
    procedure PrintMenuClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure TreeView2DblClick(Sender: TObject);
    procedure TreeView3DblClick(Sender: TObject);
    procedure DelPMenuClick(Sender: TObject);
    procedure AllDelPMenuClick(Sender: TObject);
    procedure ToTreeTabPMenuClick(Sender: TObject);
    procedure TreeView2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SearchToTreeTabPMenuClick(Sender: TObject);
    procedure SearchToBMpmenuClick(Sender: TObject);
    procedure TreeView3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure TreeView2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TreeView1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImagePopupMenuPopup(Sender: TObject);
    procedure TreePopupMenuPopup(Sender: TObject);
    procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
  private
    { Private declarations }
    ZoomOut      :single;
    ZoomIn       :Single;
    TabChanged   : boolean;
    DataFile     : string;

    Function ValiDatePass:Boolean ;               //登陆时的密码验证
    Procedure MyShowHint(sender:TObject);               //状态栏提示
    procedure InitializeStatusBar;                      //初始化状态栏
    Function CompressRepairMDB : Boolean;               //压缩修复数据库
    procedure FillTreeView(selfID:Integer;ParentNode:TTreeNode);  //数据填允TreeView1及TreeView2
    procedure FillClass;
    Function  GetMaxID:integer;                                  //取最大ID
    Procedure showPic(ID:Integer);                               //显示PICTURE
    procedure Delrecord(ID:Integer);                 //删除记录
    procedure DelNode(Node:TTreeNode) ;                 //删除节点
    Procedure DelAddBookMark(ID:Integer;bm: Boolean);     //删除添加书签
    procedure SaveAsPic(ID:Integer);                //图片另存
    procedure ModifyPic(ID:Integer;fn:string);          //更改图片
    Procedure EditPic;                    //更改图片
    procedure SaveFolder(parentID:Integer;node:TTreeNode); //保存目录
    procedure SavePicture(ParentID:Integer;node:TTreeNode;fn:string);//保存图片
    Procedure ZoomPicture(Zoom:single) ;           //图片放大,缩小
    Procedure ModifyFolderPass(ID:Integer;Password:String); //设定目录密码
    Procedure ModifyLogonPass(Password:String);          //设定登陆密码
    procedure ImportFromDir(Node:TTreeNode);  //从目录导入图片
    Procedure ChangeWallPaper(const fn:string;wallpaperStyle:integer;TileWallPaper:integer);//设置墙纸
    Function ToBMP(Image:TImage):string;  //从image转BMP
    procedure CopyToClipBoard ;
    procedure CutToClipBoard;
    Procedure PasteFromClipBoard;
    Function GetPicOrFolderCount(m:integer):integer;     //取目录或文件数m=0返回文件数,m=1反回目录数
    procedure ModifyParent(sourceID,ParentID:Integer);    //拖动后,修改父节点
    procedure WMDropFiles(var msg:TWMDROPFILES);
    Message WM_DROPFILES;
    procedure PrintPicture(Image:Timage;a:integer);

  public
    { Public declarations }
  end;

  TNodeData = record
      ID     :integer;
      Caption:string[50];
      Password:string[20];
  end;
  nodeData=^TNodeData;

var
  Form1: TForm1;

const
   link='Provider=Microsoft.Jet.OLEDB.4.0;'+
        'Data Source=%s;Persist Security Info=False;'+
        'Jet OLEDB:Database Password=dltjy.lf';

implementation

uses About, NoteUnit, LogonUnit, SetupPassUnit, AviUnit;

{$R *.dfm}

function MyCustomSortProc(node1, node2: TTreeNode; Data: longword): integer; stdcall;
begin
   if ((node1.ImageIndex=1) or (node1.ImageIndex=2)) and (node2.ImageIndex=0) then
   begin
       result:=-1;
       exit;
   end;

   if (node1.ImageIndex=0) and ((node2.ImageIndex=2) or (node2.ImageIndex=1)) then
   begin
       result:=1;
       exit;
   end;

   result:=AnsiCompareText(node1.Text,node2.Text);
end;

procedure TForm1.Splitter1Moved(Sender: TObject);
begin
   if panel5.Width<200 then panel5.Width:=200;
   //if scrollbox1.Width<200 then scrollbox1.Width:=200;
   edit1.Width:=panel4.Width-5;
   if panel1.Width<20 then panel1.Width:=20;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    ZoomOut:=1.0;
    ZoomIn:=1.0;

    label3.Caption:='注'+#13+'释';
    label3.AutoSize:=true;
    InitializeStatusBar;
    application.OnHint:=MyShowHint;

    DataFile:=ExtractFilePath(application.ExeName)+'PicData.pdb';
    ADOConnection1.ConnectionString:=format(Link,[DataFile]);
    ADOConnection1.Connected:=true;
    if NOT ValiDatePass THEN Application.Terminate;

    FillClass;

    Statusbar1.Panels[2].Text:=intToStr(GetPicOrFolderCount(1));
    Statusbar1.Panels[4].Text:=intToStr(GetPicOrFolderCount(0));

    DragAcceptFiles(handle,true);

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
    ADOConnection1.Connected:=false;
    DragAcceptFiles(Handle,False);
end;

procedure TForm1.PageControl1Change(Sender: TObject);
begin
  TabChanged:=true;
  if panel1.Width<=20 then
     panel1.Width:=185;
  edit1.Width:=panel4.Width-5;
  case PageControl1.ActivePageIndex of
     0:begin
          VFmenu.Checked:=True;
          if TreeView1.Selected=nil then
          begin
              Image1.Picture.Assign(nil);
              Memo1.Clear;
              exit;
          end;
          showPic(NodeData(Treeview1.Selected.Data).id);
       end;
     1:begin
          BMarkMenu.Checked:=True;
          if TreeView2.Selected=nil then
          begin
              Image1.Picture.Assign(nil);
              Memo1.Clear;
              exit;
          end;
          ShowPic(NodeData(Treeview2.Selected.Data).id);
       end;
     2:begin
          SearchMenu.Checked:=True;
          edit1.SetFocus;
          if TreeView3.Selected=nil then
          begin
              Image1.Picture.Assign(nil);
              Memo1.Clear;
              exit;
          end;
          ShowPic(NodeData(Treeview3.Selected.Data).id);
       end;
  end;
end;

procedure TForm1.PageControl1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if  TabChanged then  begin
      TabChanged:=false;
      exit;
  end; 
  if panel1.Width>20 then
     panel1.Width:=20
  else panel1.Width:=185;
end;


procedure TForm1.MyShowHint(sender: TObject);
begin
   StatusBar1.Panels[0].Text:=application.Hint;
end;

procedure TForm1.InitializeStatusBar;
begin
   with StatusBar1 do begin
       panels[7].Width:=110;

⌨️ 快捷键说明

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