📄 unit_main.pas
字号:
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 + -