• Что бы вступить в ряды "Принятый кодер" Вам нужно:
    Написать 10 полезных сообщений или тем и Получить 10 симпатий.
    Для того кто не хочет терять время,может пожертвовать средства для поддержки сервеса, и вступить в ряды VIP на месяц, дополнительная информация в лс.

  • Пользаватели которые будут спамить, уходят в бан без предупреждения. Спам сообщения определяется администрацией и модератором.

  • Гость, Что бы Вы хотели увидеть на нашем Форуме? Изложить свои идеи и пожелания по улучшению форума Вы можете поделиться с нами здесь. ----> Перейдите сюда
  • Все пользователи не прошедшие проверку электронной почты будут заблокированы. Все вопросы с разблокировкой обращайтесь по адресу электронной почте : info@guardianelinks.com . Не пришло сообщение о проверке или о сбросе также сообщите нам.

Остановка локального времени на компьтере

StrangeType Оффлайн

StrangeType

Знающий кодер
Принятый Кодер
Сообщения
5
Симпатии
2
Баллы
40
Всем привет, форумчане. Помогите с очень интересным вопросом по поводу времени на компьютере и его остановки.
Дело в том, что я уже лазил по форумам различным, но не нашел то, что было нужно. У меня есть уже небольшой код, но при выполнении цикла программа напрочь подвисает и невозможно нажимать другие кнопки. На форме присутствуют всего 2 кнопки, первая - "Остановить время", вторая - "Запустить время". Вот небольшой код

Код:
procedure SetDateTime(Year : word; Month, Day : byte; Hour, Min, Sec, MSec : byte);
var
  ATime: TSystemTime;
begin
  with ATime do
  begin
    wYear := Year;
    wMonth := Month;
    wDay := Day;
    wHour := Hour;
    wMinute := Min;
    wSecond := Sec;
    wMilliseconds := MSec;
  end;
  SetLocalTime(ATime);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ATime: TSystemTime;
begin
While 1 <> 1000000000000000 do
begin
  GetLocalTime(ATime);
  SetDateTime(ATime.wYear,ATime.wMonth, ATime.wDay, ATime.wHour, ATime.wMinute, ATime.wSecond, ATime.wMilliseconds-1);
end;
end;
end.
 
Lomanu4 Оффлайн

Lomanu4

Команда форума
Администратор
Сообщения
1,151
Симпатии
222
Баллы
155
VK

Код:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  type
  Tmypotok = class(TThread)
  private

    { Private declarations }
  protected

    procedure Execute; override;

    end ;


var
  Form1: TForm1;
  potok:Tmypotok;
implementation

{$R *.dfm}

{ Tmypotok }
  procedure SetDateTime(Year : word; Month, Day : byte; Hour, Min, Sec, MSec : byte);
var
  ATime: TSystemTime;
begin
  with ATime do
  begin
    wYear := Year;
    wMonth := Month;
    wDay := Day;
    wHour := Hour;
    wMinute := Min;
    wSecond := Sec;
    wMilliseconds := MSec;
  end;
  SetLocalTime(ATime);
end;


procedure Tmypotok.Execute;
var
  ATime: TSystemTime;
begin
While 1 <> 1000000000000000 do
begin
  GetLocalTime(ATime);
  SetDateTime(ATime.wYear,ATime.wMonth, ATime.wDay, ATime.wHour, ATime.wMinute, ATime.wSecond, ATime.wMilliseconds-1);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  potok.Suspend;
end;




procedure TForm1.Button3Click(Sender: TObject);
begin
potok.Terminate;
end;

procedure TForm1.Button1Click(Sender: TObject);

begin
   potok:=Tmypotok.Create(False);


  end ;
end.
 
Вверх Снизу