Fórum Aplicação com ícones de atalhos #344725

procedure TFormMenu.CriaLista(Tipo:String);
var
  x:integer;
  ico:TIcon;
  tipo,SNome,sDiretorio,sExecutavel,sComando,sSensura:string;

begin
  //Limpo o ListView para inserir os dados
  ListView1.Clear;
  //Retorna os dados gravados no banco de dados com os programas
  With SqlProMaquina do
  begin
    Close;    
    ParamByName(´TIPO´).AsString := tipo;
    Open;   
  end;
  //Aqui eu crio a imagelist para guardar os icones dos programas
  imgList := TImageList.Create(self);
  imgList.Width := 32;
  imgList.Height := 32;
  ListView1.LargeImages := imgList;

  
  //Faço um laço no resultado dessa consulta que contem o nome do programa, executavel , icone e parametros
  if DmProgramas.ListaProgrMaquina(tipo ) then
  begin

    //Inicializo a váriavel Ico que irá receber o icone do prgrama
    Ico := TIcon.Create;
    ico.SetSize(32,32);

    //aqui eu inicializo o laço na query SqlProMaquina que contem os dados que eu preciso
    SQLProMaquina.First;
    while not DmProgramas.SQLProMaquina.Eof  do
    begin
      //Guardo nessas variaveis os dados do programa
      sNome := SQLProMaquinaDESCRICAO.AsString;
      sDiretorio := SQLProMaquinaDIRETORIO.AsString;
      sExecutavel := SQLProMaquinaEXECUTAVEL.AsString;
      sComando := SQLProMaquinaCOMANDO.AsString;
      sSensura := IntToStr(SQLProMaquinaSENSURA.Value);

      //Verifico se o arquivo exist , caso exista eu insiro ele no imagelist e no listview  
      if FileExists(sExecutavel) then     
      begin
        //Na minha tabela progr_maquina (que eu guardo os dados dos programas) eu tenho um campo do tipo Blob onde eu guardo icones personalizaveis para cada programa . Ou deixo esse campo vazio que dai eu utilizo o icone do programa mesmo
        if SQLProMaquinaICONE.Value <> ´´ then
        begin
          ICO.Assign(SQLProMaquinaICONE);
        end
        else
        Ico.Handle := ExtractIcon(Handle,PChar(sExecutavel),0);
        //Insiro o icone no imagelist
        imgList.AddIcon(Ico);

        //Insiro o item no ListView
        ListView1.AddItem(sNome,ListView1);
        ListView1.Items[ListView1.Items.Count -1].SubItems.Add(sExecutavel);
        ListView1.Items[ListView1.Items.Count -1].SubItems.Add(sDiretorio);
        ListView1.Items[ListView1.Items.Count -1].SubItems.Add(sComando);
        ListView1.Items[ListView1.Items.Count -1].SubItems.Add(sSensura);
        ListView1.Items[ListView1.Items.Count -1].ImageIndex := ListView1.Items.Count -1;
      end;
      SQLProMaquina.Next;
    end;
  end;
end;

private
  imgList:TImageList;

select distinct CHAVE, COMANDO, DESCRICAO, DIRETORIO, EXECUTAVEL, LK_MAQUINA, SENSURA, TIPO , ICONE
from progr_maquina 
where ((:TIPO = ´T´) or
       (TIPO = :TIPO))

procedure TFormMenu.ListView1DblClick(Sender: TObject);
var
  sNome,sExecutavel,sPasta,sComando:String;
begin

 // if ListView1.Focused  then
  //Verifico se existe algum item selecionado para não dar erro
  if ListView1.Selected <> nil then
  if ListView1.Selected.Index > -1 then
  begin
    //Gravos os dados dos programas para executar o comando  
    sNome := ListView1.Items[ListView1.Selected.Index ].Caption;
    sExecutavel := ListView1.Items[ListView1.Selected.Index ].SubItems[0];
    sPasta := ListView1.Items[ListView1.Selected.Index ].SubItems[1];
    sComando := ListView1.Items[ListView1.Selected.Index].SubItems[2];
    
    //Executo o procedimento para abrir o programa
    RunCommand(sExecutavel,sComando,False,SW_MAXIMIZE);
  end;
end;

{-----------------------------------------------------------------------------
 - Executa programa Externo descrito em "Command", adcionando os Parametros
   "Params" na linha de comando
 - Se "Wait" for true para a execução da aplicação para esperar a conclusao do
   programa externo executado por "Command"
 - WindowState apenas é utilizado na plataforma Windows
 ---------------------------------------------------------------------------- }
procedure RunCommand(Command: String; Params: String; Wait : Boolean;
   WindowState : Word);
var
  {$ifdef MSWINDOWS}
  SUInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
  Executed : Boolean ;
  PCharStr : PChar ;
  {$endif}
  ConnectCommand : PChar;
begin
  {$ifdef LINUX}
     Command := Trim(Command + ´ ´ + Params) ;
     if not Wait then
        Command := Command + ´ &´ ;  { & = Rodar em BackGround }
     {$IFNDEF FPC}
       ConnectCommand := PChar(Command);
       Libc.system(ConnectCommand);
     {$ELSE}
       Shell(Command)
     {$ENDIF}
  {$endif}
  {$ifdef MSWINDOWS}
     Command  := Trim(Command) ;
     PCharStr := PChar(Trim(Params)) ;
     if Length(PCharStr) = 0 then
        PCharStr := nil ;

     if not Wait then
        ShellExecute(0,´open´,PChar(Command),PCharStr, nil, WindowState )
//        winexec(ConnectCommand, WindowState)
     else
      begin
        ConnectCommand := PChar(Trim(Command + ´ ´ + Params));
        PCharStr := PChar(ExtractFilePath(Command)) ;
        if Length(PCharStr) = 0 then
           PCharStr := nil ;
        FillChar(SUInfo, SizeOf(SUInfo), #0);
        with SUInfo do
        begin
           cb          := SizeOf(SUInfo);
           dwFlags     := STARTF_USESHOWWINDOW;
           wShowWindow := WindowState;
        end;

        Executed := CreateProcess(nil, ConnectCommand, nil, nil, false,
                    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil,
                    PCharStr, SUInfo, ProcInfo);

        try
           { Aguarda até ser finalizado }
           if Executed then
              WaitForSingleObject(ProcInfo.hProcess, INFINITE);
        finally
           { Libera os Handles }
           CloseHandle(ProcInfo.hProcess);
           CloseHandle(ProcInfo.hThread);
        end;
      end;
  {$endif}
end;

procedure TDmMovimento.TmCalcTempoTimer(Sender: TObject);
var
  m,ms,s,h:word;
  Tm:TDateTime;
begin
  inc(iTEMPO_UTIL);
  iTEMPO_REST := iTEMPO_SOL - iTEMPO_UTIL;
  Tm := 0;
  tm := incSecond(tm,iTEMPO_UTIL);
  sTEMPO_ATUAL := TimeToStr(tm);

  tm := 0;
  Tm := incSecond(tm,iTEMPO_REST);
  sTEMPO_REST := TimeToStr(tm);

  //GRAVANDO OS DADOS NO BANCO E NO REGISTRO
  DecodeTime(now,h,m,s,ms);
  case s  of
    5,10,15,20,25,30,35,40,55,59:GravaTempoRegistro;
    1,31:GravaTempoBAnco;
  end;
   
  {Em caso de se acabar o tempo e não estiver no modo livre (sem limite de tempo) grava os dados no banco e chama o procedimento de finalizar 
o tempo aonde eu chamo a a tela que bloqueia a máquina }
  if (iTEMPO_UTIL >= iTEMPO_SOL)
     and (sTIPO <> ´Livre / Free ´) then
  begin
    GravaTempoBanco;
    FinalizaTempo;
  end;


end;

procedure TDmMovimento.GravaTempoRegistro;
var
  key:TRegistry;
const
  chave:STRING = ´\SOFTWARE\SisLanHouse\TEMPO\´;
begin
  key := TRegistry.Create;
  key.RootKey := HKEY_LOCAL_MACHINE ;
  key.OpenKey(chave,true);

  //Grava os dados no registro
  key.WriteBool(´SESSAO ABERTA´,bSESSAO_ABERTA);
  key.WriteBool(´CARTAO´,bCARTAO );
  key.WriteBool(´COBBRAR´,bCOBRAR);
  key.WriteInteger(´CODCART´,iCODCART);
  key.WriteInteger(´CODUSER´,iCODUSER);
  key.WriteDateTime(´PERIODO INICIO´,dPERIODO_INICIO);
  key.WriteInteger(´TEMPO SOL´,iTEMPO_SOL );
  key.WriteInteger(´TEMPO UTIL´,iTEMPO_UTIL);
  key.WriteInteger(´TEMPO REST´,iTEMPO_REST);
  key.WriteString(´TIPO´,sTIPO);
  key.WriteFloat(´VALOR´,cVALOR );
  key.WriteString(´STR TEMPO REST´,sTEMPO_REST);
  key.WriteString(´STR TEMPO ATUAL´,sTEMPO_ATUAL);
  key.WriteString(´STR TEMPO SOL´,sTEMPO_SOL);
  Key.WriteInteger(´TEMPO TMP´,iTEMPO_TMP);
  key.CloseKey;
end;

procedure TDmMovimento.GravaTempoBanco;
var
  sStr:STring;
  e:Exception;
begin
  try
    //Inicio a transação
    DmPrincipal.IniciaTransacao;

    //Atualizando o Dados do banco
    sStr :=
    ´update mov_tmp ´ +
    ´set TEMPO_UTIL = ´+IntToSTr(iTEMPO_UTIL)+´,´ +
       ´VALOR = ´+StringReplace(FloatToSTrf(cVALOR ,ffFixed,10,2),´,´,´.´,[rfReplaceAll]) +´ ´ +
    ´where LK_ESTACAO = ´+IntToStr(DmMaquina.PegaCodMaquina);
    DmPrincipal.Conexao.ExecuteDirect(sStr);

    //Atualizando o dados no cliente ou cartão
    if bCARTAO  then
    begin
      if iTEMPO_UTIL < iTEMPO_SOL then      
      sStr :=
      ´update cartao ´ +
      ´set TEMPO_UTI = ´+ IntTostr(iTEMPO_UTIL)+´ ´ +
      ´where CHAVE = ´+IntToStr(iCODCART);
    end
    else
    //Atualiza os dados do cliente em caso de tipo por tempo
    //No caso do tempo livre só irá atualizar o tempo_acumulado do cliente
    //no final.
    begin
      if sTIPO = ´Tempo / Time ´ then
      sStr :=
      ´update usuario ´+
      ´set TEMPO_UTI = ´+ IntToStr(iTEMPO_TMP + iTEMPO_UTIL)+´, ´ +
      ´ TEMPO_RES = ´+ IntToStr(iTEMPO_REST)+´  ´ +
      //´ TEMPO_ACU = TEMPO_ACU + ´+IntToStr(iTEMPO_UTIL)+´ ´ +
      ´where CHAVE = ´+IntToStr(iCODUSER);
    end;

    DmPrincipal.Conexao.ExecuteDirect(sStr);
    //Em caso de suscesso dou um comit na transação
    DmPrincipal.FinalizaTransacao;
  except
    on e:Exception do
    begin
      //Em caso de erro desfaço a transação e crio um exception.
      DmPrincipal.DesfazTransacao;
      Raise Exception.Create(e.Message );
    end;

  end;

end;

Var
  Tm:TDateTime;
  sTEMPO_ATUAL : String;
begin
  Tm := 0;
  tm := incSecond(tm,iTEMPO_UTIL);
  sTEMPO_ATUAL := TimeToStr(tm);
  LbTempoRest.Caption := sTEMPO_ATUAL;