..::Свирепый Кодер::..
Профиль
Группа: Участник
Сообщений: 901
Регистрация: 17.10.2004
Где: ICQ
Репутация: нет
Всего: 11
|
ой наткнулся на эту тему) гы) раз обещал выложить) тогда ща выложу проект уже как пол года закончил) | Код |
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, registry, Mask, JvExMask, JvToolEdit, ExtCtrls, ComCtrls,
XPStyleActnCtrls, ImgList, Menus, ActnPopupCtrl, ShellAPI;
const
WM_MESSAGE_FROM_MY_HOOK = WM_USER + $AA;
type
MyProcType = procedure (Flag: Boolean); stdcall;
type
TForm1 = class(TForm)
ScrollBox1: TScrollBox;
Panel1: TPanel;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
Label1: TLabel;
Label2: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Edit5: TEdit;
Edit6: TEdit;
Edit7: TEdit;
Edit8: TEdit;
Edit9: TEdit;
Edit10: TEdit;
Edit11: TEdit;
Edit12: TEdit;
Edit13: TEdit;
Edit14: TEdit;
Edit15: TEdit;
Edit16: TEdit;
Edit17: TEdit;
Edit18: TEdit;
Edit19: TEdit;
Edit20: TEdit;
Edit21: TEdit;
Edit22: TEdit;
Edit23: TEdit;
Edit24: TEdit;
Edit25: TEdit;
Edit26: TEdit;
Edit27: TEdit;
Edit28: TEdit;
Edit29: TEdit;
Edit30: TEdit;
Edit31: TEdit;
Edit32: TEdit;
Edit33: TEdit;
Edit34: TEdit;
Edit35: TEdit;
Edit36: TEdit;
Edit37: TEdit;
Edit38: TEdit;
Edit39: TEdit;
Edit40: TEdit;
Edit41: TEdit;
Edit42: TEdit;
Edit43: TEdit;
Edit44: TEdit;
Edit45: TEdit;
Edit46: TEdit;
Edit47: TEdit;
Edit48: TEdit;
Edit49: TEdit;
Edit50: TEdit;
Edit51: TEdit;
Edit52: TEdit;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
JvFilenameEdit1: TJvFilenameEdit;
JvFilenameEdit2: TJvFilenameEdit;
JvFilenameEdit3: TJvFilenameEdit;
JvFilenameEdit4: TJvFilenameEdit;
JvFilenameEdit5: TJvFilenameEdit;
JvFilenameEdit6: TJvFilenameEdit;
JvFilenameEdit7: TJvFilenameEdit;
JvFilenameEdit8: TJvFilenameEdit;
JvFilenameEdit9: TJvFilenameEdit;
JvFilenameEdit10: TJvFilenameEdit;
JvFilenameEdit11: TJvFilenameEdit;
JvFilenameEdit12: TJvFilenameEdit;
JvFilenameEdit13: TJvFilenameEdit;
JvFilenameEdit14: TJvFilenameEdit;
JvFilenameEdit15: TJvFilenameEdit;
JvFilenameEdit16: TJvFilenameEdit;
JvFilenameEdit17: TJvFilenameEdit;
JvFilenameEdit18: TJvFilenameEdit;
JvFilenameEdit19: TJvFilenameEdit;
JvFilenameEdit20: TJvFilenameEdit;
JvFilenameEdit21: TJvFilenameEdit;
JvFilenameEdit22: TJvFilenameEdit;
JvFilenameEdit23: TJvFilenameEdit;
JvFilenameEdit24: TJvFilenameEdit;
JvFilenameEdit25: TJvFilenameEdit;
JvFilenameEdit26: TJvFilenameEdit;
JvFilenameEdit27: TJvFilenameEdit;
JvFilenameEdit28: TJvFilenameEdit;
JvFilenameEdit29: TJvFilenameEdit;
JvFilenameEdit30: TJvFilenameEdit;
JvFilenameEdit31: TJvFilenameEdit;
JvFilenameEdit32: TJvFilenameEdit;
JvFilenameEdit33: TJvFilenameEdit;
JvFilenameEdit34: TJvFilenameEdit;
JvFilenameEdit35: TJvFilenameEdit;
JvFilenameEdit36: TJvFilenameEdit;
JvFilenameEdit37: TJvFilenameEdit;
JvFilenameEdit38: TJvFilenameEdit;
JvFilenameEdit39: TJvFilenameEdit;
JvFilenameEdit40: TJvFilenameEdit;
JvFilenameEdit41: TJvFilenameEdit;
JvFilenameEdit42: TJvFilenameEdit;
JvFilenameEdit43: TJvFilenameEdit;
JvFilenameEdit44: TJvFilenameEdit;
JvFilenameEdit45: TJvFilenameEdit;
JvFilenameEdit46: TJvFilenameEdit;
JvFilenameEdit47: TJvFilenameEdit;
JvFilenameEdit48: TJvFilenameEdit;
JvFilenameEdit49: TJvFilenameEdit;
JvFilenameEdit50: TJvFilenameEdit;
JvFilenameEdit51: TJvFilenameEdit;
JvFilenameEdit52: TJvFilenameEdit;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
MainMenu: TPopupActionBarEx;
PopUpMenu: TPopupActionBarEx;
ImageList1: TImageList;
AutoStart: TMenuItem;
Sets: TMenuItem;
Exit: TMenuItem;
OnOff: TMenuItem;
Teory: TMenuItem;
Usl: TMenuItem;
Resh: TMenuItem;
Resh2: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
N24: TMenuItem;
N25: TMenuItem;
N26: TMenuItem;
N27: TMenuItem;
N28: TMenuItem;
N29: TMenuItem;
N30: TMenuItem;
N31: TMenuItem;
N32: TMenuItem;
N33: TMenuItem;
N34: TMenuItem;
N35: TMenuItem;
N36: TMenuItem;
N37: TMenuItem;
N38: TMenuItem;
N39: TMenuItem;
N40: TMenuItem;
N41: TMenuItem;
N42: TMenuItem;
N43: TMenuItem;
N44: TMenuItem;
N45: TMenuItem;
N46: TMenuItem;
N47: TMenuItem;
N48: TMenuItem;
N49: TMenuItem;
N50: TMenuItem;
N51: TMenuItem;
N52: TMenuItem;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure SaveSets;
procedure LoadSets;
procedure Ic(n:Integer;Icon:TIcon);
procedure SetsClick(Sender: TObject);
procedure ExitClick(Sender: TObject);
procedure AutoStartClick(Sender: TObject);
procedure AutoRun;
procedure OnOffClick(Sender: TObject);
procedure HookInRun;
procedure CheckBox2Click(Sender: TObject);
procedure SetCaptions;
procedure N1Click(Sender: TObject);
private
procedure WM_MSG_FROM_HOOK(var msg: TMessage); message WM_MESSAGE_FROM_MY_HOOK;
public
{ Public declarations }
protected
procedure IconMouse(var Msg: TMessage); message WM_USER + 1;
procedure ControlWindow(var Msg: TMessage); message WM_SYSCOMMAND;
end;
var
Form1: TForm1;
AutoStartUp: Boolean;
HDLL:HWND;
implementation
{$R *.dfm}
procedure TForm1.WM_MSG_FROM_HOOK(var msg: TMessage);
begin
//SetForegroundWindow(application.Handle);
MainMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
//PostMessage(Handle,WM_NULL,0,0);
end;
procedure TForm1.AutoRun;
var RegIni:TRegIniFile;
begin
if AutoStartUp then
begin
RegIni:=TRegIniFile.Create('Software');
RegIni.RootKey:=HKEY_CURRENT_USER;
RegIni.OpenKey('\Software\Microsoft\Windows\CurrentVersion', true);
RegIni.WriteString('run','TesT', Application.ExeName);
RegIni.Free;
AutoStart.Checked:=true;
CheckBox1.Checked:=true;
end
else begin
RegIni:=TRegIniFile.Create('Software');
RegIni.RootKey:=HKEY_CURRENT_USER;
RegIni.OpenKey('\Software\Microsoft\Windows\CurrentVersion', true);
RegIni.DeleteKey('run','TesT');
RegIni.Free;
AutoStart.Checked:=false;
CHeckBox1.Checked:=false;
end;
end;
procedure TForm1.SaveSets;
var
settings: TMemoryStream;
R: TRegistry;
i,b :integer;
S: PChar;
l: word;
bb: boolean;
begin
PageControl1.ActivePageIndex:=0;
PageControl1.ActivePageIndex:=1;
PageControl1.ActivePageIndex:=2;
PageControl1.ActivePageIndex:=3;
settings := TMemoryStream.Create;
for i:=0 to PageControl1.ControlCount-1 do
if PageControl1.Controls[i] is TTabSheet then
begin
for b:=0 to TTabSheet(PageControl1.Controls[i]).ControlCount-1 do
if TTabSheet(PageControl1.Controls[i]).Controls[b] is TEdit then
begin
S := PChar(TEdit(TTabSheet(PageControl1.Controls[i]).Controls[b]).Text);
l := length(S);
settings.WriteBuffer(l, 1);
if l > 0 then settings.WriteBuffer(S^, l);
end
else begin
if TTabSheet(PageControl1.Controls[i]).Controls[b] is TJvFileNameEdit then
begin
S := PChar(TJvFileNameEdit(TTabSheet(PageControl1.Controls[i]).Controls[b]).Text);
l := length(S);
settings.WriteBuffer(l, 2);
if l > 0 then settings.WriteBuffer(S^, l);
end;
end;
end;
for i:=0 to ControlCount-1 do
begin
if controls[i] is TPanel then
begin
for b:=0 to TPanel(controls[i]).ControlCount-1 do
begin
if TPanel(controls[i]).Controls[b] is TCheckBox then
begin
bb := TCheckBox(TPanel(controls[i]).Controls[b]).Checked;
settings.WriteBuffer(bb, 3);
end;
end;
end;
end;
R := TRegistry.Create;
R.RootKey := HKEY_CURRENT_USER;
R.OpenKey('Software\FragSoft\Test\', true);
settings.Seek(0, soFromBeginning);
R.WriteBinaryData('settings', settings.Memory^, settings.Size);
R.Free;
settings.free;
end;
procedure TForm1.LoadSets;
var
settings: TMemoryStream;
R: TRegistry;
buf: PChar;
size: integer;
i,b :integer;
l: word;
bb: boolean;
begin
PageControl1.ActivePageIndex:=0;
R := TRegistry.Create;
R.RootKey := HKEY_CURRENT_USER;
R.OpenKey('Software\FragSoft\Test\', true);
if R.ValueExists('settings') then
begin
size := R.GetDataSize('settings');
buf := GetMemory(size);
R.ReadBinaryData('settings', buf^, size);
settings := TMemoryStream.Create;
settings.Write(buf^, size);
FreeMemory(buf);
settings.Seek(0, soFromBeginning);
for i:=0 to PageControl1.ControlCount-1 do
if PageControl1.Controls[i] is TTabSheet then
begin
for b:=0 to TTabSheet(PageControl1.Controls[i]).ControlCount-1 do
if TTabSheet(PageControl1.Controls[i]).Controls[b] is TEdit then
begin
settings.ReadBuffer(l, 1);
if l > 0 then
begin
buf := GetMemory(l);
settings.ReadBuffer(buf^, l);
TEdit(TTabSheet(PageControl1.Controls[i]).Controls[b]).Text := copy(buf, 1, l);
FreeMemory(buf);
end;
end else
begin
if TTabSheet(PageControl1.Controls[i]).Controls[b] is TJvFileNameEdit then
begin
settings.ReadBuffer(l, 2);
if l > 0 then
begin
buf := GetMemory(l);
settings.ReadBuffer(buf^, l);
TJvFileNameEdit(TTabSheet(PageControl1.Controls[i]).Controls[b]).Text := copy(buf, 1, l);
FreeMemory(buf)
end;
end;
end;
end;
for i:=0 to ControlCount-1 do
begin
if controls[i] is TPanel then
begin
for b:=0 to TPanel(controls[i]).ControlCount-1 do
begin
if TPanel(controls[i]).Controls[b] is TCheckBox then
begin
settings.ReadBuffer(bb, 3);
TCheckBox(TPanel(controls[i]).Controls[b]).Checked := bb
end;
end;
end;
end;
settings.Free;
end;
R.Free;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action:=caNone;
ShowWindow(Handle, SW_HIDE);
ShowWindow(Application.Handle, SW_HIDE);
//Ic(1, Application.Icon);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
loadSets;
HookInRun;
SetCaptions;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked then
AutoStartUp:=true
else
AutoStartUp:=false;
AutoRun;
end;
procedure TForm1.Ic(n:Integer;Icon:TIcon);
Var
Nim:TNotifyIconData;
begin
With Nim do
Begin
cbSize:=SizeOf(Nim);
Wnd:=Form1.Handle;
uID:=1;
uFlags:=NIF_ICON or NIF_MESSAGE or NIF_TIP;
hicon:=Icon.Handle;
uCallbackMessage:=wm_user+1;
szTip:='Программа х.з. как называется) Автор FRAGNATIC';
End;
Case n OF
1: Shell_NotifyIcon(Nim_Add,@Nim);
2: Shell_NotifyIcon(Nim_Delete,@Nim);
3: Shell_NotifyIcon(Nim_Modify,@Nim);
End;
end;
procedure TForm1.ControlWindow(var Msg: TMessage);
begin
if Msg.WParam = SC_MINIMIZE then
begin
//Ic(1, Application.Icon);
ShowWindow(Handle, SW_HIDE);
ShowWindow(Application.Handle, SW_HIDE);
end
else
inherited;
end;
procedure TForm1.IconMouse(var Msg: TMessage);
var
p: tpoint;
begin
GetCursorPos(p);
case Msg.LParam of
WM_LBUTTONUP, WM_LBUTTONDBLCLK:
begin
//Ic(2, Application.Icon);
SetForegroundWindow(Handle);
PopupMenu.Popup(p.X, p.Y);
PostMessage(Handle, WM_NULL, 0, 0)
end;
WM_RBUTTONUP:
begin
//SetForegroundWindow(Handle);
//PopupMenu.Popup(p.X, p.Y);
//PostMessage(Handle, WM_NULL, 0, 0)
end;
end;
end;
procedure TForm1.SetsClick(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_SHOW);
ShowWindow(Handle, SW_SHOW);
end;
procedure TForm1.ExitClick(Sender: TObject);
begin
SaveSets;
Ic(2, Application.Icon);
Application.Terminate;
end;
procedure TForm1.AutoStartClick(Sender: TObject);
begin
AutoStart.Checked:=not AutoStart.Checked;
if AutoStart.Checked then
AutoStartUp:=true
else
AutoStartUp:=false;
AutoRun;
end;
procedure TForm1.OnOffClick(Sender: TObject);
Var Hook: MyProcType;
begin
if OnOff.Caption='Отключить' then
begin
@Hook:=nil;
IF HDLL>HINSTANCE_ERROR then
Begin
@Hook:=GetProcAddress(HDLL,'Hook');
Hook(False);
End;
OnOff.Caption:='Включить';
OnOff.ImageIndex:=23;
end
else begin
@Hook:=nil;
HDLL:=LoadLibrary(PChar('Mouse2Hook.dll'));
IF HDLL>HINSTANCE_ERROR then
Begin
@Hook:=GetProcAddress(HDLL,'Hook');
Hook(True);
End else MessageDlg('Ошибка загрузки DLL.',mtError,[mbIgnore],0);
OnOff.Caption:='Отключить';
OnOff.ImageIndex:=22;
end
end;
procedure TForm1.HookInRun;
Var Hook: MyProcType;
begin
if CheckBox2.Checked then
begin
@Hook:=nil;
HDLL:=LoadLibrary(PChar('Mouse2Hook.dll'));
IF HDLL>HINSTANCE_ERROR then
Begin
@Hook:=GetProcAddress(HDLL,'Hook');
Hook(True);
End else MessageDlg('Ошибка загрузки DLL.',mtError,[mbIgnore],0);
OnOff.Caption:='Отключить';
OnOff.ImageIndex:=22;
end
else begin
@Hook:=nil;
IF HDLL>HINSTANCE_ERROR then
Begin
@Hook:=GetProcAddress(HDLL,'Hook');
Hook(False);
End;
OnOff.Caption:='Включить';
onOff.ImageIndex:=23;
end;
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
HookInRun;
end;
procedure TForm1.SetCaptions;
var
i: integer;
m:TMenuItem;
e:TEdit;
begin
for i:=1 to 52 do
begin
m:=FindComponent('N'+inttostr(i)) as TMenuitem;
if m=nil then continue;
e:=FindComponent('Edit'+inttostr(i)) as TEdit;
if e=nil then continue;
m.caption:=e.text;
end;
end;
procedure TForm1.N1Click(Sender: TObject);
var
Jv: TJvFilenameEdit;
s: string;
begin
if Length(TMenuItem(sender).Name)=2 then
s:=copy(TMenuItem(sender).Name,length(TMenuItem(sender).Name),1)
else
if Length(TMenuItem(sender).Name)=3 then
s:=copy(TMenuItem(sender).Name,length(TMenuItem(sender).Name)-1,2);
Jv:=FindComponent('JvFilenameEdit'+s) as TJvFilenameEdit;
if jv.Text<>'' then
ShellExecute(handle, 'open', PChar(Jv.Text), '', '', sw_show)
else ShowMessage('Файл не указан');
end;
end.
|
| Код |
library Mouse2Hook;
Uses Windows,Messages, Controls;
const
WM_MESSAGE_FROM_MY_HOOK = WM_USER + $AA;
Var SysHook:HHook=0;
Function SysMsgProc(Code:Integer; WParam:LongInt; LParam:LongInt):LongInt; stdcall;
Var Msg:TMessage;
Begin
IF Code=HC_ACTION then
Case TMsg(Pointer(LParam)^).Message OF
WM_RBUTTONDOWN,WM_RBUTTONUP,WM_RBUTTONDBLCLK:
begin
TMsg(Pointer(LParam)^).Message:=WM_NULL;
PostMessage(FindWindow('TForm1',nil), WM_MESSAGE_FROM_MY_HOOK, Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
else Result:=CallNextHookEx(SysHook,Code,WParam,LParam);
End;
end;
procedure Hook(Flag:Boolean); export; stdcall;
Begin
IF Flag then SysHook:=SetWindowsHookEx(WH_GETMESSAGE,@SysMsgProc,HInstance,0) Else
Begin
UnhookWindowsHookEx(SysHook);
//SysHook:=0;
End;
End;
exports Hook;
{$R *.res}
begin
end.
|
|
Сообственое PopupMenu вместо Windows'кого 
Загрузка ...
Дата 11.12.2004, 12:27 (
1.zip 36,58 Kb
