Блокировка сочетаний типа Win+M и т.п.

← →
Вот вам кукиш (2001-12-05 05:09) [3]

Вот собственно "мессаге постер" который так просто не минимизировать

object Form1: TForm1
Left = 453
Top = 421
Width = 195
Height = 135
BorderIcons = [biSystemMenu]
Caption = "Messages Poster"
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = "MS Sans Serif"
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = False
OnActivate = FormActivate
OnCreate = FormCreate
OnDestroy = FormDestroy
OnResize = FormResize
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 33
Top = 12
Width = 25
Height = 13
Caption = "Host:"
end
object Label2: TLabel
Left = 12
Top = 36
Width = 46
Height = 13
Caption = "Message:"
end
object EHost: TComboBox
Left = 64
Top = 8
Width = 121
Height = 21
Hint = "Ins - add host, Del - delete host"
ItemHeight = 13
ParentShowHint = False
ShowHint = True
TabOrder = 0
OnKeyDown = EHostKeyDown
end
object EMsg: TMemo
Left = 64
Top = 40
Width = 121
Height = 65
Hint = ""Shift-Enter" - send message"
Lines.Strings = (
"")
ParentShowHint = False
ShowHint = True
TabOrder = 1
WordWrap = False
OnKeyDown = EMsgKeyDown
end
end

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, RxIni;

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
EHost: TComboBox;
EMsg: TMemo;
function NetSend(Host,Msg: String):boolean;
procedure EHostKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure EMsgKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Minim(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
NetMessageBufferSend: function (ServerName,
MsgName,FromName:PWideChar;
Buf:Pointer;BufLen:DWord):word; stdcall;
SFile: String;
IFile: TRxIniFile;

implementation
{$R *.DFM}
function TForm1.NetSend(Host,Msg: String): Boolean;
var
HLib:HModule;
PWCHost,PWCMsg: PWideChar;
Error:word;
begin
@NetMessageBufferSend:=nil;
HLib:=LoadLibrary("netapi32.dll");
if HLib<>0 then
begin
@NetMessageBufferSend:=GetProcAddress(HLib,"NetMessageBufferSend");
if @NetMessageBufferSend<>nil then
begin
try
Error:=1;
GetMem(PWCHost, 2*Length(Host)+2);
GetMem(PWCMsg, 2*Length(Msg)+2);
StringToWideChar(Host, PWCHost, Length(Host)+2);
StringToWideChar(Msg, PWCMsg, Length(Msg)+2);
Error:=NetMessageBufferSend(nil, PWCHost,nil,PWCMsg,2*Length(Msg));
finally
FreeMem(PWCHost);
FreeMem(PWCMsg);
Result := (Error=0);
end;
end;
FreeLibrary(HLib);
end;
end;

procedure TForm1.EHostKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
// Caption := IntTostr(Key);
Case Key of
45: begin
EHOst.Items.Add(EHost.Text);
end;
46: begin
Ehost.Items.Delete(Ehost.ItemIndex);
end;
// 40: EMSG.SetFocus;
end;
end;

procedure TForm1.EMsgKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
case Key of
38: EHost.SetFocus;
13:
if ssShift in Shift then
begin
EMsg.Enabled := False;
if Not NetSend(EHost.Text ,EMsg.Text) then ShowMessage("Error");
EMsg.Enabled := True;
end;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
GetDir(0,SFile);
Application.OnMinimize := Minim;
if SFile[Length(SFile)] <> "/" then SFile := SFile + "/";
SFile := SFile + "prog.ini";
IFile := TRxIniFile.Create(SFIle);
IFile.ReadClearList("Hosts", EHost.Items);
BoundsRect := IFile.ReadRect("WinSize", "MainWin", BoundsRect);
IFile.Free;
If EHost.Items.Count > 0 then
EHost.ItemIndex := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin

IFile := TRxIniFile.Create(SFIle);
IFile.WriteList("Hosts", EHost.Items);
Ifile.WriteRect("WinSize", "MainWin", BoundsRect);
IFile.Free;
end;

procedure TForm1.Minim(Sender: TObject);
begin
ShowWindow(Handle, SW_RESTORE);
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
Application.Minimize;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
EMSG.Width := Form1.Width - EMSG.Left - 10;
EMSG.Height := Form1.Height - EMSG.Top - 30;
end;

end.

Блокировка сочетаний типа Win+M и т.п. Найти похожие ветки