Paulo Nobre

É verdade mas no meu caso preciso mudar da cruz para a seta(normal). O que foi fornecido pelo s3c funciona perfeitamente porém, estou com um problema que não consigo resolver. Fiquei ontem umas 4 horas em cima e nada. Veja se vocês podem me ajudar. Preciso, que ao clicar na tecla F3 o cursor mude para cruz e ao soltar a F3 volte para a seta(normal). Alguém diria, por exemplo coloque no onkeydown SetSystemCursor(LoadCursor(0, IDC_Normal), OCR_Normal); e depois no onkeyup SetSystemCursor(LoadCursor(0, IDC_Normal), OCR_Normal); fazendo a chamada por if key = VK_F3 then. O problema é que meu programa, que é um capturador da parte da tela do screen, funciona da seguinte maneira: Você fica com f3 clicada(enquanto isto o código de captura está sendo executado) e arrasta o mouse. Nesta arrastada do mouse é que o cursor muda para a cruz. Só que quando solto(onkeyup) ora o cursor termina na cruz ora termina na seta(onkeyup). Parece que ficar com F3 clicada equivale a ficar fazendo apertar(down) e soltar(up) um número n de vezes. Já tentei de tudo: Coloquei uma variável inteira para ver quantas vezes a tecla f3 ficou premida no onkeydown e verificar no onkeyup se é para ou ímpar no keyup e com um if ver se precisofazer duas vezes SetSystemCursor(LoadCursor(0, IDC_Normal), OCR_Normal); ou uma . Fiz a mesma coisa jogando para o registro e fazendo a leitura no registro pelo onkeyup. Só que nada deu certo. Sempre na saída do onkeyup o resultado é aleatório ora termina na cruz ora termina na seta. Eu preciso que termine na seta. Engraçado é que achava que tinha que dar certo pois se fosse ímpar o número de vezes(descobria pelo uso do MOD) você estava indo para a seta e se fosse para voltando para a cruz. Aí fazendo a leitura com um if você acertava no final? Alguém poderia me ajudar com algum código? Obrigado.

É realmente estranho, vou testar o código mais tarde. Obrigado s3c

Para voltar seria SetSystemCursor(LoadCursor(0, IDC_Normal), OCR_Normal); ou SetSystemCursor(Screen.cursor[crNormal]), OCR_Normal);

Mais detalhes sobre API's do Windows: www.allapi.net - Mencionou o colega Denis No site acima sugerido pelo Denis existe um programa que contém todas(ou quase todas) APIS do windows. Acontece que os exemplos são todos para VB e VB.net, que não estou acostumado. O delphi nos acostumou mal com o uso das APIs( sem álias user lib etc...) Alguém que já precisou mudar o cursor e depois voltar para o defaut poderia me ajudar postando o código de como fazer isto. Gostaria de passar para crCross e depois voltar para o default. Ficaria muito grato.

Ok, s3c, entendi. Vou colocar.

Ok, s3c, obrigado.

Denis obrigado pela atenção. Você pode me dizer se estas funções estão "encapsuladas"(nem sei se é este o termo), em alguma UNIT do delphi, por exemplo a WINDOWS. Estou sem o delphi neste momento. Pelo que você colocou talvez eu precise apenas da função setcursor, pois usarei apenas o cursor cross num determinado momento e depois voltarei para o padrão.

Prezados Colegas Gostaria de saber como faço para mudar o meu cursor fora do domínio do programa, ou seja, que ele assuma, por exemplo o formato de uma cruz quando estiver em cima do screen. Só estou conseguindo fazer isto em cima do form. Estou fazendo screen.cursor:= crCross, porém, só aparece a cruz em cima do form e não na tela toda. Obrigado Paulo Nobre

Obrigado, Graymalkin pela atenção. Vou verificar Abraços Paulo Nobre

Um dia destes baixei um projeto delphi na internet e tentei fazer umas modificações para estudo, para minha surpresa o código estava travado. Embora fazendo um simples ctrl + c e ctrl +v, pudesse mecher no~código em outro lugar(arquivo), ali ele estava travado. Como faço para que o código de uma unit fique travado? Alguém tem como destravá-lo, no sentido que falei acima. Existe dentro do ambiente delphi, uma maneira de evitar o ctrl+c eo ctrl + v?

Tenho um programa, de terceiros, que abre junto com o windows. Olhando o registro na parte windows currentversion run e observei que não tinha nada lá. Alguém sabe quais são todos os lugares do registro em que o windows veerifica para abrir um programa? Só uso o registro, sei que algumas pessoas usam o sistema antigo de arquivos ini, que não uso. Por um acaso esse programa que mencionei usa um arquivo ini para consulta de dados. É possível fazer um programa abrir com o windows consultando antes o ini? Será que é assim que este programa funciona, ou existe um outro lugar no registro, sem ser o run, onde o windows consulta? Alguém sabe?

Entendi, s3c. Mas objetivando a pergunta. Tenho um programa cahmado WINKEY(não sei se você comhece).Ele serve para você associar a diversas combinações de teclas com a tecla windows(por exemplo WINDOWS + A). Por exemplo faço o word abrir no meu computador com a combinação Windows + W. Ele abre automáticamente com windows. A título de estudo fiz o meu winkey, que roda no tray e abre com o windows. Conforme você mesmo disse a minha tecla WIndows + W não faz nada pelo meu programa, pois pelo WINKEY ela já está registrada para abrir o word. Se ela já foi registrada e se pode ser registrada apenas uma vez, como eu poderia fazer para meu programa rodar primeiro e portanto registrar primeiro? Isto é muito complicado de fazer? Se é que pode se fazer. Entendeu? No meu caso particular deixo de usar o winkwy e uso o meu programa, mas se no computador de alguém as teclas forem registradas antes, meu programa não funcionaria. Os dois abrem pelo RUN. Lá existe ordem de prioridade(para que o programa seja aberto) ou é por ordem alfabética? O que você acha?

Se um programa que esteja rodando está usando RegisterHotKey(Handle, 1, MOD_CONTROL, $65); Como posso fazer para que o meu programa tenha prioridade em relação a esta tecla de atalho? Tentei colocar UnRegisterHotKey no oncreat e depois RegisterHotKey, mas não funcionou.

Obrigado s3c, havia entendido, só que escrevi errado. Obrigado

Entendi, s3c, quando se usa o decimal é que se coloca o $. Obrigado

Desculpe, não havia logado. Micheus, Muito obrigado por sua atenção em ler o código e vejo que você tem toda a razão. No mínimo estou consumindo muita memória desnecessariamente. Obrigado pelo toque. Abraços Paulo Nobre

RegisterHotKey(Handle, 1, MOD_CONTROL, $41); // Ctrl+a SErve para registrar a combinação ctrl +a, Mas, percebi que para usar a tecla windows serve RegisterHotKey(Handle, 1, MOD_Win, $41); // win+a ou RegisterHotKey(Handle, 1, MOD_CONTROL, $65); // Win+A(se não me engano é o 65 a maiúscula do a) O que quiz dizer é que com o MOD_win não tá fazendo diferença entre a maiusculo e minusculo. Alguém sabe se é isso mesmo? Outra coisa: Usei 65 ao invés de $65 e funcionou. Sempre funciona? Coloquei o código ascii. De início havia colocado VK_A, mas não teve nada a ver. Quando uso uma coisa ou outra? Alguém poderia comentar? obrigado.

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

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.

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.

Alguém sabe como fazer para capturar apenas uma parte do desktop. Vi num programa o seguinte: O usuário clicava em printscreen, o ponteiro do mouse mudava para uma cruz, clicava num ponto do desktop, deslocava o mouse abria-se um retângulo pontilhado(tipo programas de desenho onde você desenha um retângulo), clicava-se num outro ponto e a região compreendida dentro do retângulo era capturada. Não tenho a mínima idéia. Pesquisei na rede e não encontrei nada. Alguém já fez?

Prezado Graymalkin Muito obrigado pelo exemplo. Grande Abraço Paulo Nobre

Como faço para descobrir quantos arquivos tenho dentro de uma pasta? Por exemplo dentro da pasta c:\tem.

É, 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.

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?