Marcos Santana

Colegas uso o componente MediaPlayer_, não o MediaPlayer que vem com o Delphi. O problema é que no Wim XP funciona más no Wim 7 só tem som não mostra o vídeo alguém Já passo por isso tem como contornar ou esse componente só funciona no XP.

Golegas tenho um fla do flash com actionscript para setar os valores das variaveis do flash no delphi uso: ShockwaveFlashEx1.SetVariable('Senha Principal:GrupoSenha:senha0',senha1); onde Senha Principal e uma camada do fla GrupoSenha e outra e senha0 e o edit do flash. Quando os componentes do flash estão na primeira camada funciona más da segunda em diante não faz nada como devo fazer. Se usar ShockwaveFlashEx1.SetVariable('senha0',senha1); e senha0 estiver na primenira camada funciona.

Colegas estou criando um gravador com delphi e a biblioteca bass alguém conseguiu usar um componente spectrum com essa biblioteca. Pode ser em delphi 7 ou 2010, pois não consigo fazer um spectrum funcionar o resto está ok. Gostaria que quando o gravador grava-se ou toca-se o spectrum mostra-se a barra ou linha movimentando. :wacko:

Obrigado, Vou tentar.

Colega tem uma maneira ou componente que faça uma tabela do Excel escaneada, possa tem seus valores salvos em uma tabela tipo OCR ?

Obrigado colega más, não posso ignorar os outros 5 pois são o número da revista os outros 13 se repetem então se ignorar é cadastrar duas revista o código vai ser o mesmo tem outras revista tipo de simpatia que tem 15 os 2 últimos são o número da revista. A leitora vem com um manual com varios códigos de barras para configurar más não encontrei o com 18 ainda. Vou tentar ver que tipo de código é esse obrigado.

Então colega eu devo usar um componente para le 18 dígitos é não configurar a leitora para poder ler? há os 5 últimos são o número da revista.

Obrigado colega vou testar.

Colegas estou com uma dúvida sobre que tipo de código de barras que tem dezoito dígitos. Ex: 9|771517|990009|00104 estou usando um leitor MC 6280 CCD da Metrologic, tem várias configurações para código de barras já tentei um monte é o leitor só Le ate 9|771517|990009 "treze dígitos" É deixa |00104 essa seqüência 9|771517|990009 se repetem a |00104 é o número da revista. Alguém sabe que tipo de código de barras é esse: 9|771517|990009|00104 pois o normal é só treze dígitos, é esse tem dezoito.

Colegas tenho um banco Access 2003 com fotos no campo Objeto OLE como posso extrair é salvar num diretório?

Realmente colega funcionou, ontem ao ler o poste testei mas retornou um erro da função, acho que foi erro meu mesmo. Mais uma vez obrigado a vocês :mellow:

Colega isso não funciona no access.

Colegas como faço para ordenar esse select por mês não ano. SELECT Pessoal.Matrícula, Pessoal.[Nome da pessoa], Cargos.[Nome do cargo], Pessoal.[Data admissão] FROM Pessoal INNER JOIN Cargos ON Pessoal.Cargo = Cargos.Cargo Where [Grupo de Pagamento] = 2 Order By Pessoal.[Data admissão]; Resultado: 1 - 01/01/2001 2 - 01/02/2002 3 - 01/01/2003 Tem que ser assim: 1 - 01/01/2001 2 - 01/01/2003 3 - 01/02/2002 Tem como?.

Agora ficou perfeito. Obrigado a todos. :D

Ok vou testar.

É isso mesmo como converto.

Colegas tenho um aquivo .dat de um sistema de ponto Quero mostrar no grid a hora de cada pessoa, só que no campo data do arquivo a hora é gravada assim 691 como converto para hora e minuto. procurei no forum más não achei nada parecido.

Colegas montei esse exemplo de corretor com códigos do site Torry's Está meio bagunçado más está funcionando Só que se tiver mais de uma palavra para corrigir aparece um caractere estranho tipo quebra de linha onde está atribuindo esse caractere unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Word2000, Psapi, tlhelp32, OleServer, WordXP; type TForm1 = class(TForm) Button1: TButton; WordApp: TWordApplication; WordDoc: TWordDocument; Memo1: TMemo; procedure Button1Click(Sender: TObject); private function IsSatzZeichen(c: CHAR): Boolean; procedure CheckText(Memo: TMemo); function EXE_Running(FileName: string; bFullpath: Boolean): Boolean; function KillTask(ExeFileName: string): Integer; function ReplaceStr(Str, SearchStr, ReplaceStr: string): string; procedure GetProcessList(var List: TstringList); procedure CreateWin9xProcessList(List: TstringList); procedure CreateWinNTProcessList(List: TstringList); public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} { TForm1 } procedure TForm1.CheckText(Memo: TMemo); var i: Integer; MySelStart: INTEGER; Token: string; Line: string; ReplaceStr: string; WordList: TStrings; varFalse: OleVariant; begin // Läuft Word? if EXE_Running('WINWORD.EXE', False) then begin if mrYes = MessageDlg('Word ist geöffnet.' + #13 + #10 + 'Für die Rechtschreibprüfung muss Word beendet werden.' + #13 + #10 + '' + #13 + #10 + 'Word abschiessen?', mtWarning, [mbYes, mbNo], 0) then begin KillTask('WINWORD.EXE'); end; end else begin // Startwerte i := 1; Line := Memo.Text; WordList := TStringList.Create; // Memo traviersieren und einzelne Wörter (Token) rausholen while not (Line[i] = #0) do begin Token := ''; // Tokem zusammenstellen while not IsSatzZeichen(Line[i]) do begin Token := Token + Line[i]; Inc(i); end; if Token <> '' then begin // Token speichern WordList.Add(Token); end; if IsSatzZeichen(Line[i]) then begin // "Token" speichern WordList.Add(Line[i]); Inc(i); end; end; // Verbindung zu Word aufbauen WordApp.Disconnect; WordDoc.Disconnect; WordApp.Connect; WordApp.Visible := False; // Leeres Dokument erzeugen WordDoc.ConnectTo(WordApp.Documents.Add(EmptyParam, EmptyParam, EmptyParam, EmptyParam)); MySelStart := 0; // WordList traversieren und auf Rechschreibung prüfen for i := 0 to WordList.Count - 1 do begin if not IsSatzzeichen(Wordlist[i][1]) then begin WordApp.Visible := False; // WordDokumentinhalt löschen WordDoc.Range.Delete(EmptyParam, EmptyParam); // Token in Word einfügen WordDoc.Range.Set_Text(WordList[i]); // Rechtschreibprüfung aufrufen WordApp.Visible := False; WordDoc.CheckSpelling; WordApp.Visible := False; // Resultat von der Rechtschreibprüfung holen und aufbereiten ReplaceStr := WordDoc.Range.Get_Text; WordApp.Visible := False; //--- ReplaceStr := ReplaceString(ReplaceStr, #$D, ''); // Neues Wort in Memo einfügen Memo.SetFocus; Memo.SelStart := MySelStart; Memo.SelLength := Length(WordList[i]); Memo.SelText := ReplaceStr; WordList[i] := ReplaceStr; end; MySelStart := MySelStart + Length(WordList[i]); end; MessageDlg('Correção Ortográfica concluída', mtInformation, [mbOK], 0); // Verbindung zu Word abbrechen und Word schliessen ohne zu speichern WordDoc.Disconnect; WordApp.Disconnect; varFalse := False; WordApp.Quit(varFalse); end; end; function TForm1.IsSatzZeichen(c: CHAR): Boolean; begin case c of '(': Result := True; ')': Result := True; ' ': Result := True; '.': Result := True; ',': Result := True; '!': Result := True; '?': Result := True; '-': Result := True; ':': Result := True; ';': Result := True; #$D: Result := True; #$A: Result := True; else Result := False; end; end; procedure TForm1.Button1Click(Sender: TObject); begin CheckText(Memo1); end; function TForm1.EXE_Running(FileName: string; bFullpath: Boolean): Boolean; var i: Integer; MyProcList: TstringList; begin MyProcList := TStringList.Create; try GetProcessList(MyProcList); Result := False; if MyProcList = nil then Exit; for i := 0 to MyProcList.Count - 1 do begin if not bFullpath then begin if CompareText(ExtractFileName(MyProcList.Strings[i]), FileName) = 0 then Result := True end else if CompareText(MyProcList.strings[i], FileName) = 0 then Result := True; if Result then Break; end; finally MyProcList.Free; end; end; function TForm1.KillTask(ExeFileName: string): Integer; const PROCESS_TERMINATE = $0001; var ContinueLoop: BOOL; FSnapshotHandle: THandle; FProcessEntry32: TProcessEntry32; begin Result := 0; FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0); FProcessEntry32.dwSize := SizeOf(FProcessEntry32); ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32); while Integer(ContinueLoop) <> 0 do begin if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = UpperCase(ExeFileName))) then Result := Integer(TerminateProcess( OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0)); ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32); end; CloseHandle(FSnapshotHandle); end; procedure TForm1.GetProcessList(var List: TstringList); var ovi: TOSVersionInfo; begin if List = nil then Exit; ovi.dwOSVersionInfoSize := SizeOf(TOSVersionInfo); GetVersionEx(ovi); case ovi.dwPlatformId of VER_PLATFORM_WIN32_WINDOWS: CreateWin9xProcessList(List); VER_PLATFORM_WIN32_NT: CreateWinNTProcessList(List); end end; function TForm1.ReplaceStr(Str, SearchStr, ReplaceStr: string): string; begin while Pos(SearchStr, Str) <> 0 do begin Insert(ReplaceStr, Str, Pos(SearchStr, Str)); Delete(Str, Pos(SearchStr, Str), Length(SearchStr)); end; Result := Str; end; procedure TForm1.CreateWin9xProcessList(List: TstringList); var hSnapShot: THandle; ProcInfo: TProcessEntry32; begin if List = nil then Exit; hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0); if (hSnapShot <> THandle(-1)) then begin ProcInfo.dwSize := SizeOf(ProcInfo); if (Process32First(hSnapshot, ProcInfo)) then begin List.Add(ProcInfo.szExeFile); while (Process32Next(hSnapShot, ProcInfo)) do List.Add(ProcInfo.szExeFile); end; CloseHandle(hSnapShot); end; end; procedure TForm1.CreateWinNTProcessList(List: TstringList); var PIDArray: array [0..1023] of DWORD; cb: DWORD; I: Integer; ProcCount: Integer; hMod: HMODULE; hProcess: THandle; ModuleName: array [0..300] of Char; begin if List = nil then Exit; EnumProcesses(@PIDArray, SizeOf(PIDArray), cb); ProcCount := cb div SizeOf(DWORD); for I := 0 to ProcCount - 1 do begin hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, PIDArray[I]); if (hProcess <> 0) then begin EnumProcessModules(hProcess, @hMod, SizeOf(hMod), cb); GetModuleFilenameEx(hProcess, hMod, ModuleName, SizeOf(ModuleName)); List.Add(ModuleName); CloseHandle(hProcess); end; end; end; end.

Colega tenho sim más acho que vai ficar complexo para o momento, pois não é o form de login é sim o de usuário que vai criptografar as senhas no banco. Vamos fazer assim monte seu form de cadastro de usuários coloque o código de salvar e alterar como você usa, que eu implemento a criptografia, acho que assim é mais didático pra você ok, assim serve também para outros colegas que achem necessário usar criptografia também.

Colegas entendo bem que um banco mesmo Access com 22 MB Não é motivo da demora, o problema é que nessa situação eu estou como. Gerente de TI não como programador, o programa é de outra empresa que diga se De passagem já trabalhei como programador, só que no meu tempo era Deplhi 7 e SQL 2000 hoje é GAS 2003 e Access, o programador dessa dita empresa diz que é a rede, só que tenho outros programas com o banco igual ou até maior que esse com Access que funciona muito bem recorri a essa seção porque achei que algum colega programador já tinha passado por isso. Más já fiz vários teste na rede é não tem problema de trafego ou algo similar Vou passar todos os testes para o setor responsável é o programador da outra empresa que resolva a demora da sua aplicação, obrigado a todos é dou pro resolvida à questão. Até a próxima colegas :D

1º sim 2º é de string logo funciona com texto ou campo texto do Access 3º é para arquivo (copia o banco do Access para outro local).

Welcome Colega. Help: Robo Help ou Help And Manual Quanto a Tela de Login: Crei um tabela de usuarios um formulario para a mesma Crei uma Formulario de Login com dois edits, dois label e dois butões e no evento onclick do botão: {Aqui quando o botão ok e precionado recebe +1 ao somar 3 vezes a senha ou nome errado fecha o programa} Seu Butão_OK.Tag :=Butão_OK.Tag+1; // Fim If Tab_Senha.Locate('nm_usuario', EdtLogin.Text,[]) Then If Tab_Senhanu_Senha.Value = EdtSenha.Text Then Begin MessageDlg('Senha Incorreta!', mtInformation,[mBOk],0); edtSenha.Text :=''; edtSenha.SetFocus; End Else Begin MessageDlg('Usuário não existe!', mtInformation,[mBOK],0); EdtLogin.Text :=''; EdtLogin.SetFocus; End; If Btn_OK.Tag = 4 then begin Application.MessageBox('Caro usuario'+#13+'Se você esqueceu a senha entre em contato com o suporte!'+#13+ 'Caso contrario você não esta autorizado a usar este aplicativo?'+#13+ 'A aplicação será encerada!' ,'Atenção Operação Inlegal!',MB_OK + MB_ICONERROR); Application.Terminate; end; criptografar: Espero ter ajudado. function Criptografar(encode: String): widestring; var i:Integer; begin {encode} s := encode; for i := 1 to ord(s[0]) do c[i] := 23 xor c[i]; result := s; end; //Exemplo: label1 := Criptografar(edit1.text) ------------------------------------------------------------------------------------------------- function DesCriptografar(Decode: String): widestring; var i:Integer; begin {Decode} s := decode; for i:=1 to Length(s) do s[i] := char(23 xor ord(c[i])); result := s; end; //Exemplo: label1 := DesCriptografar(edit1.text) Backup: Uma maneira simples Copiar arquivos { - Coloque um Button no Form; - Altere o evento OnClick deste Button conforme abaixo: } procedure TForm1.Button2Click(Sender: TObject); var Origem, Destino: string; begin Origem := 'c:\Origem\NomeArq.txt'; Destino := 'c:\Destino\NomeArq.txt'; if not CopyFile(PChar(Origem), PChar(Destino), true) then ShowMessage('Erro ao copiar ' + Origem + ' para ' + Destino); end; Observações No exemplo acima, se o arquivo já existir no destino, a função falha (não copia). Para que a função possa sobreescrever o arquivo destino (caso exista), altere o último parâmetro de CopyFile para false. CUIDADO! Se um arquivo for sobreescrito, estará perdido para sempre!

Bom dia, quanto tempo pessoal. Estou precisando novamente da ajuda de vocês Problema: Monitorar o desempenho de uma aplicação com banco Access O banco tem uns 22 MB está muito lento. Ex: uma consulta à base para pesquisar um cliente leva até 2 minutos Só tem um problema à aplicação não é minha e é efeito em GAS 2003(VB) Tem como criar uma aplicação Delphi para “Monitorar” essa outra Ou verificar o acesso ao Access, aceito sugestões. :wacko:

Ola pessoal, Jhonas desculpe a demora para responder Realmente o erro estava aqui: if (vetor_1[wind] = Grid.Cells[Acol,Arow]) then O correto é assim if (vetor_1[wind] = Trim(Grid.Cells[Acol,Arow])) then O resto está certo obrigado pela dica. Bem para completar esse post só falta uma idéia na segui-te questão: Como posso Salvar no banco (Access 2003) um calendário com todas as aulas de um determinado professor? Ex: Se o professor Marcos tem duas aulas de Física na semana, então ele deve dar 80 aulas no ano, ou seja, para cada aula que um professor da na semana, ele deve dar 40 aulas por ano. Exemplo: Carlos da 2 aulas por semana = 80 Aulas anuais Jorge da 3 aulas por semana = 120 Aulas anuais Como posso gravar de uma só vez: Carlos da 2 aulas por semana na segunda Todos os dias do mês que sejam segunda-feira, até que complete 80 aulas, caso a quantidade de segundas não complete a conta, passo a gravar em um outro dia da semana previamente informado, pois nas segundas que forem feriado. (Existe um tabela com todos os feriados cadastrados) a inclusão pule esse dia é passe para outro dia válido Estou fazendo assim: { Declarando o Array... creio que 5 elementos são suficientes, não me recordo se é possível que um mes tenha o mesmo dia da semana 6 vezes...} ArrayDeDias: Array[0..5] of TDateTime; Function DiadaSemana(Data : String) : string; const semana : array[1..7] of string = ('Domingo','Segunda-feira','Terça-feira', 'Quarta-feira','Quinta-feira','Sexta-feira', 'Sábado'); begin Result := semana[DayOfWeek(strtodate(Data))] end; { A Procedure que irá acumular os dias de Segunda por Ex... } procedure GuardaDias(Mes, Ano: Integer); var i, Dia: Byte; Num : integer; begin { "Zerando" o Array...} for i:= 0 to 5 do ArrayDeDias[i]:= 0; { Guardando as datas } i:= 0; for Dia:= 1 to 31 do begin if IsValidDate(Ano, Mes, Dia) then if DayOfTheWeek(EncodeDate(Ano, Mes, Dia)) = Num then // Num paga o Índice de uma combo begin ArrayDeDias[i]:= EncodeDate(Ano, Mes, Dia); i:= i + 1; end; end; end; { Exemplo de uso... } procedure TForm1.Button1Click(Sender: TObject); var i: Byte; dat: string; begin Memo1.Clear; cont:= 0; Num:= cbbDia.ItemIndex + 1; GuardaDias(1,2007); Memo1.Lines.Add('Mês de Janeiro'); for i:= 0 to Length(ArrayDeTercas) - 1 do if (ArrayDeDias[i] <> 0) then if ContarAulas < 80 then begin with qryAuxiliar do begin Close; SQL.Clear; SQL.Add('Insert Into Tab_Calendario (dt_Aula, id_Professor, id_Materia) values('); SQL.Add('"' + datetostr(ArrayDeDias[i]) + '",'); SQL.Add('"' + TRIM(GetStrEsquedo(cbbProfessor.text,'-')) + '",'); SQL.Add('"' + TRIM(GetStrEsquedo(cbbMateria.text,'-')) + '"'); SQL.Add(')'); ExecSQL; end; dat:= DateToStr(ArrayDeDias[i]); Memo1.Lines.Add(DateToStr(ArrayDeDias[i]) + ' - ' + DiadaSemana(dat)); Cont:= Cont + 1; end else Exit; Memo1.Lines.Add('----------------------------------------------'); Funciona corretamente só que mesmo o professor dando duas ou três aulas no dia da semana assim só grava um dia. Como posso gravar de modo que se é dado duas aulas num dia, é a primeira segunda for 07/01/2007 assim que grava conte como se fossem duas aulas ao invés de um como está gravando?

Jhonas vendo exemplo mudei um pouco o código ficou assim: procedure TForm1.GridDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); var vetor_1 :array[1..31] of string; wAux, InicioTermino:string; wind,wPos :integer; begin InicioTermino:= '1,9,11,20'; for wind := 1 to 31 do vetor_1[wind] := ''; wAux := InicioTermino; wind := 1; while wAux <> '' do begin wPos := pos(',',waux); if wPos > 0 then begin vetor_1[wind] := copy(waux,1,wPos-1); delete(wAux,1,wPos); inc(wind); end else begin vetor_1[wind] := waux; wAux := ''; end; end; -------------- if InicioTermino <> '' then begin for wind := 1 to high(vetor_1) do begin if (vetor_1[wind] = '') then break else if (vetor_1[wind] = Grid.Cells[Acol,Arow]) then begin Grid.Canvas.Brush.Color := ColorBox1.Selected; Grid.Canvas.FillRect(Rect); grid.Canvas.TextRect(Rect, Rect.Left, Rect.Top, Grid.Cells[Acol,Arow]); break; end; end; end; Funciona corretamante se os valores forem apartir de 10 ou seja Se InicioTermino:= 1 até 9 --> não pinta Se InicioTermino:= 10 até 31 --> pintar Onde está errado? :mellow: