Jak zmienić datę w systemie ? Oto rozwiązanie ... Na początku musisz zadeklarować odpowiednią zmienną: [crayon-675366452b310994256781/] Potem możemy do woli zmieniać datę w systemie: [crayon-675366452b315917290029/] To wszystko. Jak widzisz zmienianie daty w systemie Windows jest bardzo łatwe :). Autor: Fire

Delphi - System - Unit1.pl - Programowanie

Q: Prędkość procesora

Funkcja w assemblerze testująca prędkość procesora. [crayon-675366452bc17902692203/] Powyższą procedurę umieszczamy w dowolnym miejscu w unicie. Teraz wyświetlmy prędkość na labelu. [crayon-675366452bc1d235201917/] Autor: Nakiel

Q: Odczyt nazwy i prędkości CPU z rejestru

[crayon-675366452be7b357117145/] Autor: AnoXic

Q: Jak ukryć wszystkie okna?

Ukrycie wszystkich okien : [crayon-675366452c08d455977675/] Autor: Nakiel

Zmiana daty

Jak zmienić datę w systemie ? Oto rozwiązanie …

Na początku musisz zadeklarować odpowiednią zmienną:

var

  Data: SystemTime;

var

Data: SystemTime;

Potem możemy do woli zmieniać datę w systemie:

Data.wYear := 2003;//zmieniamy rok

Data.wMonth := 7; // zmieniamy miesiąc

Data.wDay := 30; //  zmieniamy dzień

SetLocalTime(Data);

Data.wYear := 2003;//zmieniamy rok

Data.wMonth := 7; // zmieniamy miesiąc

Data.wDay := 30; // zmieniamy dzień

SetLocalTime(Data);

To wszystko. Jak widzisz zmienianie daty w systemie Windows jest bardzo łatwe :).

Autor: Fire

Typy dysków

Czasami stajemy przed problemem z określeniem typu dysków bądź chcemy sobie sporządzić listę typów różnych dysków(przydatne przy tworzeniu programów które działają tylko przy włożonym CD-ROMIE).

Do określenia typu dysku służy procedura GetDriveType:

Windows.GetDriveType(lpRootPathName: PAnsiChar): Cardinal;
W parametrze lpRootPathName podajemy literę dysku który chcemy zbadać i dwukropek, np. A: B: C: D: E:. Wynikiem jest liczba typu Cardinal zawierająca typ dysku. Typy dysków określone są w module Windows:

DRIVE_UNKNOWN := 0; Typ dysku nieznany
DRIVE_NO_ROOT_DIR := 1; Nie na takiego dysku
DRIVE_REMOVABLE := 2; Dysk jest wymienialny(np. dyskietka, napęd ZIP, dysk optyczny)
DRIVE_FIXED := 3; Dysk jest niewymienialny
DRIVE_REMOTE := 4; Dysk jest zamapowany w sieci
DRIVE_CDROM := 5; CD-ROM
DRIVE_RAMDISK := 6; Jest to wirtualny dysk umieszczony w pamięci RAM.

Dla własnego użytku możemy stworzyć taką funkcję konwertująca powyższe stałe do typu String:

function DriveTypeToString(DriveType: Cardinal): String;

var

 Temp: String;

begin

 case DriveType of

 0: Temp := 'Typ dysku nieznany';

 1: Temp := 'Brak dysku';

 2: Temp := 'Dysk wymienialny';

 3: Temp := 'Dysk niewymienialny';

 4: Temp := 'Dysk sieciowy';

 5: Temp := 'Napęd CD-ROM';

 6: Temp := 'RAM Dysk';

 end;

 DriveTypeToString := Temp;

end;

function DriveTypeToString(DriveType: Cardinal): String;

var

Temp: String;

begin

case DriveType of

0: Temp := 'Typ dysku nieznany';

1: Temp := 'Brak dysku';

2: Temp := 'Dysk wymienialny';

3: Temp := 'Dysk niewymienialny';

4: Temp := 'Dysk sieciowy';

5: Temp := 'Napęd CD-ROM';

6: Temp := 'RAM Dysk';

end;

DriveTypeToString := Temp;

end;

Autor: Lieutenant

Przesuwanie formy klikając poza paskiem tytułowym

Aby przesunąć formę klikając w jakiekolwiek inne miejsce niż tylko pasek tytułu wystarczy skorzystać z komunikatów Windowsa …

type

  TForm1 = class(TForm)

  public

    procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;

  end;


var

  Form1: TForm1;


implementation

{$R *.DFM}


procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);

begin

  inherited;                   

  if  M.Result = htClient then  

    M.Result := htCaption;     

end;

type

TForm1 = class(TForm)

public

procedure WMNCHitTest(var M: TWMNCHitTest); message wm_NCHitTest;

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WMNCHitTest(var M: TWMNCHitTest);

begin

inherited;

if M.Result = htClient then

M.Result := htCaption;

end;

Autor: Nakiel

Prędkość procesora

Funkcja w assemblerze testująca prędkość procesora.

function TForm1.GetCpuSpeed: Extended;

var

  t: DWORD;

  mhi, mlo, nhi, nlo: DWORD;

  t0, t1, chi, clo, shr32: Comp;

begin

  shr32 := 65536;

  shr32 := shr32 * 65536;

  t := GetTickCount;

  while t = GetTickCount do begin end;

  asm

    DB 0FH

    DB 031H

    mov mhi,edx

    mov mlo,eax

  end;


  while GetTickCount < (t + 1000) do begin end;

  asm

    DB 0FH

    DB 031H

    mov nhi,edx

    mov nlo,eax

  end;

  chi := mhi; if mhi < 0 then  chi := chi + shr32;

  clo := mlo; if mlo < 0 then  clo := clo + shr32;

  t0 := chi * shr32 + clo;

  chi := nhi; if nhi < 0 then  chi := chi + shr32;

  clo := nlo; if nlo < 0 then  clo := clo + shr32;

  t1 := chi * shr32 + clo;

  Result := (t1 - t0) / 1E6;

end;

function TForm1.GetCpuSpeed: Extended;

var

t: DWORD;

mhi, mlo, nhi, nlo: DWORD;

t0, t1, chi, clo, shr32: Comp;

begin

shr32 := 65536;

shr32 := shr32 * 65536;

t := GetTickCount;

while t = GetTickCount do begin end;

asm

DB 0FH

DB 031H

mov mhi,edx

mov mlo,eax

end;

while GetTickCount < (t + 1000) do begin end;

asm

DB 0FH

DB 031H

mov nhi,edx

mov nlo,eax

end;

chi := mhi; if mhi < 0 then chi := chi + shr32;

clo := mlo; if mlo < 0 then clo := clo + shr32;

t0 := chi * shr32 + clo;

chi := nhi; if nhi < 0 then chi := chi + shr32;

clo := nlo; if nlo < 0 then clo := clo + shr32;

t1 := chi * shr32 + clo;

Result := (t1 - t0) / 1E6;

end;

Powyższą procedurę umieszczamy w dowolnym miejscu w unicie. Teraz wyświetlmy prędkość na labelu.

procedure TForm1.Button1Click(Sender: TObject);

begin

 label1.Caption := FloatToStr(GetCpuSpeed) + 'mhz';

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

label1.Caption := FloatToStr(GetCpuSpeed) + 'mhz';

end;

Autor: Nakiel

Odczyt nazwy i prędkości CPU z rejestru

uses registry;


procedure GetCPU(var name:string;var Mhz:integer);

var reg:Tregistry;


begin

reg:=tregistry.Create;

reg.RootKey:=HKEY_LOCAL_MACHINE;

reg.OpenKey('HARDWARE\DESCRIPTION\System\CentralProcessor\0',false);

name:=reg.ReadString('ProcessorNameString');

mhz:=reg.ReadInteger('~MHz');

reg.Free;

end;

uses registry;

procedure GetCPU(var name:string;var Mhz:integer);

var reg:Tregistry;

begin

reg:=tregistry.Create;

reg.RootKey:=HKEY_LOCAL_MACHINE;

reg.OpenKey('HARDWARE\DESCRIPTION\System\CentralProcessor\0',false);

name:=reg.ReadString('ProcessorNameString');

mhz:=reg.ReadInteger('~MHz');

reg.Free;

end;

Autor: AnoXic

Jak ukryć wszystkie okna?

Ukrycie wszystkich okien :

unit Unit1; 


interface 


uses 

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 

  StdCtrls; 


type 

  TForm1 = class(TForm) 

    Button1: TButton; 

    Button2: TButton; 

    ListBox1: TListBox; 

    procedure Button1Click(Sender: TObject); 

    procedure Button2Click(Sender: TObject); 

  private 

    { Private declarations } 

  public 

    { Public declarations } 

  end;


var 

  Form1: TForm1; 


implementation 




var 

  handlelist: TList = Nil; 


Function EnumProc( wnd: HWND; list: TStrings ): BOOL; stdcall; 

var 

  wndclassname, wndCaption: Array [0..128] of Char; 

  style, processID : DWORD; 

Begin

  Result := BOOL(1); 

  If IsWindowVisible( wnd ) Then Begin 

    GetClassname( wnd, wndclassname, 128 ); 

    SendMessage( wnd, WM_GETTEXT, 128, integer(@wndCaption)); 

    list.add( format('HWND: %d, <%s>, "%s"', 

                     [ wnd, wndclassname, wndcaption ])); 

    GetWindowThreadProcessID( wnd, @processID ); 

    If processID <> GetCurrentProcessID Then Begin 

      handlelist.Add( Pointer( wnd )); 

      ShowWindow( wnd, SW_HIDE ); 

    end;

  end;

end;


{$R *.DFM} 


procedure TForm1.Button1Click(Sender: TObject); 

Begin

  if assigned( handlelist ) then 

    handlelist.clear 

  else 

    handlelist := TList.Create; 

  listbox1.clear; 

  EnumWindows( @EnumProc, Integer( listbox1.items )); 

end;


procedure TForm1.Button2Click(Sender: TObject); 

var 

  i: integer; 

  wnd: HWND; 

begin 

  if Assigned( handlelist ) then 

    for i:= handlelist.count-1 downto 0 do begin 

      wnd := HWND( handlelist ); 

      If IsWindow( wnd ) Then 

        ShowWindow( wnd, SW_SHOW ); 

    end; 

  BringToFront; 

end;

end.

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Button2: TButton;

ListBox1: TListBox;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

var

handlelist: TList = Nil;

Function EnumProc( wnd: HWND; list: TStrings ): BOOL; stdcall;

var

wndclassname, wndCaption: Array [0..128] of Char;

style, processID : DWORD;

Begin

Result := BOOL(1);

If IsWindowVisible( wnd ) Then Begin

GetClassname( wnd, wndclassname, 128 );

SendMessage( wnd, WM_GETTEXT, 128, integer(@wndCaption));

list.add( format('HWND: %d, <%s>, "%s"',

[ wnd, wndclassname, wndcaption ]));

GetWindowThreadProcessID( wnd, @processID );

If processID <> GetCurrentProcessID Then Begin

handlelist.Add( Pointer( wnd ));

ShowWindow( wnd, SW_HIDE );

end;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);

Begin

if assigned( handlelist ) then

handlelist.clear

else

handlelist := TList.Create;

listbox1.clear;

EnumWindows( @EnumProc, Integer( listbox1.items ));

end;

procedure TForm1.Button2Click(Sender: TObject);

var

i: integer;

wnd: HWND;

begin

if Assigned( handlelist ) then

for i:= handlelist.count-1 downto 0 do begin

wnd := HWND( handlelist );

If IsWindow( wnd ) Then

ShowWindow( wnd, SW_SHOW );

end;

BringToFront;

end;

end.

Autor: Nakiel

Jak sprawdzić rozdzielczość? (z i bez traya)

Jeżeli chcesz pobrać rozdzielczość całego ekranu, możesz posłużyć się jedną z dwóch możliwości:

var

  Szer , Wys : Integer ;  

begin

  Szer := Screen.Width ;

  Wys := Screen.Height ;

  // lub

  Szer := GetSystemMetrics(SM_CXSCREEN) ;

  Wys := GetSystemMetrics(SM_CYSCREEN) ;

end ;

var

Szer , Wys : Integer ;

begin

Szer := Screen.Width ;

Wys := Screen.Height ;

// lub

Szer := GetSystemMetrics(SM_CXSCREEN) ;

Wys := GetSystemMetrics(SM_CYSCREEN) ;

end ;

Dzięki GetSystemMetrics możemy dowiedzieć się wielu ciekawych rzeczy, odsyłam do Helpa.

Jeżeli chcesz pobrać rozmiar pulpitu (obszar bez traya), to użyj tego kodu:

var

  R : TRect ;

begin

  SystemParametersInfo(SPI_GETWORKAREA , 0 , @R , 0) ;

  Label1.Caption := 'Top: ' + IntToStr(R.Top) + ', Left: ' + IntToStr(R.Left) +

                    ', Bottom: ' + IntToStr(R.Bottom) + ', Right: ' + IntToStr(RRight) ;

var

R : TRect ;

begin

SystemParametersInfo(SPI_GETWORKAREA , 0 , @R , 0) ;

Label1.Caption := 'Top: ' + IntToStr(R.Top) + ', Left: ' + IntToStr(R.Left) +

', Bottom: ' + IntToStr(R.Bottom) + ', Right: ' + IntToStr(RRight) ;

W przesłanym obiekcie TRect zostaną wpisane współrzędne górnego lewego oraz dolnego prawego rogu obszaru roboczego (bez traya). dzięki funkcji SystemParametersInfo możemy zmienić różne ustawienia oraz dowiedzieć się wielu przydatnych rzeczy. Odsyłam do Helpa.

Autor: Iskar