Banner 468

Showing posts with label Delphi - Delphi Tips and Tricks. Show all posts
Showing posts with label Delphi - Delphi Tips and Tricks. Show all posts
Wednesday, April 20, 2011

Disable Mouse and Keyboard

0 comments
 
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

function BlockInput(fBlockInput: Boolean): DWORD; stdcall; external 'user32.DLL';

function FunctionDetect(LibName, FuncName: string; var LibPointer: Pointer): Boolean;
var
LibHandle: THandle;
begin
Result := False;
LibPointer := nil;
if LoadLibrary(PChar(LibName)) = 0 then Exit;
LibHandle := GetModuleHandle(PChar(LibName));
if LibHandle <> 0 then
begin
LibPointer := GetProcAddress(LibHandle, PChar(FuncName));
if LibPointer <> nil then Result := True;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
xBlockInput: function (Block: BOOL): BOOL; stdcall;
begin
if FunctionDetect('USER32.DLL', 'BlockInput', @xBlockInput) then
begin
xBlockInput(True); // Disable Keyboard & mouse
Sleep(10000); // tunggu 10 detik
xBlockInput(False); // Enable Keyboard & mouse
end;
end;

end.
Readmore...

Draw on the title bar

0 comments
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;

type
TForm1 = class(TForm)
private
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);

var
ACanvas : TCanvas;
begin
inherited;
ACanvas := TCanvas.Create;
try
ACanvas.Handle := GetWindowDC(Form1.Handle);
with ACanvas do begin
Brush.Color := clActiveCaption;
Font.Name := 'Tahoma';
Font.Size := 8;
Font.Color := clYellow;
Font.Style := [fsItalic, fsBold];
TextOut(GetSystemMetrics(SM_CYMENU) + GetSystemMetrics(SM_CXBORDER),
Round((GetSystemMetrics(SM_CYCAPTION) - Abs(Font.Height))/2) + 1,
' Teks pada Caption');
end;
finally
ReleaseDC(Form1.Handle, ACanvas.Handle);
ACanvas.Free;
end;
end;

end.
Readmore...

disable the close menu

0 comments
 
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Label1: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
hMenuHandle : HMENU;
begin
hMenuHandle := GetSystemMenu(Form1.Handle, FALSE);
if (hMenuHandle <> 0) then DeleteMenu(hMenuHandle, SC_CLOSE, MF_BYCOMMAND);
end;

end.
Readmore...