mainform.pas

基于DELPHI的图片浏览系统设计与实现

  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
imagefreeall;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if pos(':\', ComboBox_url.Text) <> 0 then
  LocalPic else
  RemotePic;
end;

procedure TForm1.LocalPic;
var
tmpimage: TImage;
begin
  if FileExists(ComboBox_url.Text) then
  begin
  tmpimage := TImage.Create(Self);
  if showPic(ComboBox_url.Text) <> nil then
  tmpimage.Picture.Assign (showPic(ComboBox_url.Text).GetInstance(ComboBox_url.Text)) else
  tmpimage.Picture.LoadFromFile(ComboBox_url.Text);

  image1.Height := tmpimage.Picture.Height;
  image1.Width := tmpimage.Picture.Width;
  image1.Picture:=tmpimage.Picture;
  image1.HelpKeyword := ComboBox_url.Text;

  FreeAndNil(tmpimage);
  end else
  exit;
end;


procedure TForm1.RemotePic;
begin
  //
end;

procedure TForm1.Panel1Click(Sender: TObject);
begin
 Dockform.TabSet1.TabIndex := 2;
 Dockform.Notebook1.PageIndex := 2;
end;

procedure TForm1.ScrollBox3Click(Sender: TObject);
begin
  ScrollBox3.SetFocus;
end;

procedure TForm1.ComboBox_urlExit(Sender: TObject);
begin
  Dockform.ShellTreeView1.SetFocus;//为了叫clipbrd有效
end;

procedure TForm1.MainTimerTimer(Sender: TObject);
var
  Fullscreen : TBitmap;
  FullscreenCanvas : TCanvas;
  DC : HDC;
begin
  MainTimer.Enabled := False;//取消时钟
  Fullscreen:=TBitmap.Create;//创建一个BITMAP来存放图象
  Fullscreen.Width := Screen.Width;
  Fullscreen.Height := Screen.Height;
  DC:=GetDC(0);//取得屏幕的DC，参数0指的是屏幕
  FullscreenCanvas := TCanvas.Create;//创建一个CANVAS对象
  FullscreenCanvas.Handle := DC;

  Fullscreen.Canvas.CopyRect
  (Rect(0,0,Screen.Width,Screen.Height),FullScreenCanvas,
  Rect(0,0,Screen.Width,Screen.Height));
  //把整个屏幕复制到BITMAP中
  FullScreenCanvas.Free;//释放CANVAS对象
  ReleaseDC(0,DC);//释放DC
   //*******************************
  image1.Picture.Bitmap := FullScreen;//拷贝下的图象赋给IMAGE对象
  image1.Width := FullScreen.Width;
  image1.Height := FullScreen.Height;
  FullScreen.Free;//释放bitmap
  self.Show;//显示窗口
  self.WindowState := wsMaximized;//复原窗口状态

  MessageBeep(1);//BEEP叫一声，报告图象已经截取好了。
end;

procedure TForm1.ToolButton21Click(Sender: TObject);
begin
  if image1.HelpKeyword <> '' then
  begin
    magnify.Image1.Picture.Assign(Self.Image1.Picture);
    magnify.Show;
  end else
  ShowMessage('没有可以预览的图片');
end;

procedure TForm1.ToolButton17Click(Sender: TObject);
begin
  if form1.Image1.HelpKeyword <> '' then
  begin
  if Application.MessageBox('是否删除此图片？','图片浏览工具',MB_OKCANCEL+MB_ICONQUESTION) =IDOK	then
  DeleteFile(form1.Image1.HelpKeyword);
  end else
  ShowMessage('没有可以删除的图片');
end;

procedure TForm1.ToolButton12Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
  Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;

procedure TForm1.ToolButton16Click(Sender: TObject);
begin
  if SavePictureDialog1.Execute then
  Image1.Picture.SaveToFile(SavePictureDialog1.FileName);
end;

procedure TForm1.ToolButton5Click(Sender: TObject);
begin
  Dockform.SpeedButton7.Click;
end;

procedure TForm1.ToolButton7Click(Sender: TObject);
begin
 Dockform.SpeedButton10.Click;
end;

procedure TForm1.ToolButton23Click(Sender: TObject);
var
recta:TRect;
begin
  Panel2.Visible:=true;
  DockForm.Dock(Panel2,recta);
  DockForm.Show;
  adjustCombox_url;
end;

procedure TForm1.changeformat(const filename: string);
begin
  Dockform.CheckListBox1.Items.Clear;
  if UpperCase(ExtractFileExt(filename)) = '.BMP' then
  begin
    Dockform.CheckListBox1.Items.Add('BMP转JPG');
    Dockform.CheckListBox1.Items.Add('BMP转ICO');
    Dockform.CheckListBox1.Items.Add('压缩成JPG');
  end;
  if (UpperCase(ExtractFileExt(filename)) = '.JPG') or
  (UpperCase(ExtractFileExt(filename)) = '.JPEG') then
  begin
    Dockform.CheckListBox1.Items.Add('JPG转BMP');
    Dockform.CheckListBox1.Items.Add('JPG转ICO');
    Dockform.CheckListBox1.Items.Add('JPG单独压缩');
  end;
  if UpperCase(ExtractFileExt(filename)) = '.ICO' then
  begin
    Dockform.CheckListBox1.Items.Add('ICO转BMP');
    Dockform.CheckListBox1.Items.Add('ICO转JPG');
  end;
end;

procedure TForm1.ToolButton24Click(Sender: TObject);
begin
  if image1.HelpKeyword <> '' then
  begin
    //bmp的JPG压缩
    if UpperCase(ExtractFileExt(Image1.HelpKeyword)) = '.BMP' then
    begin
      if CompressBMP(Image1.HelpKeyword) then
      begin
      Application.CreateForm(Tcompressinfo, compressinfo);
      compressinfo.Edit1.Text := editaddr;
      compressinfo.ShellListView1.Root := editaddr;
      compressinfo.ShowModal;
      end;
    end else
    if UpperCase(ExtractFileExt(Image1.HelpKeyword)) = '.JPG' then
    begin
      if CompressJPG(Image1.HelpKeyword) then
      begin
      Application.CreateForm(Tcompressinfo, compressinfo);
      compressinfo.Edit1.Text := editaddr;
      compressinfo.ShellListView1.Root := editaddr;
      compressinfo.ShowModal;
      end;
    end else
    begin
      //这里留着给插件吧
    end;
  end;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
var
tmppnt: TPoint;
begin
  tmppnt.X := SpeedButton3.Left - compress.Width;
  tmppnt.Y := SpeedButton3.Top + SpeedButton3.Height;
  tmppnt := ClientToScreen(tmppnt);
  compress.Left := tmppnt.X;
  compress.Top := tmppnt.Y;

  compress.Show;
end;

procedure TForm1.ToolButton26Click(Sender: TObject);
var
  i: integer;
begin
  if Shape1.Visible then
  begin
  Shape1.Visible := false;
  zoom.Close;
  end
  else
  begin
  Image1.SendToBack;
  Shape1.Visible := true;

  zoom.Top := Screen.Height;
  zoom.left := Screen.Width - zoom.Width;
  zoom.Show;
  for i:= Screen.Height downto (Screen.Height - zoom.Height) do
  begin
    Application.ProcessMessages;
    zoom.Top := i;
  end;
 // zoom.FormFadeIn(zoom, 1000);
  end;
end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  startpnt.X := x;
  startpnt.Y := y;
  begindrag := true;
end;

procedure TForm1.Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if begindrag then
  begin

  if x > startpnt.X then
  Shape1.Left := Shape1.Left + x - startpnt.X;
  if y > startpnt.Y then
  Shape1.Top := Shape1.Top + y - startpnt.Y;
  if x < startpnt.X then
  Shape1.Left := Shape1.Left - (startpnt.X - x) ;
  if y < startpnt.Y then
  Shape1.Top := Shape1.Top - (startpnt.Y - y) ;
  image1.Canvas.CopyMode := cmSrcCopy;
  zoom.image1.Canvas.CopyRect(zoom.Image1.BoundsRect,image1.Canvas, shape1.BoundsRect);
  end;
end;

procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  begindrag := false;
end;

procedure TForm1.ToolButton29Click(Sender: TObject);
begin
  if Application.MessageBox('是否要退出此程序？','图片浏览工具',MB_OKCANCEL+MB_ICONQUESTION	) =IDOK	then
  begin
  imagefreeall;
  Application.Terminate;
  end;
end;

procedure TForm1.ToolButton33Click(Sender: TObject);
begin
  MakeAVI.Show;
end;

procedure TForm1.getEditMsg(var msg: TMessage);
begin
 ///
end;

procedure TForm1.C2Click(Sender: TObject);
begin
  Application.CreateForm(Tconfig, config);
  config.Show;
end;

procedure TForm1.Image1DblClick(Sender: TObject);
begin
  if image1.HelpKeyword <> '' then
  begin
    magnify.Image1.Picture.Assign(Self.Image1.Picture);
    magnify.Show;
  end else
  ShowMessage('没有可以预览的图片');
end;

end.