📄 main.pas
字号:
Unit Main;
Interface
Uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, StdCtrls, Forms,
Dialogs, Menus, MMSystem, PluginsType, RzTabs, RzGroupBar, ComCtrls, RzTreeVw,
ImgList, RzShellCtrls, Shellapi, ExtCtrls, TaskBars, RzBmpBtn, RzPanel, RzBHints, RzCommon;
Type
TNodeType = (ntItem, ntEmptyFolder, ntFolder);
TFrmCCTMain = Class(TForm)
ImageList: TImageList;
Timer: TTimer;
MainPopupMenu: TPopupMenu;
O1: TMenuItem;
A1: TMenuItem;
N1: TMenuItem;
LbTitle: TLabel;
CmdClose: TRzBmpButton;
CmdMax: TRzBmpButton;
CmdTab1: TRzBmpButton;
Panel: TRzPanel;
CmdTab2: TRzBmpButton;
RzMenuController: TRzMenuController;
RzPanelCenter: TRzPanel;
Note: TNotebook;
FavPanel1: TRzPanel;
FavPanel2: TRzPanel;
TV_Fav1: TRzTreeView;
TV_Fav2: TRzShellTree;
Procedure FormClose(Sender: TObject; Var Action: TCloseAction);
Procedure FormCreate(Sender: TObject);
Procedure TV_Fav2DblClick(Sender: TObject);
Procedure TimerTimer(Sender: TObject);
Procedure FormPaint(Sender: TObject);
Procedure FormResize(Sender: TObject);
Procedure LbTitleMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure CmdCloseClick(Sender: TObject);
Procedure CmdMaxClick(Sender: TObject);
Procedure FavPanel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
Procedure FavPanel1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure FavPanel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure FavPanel1MouseLeave(Sender: TObject);
Procedure FavPanel2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure FavPanel2MouseLeave(Sender: TObject);
Procedure FavPanel2MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
Procedure FavPanel2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
Procedure FavPanel1Click(Sender: TObject);
Procedure FavPanel2Click(Sender: TObject);
Procedure FormShow(Sender: TObject);
Private
Bmp: Array[1..15] Of TBitmap;
lpRect: TRect;
Procedure HitTest(Var Msg: TWMNCHITTEST); Message WM_NCHITTEST;
Procedure DrawBtnIcon(Index: Integer; Bitmaps: TRzButtonBitmaps; Image1, Image2: TBitmap);
Procedure LeftTabClick(Sender: TObject);
Public
Protected
Procedure CreateParams(Var Params: TCreateParams); Override;
End;
Function Sg_Plugin: PPluginModule; Stdcall;
Var
FrmCCTMain: TFrmCCTMain = Nil;
Implementation
Uses ShlObj;
{$R *.dfm}
{$R WindowsXP.Res}
Var
ExeApp: TApplication;
MenuItem: TMenuItem;
LibHandle: THandle;
AddPluginPic: PAddPluginPic_CallBack;
Const
{$I PluginInfo.inc}
Info: TPluginInfo = (
Version: PluginVersion;
Name: PluginName;
Description: PluginDescription;
ModulePath: GetModulePath;
);
Function GetPluginInfo: PPluginInfo; Stdcall;
Begin
Result := @Info;
End;
Procedure SetPluginManagerInfo(PMI: PPluginManagerInfo); Stdcall;
Begin
ExeApp := TApplication(PMI^.App);
MenuItem := TMenuItem(PMI^.MenuItem);
LibHandle := PMI^.LibHandle;
AddPluginPic := PMI^.AddPluginPicCallBack;
End;
Procedure SetAbout(This_Module: PPluginModule); Stdcall;
Begin
ExeApp.MessageBox('关于...', '', MB_ICONINFORMATION);
End;
Procedure SetConfig(This_Module: PPluginModule); Stdcall;
Begin
ExeApp.MessageBox('无配置...', '', MB_ICONINFORMATION);
End;
Function SetInitialize(This_Module: PPluginModule): Integer; Stdcall;
Begin
Result := S_OK;
End;
Function SetTerminate(This_Module: PPluginModule): Integer; Stdcall;
Begin
If FrmCCTMain <> Nil Then FreeAndNil(FrmCCTMain);
Result := S_OK;
End;
Function SetStart(This_Module: PPluginModule): Integer; Stdcall;
Begin
If FrmCCTMain = Nil Then ExeApp.CreateForm(TFrmCCTMain, FrmCCTMain);
FrmCCTMain.Show;
Result := S_OK;
End;
Function SetStop(This_Module: PPluginModule): Integer; Stdcall;
Begin
Result := S_OK;
End;
Function SetUninstall(This_Module: PPluginModule): Integer; Stdcall;
Begin
Result := S_OK;
End;
Const
DllModule: TPluginModule = (
PluginInfo: GetPluginInfo;
PluginManagerInfo: SetPluginManagerInfo;
About: SetAbout;
Config: SetConfig;
Initialize: SetInitialize;
Terminate: SetTerminate;
Start: SetStart;
Stop: SetStop;
Uninstall: SetUninstall;
);
Function Sg_Plugin: PPluginModule; Stdcall;
Begin
Result := @DllModule;
End;
{==============================================================================}
Const
Fav: Array[0..1] Of String = ('我的收藏夹', '本地收藏夹');
Procedure DrawRgn(Control: TWinControl; Width, Height, Rgn: Integer);
Var
Hround: HRGN;
Begin
Hround := CreateRoundRectRgn(0, 0, Width, Height, Rgn, Rgn);
SetWindowRgn(Control.Handle, Hround, True);
DeleteObject(Hround);
End;
Procedure DrawPanelBtn(Panel: TRzPanel; Bmp: TBitmap; Caption: String);
Begin
Panel.Canvas.CopyRect(Rect(0, 0, 5, 5), Bmp.Canvas, Rect(0, 0, 5, 5));
Panel.Canvas.CopyRect(Rect(0, Panel.Height - 5, 5, Panel.Height), Bmp.Canvas, Rect(0, Bmp.Height - 5, 5, Bmp.Height { - 1}));
Panel.Canvas.CopyRect(Rect(Panel.Width - 5, 0, Panel.Width, 5), Bmp.Canvas, Rect(Bmp.Width - 5, 0, Bmp.Width, 5));
Panel.Canvas.CopyRect(Rect(Panel.Width - 5, Panel.Height - 5, Panel.Width, Panel.Height), Bmp.Canvas, Rect(Bmp.Width - 5, Bmp.Height - 5, Bmp.Width, Bmp.Height { - 1}));
Panel.Canvas.CopyRect(Rect(5, 0, Panel.Width - 5, 5), Bmp.Canvas, Rect(5, 0, Bmp.Width - 5, 5));
Panel.Canvas.CopyRect(Rect(0, 5, 5, Panel.Height - 5), Bmp.Canvas, Rect(0, 5, 5, Bmp.Height - 5));
Panel.Canvas.CopyRect(Rect(Panel.Width - 5, 5, Panel.Width, Panel.Height - 5), Bmp.Canvas, Rect(Bmp.Width - 5, 5, Bmp.Width, Bmp.Height - 5));
Panel.Canvas.CopyRect(Rect(5, Panel.Height - 5, Panel.Width - 5, Panel.Height), Bmp.Canvas, Rect(5, Bmp.Height - 5, Bmp.Width - 5, Bmp.Height { - 1}));
Panel.Canvas.CopyRect(Rect(5, 5, Panel.Width - 5, Panel.Height - 5), Bmp.Canvas, Rect(5, 5, Bmp.Width - 5, Bmp.Height - 5));
Panel.Canvas.Brush.Style := bsClear;
Panel.Canvas.Font.Color := $00933E1E;
Panel.Canvas.TextOut((Panel.Width Div 2) - (Panel.Canvas.TextWidth(Caption) Div 2), (Panel.Height Div 2) - (Panel.Canvas.TextHeight(Caption) Div 2) - 1, Caption);
End;
Procedure AddBmpSy(Bmp1, Bmp2: TBitmap; Var Image: TBitmap; X, Y: Integer);
Var
i, j: Integer;
Color1, Color2: Tcolor;
Begin
Image.Width := Bmp1.Width;
Image.Height := Bmp1.Height;
For i := 0 To Bmp1.Width - 1 Do
For j := 0 To Bmp1.Height - 1 Do
Image.Canvas.Pixels[i, j] := Bmp1.Canvas.Pixels[i, j];
For i := X To Bmp2.Width + X - 1 Do
For j := Y To Bmp2.Height + Y - 1 Do
Begin
Color1 := Bmp2.Canvas.Pixels[i - X, j - Y];
Color2 := Bmp1.Canvas.Pixels[i, j];
If (GetRValue(Color1) > 254) And (GetGValue(Color1) > 254) And (GetBValue(Color1) > 254) Then
Image.Canvas.Pixels[i, j] := Color2
Else
Image.Canvas.Pixels[i, j] := Color1
End;
End;
Procedure TFrmCCTMain.DrawBtnIcon(Index: Integer; Bitmaps: TRzButtonBitmaps; Image1, Image2: TBitmap);
Begin
Image1.Assign(Nil);
Image2.Assign(Nil);
ImageList.GetBitmap(Index, Image1);
With Bitmaps Do
Begin
AddBmpSy(Up, Image1, Image2, 5, 5);
Up.Assign(Image2);
AddBmpSy(Hot, Image1, Image2, 5, 5);
Hot.Assign(Image2);
AddBmpSy(Disabled, Image1, Image2, 5, 5);
Disabled.Assign(Image2);
AddBmpSy(Down, Image1, Image2, 6, 6);
Down.Assign(Image2);
End;
End;
Procedure TFrmCCTMain.CreateParams(Var Params: TCreateParams);
Begin //重载不显示在任务栏
Inherited CreateParams(Params);
Params.WndParent := ExeApp.MainForm.Handle;
End;
Procedure TFrmCCTMain.HitTest(Var Msg: TWMNCHITTEST);
Var
pt: TPoint;
Begin
pt.X := Msg.XPos;
pt.Y := Msg.YPos;
pt := ScreenToClient(pt);
If PtInRect(Rect(lpRect.Right - 5, lpRect.Top + 5,
lpRect.Right + 5, lpRect.Bottom - 5), pt) Then
Msg.Result := HTRIGHT //右边
Else If PtInRect(Rect(lpRect.Left - 5, lpRect.Top + 5,
lpRect.Left + 5, lpRect.Bottom - 5), pt) Then
Msg.Result := HTLEFT //左边
Else If PtInRect(Rect(lpRect.Left + 5, lpRect.Top - 5,
lpRect.Right - 5, lpRect.Top + 5), pt) Then
Msg.Result := HTTOP //上边
Else If PtInRect(Rect(lpRect.Left + 5, lpRect.Bottom - 5,
lpRect.Right - 5, lpRect.Bottom + 5), pt) Then
Msg.Result := HTBOTTOM //下边
Else If PtInRect(Rect(lpRect.Left - 5, lpRect.Top - 5,
lpRect.Left + 5, lpRect.Top + 5), pt) Then
Msg.Result := HTTOPLEFT //左上角
Else If PtInRect(Rect(lpRect.Right - 5, lpRect.Bottom - 5,
lpRect.Right + 5, lpRect.Bottom + 5), pt) Then
Msg.Result := HTBOTTOMRIGHT //右下角
Else If PtInRect(Rect(lpRect.Left - 5, lpRect.Bottom - 5,
lpRect.Left + 5, lpRect.Bottom + 5), pt) Then
Msg.Result := HTBOTTOMLEFT //左下角
Else If PtInRect(Rect(lpRect.Right - 5, lpRect.Left - 5,
lpRect.Right + 5, lpRect.Left + 5), pt) Then
Msg.Result := HTTOPRIGHT //右上角
Else
Inherited;
End;
Procedure TFrmCCTMain.FormClose(Sender: TObject; Var Action: TCloseAction);
Var
i: Integer;
Begin
For i := 1 To High(Bmp) Do
Bmp[i].Free;
Action := caFree; //自释放窗体
FrmCCTMain := Nil;
End;
Procedure TFrmCCTMain.FormCreate(Sender: TObject);
Procedure InitBmpBtn(Btn: TRzBmpButton);
Begin
With Btn.Bitmaps Do
Begin
Up.LoadFromResourceID(HInstance, 10);
Hot.LoadFromResourceID(HInstance, 11);
Disabled.LoadFromResourceID(HInstance, 12);
Down.LoadFromResourceID(HInstance, 10);
TransparentColor := clFuchsia;
End;
Btn.OnClick := LeftTabClick;
End;
Var
i: Integer;
Bitmap1, Bitmap2: TBitmap;
Begin
With Constraints Do
Begin
MaxHeight := Screen.Height;
MaxWidth := 500;
MinHeight := 480;
MinWidth := 175;
End;
For i := 1 To High(Bmp) Do
Begin
Bmp[i] := TBitmap.Create;
Bmp[i].LoadFromResourceID(HInstance, i);
End;
TV_Fav1.Align := alClient;
TV_Fav2.Visible := False;
InitBmpBtn(CmdTab1);
InitBmpBtn(CmdTab2);
Bitmap1 := TBitmap.Create;
Bitmap2 := TBitmap.Create;
Bitmap1.PixelFormat := pf24bit;
Bitmap2.PixelFormat := pf24bit;
DrawBtnIcon(3, CmdTab1.Bitmaps, Bitmap1, Bitmap2);
DrawBtnIcon(4, CmdTab2.Bitmaps, Bitmap1, Bitmap2);
Bitmap2.Free;
Bitmap1.Free;
//TabSheet1.Color := RGB(198, 213, 241);
//TabSheet2.Color := RGB(243, 231, 202);
//TabSheet1.Caption := '收' + #13#10 + '藏' + #13#10 + '夹';
//TabSheet2.Caption := '程' + #13#10 + '序' + #13#10 + '组';
//TV_Fav1.Color := RGB(213, 229, 251);
//TV_Fav2.Color := RGB(213, 229, 251);
//RzGroupBar1.BorderColor := TabSheet1.Color;
SetWindowPos(FrmCCTMain.Handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE);
FrmCCTMain.Top := 50;
FrmCCTMain.Left := Screen.Width - FrmCCTMain.Width - 50;
End;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -