StatusBar a zobrazení času, datumu, uživatele, PC atd

StatusBar a zobrazení času, datumu, uživatele, PC atd

Odoslaťod TenglerDaniel » 14 Apr 2009, 10:39

Kdysi jsem zde na fóru hledal odpovědi a bylo mi perfektně poraděno a na oplátku přidávám funkce a procedury k vypsání informací ve StatusBaru.
Celý zdrojový kód :
Na formulář vložíme StatusBar, FontDialog, Timer.
StatusBar rozdělíme na 7 panelů, kdy velikost panelů bude následující:
Panel 0 >> Width 10 ( odsazení od okraje)
Panel 1 >> Width 150 ( jméno přihlášeného uživatele)
Panel 2 >> Width 150 (název PC)
Panel 3 >> Width 100 (datum)
Panel 4 >> Width 100 (čas)
Panel 5 >> Width 150 (použitý font)
Panel 6 >> Width 50 (velikost fontu)
Panel 7 >> Width 0
Timer nastavíme na Interval 1000 .



Kód: Vybrať všetko
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls ;

type
  TForm1 = class(TForm)
    dlgFont: TButton;
    FontDialog1: TFontDialog;
    StatusBar1: TStatusBar;
    Timer1: TTimer;
    procedure dlgFontClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);

private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

Function GetUserFromWindows: string; //zjištění  jména uživatele
Var
   UserName : string;
   UserNameLen : Dword;
begin
   UserNameLen := 1060;
   SetLength(userName, UserNameLen) ;
   If GetUserName(PChar(UserName), UserNameLen) Then
     Result := Copy(UserName,1,UserNameLen - 1)
   else
     Result := 'Unknown';
end;

Function GetComputerNetName: string; // zjištění jména PC
var
  buffer: array[0..1060] of char;
  size: dword;
begin
  size := 1061;
  if GetComputerName(buffer, size) then
    Result := buffer
  else
    Result := ''
end;


procedure TForm1.dlgFontClick(Sender: TObject);
begin
FontDialog1.Execute;
  Form1.StatusBar1.Panels[5].Text:= (FontDialog1 .Font.Name);
  Form1.StatusBar1.Panels[6].Text:=IntToStr(FontDialog1.Font.Size);

end;


procedure TForm1.Timer1Timer(Sender: TObject);
begin
StatusBar1.Panels[4].Text:=TimeToStr(Now);
end;

end.

procedure TForm1.FormCreate(Sender: TObject);
begin
Form1.StatusBar1.Color:= clBlue; // zde si nastavíme barvu pozadí panelu
Form1.StatusBar1.Panels[1].Text:= GetUserFromWindows() ;
Form1.StatusBar1.Panels[2].Text:= GetComputerNetName();
Form1.StatusBar1.Panels[3].Text:= DateToStr(Now);
Form1.StatusBar1.Font.Name:= 'Arial ';
Form1.StatusBar1.Font.Size:= 11;
end;
end.
TenglerDaniel
vychádzajúca hviezda
vychádzajúca hviezda
 
Príspevky: 15
Založený: 09 Nov 2008, 10:06

Naspäť na Dátum a čas

Kto je prítomný

Užívatelia prezerajúci si toto fórum: Žiadny registrovaný používateľ a 1 hosť.

cron