mainunit.pas

一个简单的管理系统

   Pass  :String;
begin
   Query:=TADOQuery.Create(self);
   query.Connection:=ADOConnection1;
   query.Close;
   query.SQL.Clear;
   query.SQL.Add('select * from PassW');
   query.Open;
   query.First;
   if Query.RecordCount=0 then
   begin
       query.Close;
       query.Free;
       result:=true;
       exit;
   end;
   pass:=Query.fieldbyname('Pass').AsString;
   query.Close;
   query.Free;
   if pass='' then begin
      result:=true;
      exit;
   end;
   LogonForm:=TLogonForm.Create(self);
   LogonForm.Caption:='登陆';
   if (LogonForm.ShowModal<>mrOK) OR (LogonForm.Edit1.Text<>pass) then
       Result:=false else result:=True;
   LogonForm.Free;
end;

procedure TForm1.PassMenuClick(Sender: TObject);
var
   query:TADOQuery;
   pass :String;
   NewPass:string;
begin
   if  ADOConnection1.Connected=false then exit;
   PassForm:=TPassForm.Create(self);
   if PassForm.ShowModal<>mrOK Then begin
       PassForm.Free;
       Exit;
   end;
   if PassForm.Edit2.Text<>PassForm.Edit3.Text then
   begin
        Messagedlg('新密码不匹配!',mtWarning,[mbOK],0);
        PassForm.Free;
        Exit;
   end;
   pass:=PassForm.Edit1.Text;
   NewPass:=passForm.Edit2.Text;
   PassForm.Free;

   query:=TADOQuery.Create(self);
   query.Connection:=ADOConnection1;
   query.Close;
   query.SQL.Clear;
   query.SQL.Add('Select * from PassW');
   Query.Open;
   query.First;
   if query.FieldByName('Pass').AsString<>Pass then
   begin
        messagedlg('密码不正确!',mtError,[mbOK],0);
        query.Close;
        Query.Free;
        exit;
   end;
   query.Close;
   query.Free;
   ModifyLogonPass(NewPass);
   messagedlg('密码修改成功!',mtInformation,[mbOK],0);
end;

procedure TForm1.ModifyLogonPass(Password:String);
var
   query:TADOQuery;
begin
   query:=TADOQuery.Create(self);
   try
       query.Connection:=ADOConnection1;
       query.Close;
       query.SQL.Clear;
       query.SQL.Add('Select * from PassW');
       Query.Open;
       query.First;
       query.Edit;
       query.FieldByName('Pass').AsString:=PassWord;
       query.Post;
       query.Close;
   finally
       query.Free;
   end;
end;

procedure TForm1.RunMenuClick(Sender: TObject);
begin
   ShellExecute(Handle,'open','mspaint.exe',nil,nil,SW_SHOWNORMAL);    //运行小画家
end;

procedure TForm1.N19Click(Sender: TObject);
var
  image:TImage;
begin
   if PageControl1.ActivePage=TreeTab then
      if (TreeView1.Selected=nil) or (TreeView1.Selected.ImageIndex<>0) then exit;
   if PageControl1.ActivePage=BMarkTab then
      if TreeView2.Selected=nil then exit;
   if PageControl1.ActivePage=SearchTab then
      if TreeView3.Selected=nil then exit;
   if (ZoomOut=1.0) and (ZoomIn=1.0) then image:=image1
       else image:=image2;
  Case (sender as TMenuItem).Tag of
    0: ChangeWallPaper(Tobmp(image),0,0);   //居中
    1: ChangeWallPaper(Tobmp(image),0,1);   //平铺
    2: ChangeWallPaper(Tobmp(image),2,0);   //拉伸
  end;
end;

procedure TForm1.ChangeWallPaper(const fn: string; wallpaperStyle,
  TileWallPaper: integer);
var
   reg:TRegistry;
begin
   reg:=TRegistry.Create;
   TRY
       reg.RootKey:=HKEY_CURRENT_USER;
       reg.OpenKey('Control Panel\Desktop',false);
       reg.WriteString('TileWallPaper',intToStr(TileWallPaper));
       reg.WriteString('WallPaperStyle',inttostr(wallpaperStyle));
       reg.WriteString('WallPaper',fn);
       systemParametersInfo(SPI_SETDESKWallPaper,0,nil,SPIF_SENDCHANGE);
       reg.CloseKey;
   Finally
       reg.Free;
   end;
end;

function TForm1.ToBMP(Image: TImage): string;
Var
   bmp:TBitMap;
   bmpfile:string;
begin
   bmpfile:=ExtractFilePath(Application.ExeName)+'WallPaperByDltjy.bmp';
   bmp:=TBitmap.Create;
   try
       bmp.PixelFormat:=pfDevice;
       bmp.Width:=image.Picture.Width;
       bmp.Height:=image.Picture.Height;
       bmp.Canvas.Draw(0,0,image.Picture.Graphic);
       bmp.SaveToFile(bmpfile);
   finally
       bmp.Free;
   end;
   result:=bmpfile;
end;

procedure TForm1.CopyToClipBoard;
begin
    ClipBoard.Assign(Image1.Picture);
end;

procedure TForm1.CutToClipBoard;
var
  ARect:TRect;
  bmp  :TBitMap;
  jpg  :TJPEGImage;
  fn   :String;
begin
   ClipBoard.Assign(Image1.Picture);
   bmp:=TBitMap.Create;
   try
       bmp.Assign(Image1.Picture.Graphic);
       bmp.Canvas.CopyMode:=cmWhiteNess;
       ARect:=Rect(0,0,Image1.Width,Image1.Height);
       bmp.Canvas.CopyRect(ARect,bmp.Canvas,ARect);
       bmp.Canvas.CopyMode:=cmSrcCopy;
       image1.Picture.Assign(bmp);
   finally
       bmp.Free;
   end;
   IF messagedlg('图片已经修改,是否保存?', mtConfirmation,[mbYes,mbNO],0)<>mrYES THEN exit;
   fn:=ExtractFilePath(Application.ExeName)+'TjpgByDltjy.jpg';
   jpg:=TJPEGImage.Create;
   try
       jpg.Assign(image1.Picture.Bitmap);
       jpg.CompressionQuality:=5;
       jpg.Compress;
       jpg.SaveToFile(fn);
   finally
       jpg.Free;
   end;
   ModifyPic(NodeData(TreeView1.Selected.Data).ID,fn);        //剪贴转JPG后保存
   DeleteFile(fn);
end;

procedure TForm1.PasteFromClipBoard;
var
    jpg:TJPEGImage;
    fn :string;
    bmp:TBitMap;
begin
    fn:=ExtractFilePath(Application.ExeName)+'TjpgByDltjy.jpg';
    if ClipBoard.HasFormat(CF_PICTURE) THEN
    begin
        image1.Picture.Assign(ClipBoard);
        {f (Image1.Picture.Graphic is TJPEGImage) then showmessage('TJPEGImage')
        else if (Image1.Picture.Graphic is TBitMap) then showmessage('TBitMap')
        else if (Image1.Picture.Graphic is TMetaFile) then showmessage('emf')
        else showmessage('other'); }
        IF messagedlg('图片已经修改,是否保存?', mtConfirmation,[mbYes,mbNO],0)<>mrYES THEN exit;
        if (image1.Picture.Graphic is TBitMap) then begin
            jpg:=TJPEGImage.Create;           //粘贴转JPG后保存
            try
                jpg.Assign(image1.Picture.Bitmap);
                jpg.CompressionQuality:=70;
                jpg.Compress;
                jpg.SaveToFile(fn);
            finally
                jpg.Free;
            end;
        end else if (image1.Picture.Graphic is TJPEGImage) then begin
            image1.Picture.SaveToFile(fn);
        end else if (image1.Picture.Graphic is TMetaFile) then begin
            bmp:=TBitMap.Create;
            jpg:=TJPEGImage.Create;
            try
                bmp.Width:=image1.Picture.Width;
                bmp.Height:=image1.Picture.Height;
                bmp.Canvas.Draw(0,0,image1.Picture.Metafile);
                jpg.Assign(bmp);
                jpg.CompressionQuality:=70;
                jpg.Compress;
                jpg.SaveToFile(fn);
            finally
                bmp.Free;
                jpg.Free;
            end;
        end else begin
            messagedlg('剪贴板中没有图片或者不是有效的图片格式!',mtWarning,[mbOK],0);
            Exit;
        end;
        ModifyPic(NodeData(TreeView1.Selected.Data).ID,fn);
        DeleteFile(fn);
    end;
end;

procedure TForm1.CutMenuClick(Sender: TObject);
begin
   if PageControl1.ActivePage<>TreeTab then PageControl1.ActivePage:=TreeTab;
   if (TreeView1.Selected=nil) or (TreeView1.Selected.ImageIndex<>0) then
   begin
       messagedlg('没有图片可以剪贴!',mtWarning,[mbOK],0);
       exit;
   end;
   CutToClipBoard;
end;

procedure TForm1.CopyMenuClick(Sender: TObject);
begin
   if PageControl1.ActivePage<>TreeTab then PageControl1.ActivePage:=TreeTab;
   if (TreeView1.Selected=nil) or (TreeView1.Selected.ImageIndex<>0) then
   begin
       messagedlg('没有图片可以复制!',mtWarning,[mbOK],0);
       exit;
   end;
   CopyToClipBoard;
end;

procedure TForm1.PasteMenuClick(Sender: TObject);
begin
   if PageControl1.ActivePage<>TreeTab then PageControl1.ActivePage:=TreeTab;
   if (TreeView1.Selected=nil) or (TreeView1.Selected.ImageIndex<>0) then
   begin
       //messagedlg('不能把图片粘贴在文件夹上!',mtWarning,[mbOK],0);
       exit;
   end;
   PasteFromClipBoard;
end;

function TForm1.GetPicOrFolderCount(m: integer): integer;  //取目录或文件数m=0返回文件数,m=1反回目录数
var
   query:TADOQuery;
   ql   :string;
begin
   Case m of
      0 : ql:='select ID From PData where Folder=0' ;
      1 : ql:='select ID From PData where Folder<>0' ;
   end;
   query:=TADOQuery.Create(self);
   try
       query.Connection:=ADOConnection1;
       query.Close;
       query.SQL.Clear;
       query.SQL.Add(ql);
       query.Open;
       result:=query.RecordCount;
       query.Close;
   finally
       query.Free;
   end;
end;

procedure TForm1.ImportFromDir(Node: TTreeNode);   //从目录导入
var
   pic     :integer;
   S       :TSearchRec;
   pnode   :NodeData;
   anode   :TTreeNode;      //图片节点
   mlnode  :TTreeNode;     //目录节点
   Firsted :boolean;
begin
   application.ProcessMessages;
   if aviform.stop then exit;
   //IF copy(aDir,length(aDir),1)<>'\' then aDir:=aDir+'\';
   //showmessage(GetCurrentDir);
   Firsted:=true;
   mlnode:=node;
   pic:=FindFirst('*.*',faAnyFile,s);    //查找*.jpg ,*.bmp
   while pic=0 do begin
       Application.ProcessMessages;
       if AviForm.stop then break;
       if (S.Attr and faDirectory)=0 then
       begin
          if (lowercase(ExtractFileExt(s.Name))='.jpg') or (lowercase(ExtractFileExt(s.Name))='.bmp') then
          begin
              AviForm.Label1.Caption:=s.Name;
              if Firsted then
              begin
                  new(pnode);                                                     //目录
                  pnode.ID:=GetMaxID+1;
                  pnode.Caption:=ExtractFileName(GetCurrentDir);
                  Pnode.Password:='';
                  mlnode:=TreeView1.Items.AddChildObject(node,pnode.Caption,pnode);
                  SaveFolder(NodeData(node.Data).ID,mlnode);
                  mlnode.ImageIndex:=1;
                  mlnode.SelectedIndex:=1;
                  Firsted:=false;
              end;

              new(Pnode);                                                        //文件
              pnode.ID:=GetMaxID+1;
              pnode.Caption:=Copy(s.Name,1,length(s.Name)-4);
              Pnode.Password:='';
              anode:=TreeView1.Items.AddChildObject(mlnode,pnode.Caption,pnode);
              SavePicture(NodeData(mlnode.Data).ID,anode,s.Name);
              anode.ImageIndex:=0;
              anode.SelectedIndex:=0;
          end;
       end;
       pic:=FindNext(s);
   end;

   IF Aviform.stop then begin
       FindClose(s);
       exit;
    end;

   pic:=FindFirst('*.*',faAnyFile,s); //查找目录
   while pic=0 do begin
       application.ProcessMessages;
       if aviform.stop then break;
       if ((s.Attr and faDirectory)<>0) and (s.Name<>'.') and (s.Name<>'..') then
       begin
           {new(pnode);
           pnode.ID:=GetMaxID+1;
           Pnode.Caption:=s.Name;     //????????
           pnode.Password:='';
           anode:=TreeView1.Items.AddChildObject(node,pnode.Caption,pnode);
           SaveFolder(NodeData(node.Data).ID,anode);
           anode.ImageIndex:=1;
           anode.SelectedIndex:=1; }
           ChDir(s.Name);
           ImportFromDir(mlnode);
           ChDir('..');
       end;
       pic:=FindNext(s);
   end;  
   FindClose(s);
end;

procedure TForm1.InFolderMenuClick(Sender: TObject);
var
  dir:string;
  //currentdir:string;
begin
   if PageControl1.ActivePage<>TreeTab then PageControl1.ActivePage:=TreeTab;
   if (TreeView1.Selected=nil) then
   begin
       messagedlg('必须先选择一个目录,以便导入图片!',mtError,[mbOK],0);
       Exit;
   end;
   if TreeView1.Selected.ImageIndex=0 then
      if TreeView1.Selected.Parent<>nil then TreeView1.Selected.Parent.Selected:=True
      else TreeView1.Selected:=nil;
   if not selectDirectory('选择图片目录:','',Dir) then exit;
   //showmessage(dir);
   Screen.Cursor:=crHourGlass;
   AviForm:=TAviForm.Create(self);
   AviForm.Caption:='正在导入图片,请等待...';
   AviForm.Label1.Caption:='';
   aviform.Label1.Visible:=true;
   AviForm.stop:=False;
   AviForm.Button1.Enabled:=True;
   AviForm.Animate1.CommonAVI:=aviCopyFiles;
   AviForm.Animate1.Active:=True;