Form Travado

[Paulo Nobre]

EStou com um form que ao ser mostrado não consigo movê-lo nem pela barra onde está o caption nem pelo menu que aparece no ícone do lado esquerdo.

Não sei o que está acontecendo.

Olhei todas as propriedades do form e nenhuma foi mexida para que isto acontecesse.

Alguém conhece algum código para que eu pudesse colocar no onshow para que ele destravasse?

O que tem nele de diferente é que pode iniciar hide no tray, e foi codificado para ao minnimizar fique no tray.

Existe alguma função que erradamente usada poderia sabidamente causar isto?

Que me lembre não tem mais nada de extraordinário.

Alguém tem alguma idéia do que poderia ser.

obrigado

[s3c]

Só me vem duas hipóteses:

Enabled := false; ou o Form está sem o foco

[Paulo Nobre]

Vou observar os dois.

[Paulo Nobre]

As duas propriedades acima estão oK; enable:= false e coloquei Form1.setfocus.

Observei que seu eu alterar por exemplo, o form para poder ser reajustado( o seu tamanho), não consigo reajustá-lo também.

Já aconteceu isto com alguém?

[Progr'amador]

Olá Paulo, beleza!?

Tem algum evento no OnShow do Form?

Aconteceu quase igual comigo, e fui ver erra um loop infinito (while) numa Query.

Abs. Progr'amador.

[s3c]

As duas propriedades acima estão oK; enable:= false e coloquei Form1.setfocus.

Não entendí; se enabled está false, então o Form não se mexe mesmo.

[Paulo Nobre]

Olá, progr´amador, quanto tempo em..

Tem muita coisa no OnShow, vou dar uma olhada, mas não tem nenhum looping não.

s3c,

Desculpa, escrevi errado.

Enable:= TRUE;

[s3c]

Mas no evento onShow, o Form ainda não está visível.

É no evento onActivate que ele está visível.

[Paulo Nobre]

Acho que vou ter que reconstruir tudo de novo.

Nunca vi uma loucura destas.

Consigo usar os componentes do form,mas não consigo movê-lo nem rewdimensioná-lo.

Verdadeiro mistério.

[s3c]

você tem alguma WndProc ou outra procedure que intercepte msgs nesse Form ?

[Paulo Nobre]

Tenho a procedure que intercepta o minimizar para minimizar no tray:

WMSysCommand

procedure TfrmPrincipal.WMSysCommand(var Msg: TWMSysCommand);

begin

if (Msg.CmdType = SC_MINIMIZE) then

begin

frmPrincipal.Hide;

frmPrincipal.RxTrayIcon1.Active := True;

end;

if (Msg.CmdType = SC_CLOSE) then

begin

Application.Terminate;

end;

end;

DEpois que voçe falou experimentei desativar(retirar) a procedure e o form destravou. Acontece que preciso desta procedure pois quero minimizar no tray, quando o usuário clicar em minimizar.

O programa que a principio estva ficando bom agora parece que está uma M...

Além disso s3c deixa eu aproveitar a carona deste texto e lhe perguntar o seguinte:

Estou neste mesmo form com a seguinte mensagem:

[Pascal Error] UnitPrincipal.pas(1): Unable to invoke Code Parameters due to errors in source code

ela aparece quando vou tentar completar alguma coisa tipo reg.closeKey;

Messagebox(0,....), não mostra as opções corretas para completar e aparece esta mensagem.

Isto so neste form principal.

Tem como consertar isto?

Por favor preciso desta ajuda também!!

[s3c]

Aí está a explicação. você intercepta a SysCommand e não deixa prosseguir.

Coloque inherited; no início da procedure.

[s3c]

Quanto a segunda questão, tente dar Build All no projeto e veja se não tem algum erro numa linha anterior; se tiver, ele não consegue completar o código nas linhas debaixo.

[Paulo Nobre]

Coloquei inherited liberou o form .

Você pode falar um pouco do inherited(quando puder)

Em relação a segunda dúvida, dei o build all e não aconteceu nada.

Observe que embora não consiga completar o código, escrevendo ele corretamente ele é executado. O que significa isto?

Isto aconteceu depois que fui mecher com adica do warn e acabei deletando sem querer o {$R *.dfm}

depois coloquei e não sei se coloquei no lugar certo.

Qual o lugar certo?Depois do uses adicionais, que vem depois do implemation?

As procedures criadas por mim devem apareer todas depois de {$R *.dfm} ou pode ser antes mesmo?

[s3c]

Olá Paulo, bom inherited é muito utilizado em classes herdadas quando elas sobreescrevem métodos ou funções da classe ancestral com a cláusula override. Então quando você coloca inherited no método override da classe filha, você diz para executar todo o código da classe ancestral.

No caso de interceptação de msgs (SysCommand), o Windows informa que veio uma msg de System e passa ela para o seu aplicativo. Se você colocar inherited, o Windows continua a processar essa msg; se não colocar, o Windows não faz mais nada.

Quanto ao não completar o código, pode ser algum bug do Delphi, mas acho que é só fechar e reabrir novamente.

Quanto ao {$R *.dfm}, normalmente é automaticamente colocado imediatamente após a implementation

[Micheus]

(desculpe me intrometer) você provavelmente observará que ao seguir a orientação do s3c, colocar o {$R *.dfm} logo após o Implementation, o recurso "Code Parameters" estará em operação. Se você tiver outro form em seu projeto, que não tenha sofrido a alteração citada, você deverá observar que o recurso funciona perfeitamente.

Isto também ocorre quando você estiver editando uma linha do código fonte e deixá-la incompleta (pode ser sem um ";"), passar para uma linha abaixo e nela escrever a chamada de uma função, p.ex. (já aconteceu comigo). Logo, se houver alguma coisa fora dos padrões de codificação esperado, esta situação deverá sempre se repetir.

As procedures criadas por mim devem apareer todas depois de {$R *.dfm} ou pode ser antes mesmo?

você vai observar que não faz a menor diferença para a compilação do programa, porém seria melhor manter da forma com é o padrão ou seja, não coloque nada entre o Implementation e o {$R *.dfm}

[]s

[s3c]

Isto também ocorre quando você estiver editando uma linha do código fonte e deixá-la incompleta (pode ser sem um ";"), passar para uma linha abaixo e nela escrever a chamada de uma função, p.ex. (já aconteceu comigo). Logo, se houver alguma coisa fora dos padrões de codificação esperado, esta situação deverá sempre se repetir.

É isso aí; quando ocorre comigo, compilo o projeto com Build All para ver se há erros em linhas anteriores.

Aproveitando o tópico, alguém saberia me dizer o porquê do erro: "Internal Error URW3537" quando se compila com Ctrl F9; mas se der Build All, o projeto compila normalmente ?

[Paulo Nobre]

É, mais infelizmente comigo não deu certo.

Coloquei {$R *.dfm} logo após o Implementation, mas acontece a mesma coisa.

Nos outros forms tudo corre normalmente.

Compilando com Build All não acontece nada.

[Micheus]

Aproveitando o tópico, alguém saberia me dizer o porquê do erro: "Internal Error URW3537" quando se compila com Ctrl F9; mas se der Build All, o projeto compila normalmente ?

Veja se estes possíveis "contornos" (workarounds) do problema se aplicam ao seu caso: http://qc.borland.com/qc/wc/qcmain.aspx?d=7561

[]s

[s3c]

Obrigado Micheus; mas em ambos os casos ele força a geração dos .DCU o que é efetuado dando-se Build All.

[s3c]

É, mais infelizmente comigo não deu certo.

Coloquei {$R *.dfm} logo após o Implementation, mas acontece a mesma coisa.

Nos outros forms tudo corre normalmente.

Compilando com Build All não acontece nada.

Poste o código para ver se não há nada que possa interferir nisso.

[Paulo Nobre]

Olá, s3c, estou mandando o código como você pediu.

Este código é do form que dá o problema.

unit UnitPrincipal;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, RXShell, ExtCtrls, StdCtrls,MMSystem, Buttons,
  ColHint, ExtDlgs,JPEG,ClipBrd,Registry,ads_GraphicConversion,GIFImage;

type
  TfrmPrincipal = class(TForm)
    PopupMenu1: TPopupMenu;
    mnuRestaurar: TMenuItem;
    mnuFechar: TMenuItem;
    RxTrayIcon1: TRxTrayIcon;
    N1: TMenuItem;
    mnuColocarSons: TMenuItem;
    mnuRetirarSons: TMenuItem;
    N2: TMenuItem;
    mnuConfig: TMenuItem;
    cmdConfig: TSpeedButton;
    ColHint1: TColHint;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Image1: TImage;
    rdbFormato: TRadioGroup;
    Label1: TLabel;
    Label2: TLabel;
    mnuSobreFlash: TMenuItem;
    mnuDicas: TMenuItem;
    cmdScreens: TSpeedButton;
    OpenPictureDialogScreen: TOpenPictureDialog;
    Timer1: TTimer;
    cmdSobre: TSpeedButton;
    mnuNumArq: TMenuItem;
    Panel5: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure mnuRestaurarClick(Sender: TObject);
    procedure mnuFecharClick(Sender: TObject);
    procedure RxTrayIcon1Click(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnuColocarSonsClick(Sender: TObject);
    procedure mnuRetirarSonsClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure mnuConfigClick(Sender: TObject);
    procedure cmdConfigClick(Sender: TObject);
    procedure cmdConfigMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure rdbFormatoClick(Sender: TObject);
    procedure Panel3MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel3MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure mnuDicasClick(Sender: TObject);
    procedure cmdScreensMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure cmdScreensClick(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure cmdSobreMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure cmdSobreClick(Sender: TObject);
    procedure Panel3Click(Sender: TObject);
    procedure mnuSobreFlashClick(Sender: TObject);
    procedure mnuNumArqClick(Sender: TObject);
    procedure Panel5MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Panel5MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Panel5MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    {*****************************************************}
    //A procedure abaixo serve para capturar a mensagem de
    //minimizar ou maximizar do windows.
    procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
    {**********************************************************}
    //A procedure abaixo serve para manipular a tecla
    //Print que esta sendo capturada pelo programa.
    procedure WMHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
    procedure NumeroDeArquivos(Pasta:String);

  public
    { Public declarations }
    Procedure CapturarSalvarBitmap(Filename:TFilename);
    Procedure CapturarSalvarJPEG(Filename:TFilename);
    Procedure CapturarSalvarGIF(Filename:TFilename);
  end;

var
  frmPrincipal: TfrmPrincipal;
  reg:TRegistry;
  Muda: Integer;//Variavel para alternar entre strch e não estrech

implementation

{$R *.dfm}

Uses
UnitConfiguracoes, UnitDiretorio,UnitSobreFlash,UnitDicas;

//A procedure abaixo serve para contar o número de arquivos
// da pasta onde estão armazenadas as imagens.
procedure TfrmPrincipal.NumeroDeArquivos(Pasta:String);
Var
  RetornoBMP:TSearchRec;
  RetornoGIF:TSearchRec;
  RetornoJPEG:TSearchRec;
  qtBMP:Integer;
  qtGIF:Integer;
  qtJPEG:Integer;
  Total:Integer;
begin
  qtBMP:=0;
  qtGIF:=0;
  qtJPEG:=0;

  If(FindFirst(Pasta + '\*.bmp',faArchive,RetornoBMP)=0) then
    Repeat
      qtBMP:= qtBMP + 1;
    Until FindNext(RetornoBMP)<>0;
    FindClose(RetornoBMP);

  If(FindFirst(Pasta + '\*.gif',faArchive,RetornoGIF)=0) then
    Repeat
      qtGIF:= qtGIF + 1;
    Until FindNext(RetornoGIF)<>0;
    FindClose(RetornoGIF);

  If(FindFirst(Pasta + '\*.jpeg',faArchive,RetornoJPEG)=0) then
    Repeat
      qtJPEG:= qtJPEG + 1;
    Until FindNext(RetornoJPEG)<>0;
    FindClose(RetornoJPEG);

    Total:= qtBMP + qtGIF + qtJPEG;

    Messagebox(0,PChar('O número de arquivos encontrados é igual a '+ IntToStr(Total)+ '.     '+#13+ 'Sendo '+ IntToStr(qtBMP)+ ' salvos no formato bmp.'+#13+ 'Sendo '+ IntToStr(qtGIF)+ ' salvos no formato gif.'+#13+'Sendo '+ IntToStr(qtJPEG)+ ' salvos no formato jpeg.'+#13+'Desejando vê-los, clique em Mostrar Imagens Gravadas na janela principal. '),'TOTAL DE ARQUIVOS DE IMAGENS',MB_IconInformation);
end;

//A função abaixo serve para escolher qual ato irá acontecer
//caso minimize ou feche, ou seja, ela intercepta a mensagem
//do windows.
procedure TfrmPrincipal.WMSysCommand(var Msg: TWMSysCommand);
Var
  H : HWnd;
begin
inherited;
if (Msg.CmdType = SC_MINIMIZE) then
    begin
      If reg.ReadString('Timer')='Sim' then
        begin
          frmConfig.cmdPararCaptura.ShowHint:= True;
          frmConfig.cmdPararCaptura.Enabled:= True;
          frmConfig.TimerCaptura.Interval:= 60000*reg.ReadInteger('Segundos');
          frmConfig.TimerCaptura.Enabled:= True;
        end;
      //O código abaixo esconde a aplicação da barra
      // de tarefas.
      H := FindWindow(Nil,'FLASH');
      If H <> 0 then ShowWindow(H,SW_HIDE);
      frmPrincipal.Hide;
      frmPrincipal.RxTrayIcon1.Active := True;
    end;

if (Msg.CmdType = SC_CLOSE) then
    begin
      Application.Terminate;
    end;
end;

//A procedure abaixo serve para salvar o desktop mostrar e salvar
//bitmap no diretório escolhido.
Procedure TfrmPrincipal.CapturarSalvarBitmap(Filename:TFilename);
Var
  Bmp:TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.LoadFromClipboardFormat(CF_BitMap, Clipboard.GetAsHandle(CF_Bitmap), 0);
  Image1.Picture.Bitmap.Assign(Bmp);
  Bmp.SaveToFile(FileName);
  Bmp.Free;
end;

//A procedure abaixo serve para salvar o desktop mostrar e salvar
//jpeg no diretório escolhido.
Procedure TfrmPrincipal.CapturarSalvarJPEG(Filename:TFilename);
Var
  JPEG:TJPEGImage;
begin
  //Primeiro você cria o JPEG:
  JPEG := TJPEGImage.Create;
  //Depois você carrega o bitmap do Image pelo Clipboard:
  Image1.Picture.Bitmap.LoadFromClipboardFormat(CF_BitMap,Clipboard.GetAsHandle(CF_BitMap),0);
  //Depois você assinala o JPEG a partir do Bitmap:
  JPEG.Assign(Image1.Picture.Bitmap);
  //Depois você salva o JPEG:
  JPEG.SaveToFile(FileName);
  JPEG.Free;
end;

//A procedure abaixo serve para salvar o desktop mostrar e salvar
//gif no diretório escolhido.
Procedure TfrmPrincipal.CapturarSalvarGIF(Filename:TFilename);
Var
  Bitmap: TBitmap;
  Gif:TGifImage;
begin
  Bitmap := TBitmap.Create;
  Gif:= TGifImage.Create;
  Image1.Picture.Bitmap.LoadFromClipboardFormat(CF_BitMap,Clipboard.GetAsHandle(CF_BitMap),0);
  BitmapToGif(Bitmap,Gif);
  Gif.Assign(Image1.Picture.Bitmap);
  Gif.SaveToFile(FileName);
  Bitmap.Free;
  Gif.Free;
end;

//A procedure abaixo é a principal, pois manipula
//dizendo o que será feito depois do usuário clicar
//na tecla print.
procedure TfrmPrincipal.WMHotKey (var Msg : TWMHotKey);
begin
  if Msg.HotKey = 500 then
  begin
    {== habilita a tecla Print Screen ==}
    UnRegisterHotkey( Handle, 500 );

    reg.RootKey:=HKEY_LOCAL_MACHINE;
    reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
    If reg.ReadString('Capturar')= 'A tela toda' then
      begin
        Clipboard.Clear;//Se não colocar dá erro
        Keybd_Event(VK_Snapshot,0, 0, 0);
      end
    Else If reg.ReadString('Capturar')= 'A janela ativa' then
      begin
        Clipboard.Clear;//Se não colocar dá erro
        Keybd_Event(VK_Snapshot,1, 0, 0);
      end;
  {== Desabilita a tecla Print Screen ==}
  RegisterHotkey( Handle, 500, 0, VK_SNAPSHOT );
  reg.CloseKey;
  Timer1.Enabled:=True;
  end;
end;

procedure TfrmPrincipal.FormCreate(Sender: TObject);
begin
  {== Desabilita a tecla Print Screen ==}
  RegisterHotkey( Handle, 500, 0, VK_SNAPSHOT );

  frmPrincipal.Caption:= 'FLASH - CAPTURADOR DE IMAGENS';
  Application.ShowMainForm:= False;
  Application.HintPause:= 3000;
  Application.HintHidePause:= 3000;

  reg:= TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',TRUE);
  reg.CloseKey;

  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',False);
  If reg.ValueExists('Primeira Vez')= True Then
    begin
       If reg.ReadString('QuerSom?')= 'Sim' then
        begin
         //Faz aparecer o menu retirar o som
         mnuColocarSons.Visible:= False;
         mnuRetirarSons.Visible:= True;
         reg.CloseKey
        end
       Else
        begin
         //Faz aparecer o menu colocar o som
         mnuColocarSons.Visible:= True;
         mnuRetirarSons.Visible:= False;
         reg.CloseKey;
        end;
    end
  Else
    begin
      MkDir(ExtractFileDir(Application.exename)+'\SCREEN');
      reg.WriteString('Primeira Vez','Não');
      reg.WriteString('QuerSom?','Sim');
      reg.WriteString('Tray','Não');
      reg.WriteString('Inicia com windows','Não');
      reg.WriteInteger('Número do último screen salvo',0);
      reg.WriteInteger('Screens Salvos',0);
      reg.WriteInteger('Hora Inicial',0);
      reg.WriteInteger('Minuto Inicial',0);
      reg.WriteInteger('Hora Final',0);
      reg.WriteInteger('Minuto Final',0);
      reg.WriteString('Já mostrou Dicas','Não');
      reg.WriteInteger('Segundos',1);
      reg.WriteString('Último Shot','');
      reg.WriteString('Formato','JPEG');
      reg.WriteString('Capturar','A tela toda');
      reg.WriteString('Timer','Não');
      reg.WriteString('Diretório de Destino',PChar(ExtractFilePath(application.ExeName))+'SCREEN');
      //Faz aparecer o menu retirar o som
      mnuColocarSons.Visible:= False;
      mnuRetirarSons.Visible:= True;
      reg.CloseKey;
    end;

  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  If reg.ReadString('Tray')= 'Não' then
    begin
      frmPrincipal.RxTrayIcon1.Active := False;
      frmPrincipal.show;
      SetForegroundWindow(handle);
      reg.CloseKey;
    end
  Else
    begin
      frmPrincipal.Hide;
      frmPrincipal.RxTrayIcon1.Active := True;
      reg.CloseKey;
    end;

  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  If reg.ReadString('Formato')= 'JPEG' then
    begin
      rdbFormato.ItemIndex := 2;
      reg.CloseKey;
    end
  Else If reg.ReadString('Formato')= 'GIF' then
    begin
      rdbFormato.ItemIndex := 1;
      reg.CloseKey;
    end
  Else If reg.ReadString('Formato')= 'BMP'  then
    begin
      rdbFormato.ItemIndex := 0;
      reg.CloseKey;
    end;
end;

procedure TfrmPrincipal.mnuRestaurarClick(Sender: TObject);
Var
  h1, h2: THandle;
  pSom: PChar;
begin
  //Código do Som
  //O código abaixo toca o som ou não de acordo
  //com a preferência do usuário
  reg:= TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  If reg.ReadString('QuerSom?')= 'Sim' then
    begin
       h1:= FindResource(HInstance,'FOTO','WavFile');
       h2:= LoadResource(HInstance,h1);
       pSom:= LockResource(h2);
       SNDPlaySound(pSom,SND_ASYNC or Snd_Memory);
       UnlockResource(h2);
       reg.CloseKey;
    end
  Else
    begin
      reg.CloseKey;
    end;

  frmPrincipal.Show;
  frmPrincipal.RxTrayIcon1.Active := false;
  If frmConfig.chkTemporizador.State = cbChecked then
    begin
      frmConfig.TimerCaptura.Enabled:= False;
      Messagebox(0,'A captura foi interrompida momentaneamente. '+#13+ 'Minimizando a janela principal, o FLASH voltará a capturar normalmente.','INTERRUPÇÃO DA CAPTURA',MB_IconExclamation);
    end;
end;

procedure TfrmPrincipal.mnuFecharClick(Sender: TObject);
begin
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  reg.WriteInteger('Screens salvos',0);
  reg.closekey;
  application.Terminate;
end;

procedure TfrmPrincipal.RxTrayIcon1Click(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  frmPrincipal.show;
  SetForegroundWindow(handle);
  frmPrincipal.RxTrayIcon1.Active := false;
  If frmConfig.chkTemporizador.State = cbChecked then
    begin
      frmConfig.TimerCaptura.Enabled:= False;
      Messagebox(0,'A captura foi interrompida momentaneamente. '+#13+ 'Minimizando a janela principal, o FLASH voltará a capturar normalmente.','INTERRUPÇÃO DA CAPTURA',MB_IconExclamation);
    end;
end;

procedure TfrmPrincipal.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  reg.Free;
end;

procedure TfrmPrincipal.mnuColocarSonsClick(Sender: TObject);
begin
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',False);
  reg.WriteString('QuerSom?','Sim');
  MessageBox(handle,'A partir de agora os sons do programa serão ouvidos.','COLOCAÇÃO DOS SONS',MB_IconInformation);
  mnuColocarSons.Visible:= False;
  mnuRetirarSons.Visible:= True;
  reg.CloseKey;
end;

procedure TfrmPrincipal.mnuRetirarSonsClick(Sender: TObject);
begin
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',False);
  reg.WriteString('QuerSom?','Não');
  MessageBox(handle,'A partir de agora os sons do programa NÃO serão ouvidos.','RETIRADA DOS SONS',MB_IconInformation);
  mnuColocarSons.Visible:= True;
  mnuRetirarSons.Visible:= False;
  reg.CloseKey;
end;

procedure TfrmPrincipal.FormShow(Sender: TObject);
Var
  h1, h2: THandle;
  pSom: PChar;
  Destino:String;
  //H : HWnd;
begin
  //O código abaixo esconde a aplicação da barra
  // de tarefas.
  //*************************************
  {H := FindWindow(Nil,'FLASH');
  If H <> 0 then ShowWindow(H,SW_HIDE);
  //*************************************}

  //Código do Som
  //O código abaixo toca o som ou não de acordo
  //com a preferência do usuário
  reg:= TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  If reg.ReadString('QuerSom?')= 'Sim' then
    begin
       h1:= FindResource(HInstance,'FOTO','WavFile');
       h2:= LoadResource(HInstance,h1);
       pSom:= LockResource(h2);
       SNDPlaySound(pSom,SND_ASYNC or Snd_Memory);
       UnlockResource(h2);
       reg.CloseKey;
    end
  Else
    begin
    //Não faz nada.
    reg.closekey;
    end;

  begin
    reg.RootKey:=HKEY_LOCAL_MACHINE;
    reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
    Destino:=reg.ReadString('Último Shot');
    If Destino <>'' then
      begin
        try
          Image1.Picture.LoadFromFile(Destino);
        except
        reg.CloseKey;
        //MessageBox(0,'Não existe nenhum arquivo armazenado','AVISO',MB_IconExclamation);
        end;
      end
    Else
      begin
        reg.CloseKey;
        Abort;
      end;
    reg.CloseKey;
  end;
end;

procedure TfrmPrincipal.mnuConfigClick(Sender: TObject);
Var
  h1, h2: THandle;
  pSom: PChar;
begin
  //Código do Som
  //O código abaixo toca o som ou não de acordo
  //com a preferência do usuário
  reg:= TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  If reg.ReadString('QuerSom?')= 'Sim' then
    begin
       h1:= FindResource(HInstance,'NAVIO','WavFile');
       h2:= LoadResource(HInstance,h1);
       pSom:= LockResource(h2);
       SNDPlaySound(pSom,SND_ASYNC or Snd_Memory);
       UnlockResource(h2);
       reg.CloseKey;
    end
  Else
    begin
      reg.CloseKey;
    end;

  frmConfig.Show;
end;

procedure TfrmPrincipal.cmdConfigClick(Sender: TObject);
Var
  h1, h2: THandle;
  pSom: PChar;
begin
  //Código do Som
  //O código abaixo toca o som ou não de acordo
  //com a preferência do usuário
  reg:= TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  If reg.ReadString('QuerSom?')= 'Sim' then
    begin
       h1:= FindResource(HInstance,'NAVIO','WavFile');
       h2:= LoadResource(HInstance,h1);
       pSom:= LockResource(h2);
       SNDPlaySound(pSom,SND_ASYNC or Snd_Memory);
       UnlockResource(h2);
       reg.CloseKey;
    end
  Else
    begin
      reg.CloseKey;
    end;

  frmConfig.Show;
end;

procedure TfrmPrincipal.cmdConfigMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  cmdConfig.Font.Style := [fsBold];
  cmdConfig.Font.Color:= clRed;
end;

procedure TfrmPrincipal.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  cmdConfig.Font.Style := [];
  Panel3.Font.Style := [];
  Panel3.Font.Color:= clBlack;
  Panel5.Font.Style := [];
  Panel5.Font.Color:= clBlack;
  cmdSobre.Font.Color:= clBlack;
  cmdScreens.Font.Color:= clBlack;
  cmdConfig.Font.Color:= clBlack;
  cmdScreens.Font.Style := [];
  cmdSobre.Font.Style := [];
end;

procedure TfrmPrincipal.rdbFormatoClick(Sender: TObject);
begin
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  If rdbFormato.ItemIndex = 0 then reg.WriteString('Formato','BMP');
  If rdbFormato.ItemIndex = 1 then reg.WriteString('Formato','GIF');
  If rdbFormato.ItemIndex = 2 then reg.WriteString('Formato','JPEG');
  reg.CloseKey;
end;

procedure TfrmPrincipal.Panel3MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel3.BevelInner := bvLowered;
end;

procedure TfrmPrincipal.Panel3MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel3.BevelInner := bvSpace;
end;

procedure TfrmPrincipal.Panel3MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  Panel3.Font.Style := [fsBold];
  Panel3.Font.Color:= clRed;
end;

procedure TfrmPrincipal.mnuDicasClick(Sender: TObject);
Var
  h1, h2: THandle;
  pSom: PChar;
begin
  //Código do Som
  //O código abaixo toca o som ou não de acordo
  //com a preferência do usuário
  reg:= TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  If reg.ReadString('QuerSom?')= 'Sim' then
    begin
       h1:= FindResource(HInstance,'FOTO','WavFile');
       h2:= LoadResource(HInstance,h1);
       pSom:= LockResource(h2);
       SNDPlaySound(pSom,SND_ASYNC or Snd_Memory);
       UnlockResource(h2);
       reg.CloseKey;
    end
  Else
    begin
      reg.CloseKey;
    end;
  frmDicas.Show;
end;

procedure TfrmPrincipal.cmdScreensMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  cmdScreens.Font.Style := [fsBold];
  cmdScreens.Font.Color:= clRed;
end;

procedure TfrmPrincipal.cmdScreensClick(Sender: TObject);
Var
  h1, h2: THandle;
  pSom: PChar;
  Destino:String;
  CaminhoDoScreen:String;
begin
  //Código do Som
  //O código abaixo toca o som ou não de acordo
  //com a preferência do usuário
  reg:= TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  If reg.ReadString('QuerSom?')= 'Sim' then
    begin
       h1:= FindResource(HInstance,'FOTO','WavFile');
       h2:= LoadResource(HInstance,h1);
       pSom:= LockResource(h2);
       SNDPlaySound(pSom,SND_ASYNC or Snd_Memory);
       UnlockResource(h2);
       reg.CloseKey;
    end
  Else
    begin
      reg.CloseKey;
    end;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  Destino:=reg.ReadString('Diretório de Destino');
  reg.CloseKey;

  OpenPictureDialogScreen.FileName :='';
  OpenPictureDialogScreen.InitialDir:= Destino;
  OpenPictureDialogScreen.Execute;
  CaminhoDoScreen := OpenPictureDialogScreen.FileName;
  If OpenPictureDialogScreen.FileName = '' Then
    Begin
      MessageBox(Handle,'Você deve selecionar um documento e clicar em abrir !'+#13 + 'Clicando em cancelar nada acontecerá !','OPERAÇÃO NÃO EFETUADA',MB_ICONSTOP);
      Abort;
    end;
  //Image1.AutoSize:= True;
  //Image1.Proportional:= True;
  Image1.Stretch:= True;
  //Image1.Align := alNone;
  Image1.Picture.LoadFromFile(CaminhoDoScreen);
 end;
procedure TfrmPrincipal.Image1Click(Sender: TObject);
begin
  If Muda = 0 then
    begin
      Image1.Stretch:= False;
      Muda:= 1;
    end
  Else if Muda = 1 then
    begin
      Image1.Stretch:= True;
      Muda:= 0;
    end;
end;

procedure TfrmPrincipal.FormActivate(Sender: TObject);
Var
  Salvos:Integer;
begin
  Muda:=0;//variavel que controla o strech da figura
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  Salvos:= reg.ReadInteger('Número do último screen salvo');
  If Salvos = 100 then
    begin
      Messagebox(0,'Você até agora já teve 100 imagens salvas pelo FLASH.'+#13+ 'Pode ser que a pasta contendo as imagens esteja muito sobrecarregada.'+ #13+ 'Verifique se algumas imagens podem ser eliminadas.'+ #13+'Qualquer dúvida consulte as dicas do programa.','ALERTA',MB_IconExclamation);
    end;
  If Salvos = 200 then
    begin
      Messagebox(0,'Você até agora já teve 200 imagens salvas pelo FLASH.'+#13+ 'Pode ser que a pasta contendo as imagens esteja muito sobrecarregada.'+ #13+ 'Verifique se algumas imagens podem ser eliminadas.'+ #13+'Qualquer dúvida consulte as dicas do programa.','ALERTA',MB_IconExclamation);
    end;
end;

procedure TfrmPrincipal.FormDestroy(Sender: TObject);
begin
  {== habilita a tecla Print Screen ==}
  UnRegisterHotkey( Handle, 500 );
  //Libera o registro
  reg.Destroy;
end;

procedure TfrmPrincipal.Timer1Timer(Sender: TObject);
Var
  Destino:String;
  Numero:Integer;
  ScreensSalvos: Integer;
begin
  Timer1.Enabled:=False;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  Numero:= reg.ReadInteger('Número do último screen salvo')+ 1;
  ScreensSalvos:= reg.ReadInteger('Screens Salvos')+ 1;
  If reg.ReadString('Formato')= 'BMP' then
      begin
        Destino:= reg.ReadString('Diretório de Destino')+'\Flash'+IntToStr(Numero)+'.bmp';
        CapturarSalvarBitmap(Destino);
      end
  Else If reg.ReadString('Formato')= 'JPEG' then
      begin
        Destino:= reg.ReadString('Diretório de Destino')+'\Flash'+IntToStr(Numero)+'.jpeg';
        CapturarSalvarJPEG(Destino);
      end
  Else If reg.ReadString('Formato')= 'GIF' then
     begin
        Destino:= reg.ReadString('Diretório de Destino')+'\Flash'+IntToStr(Numero)+'.gif';
        CapturarSalvarGIF(Destino);
      end;

  reg.WriteInteger('Número do último screen salvo',Numero);
  Label2.Caption:= IntToStr(ScreensSalvos);
  reg.WriteInteger('Screens Salvos',ScreensSalvos);
  reg.WriteString('Último Shot',Destino);
  reg.CloseKey;
  
  //Manda o form para frente.
  SetForegroundWindow(handle);
end;

procedure TfrmPrincipal.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
begin
  CanClose:= False;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  reg.WriteInteger('Screens salvos',0);
end;

procedure TfrmPrincipal.cmdSobreMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  cmdSobre.Font.Style := [fsBold];
  cmdSobre.Font.Color:= clRed;
end;

procedure TfrmPrincipal.cmdSobreClick(Sender: TObject);
Var
  h1, h2: THandle;
  pSom: PChar;
begin
  //Código do Som
  //O código abaixo toca o som ou não de acordo
  //com a preferência do usuário
  reg:= TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  If reg.ReadString('QuerSom?')= 'Sim' then
    begin
       h1:= FindResource(HInstance,'ALERTA','WavFile');
       h2:= LoadResource(HInstance,h1);
       pSom:= LockResource(h2);
       SNDPlaySound(pSom,SND_ASYNC or Snd_Memory);
       UnlockResource(h2);
       reg.CloseKey;
    end
  Else
    begin
      reg.CloseKey;
    end;
  frmSobreFlash.Show;
end;

procedure TfrmPrincipal.Panel3Click(Sender: TObject);
begin
  reg:= TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  reg.WriteInteger('Número do último screen salvo',0);
  reg.closekey;
  Messagebox(0,'Suas imagens passarão a ser renumeradas a partir do 1.'+#13+'É possível que elas venham a ser sobrescritas, caso tenham a mesma extensão.','RENUMERAÇÃO',MB_IconInformation);
end;

procedure TfrmPrincipal.mnuSobreFlashClick(Sender: TObject);
Var
  h1, h2: THandle;
  pSom: PChar;
begin
  //Código do Som
  //O código abaixo toca o som ou não de acordo
  //com a preferência do usuário
  reg:= TRegistry.Create;
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  If reg.ReadString('QuerSom?')= 'Sim' then
    begin
       h1:= FindResource(HInstance,'ALERTA','WavFile');
       h2:= LoadResource(HInstance,h1);
       pSom:= LockResource(h2);
       SNDPlaySound(pSom,SND_ASYNC or Snd_Memory);
       UnlockResource(h2);
       reg.CloseKey;
    end
  Else
    begin
      reg.CloseKey;
    end;
  frmSobreFlash.Show;
end;

procedure TfrmPrincipal.mnuNumArqClick(Sender: TObject);
Var
  Pasta: String;
begin
  reg.RootKey:=HKEY_LOCAL_MACHINE;
  reg.OpenKey('SOFTWARE\NOBRE INFORMÁTICA\FLASH',FALSE);
  Pasta:= reg.ReadString('Diretório de Destino');
  NumeroDeArquivos(Pasta);
end;

procedure TfrmPrincipal.Panel5MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel5.BevelInner := bvLowered;
end;

procedure TfrmPrincipal.Panel5MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  Panel5.Font.Style := [fsBold];
  Panel5.Font.Color:= clRed;
end;

procedure TfrmPrincipal.Panel5MouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Panel5.BevelInner := bvSpace;
end;

end.

[s3c]

Olá Paulo, você compila normalmente o projeto sem erros certo ?

Em qual método ele não completa o código ?

Qual código que ele deveria completar e não completa nesse método ?

[Paulo Nobre]

Compilo sem erros.

O form aceita o código e executa, apenas não completa.

Por exemplo, aqui não completa. (pedaço do oncreat)

Else
   begin
     MkDir(ExtractFileDir(Application.exename)+'\SCREEN');
     reg.WriteString('Primeira Vez','Não');
     reg.WriteString('QuerSom?','Sim');
     reg.WriteString('Tray','Não');
     reg.WriteString('Inicia com windows','Não');
     reg.WriteInteger('Número do último screen salvo',0);
     reg.WriteInteger('Screens Salvos',0);
     reg.WriteInteger('Hora Inicial',0);
     reg.WriteInteger('Minuto Inicial',0);
     reg.WriteInteger('Hora Final',0);
     reg.WriteInteger('Minuto Final',0);
     reg.WriteString('Já mostrou Dicas','Não');
     reg.WriteInteger('Segundos',1);
     reg.WriteString('Último Shot','');
     reg.WriteString('Formato','JPEG');
     reg.WriteString('Capturar','A tela toda');
     reg.WriteString('Timer','Não');
     reg.WriteString('Diretório de Destino',PChar(ExtractFilePath(application.ExeName))+'SCREEN');
     //Faz aparecer o menu retirar o som
     mnuColocarSons.Visible:= False;
     mnuRetirarSons.Visible:= True;
     reg.CloseKey;
   end;

se eu digitar reg aparece outro tipo de procedimento depois do ponto mais não o writestring em alguns lugares não aparece nada.

[s3c]

Agora você me pegou; comigo ele completa normalmente. Não sei o que pode ser; assim como comigo dá um erro URW3537 e até hoje não achei explicação plausível para isto.

[Paulo Nobre]

s3c,

Muito obrigado por sua atenção neste problema, mas vou deixar de lado até porque o programa não deixa de funcionar por conta disto.

Abraços

Paulo Nobre