Quando clicar em ALT F4 abrir um form sem fechar o programa?

unit Uprincipal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ActnMan, ActnColorMaps, ToolWin,
  ActnCtrls, ActnMenus, CustomizeDlg, StdActns, ActnList, ComCtrls, ImgList, DB, ADODB, ExtCtrls, Buttons,
  XPStyleActnCtrls, WinSock, ScktComp, MSNPopUp, ZAbstractRODataset,
  ZAbstractDataset, ZDataset, ZConnection, XPMan;

type
  TfrmPrincipal = class(TForm)
    ImageList1: TImageList;
    Timer1: TTimer;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    Label4: TLabel;
    Label3: TLabel;
    Label13: TLabel;
    Label15: TLabel;
    Label14: TLabel;
    Label16: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Shape5: TShape;
    Shape6: TShape;
    Shape7: TShape;
    Shape8: TShape;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Panel2: TPanel;
    Shape1: TShape;
    Shape2: TShape;
    Panel3: TPanel;
    Label2: TLabel;
    Shape3: TShape;
    Shape4: TShape;
    Shape9: TShape;
    Shape10: TShape;
    Shape11: TShape;
    Shape12: TShape;
    Shape13: TShape;
    Shape14: TShape;
    Label19: TLabel;
    Label53: TLabel;
    Label21: TLabel;
    Label51: TLabel;
    Label23: TLabel;
    Label50: TLabel;
    Label25: TLabel;
    Label52: TLabel;
    ActionManager1: TActionManager;
    ActionMainMenuBar1: TActionMainMenuBar;
    finalizar: TAction;
    consulta: TAction;
    empre: TAction;
    proce: TAction;
    desenvol: TAction;
    software: TAction;
    zerar: TAction;
    configuracao: TAction;
    popabrir: TMSNPopUp;
    CS: TClientSocket;
    CS_A: TClientSocket;
    Memo1: TMemo;
    ADOConnection1: TZConnection;
    ADOQuery11: TZQuery;
    Empresa: TZQuery;
    QueryBarraStatus: TZQuery;
    ADOQuery22: TZQuery;
    ADOQuery33: TZQuery;
    ADOQuery1: TZQuery;
    Image2: TImage;
    Image1: TImage;
    Label1: TLabel;
    XPManifest1: TXPManifest;
    Bevel1: TBevel;
    procedure Empresa1Click(Sender: TObject);
    procedure Processo1Click(Sender: TObject);
    procedure Sair1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ConsultarProcesso1Click(Sender: TObject);
    procedure Sobre1Click(Sender: TObject);
    procedure Software1Click(Sender: TObject);
    procedure finalizarExecute(Sender: TObject);
    procedure consultaExecute(Sender: TObject);
    procedure empreExecute(Sender: TObject);
    procedure proceExecute(Sender: TObject);
    procedure desenvolExecute(Sender: TObject);
    procedure softwareExecute(Sender: TObject);
    procedure zerarExecute(Sender: TObject);
    procedure CSError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure configuracaoExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CSConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure CS_AError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure CS_AConnect(Sender: TObject; Socket: TCustomWinSocket);

    procedure FormKeyDown(Sender: TObject; var Key: Word;
    Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btfecharClick(Sender: TObject);


  private
    { Private declarations }
  public
  fecha:boolean;
    { Public declarations }
  end;

var
  frmPrincipal: TfrmPrincipal;
  nome: string;
implementation

uses UEmpresa, ULogin, UProcesso, UFechar, UConsulta, USobre, UKPI, UTelaConsulta,
  Usplash, USoftware, UZerar, UConfiguracaoSistema;



{$R *.dfm}


// Bloquear ALT+F4 inicio
Function GetStateK (Key: integer): boolean;
begin
Result := Odd (GetKeyState (Key));
end;

procedure TfrmPrincipal.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
If GetStateK (VK_LMENU) And (Key = VK_F4) Then
begin
frmFechar.ShowModal;
fecha:=false;
end;
end;

procedure TfrmPrincipal.FormClose(Sender: TObject; var Action: TCloseAction);
begin
If Not fecha Then
Action := caNone Else
Action := caFree;
end;
procedure TfrmPrincipal.btfecharClick(Sender: TObject);
begin
fecha:=true;
close;
end;
// Bloquear ALT+F4 fim



// FUNÇÃO PARA ABREVIAR NOMES
function AbreviaNome(Nome:String):String; 

var 
Nomes : Array[1..20] of String; 
I, TotalNomes:Integer; 

begin 
Nome := Trim(Nome); 
Result:=Nome; 
Nome:=Nome + 32; 
I :=Pos(32,Nome); 
If I > 0 then 
begin 
totalNomes:=0; 
//Separa todos os nomes 
While I > 0 do 
begin 
Inc(totalNomes); 
Nomes[TotalNomes]:=Copy(Nome,1,I-1); 
Delete(Nome,1,I); 
I := Pos(32,Nome); 
end; 
If TotalNomes > 2 Then
begin
//Abreviar a apartir do segundo nome, exceto o último
For I := 2 to totalNomes - 1 do
begin
//Contém mais de 3 Letras? ( Ignorar de, da, das , do, dos, etc)
If Length(Nomes[I]) > 3 Then
//Pega apenas a primeira letra do nome é coloca um ponto após
Nomes[I]:=Nomes[I][1] + ´.´;
end;
Result:=´´;
For I := 1 to totalNomes do
Result:=Result+Trim(Nomes[I]) + 32;
Result:=Trim(Result);
end;
end;
end;


function PegaIP:string;
//--> Declare a Winsock na clausula uses da unit
var
WSAData: TWSAData;
HostEnt: PHostEnt;
Name:string;
begin
WSAStartup(2, WSAData);
SetLength(Name, 255);
Gethostname(PChar(Name), 255);
SetLength(Name, StrLen(PChar(Name)));
HostEnt := gethostbyname(PChar(Name));
with HostEnt^ do
begin
Result := Format(´¬d.¬d.¬d.¬d´,
[Byte(h_addr^[0]),Byte(h_addr^[1]),
Byte(h_addr^[2]),Byte(h_addr^[3])]);
end;
WSACleanup;
end;




procedure TfrmPrincipal.Empresa1Click(Sender: TObject);
begin
frmEmpresa.ShowModal;
end;

procedure TfrmPrincipal.Processo1Click(Sender: TObject);
var x: integer;
begin

With Empresa do
Begin
   Close;
   Sql.Clear;
   Sql.Add(´Select * from EMPRESA´);
   Open;
end;
Empresa.First;

x:=0;
while not Empresa.Eof do
begin
   x:= x + 1;
   Empresa.Next;
end;


   if x = 0 then begin
   ShowMessage(´Não existe empresa cadastrada! Você deve cadastrar pelo menos uma empresa.´);
   exit;
   end;



frmProcesso.ShowModal;
frmProcesso.ComboBox1.ClearSelection;
frmProcesso.ComboBox1.Text:=´Selecione´;
frmProcesso.ComboBox2.Clear;
frmProcesso.combobox2.Visible:=false;
frmProcesso.Label1.Visible:=false;
frmProcesso.Image2.Visible:=false;
frmProcesso.btn1.Visible:=false;
frmProcesso.btn1.Enabled:=true;
frmProcesso.Btn1.Caption:=´Incluir Novo Processo´;

frmProcesso.Edit1.Text:=´´;
frmProcesso.Edit2.Text:=´´;
frmProcesso.Memo1.Text:=´´;
frmProcesso.Edit1.Enabled:=false;
frmProcesso.Edit2.Enabled:=false;
frmProcesso.Memo1.Enabled:=false;

frmProcesso.SpeedButton1.Enabled:=false;
frmProcesso.SpeedButton2.Enabled:=false;
frmProcesso.Btn4.Enabled:=false;
frmProcesso.Btn3.Enabled:=false;






frmProcesso.Combobox2.Enabled:=true;
end;

procedure TfrmPrincipal.Sair1Click(Sender: TObject);
begin
    frmFechar.ShowModal;
end;

procedure TfrmPrincipal.Timer1Timer(Sender: TObject);
begin

ADOQuery11.Close;
ADOQuery11.sql.clear;
ADOQuery11.sql.add(´select * from EMPRESA´);
ADOQuery11.open;
label50.caption := IntToStr(ADOQuery11.recordcount);
ADOQuery11.Close;

ADOQuery22.Close;
ADOQuery22.sql.clear;
ADOQuery22.sql.add(´select * from PROCESSO´);
ADOQuery22.open;
label51.caption := IntToStr(ADOQuery22.recordcount);
ADOQuery22.Close;

ADOQuery33.Close;
ADOQuery33.sql.clear;
ADOQuery33.sql.add(´select * from PROBLEMAS´);
ADOQuery33.open;
label52.caption := IntToStr(ADOQuery33.recordcount);
ADOQuery33.Close;

ADOQuery1.Close;
ADOQuery1.sql.clear;
ADOQuery1.sql.add(´select * from KPI´);
ADOQuery1.open;
label53.caption := IntToStr(ADOQuery1.recordcount);
ADOQuery1.Close;


end;

procedure TfrmPrincipal.ConsultarProcesso1Click(Sender: TObject);
begin
frmConsulta.ShowModal;
end;

procedure TfrmPrincipal.Sobre1Click(Sender: TObject);
begin
frmSobre.ShowModal;
end;
procedure TfrmPrincipal.Software1Click(Sender: TObject);
begin
frmSoftware.ShowModal;
end;

procedure TfrmPrincipal.finalizarExecute(Sender: TObject);
begin
frmFechar.ShowModal;
end;

procedure TfrmPrincipal.consultaExecute(Sender: TObject);
begin
frmTelaConsulta.panel2.Visible:=false;
frmTelaConsulta.panel3.Visible:=false;
frmTelaConsulta.ComboBox1.Clear;
frmTelaConsulta.ComboBox2.Clear;
frmTelaConsulta.ComboBox3.Clear;
frmTelaConsulta.Edit1.Clear;
frmTelaConsulta.Edit2.Clear;
frmTelaConsulta.Edit3.Clear;
frmTelaConsulta.Edit4.Clear;
frmTelaConsulta.Memo1.Clear;
frmTelaConsulta.DBGrid1.CleanupInstance;
frmTelaConsulta.DBGrid2.CleanupInstance;
frmTelaConsulta.ShowModal;
end;

procedure TfrmPrincipal.empreExecute(Sender: TObject);
begin
frmEmpresa.ShowModal;
end;

procedure TfrmPrincipal.proceExecute(Sender: TObject);
begin
frmProcesso.ShowModal;
end;

procedure TfrmPrincipal.desenvolExecute(Sender: TObject);
begin
frmSobre.ShowModal;
end;

procedure TfrmPrincipal.softwareExecute(Sender: TObject);
begin
frmSoftware.ShowModal;
end;

procedure TfrmPrincipal.zerarExecute(Sender: TObject);
begin
frmZerar.ShowModal;
end;

procedure TfrmPrincipal.CSError(Sender: TObject; Socket: TCustomWinSocket;
  ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
if ErrorCode <> 0 Then ErrorCode := 0;
end;



procedure TfrmPrincipal.configuracaoExecute(Sender: TObject);
begin
frmConfiguracaoSistema.ShowModal;
end;






procedure TfrmPrincipal.FormShow(Sender: TObject);
var F: TForm;
begin


// Carrega a tela de login junto com a tela principal
F := TfrmLogin.Create(Application);
if F.ShowModal = mrCancel then
Close;


end;


procedure TfrmPrincipal.CSConnect(Sender: TObject;
  Socket: TCustomWinSocket);
  var user: string;
begin
user:=StatusBar1.Panels[0].Text;
CS.Socket.SendText(PegaIp+´-´+AbreviaNome(user));
end;



procedure TfrmPrincipal.CS_AError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
if ErrorCode <> 0 Then ErrorCode := 0;
end;



procedure TfrmPrincipal.CS_AConnect(Sender: TObject;
  Socket: TCustomWinSocket);
  var user: string;
begin
user:=StatusBar1.Panels[0].Text;
CS_A.Socket.SendText(PegaIp+´-´+AbreviaNome(user));
end;

end.