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

📄 mainform.pas

📁 基于DELPHI的图片浏览系统设计与实现
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, Menus, Buttons, StdCtrls, OleCtrls, SHDocVw, jpeg, clipbrd,
  ComCtrls, ToolWin, ImgList, ExtDlgs;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    F1: TMenuItem;
    Panel5: TPanel;
    Panel6: TPanel;
    Panel7: TPanel;
    T1: TMenuItem;
    Panel8: TPanel;
    Panel9: TPanel;
    Panel10: TPanel;
    ComboBox_url: TComboBox;
    SpeedButton1: TSpeedButton;
    C1: TMenuItem;
    Panel_image: TPanel;
    Splitter1: TSplitter;
    SpeedButton2: TSpeedButton;
    PopupMenu1: TPopupMenu;
    C2: TMenuItem;
    Panel12: TPanel;
    Panel_web: TPanel;
    WebBrowser1: TWebBrowser;
    ScrollBox3: TScrollBox;
    Image1: TImage;
    ScrollBox1: TScrollBox;
    Label1: TLabel;
    MainTimer: TTimer;
    ImageList1: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    video: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    ToolButton18: TToolButton;
    ToolButton19: TToolButton;
    ToolButton20: TToolButton;
    ToolButton21: TToolButton;
    ToolButton22: TToolButton;
    OpenPictureDialog1: TOpenPictureDialog;
    SavePictureDialog1: TSavePictureDialog;
    ToolButton23: TToolButton;
    ToolButton24: TToolButton;
    SpeedButton3: TSpeedButton;
    ToolButton25: TToolButton;
    ToolButton26: TToolButton;
    ToolButton27: TToolButton;
    Shape1: TShape;
    ToolButton28: TToolButton;
    ToolButton29: TToolButton;
    ToolButton30: TToolButton;
    ToolButton31: TToolButton;
    ToolButton32: TToolButton;
    ToolButton33: TToolButton;
    ToolButton34: TToolButton;
    procedure FormShow(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure FindFile(Dir: String;file_type:string;var save_str:tstringlist);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SpeedButton1Click(Sender: TObject);
    procedure LocalPic;
    procedure RemotePic;
    procedure Panel1Click(Sender: TObject);
    procedure ScrollBox3Click(Sender: TObject);
    procedure ComboBox_urlExit(Sender: TObject);
    procedure MainTimerTimer(Sender: TObject);
    procedure ToolButton21Click(Sender: TObject);
    procedure ToolButton17Click(Sender: TObject);
    procedure ToolButton12Click(Sender: TObject);
    procedure ToolButton16Click(Sender: TObject);
    procedure ToolButton5Click(Sender: TObject);
    procedure ToolButton7Click(Sender: TObject);
    procedure ToolButton23Click(Sender: TObject);
    procedure changeformat(const filename:string);
    procedure ToolButton24Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure ToolButton26Click(Sender: TObject);
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ToolButton29Click(Sender: TObject);
    procedure ToolButton33Click(Sender: TObject);
    procedure getEditMsg(var msg: TMessage);message wm_user + 1;
    procedure C2Click(Sender: TObject);
    procedure Image1DblClick(Sender: TObject);
  private
  startpnt:TPoint;
  begindrag: boolean;

    { Private declarations }
  public
  editaddr:string;
  procedure  bigimage(Sender: TObject);
  procedure  addimage(imagefile:string);
  procedure  imagefreeall;
  procedure  scrolllist;
  
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses left, commom_func, ShowInterface, videocap, umagnify, Ucompress,
  Uzoom, UmakeAVI, Ucompressinfo, Ushezhi;

{$R *.dfm}

procedure TForm1.FormShow(Sender: TObject);
var
recta:TRect;
begin
   Panel_web.Visible := false;
   Panel_image.Align := alClient;
   DockForm.Dock(Panel2,recta);
   DockForm.Show;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  adjustCombox_url;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin

end;

{装载图片
  if showPic('E:\mbl-dbtn7.gif') <> nil then
  form1.Image1.Picture.Assign (showPic('E:\mbl-dbtn7.gif').GetInstance);
}
procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  PopM: TPoint;
begin
  GetCursorPos(PopM);
  PopupMenu1.Popup(PopM.X, PopM.Y);
end;

procedure TForm1.addimage(imagefile: string);
var
image:timage;
begin
image:=timage.Create(ScrollBox1);
try
if showPic(imagefile) <> nil then
image.Picture.Assign (showPic(imagefile).GetInstance(imagefile)) else
image.Picture.LoadFromFile(imagefile);
image.HelpKeyword := imagefile;
image.Hint :=ExtractFileName(imagefile);
image.Cursor := crHandPoint;
image.ShowHint :=true;
image.Width:=100;
image.Height:=100;
image.Left:=lefti;
image.top:=i;
image.AutoSize:=false;
image.Center:=true;
image.Stretch:=true;
image.Parent :=scrollbox1;
image.Visible:=true;
image.OnClick :=bigimage;
if left_view_count<(scrollbox1.Width div 110) then
begin
lefti:=lefti+110;
inc(left_view_count);
end
else
begin
i:=i+110;
left_view_count:=1;
lefti:=10;
end;

except
end;
end;

procedure TForm1.bigimage(Sender: TObject);
begin
  if sender is timage then
  begin
  //加载图片
  image1.Height := (Sender as timage).Picture.Height;
  image1.Width := (Sender as timage).Picture.Width;
  image1.Picture:=(Sender as timage).Picture;
  image1.HelpKeyword := (Sender as timage).HelpKeyword;
  (Sender as timage).SendToBack;
  Label1.Visible := true;
  Label1.Left := (Sender as timage).Left;
  Label1.Top := (Sender as timage).Top;
  ComboBox_url.Text := (Sender as timage).HelpKeyword;
  //显示属性
  Dockform.TabSet1.TabIndex := 2;
  Dockform.Notebook1.PageIndex := 2;
  Dockform.fheight.Caption := IntToStr((Sender as timage).Picture.Height);
  Dockform.fwidth.Caption := IntToStr((Sender as timage).Picture.Width);
  Dockform.Panel7.Hint := Dockform.fheight.Caption + '×' + Dockform.fwidth.Caption;
  Dockform.fsource.Caption := (Sender as timage).HelpKeyword;
  Dockform.fsource.Hint := Dockform.fsource.Caption;
  Dockform.fformat.Caption := GetFileFormat((Sender as timage).HelpKeyword);
  Dockform.fsize.Caption := IntToStr(GetFileSizeInt64((Sender as timage).HelpKeyword))+'K';
  //显示格式转换
  changeformat((Sender as timage).HelpKeyword);
  end;

end;

procedure TForm1.imagefreeall;

var
i:integer;
tmpimage:timage;
begin
tmpimage:=timage.Create(nil);
for i:=ScrollBox1.ComponentCount - 1  downto 0 do
    if ScrollBox1.Components[i] is TImage then
       begin
       tmpimage:=TImage(ScrollBox1.Components[i]);
       FreeAndNil(tmpimage);
       end;

tmpimage.Free ;

end;

procedure TForm1.scrolllist;
var
strlist:tstringlist;
i:integer;
dirstr:string;
begin

dirstr:=trim(Dockform.ShellTreeView1.Path)+'\';
strlist:=tstringlist.Create ;
FindFile(dirstr,'*.bmp',strlist);
FindFile(dirstr,'*.gif',strlist);
FindFile(dirstr,'*.jpg',strlist);
FindFile(dirstr,'*.ico',strlist);
FindFile(dirstr,'*.emf',strlist);
FindFile(dirstr,'*.wmf',strlist);
FindFile(dirstr,'*.jpeg',strlist);
//FindFile(dirstr,'*.gif',strlist);
for i:= 0 to strlist.Count-1 do
    addimage(strlist.Strings[i]);
strlist.Free ;

end;

procedure TForm1.FindFile(Dir: String;file_type:string;var save_str:tstringlist);
var
  sr: TSearchRec;
  FileAttrs: Integer;
begin
  FileAttrs := faReadOnly+faHidden+faSysFile+faVolumeID+faArchive;
  if FindFirst(Dir + file_type, FileAttrs, sr) = 0 then
  begin
    if (sr.Attr and FileAttrs) = sr.Attr then
       save_str.Add(Dir + sr.Name);
    while FindNext(sr) = 0 do
      if (sr.Attr and FileAttrs) = sr.Attr then
         save_str.Add(Dir + sr.Name);
    FindClose(sr);

⌨️ 快捷键说明

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