Ir para conteúdo
Fórum Script Brasil

Jhonas

Monitores
  • Total de itens

    9.657
  • Registro em

Tudo que Jhonas postou

  1. Colega ... eu te dei um exemplo de busca usando a pesquisa do forum .... procure pelas palavras chaves que voce acha que podem existir no forum... caso realmente não encontre nada, os colegas tentarão dar uma ajuda mais especifica. ok ? abraço
  2. Voce pode tentar dessa maneira: uses typinfo; procedure TForm1.FormCreate(Sender: TObject); var i , w, sw : integer; begin sw := 600; w := width; Scaled := true; if (Screen.width <> sw) then Scaleby(screen.width,sw); for i := ComponentCount-1 downto 0 do with Components[i] do begin if GetPropInfo(ClassInfo, 'Font') <> nil then Font.Size := (width div w) * font.Size; end; end; OBS: sw := 600; // tamanho que será aumentado de todos os componentes do form em função da sua configuração de video ( ex: 1024x768 ) abraço abraço
  3. Da uma pesquisada neste endereço ... mas olhe com calma http://www.efg2.com/Lab/Library/Delphi/Graphics/index.html abraço
  4. Procure usar a pesquisa do forum ... já existem dúvidas iguais a sua... digite a palara usuarios conectados ou usuarios rede exmplo: http://scriptbrasil.com.br/forum/index.php...rios+conectados abraço
  5. Jhonas

    PNGDelphi

    Veja nestes endereços: http://ufpr.dl.sourceforge.net/sourceforge...hi/pngimage.zip http://www.fulldls.com/search-all-torrents/?qa=Pngdelphi abraço
  6. use os componentes da paleta ADO abraço
  7. não existe uma propriedade autosize para o Height , o que voce pode fazer é um tipo de controle, mas vai ficar estranho exemplo: procedure TForm1.Button1Click(Sender: TObject); begin DBGrid1.Height := DBGrid1.Height + Query1.RecordCount; // nº de registros na tabela end; abraço
  8. Tem sim .. entretanto isto dependerá de voce... veja neste endereço como customizar o DBNavigator http://delphi.about.com/od/usedbvcl/l/aa090203a.htm abraço
  9. Coloque a parte do codigo que é usada para fazer a conexão com o banco de dados
  10. Neste caso é só modificar o codigo procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var i : integer; begin i := Stringgrid1.row; // FAÇA ESTA MODIFICAÇÃO ... quando CLICAR NA SETA A CELULA FICA COM O TRACEJADO if StringGrid1.Row <> StringGrid1.RowCount -1 then if ((key = vk_Down) or (key = vk_up) or (key = vk_Left) or (key = vk_Right)) then StringGrid1.EditorMode := false; // enter para nova linha if (key = vk_return) and (StringGrid1.Col = StringGrid1.ColCount -1) then if StringGrid1.Cells[1,i] <> '' then begin StringGrid1.RowCount := StringGrid1.RowCount + 1; StringGrid1.Col := 1; StringGrid1.Row := StringGrid1.Row + 1; exit; end; // se a ultima linha estiver vazia, exclui if (key = vk_up) and (stringgrid1.Row > 1) then if StringGrid1.Cells[1,i] = '' then if (StringGrid1.Row = StringGrid1.RowCount -1) then StringGrid1.RowCount := StringGrid1.RowCount - 1; //pula de uma coluna para a outra com enter if StringGrid1.Cells[1,i] <> '' then if (key = vk_return) then StringGrid1.Col := StringGrid1.Col +1; end; Abraço
  11. como mandar para mais de um endereço: IdMessage1.Recipients.EMailAddresses := 'sicrano@bol.com.br ; fulano@bol.com.br ; beltrano@bol.com.br'; ou pode trazer a lista de outro lugar IdMessage1.Recipients.EMailAddresses := Memo1.Lines.Text; abraço
  12. Teste o código e veja o que acontece. Vai ficar melhor do que voce está querendo. abraço
  13. Eduardo ... vou te dar algumas rotinas para obter dados do micro .... entretanto dependerá de voce complementar o codigo para obter os mesmos dados de outros micros na rede. OBS: coloque em um form 10 Labels e um botão. uses WinSock; function GetCPUSpeed: Double; const DelayTime = 500; var TimerHi, TimerLo: DWORD; PriorityClass, Priority: Integer; begin try PriorityClass := GetPriorityClass(GetCurrentProcess); Priority := GetThreadPriority(GetCurrentThread); SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS); SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL); Sleep(10); asm dw 310Fh // rdtsc mov TimerLo, eax mov TimerHi, edx end; Sleep(DelayTime); asm dw 310Fh // rdtsc sub eax, TimerLo sbb edx, TimerHi mov TimerLo, eax mov TimerHi, edx end; SetThreadPriority(GetCurrentThread, Priority); SetPriorityClass(GetCurrentProcess, PriorityClass); Result := TimerLo / (1000.0 * DelayTime); except end; end; function Retorna_IP: string; var p: PHostEnt; s: array[0..128] of char; p2: pchar; wVersionRequested: WORD; wsaData: TWSAData; begin wVersionRequested := MAKEWORD(1, 1); WSAStartup(wVersionRequested, wsaData); GetHostName(@s, 128); p := GetHostByName(@s); p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^); Result := p2; WSACleanup; end; function Retorna_Nome: string; var p: PHostEnt; s: array[0..128] of char; p2: pchar; wVersionRequested: WORD; wsaData: TWSAData; begin wVersionRequested := MAKEWORD(1, 1); WSAStartup(wVersionRequested, wsaData); GetHostName(@s, 128); p := GetHostByName(@s); Result := p^.h_Name; end; function Retorna_Dominio: string; var hProcesso, hTokenAcesso: THandle; Buffer: PChar; Usuario: array[0..31] of char; Dominio: array[0..31] of char; TamanhoBufferInfo: Cardinal; TamanhoUsuario: Cardinal; TamanhoDominio: Cardinal; snu: SID_NAME_USE; begin TamanhoBufferInfo := 1000; TamanhoUsuario := sizeof(Usuario); TamanhoDominio := sizeof(Dominio); hProcesso := GetCurrentProcess; if OpenProcessToken(hProcesso, TOKEN_READ, hTokenAcesso) then try GetMem(Buffer, TamanhoBufferInfo); try if GetTokenInformation(hTokenAcesso, TokenUser, Buffer, TamanhoBufferInfo, TamanhoBufferInfo) then LookupAccountSid(nil, PSIDAndAttributes(Buffer)^.sid, Usuario, TamanhoUsuario, Dominio, TamanhoDominio, snu) else //RaiseLastOSError; finally FreeMem(Buffer); end; result := Dominio; finally CloseHandle(hTokenAcesso); end end; function Retorna_Usuario: string; var cUser: array[0..144] of Char; BufferSize: DWord; cUserName: string; begin BufferSize := SizeOf(cUser); GetUserName(cUser, BufferSize); cUserName := Trim(StrPas(cUser)); Result := cUserName; end; function Retorna_Memoria: string; var MemoryStatus: TMemoryStatus; begin MemoryStatus.dwLength := sizeof(MemoryStatus); GlobalMemoryStatus(MemoryStatus); Result := 'Total de memória física : ' + FormatFloat('#0,000', MemoryStatus.dwTotalPhys); (* {typedef struct _MEMORYSTATUS} DWORD dwLength; // sizeof(MEMORYSTATUS) DWORD dwMemoryLoad; // percentual de memória em uso DWORD dwTotalPhys; // bytes de memória física DWORD dwAvailPhys; // bytes livres de memória física DWORD dwTotalPageFile; // bytes de paginação de arquivo DWORD dwAvailPageFile; // bytes livres de paginação de arquivo DWORD dwTotalVirtual; // bytes em uso de espaço de endereço DWORD dwAvailVirtual; // bytes livres} *) end; procedure ChangeByteOrder( var Data; Size : Integer ); var ptr : PChar; i : Integer; c : Char; begin ptr := @Data; for i := 0 to (Size shr 1)-1 do begin c := ptr^; ptr^ := (ptr+1)^; (ptr+1)^ := c; Inc(ptr,2); end; end; { função que pega o serial number FÍSICO do HD e retorna string } function GetIdeDiskSerialNumber : String; type TSrbIoControl = packed record HeaderLength: ULONG; Signature: Array[0..7] of Char; Timeout: ULONG; ControlCode: ULONG; ReturnCode: ULONG; Length: ULONG; end; SRB_IO_CONTROL = TSrbIoControl; PSrbIoControl = ^TSrbIoControl; TIDERegs = packed record bFeaturesReg : Byte; // especificar "comandos" SMART bSectorCountReg : Byte; // registro de contador de setor bSectorNumberReg : Byte; // registro de número de setores bCylLowReg : Byte; // valor de cilindro (byte mais baixo) bCylHighReg : Byte; // valor de cilindro (byte mais alto) bDriveHeadReg : Byte; // registro de drive/cabeça bCommandReg : Byte; // comando IDE bReserved : Byte; // reservado- tem que ser zero end; IDEREGS = TIDERegs; PIDERegs = ^TIDERegs; TSendCmdInParams = packed record cBufferSize : DWORD; irDriveRegs : TIDERegs; bDriveNumber : Byte; bReserved : Array[0..2] of Byte; dwReserved : Array[0..3] of DWORD; bBuffer : Array[0..0] of Byte; end; SENDCMDINPARAMS = TSendCmdInParams; PSendCmdInParams = ^TSendCmdInParams; TIdSector = packed record wGenConfig : Word; wNumCyls : Word; wReserved : Word; wNumHeads : Word; wBytesPerTrack : Word; wBytesPerSector : Word; wSectorsPerTrack : Word; wVendorUnique : Array[0..2] of Word; sSerialNumber : Array[0..19] of Char; wBufferType : Word; wBufferSize : Word; wECCSize : Word; sFirmwareRev : Array[0..7] of Char; sModelNumber : Array[0..39] of Char; wMoreVendorUnique : Word; wDoubleWordIO : Word; wCapabilities : Word; wReserved1 : Word; wPIOTiming : Word; wDMATiming : Word; wBS : Word; wNumCurrentCyls : Word; wNumCurrentHeads : Word; wNumCurrentSectorsPerTrack : Word; ulCurrentSectorCapacity : ULONG; wMultSectorStuff : Word; ulTotalAddressableSectors : ULONG; wSingleWordDMA : Word; wMultiWordDMA : Word; bReserved : Array[0..127] of Byte; end; PIdSector = ^TIdSector; const IDE_ID_FUNCTION = $EC; IDENTIFY_BUFFER_SIZE = 512; DFP_RECEIVE_DRIVE_DATA = $0007c088; IOCTL_SCSI_MINIPORT = $0004d008; IOCTL_SCSI_MINIPORT_IDENTIFY = $001b0501; DataSize = sizeof(TSendCmdInParams)-1+IDENTIFY_BUFFER_SIZE; BufferSize = SizeOf(SRB_IO_CONTROL)+DataSize; W9xBufferSize = IDENTIFY_BUFFER_SIZE+16; var hDevice : THandle; cbBytesReturned : DWORD; pInData : PSendCmdInParams; pOutData : Pointer; // PSendCmdOutParams Buffer : Array[0..BufferSize-1] of Byte; srbControl : TSrbIoControl absolute Buffer; begin Result := ''; FillChar(Buffer,BufferSize,#0); if Win32Platform=VER_PLATFORM_WIN32_NT then // Windows NT, Windows 2000, Windows XP begin // recuperar handle da porta SCSI hDevice := CreateFile('\\.\Scsi0:', // Nota: '\\.\C:' precisa de privilégios administrativos GENERIC_READ or GENERIC_WRITE, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0); if hDevice=INVALID_HANDLE_VALUE then Exit; try srbControl.HeaderLength := SizeOf(SRB_IO_CONTROL); System.Move('SCSIDISK',srbControl.Signature,8); srbControl.Timeout := 2; srbControl.Length := DataSize; srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY; pInData := PSendCmdInParams(PChar(@Buffer) +SizeOf(SRB_IO_CONTROL)); pOutData := pInData; with pInData^ do begin cBufferSize := IDENTIFY_BUFFER_SIZE; bDriveNumber := 0; with irDriveRegs do begin bFeaturesReg := 0; bSectorCountReg := 1; bSectorNumberReg := 1; bCylLowReg := 0; bCylHighReg := 0; bDriveHeadReg := $A0; bCommandReg := IDE_ID_FUNCTION; end; end; if not DeviceIoControl( hDevice, IOCTL_SCSI_MINIPORT, @Buffer, BufferSize, @Buffer, BufferSize, cbBytesReturned, nil ) then Exit; finally CloseHandle(hDevice); end; end else begin // Windows 95 OSR2, Windows 98, Windows ME hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 ); if hDevice=INVALID_HANDLE_VALUE then Exit; try pInData := PSendCmdInParams(@Buffer); pOutData := @pInData^.bBuffer; with pInData^ do begin cBufferSize := IDENTIFY_BUFFER_SIZE; bDriveNumber := 0; with irDriveRegs do begin bFeaturesReg := 0; bSectorCountReg := 1; bSectorNumberReg := 1; bCylLowReg := 0; bCylHighReg := 0; bDriveHeadReg := $A0; bCommandReg := IDE_ID_FUNCTION; end; end; if not DeviceIoControl( hDevice, DFP_RECEIVE_DRIVE_DATA, pInData, SizeOf(TSendCmdInParams)-1, pOutData, W9xBufferSize, cbBytesReturned, nil ) then Exit; finally CloseHandle(hDevice); end; end; with PIdSector(PChar(pOutData)+16)^ do begin ChangeByteOrder(sSerialNumber,SizeOf(sSerialNumber)); SetString(Result,sSerialNumber,SizeOf(sSerialNumber)); end; end; procedure TForm1.Button1Click(Sender: TObject); var Temp, Platform , Version : String; osInfo : TOSVersionInfo; cpuspeed: string; begin osInfo.dwOSVersionInfoSize:=SizeOf(osInfo); GetVersionEx(osInfo); Version :=IntToStr(osInfo.dwMinorVersion); Temp:=IntToStr(osInfo.dwBuildNumber and $0ffff); Temp:=String(osInfo.szCSDVersion); if (Length(Temp) > 0) then if (Temp[1] <> ' ') then Temp:=' ' + Temp; Version:= Version + Temp; label10.caption := Version; case osInfo.dwPlatformId of VER_PLATFORM_WIN32s : Platform:='Win32s'; VER_PLATFORM_WIN32_WINDOWS : begin if (osInfo.dwMinorVersion = 0) then Platform:='Windows 95' else if (osInfo.dwMinorVersion = 10) then Platform:='Windows 98' else Platform:='Windows Me'; end; VER_PLATFORM_WIN32_NT : case osInfo.dwMajorVersion of 3 : Platform:='Windows NT 3'; 4 : Platform:='Windows NT 4.0'; 5 : case osInfo.dwMinorVersion of 0: Platform:='Windows 2000, Windows Vista ou Windows Server 2008'; 1: Platform:='Windows XP'; 2: Platform:='Windows Server 2003 R2, 2003 ou XP Professional X64 Edition'; else Platform:='Windows Version +'; end; end; end; cpuspeed := Format('%f MHz', [GetCPUSpeed]); Label1.Caption := 'Nome máquina: ' + Retorna_Nome; Label2.Caption := 'IP: ' + Retorna_IP; Label3.Caption := 'Domínio: ' + Retorna_Dominio; Label4.Caption := 'Velocidade do CPU: ' + cpuspeed + ' (valor aproximado)'; Label5.Caption := 'Nome do usuário na rede: ' + Retorna_Usuario; Label6.Caption := 'Memória RAM: ' + Retorna_Memoria; Label8.Caption := 'Tamanho do Disco: ' + FormatFloat('#0,000',DiskSize(0) div 1024); Label7.Caption := 'Espaço Livre: ' + FormatFloat('#0,000',DiskFree(0) div 1024); Label9.Caption := 'Serial Físico do HD: ' + Trim(GetIdeDiskSerialNumber); label11.caption := Platform; end; O resto agora é com voce. abraço
  14. Jhonas

    String

    Bem lembrado... estou tão acostumado com isso que me esqueço de informar.... Valeu. abraço
  15. Veja as propriedades e os eventos que o componente possui. O active é do componente SyTray ... o popupmenu é linkado a ele ( onde estão os itens de menu que voce quer executar ) . Os outros eventos voce usa da maneira que achar melhor ( OnClick, OnDblClick, OnMouseDown, OnMouseMove..etc ) da mesma maneira que voce usaria em um form. abraço
  16. Tem sim ... veja : procedure TForm1.StringGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var i : integer; begin i := Stringgrid1.row; // desabilita setas se celula estiver vazia if StringGrid1.Cells[1,i] = '' then if StringGrid1.Row <> StringGrid1.RowCount -1 then if ((key = vk_Down) or (key = vk_up)) then key := 0; // enter para nova linha if (key = vk_return) and (StringGrid1.Col = StringGrid1.ColCount -1) then if StringGrid1.Cells[1,i] <> '' then begin StringGrid1.RowCount := StringGrid1.RowCount + 1; StringGrid1.Col := 1; StringGrid1.Row := StringGrid1.Row + 1; exit; end; // se a ultima linha estiver vazia, exclui if (key = vk_up) and (stringgrid1.Row > 1) then if StringGrid1.Cells[1,i] = '' then if (StringGrid1.Row = StringGrid1.RowCount -1) then StringGrid1.RowCount := StringGrid1.RowCount - 1; //pula de uma coluna para a outra com enter if StringGrid1.Cells[1,i] <> '' then if (key = vk_return) then StringGrid1.Col := StringGrid1.Col +1; end; abraço
  17. estranho... aqui eu coloco um icone na propriedade icon e linko este componente a um outro chamado PopupMenu1 ( itens de menu ) e deixo a propriedade active como true... e utilizo o evento OnClick para utiliza-lo .... funciona perfeitamente. abraço
  18. Jhonas

    String

    Function Trim(const S: string): string; Remove todos os espaços da string S; Function TrimLeft(const S: string): string; Remove todos os espaços à esquerda da string S; Function TrimRight(const S: string): string; Remove todos os espaços à direita da string S; abraço
  19. Veja se voce não esqueceu de colocar um icone na propriedade icon, se não não aparece. abraço
  20. Jhonas

    String

    Oi Eder.. isto é muito simples: procedure TForm1.Button1Click(Sender: TObject); var i : integer; s : string; begin i := length(trim(Edit1.Text)); i := i div 2; s := trim(Edit1.Text); insert('-',s,i+1); label1.caption := s; end; Onde O Edit1.Text recebe a palavra SCRIPTBRASIL abraço
  21. Seu tópico < Obrigado pela sua ciatção > foi deletado, pois já está contido neste. Quanto ao seu questionamento: Voce está certo, e já existem softwares prontos para tal finalidade ... mas vou ver se acho alguma coisa mais acessível. abraço
  22. Jhonas

    GetAsyncKeyState

    Se voce procurasse, iria encontrar em um destes posts, um código que captura as teclas digitadas em qualquer janela do seu programa ou do windows ( excel ) abraço
  23. De acordo com o fornecedor ele serve tambem para o delphi 7 http://gd.tuwien.ac.at/softeng/delphi/ftp/d20free/kdbexp.zip abraço
  24. Jhonas

    Biometria

    Com certeza é falta de alguma dll, mas na compra de um leitor biométrico, o mesmo já vem com as dlls necessárias à comunicação com o software ( Delphi ) Veja nestes endereços, voce vai encontrar o material necessário. http://www.nitgen.com.br/download.aspx http://www.griaulebiometrics.com/page/pt-br/index abraço
×
×
  • Criar Novo...