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

📄 unit_main.pas

📁 至于这小软件的用途
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Unit_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, jpeg,GIFImage,Unit_Common, Menus,shellapi,
  CnClasses, CnTrayIcon,GraphicEx,Registry,Unit_ListPic,iniFiles;

const    WM_MYTRAYICONCALLBACK = WM_USER + 1000 ;
  
type  TcontrolThread = class(TThread)
  public
    constructor create;//override;
    procedure Execute;override;
  end;
type
  TFrm_Main = class(TForm)
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    Image1: TImage;
    Image2: TImage;
    procedure FormCreate(Sender: TObject);
    procedure N1Click(Sender: TObject);

    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure  ReadIni;
    procedure  WriteIni;
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormPaint(Sender: TObject);

  private
    { Private declarations }
      MyTrayIcon : TNotifyIconData ;
    procedure FnLoadImage(inImgName:string);//读取指定图像
    procedure redraw;
    procedure downalpha;
    procedure upalpha;
    procedure delIcon;
  procedure TrayShow(Sender: TObject);
  procedure WMMyTrayIconCallBack(Var Msg:TMessage); message  WM_MYTRAYICONCALLBACK;
    // 当文件拖放至窗体中后,系统将向窗体发送WM_DRAPFILES事件,
    // 因此我们可以在WMDROPFILES过程中获取文件总数及文件名。
    procedure WMDROPFILES(var Msg: TMessage);message WM_DROPFILES;
  public
    { Public declarations }
    procedure Changestate; //改变主窗体状态
    procedure NewLoadPic;  //直接读取图片
  end;

var
  Frm_Main: TFrm_Main;
  ControlThread:TcontrolThread;
  Piclist:TPicList;
    jpg : TJpegImage;
    gif : TGIFImage;
    bmp : TBitmap;
    FromHandle:THandle;
    LastChangeTime:Cardinal=0;  //图片上次变化时间
    EXimage :TGraphicExGraphic;
    procedure Didchange;  //线程调用进行改变

implementation


uses
  Unit_State;

{$R *.dfm}


constructor TcontrolThread.create;
begin
  inherited Create(false);
end;

procedure TcontrolThread.Execute;
begin
  Sleep(10);
  ImgFolderChanged:=true;
  Frm_Main.NewLoadPic;
  ImgFolderChanged:=false;
  while not Terminated do begin
    try
       DidChange; //根据全局变量来考虑是否改变图像
      Sleep(5000);
    except
      Sleep(5000);
    end; // try
  end; // while
end;

procedure Didchange;
var tmpstr:string;
begin
  if ImgChangeTime=99 then exit;
  
  if GetTickCount - LastChangeTime >= (ImgChangeTime*60000) then
  begin
    if not Piclist.HavPic then Exit;

    if ImgViewType=0 then
      tmpstr:=Piclist.GetFirstPicFile
      else
      tmpstr:=Piclist.GetRandomPicFile;

     if isPicture(tmpstr) then
     begin
       Frm_Main.FnLoadImage(tmpstr);
       LastChangeTime:= GetTickCount;
     end;
  end
  else
  begin
  end;
end;

procedure TFrm_Main.FormCreate(Sender: TObject);
begin
  //  Sleep(10);
  SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);//程序不在任务栏上显示
  ReadIni;
  //创建控制线程
  Piclist:=TPicList.create;
  EXimage:=TGraphicExGraphic.create;

  // 当程序启动时,启用文件拖放功能。当第二个参数True时,
  // 启用文件拖放,如果为False则禁止文件拖放。
  Changestate;
  upalpha;
  DragAcceptFiles(Handle, True);
  ControlThread:=TControlThread.create;

  TrayShow(Application.MainForm);//显示图标
end;


procedure  TFrm_Main.FnLoadImage(inImgName:string);
var
  GraphicClass: TGraphicExGraphicClass;
  Graphic: TGraphic;
  JPGGraphic:TPicture;
  tmpt:Integer;
  tmpl:Integer;
  tmpw:Integer;
  tmph:integer;
begin
  tmpl:= Image1.Left;
  tmpt:= Image1.Top;
  upalpha;
  GraphicClass := FileFormatList.GraphicFromContent(inImgName);
  if GraphicClass = nil then
    begin
      JPGGraphic:= TPicture.Create;
      JPGGraphic.LoadFromFile(inImgName);
      if (JPGGraphic.Graphic.Width>ImgLarge) or (JPGGraphic.Graphic.Height>ImgLarge) then
      begin
         if JPGGraphic.Graphic.Width>=JPGGraphic.Graphic.Height then
         begin
          tmpw:=ImgLarge;
          tmph:= (JPGGraphic.Graphic.Height * ImgLarge) div JPGGraphic.Graphic.Width;

         end
         else
         begin
          tmpw:=(JPGGraphic.Graphic.Width * ImgLarge) div JPGGraphic.Graphic.Height;
          tmph:=ImgLarge;
           
         end;
      end
      else
      begin
        tmpw:=JPGGraphic.Graphic.Width;
        tmph:=JPGGraphic.Graphic.Height;


      end;
      //sleep(100);
      Image1.SetBounds(tmpl,tmpt,tmpw,tmph);
      redraw;
    Image1.Picture.Graphic := JPGGraphic.Graphic;
    JPGGraphic.Destroy;
    end
  else
    begin
      Graphic:= GraphicClass.Create;
      Graphic.LoadFromFile(inImgName);

      if (Graphic.Width>ImgLarge) or (Graphic.Height>ImgLarge) then
      begin
         if Graphic.Width>=Graphic.Height then
         begin
            tmph:=(Graphic.Height * ImgLarge) div
              Graphic.Width;
            tmpw:=ImgLarge;
         end
         else
         begin
            tmpw:=(Graphic.Width * ImgLarge) div
              Graphic.Height;
            tmph:=ImgLarge;
         end;
      end
      else
      begin
          tmph:=Graphic.Height;
          tmpw:=Graphic.Width;
      end;
    Image1.SetBounds(tmpl,tmpt,tmpw,tmph);
    redraw;
    Image1.Picture.Graphic := Graphic;
    Graphic.Destroy;
    end;


    downalpha;
end;

procedure TFrm_Main.downalpha;      //显示
begin
 while Frm_Main.AlphaBlendValue<(255-Alphafrm) do
 begin
   if Frm_Main.AlphaBlendValue>=(245-Alphafrm) then
     Frm_Main.AlphaBlendValue:=(255-Alphafrm)
   else
     Frm_Main.AlphaBlendValue:=Frm_Main.AlphaBlendValue+10;
     Sleep(30);
   end;
end;

procedure TFrm_Main.upalpha;        //消失
begin
 while Frm_Main.AlphaBlendValue>0 do
 begin
   if Frm_Main.AlphaBlendValue<=10 then
      Frm_Main.AlphaBlendValue:=0
   else
      Frm_Main.AlphaBlendValue:=Frm_Main.AlphaBlendValue-10;
   Sleep(30);
   end;
end;

procedure TFrm_Main.NewLoadPic;
var  tmpstr:string;
begin
  if not Piclist.HavPic then Exit;
  if ImgFolderChanged then
  begin
    if ImgViewType=0 then
      tmpstr:=Piclist.GetFirstPicFile
      else
      tmpstr:=Piclist.GetRandomPicFile;

     if isPicture(tmpstr) then
     begin
       Frm_Main.FnLoadImage(tmpstr);
       LastChangeTime:= GetTickCount;
     end;
  end;
end;  
procedure TFrm_Main.Changestate;
var
regRunself : TRegistry;

begin
  WriteIni;
  //透明度
  Frm_Main.AlphaBlend:=True;
  Frm_Main.AlphaBlendValue:=255-Alphafrm;
  //那么鼠标穿透
  if ImgMouseIn then
  begin
    SetWindowLong(Handle, GWL_EXSTYLE,GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_TRANSPARENT)

  end
  else
  begin
    SetWindowLong(Handle, GWL_EXSTYLE,GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_TRANSPARENT);
  end;
  //窗体位置
  delIcon;
  case ImgFrmlayer of
  0:
    begin

      Frm_Main.FormStyle:=fsNormal;
      windows.SetParent(Frm_Main.Handle,findwindow('Progman',nil));  //
       BringWindowToTop(Frm_Main.Handle);
      //这个实现了嵌入桌面
      TrayShow(Application.MainForm);//显示图标
    end;
  1:
    begin
       Frm_Main.FormStyle:=fsStayOnTop;   //置顶
       BringWindowToTop(Frm_Main.Handle);
       TrayShow(Application.MainForm);//显示图标
    end;
  end;

  //开机自动运行
  regRunself := TRegistry.Create;
  if ImgAutoRun then
  begin
    try
      regRunself.RootKey := HKEY_LOCAL_MACHINE;
      If regRunself.OpenKey('Software\Microsoft\Windows\CurrentVersion\Run',true) then
      begin
        if not regRunself.ValueExists('DesktopPic') then
        begin
          regRunself.WriteString('DesktopPic',Application.Exename);
        end;
        regRunself.CloseKey;
      end;

⌨️ 快捷键说明

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