Konuyu Oyla:
  • Derecelendirme: 0/5 - 0 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Timer -Procedure ?
#5
Normalde hazır kod vermeyi sevmem ama bu kodu incele biraz vcl uygulaması ama kullanım hakkında çok fikir verecek Wink


Aşağıdaki linkte formun çalışma videosu var onu da izle.

https://blog.yakupulutas.com/uzak-masaus...ygulamasi/


unit UpdateForm;

interface

uses
 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
 Vcl.Controls, Vcl.Forms, Vcl.Dialogs, dxGDIPlusClasses, Vcl.ExtCtrls, cxGraphics, cxLookAndFeels,
 cxLookAndFeelPainters, Vcl.Menus, dxSkinsCore, dxSkinBlack, dxSkinBlue, dxSkinBlueprint, dxSkinCaramel, dxSkinCoffee,
 dxSkinDarkRoom, dxSkinDarkSide, dxSkinDevExpressDarkStyle, dxSkinDevExpressStyle, dxSkinFoggy, dxSkinGlassOceans,
 dxSkinHighContrast, dxSkiniMaginary, dxSkinLilian, dxSkinLiquidSky, dxSkinLondonLiquidSky, dxSkinMcSkin,
 dxSkinMetropolis, dxSkinMetropolisDark, dxSkinMoneyTwins, dxSkinOffice2007Black, dxSkinOffice2007Blue,
 dxSkinOffice2007Green, dxSkinOffice2007Pink, dxSkinOffice2007Silver, dxSkinOffice2010Black, dxSkinOffice2010Blue,
 dxSkinOffice2010Silver, dxSkinOffice2013DarkGray, dxSkinOffice2013LightGray, dxSkinOffice2013White, System.math,
 dxSkinOffice2016Colorful, dxSkinOffice2016Dark, dxSkinPumpkin, dxSkinSeven, dxSkinSevenClassic, dxSkinSharp,
 dxSkinSharpPlus, dxSkinSilver, dxSkinSpringTime, dxSkinStardust, dxSkinSummer2008, dxSkinTheAsphaltWorld,
 dxSkinTheBezier, dxSkinsDefaultPainters, dxSkinValentine, dxSkinVisualStudio2013Blue, dxSkinVisualStudio2013Dark,
 dxSkinVisualStudio2013Light, IdComponent, Zip, dxSkinVS2010, dxSkinWhiteprint, dxSkinXmas2008Blue, Vcl.StdCtrls, cxButtons, shellapi,
 IdHTTP, Vcl.ComCtrls, clMultiDC, clSingleDC, clDownLoader, clResourceState;

type
 TMyHTTP = class(TIdHTTP)
 public
   FileSize: Int64;
 end;

 TFrmUpdate = class(TForm)
   Image1: TImage;
   Image2: TImage;
   Image3: TImage;
   Label1: TLabel;
   btn_sil: TcxButton;
   cxButton1: TcxButton;
   Image4: TImage;
   Image5: TImage;
   LabelVersion: TLabel;
   Prg1: TProgressBar;
   Label2: TLabel;
   whatisnew: TcxButton;
   procedure cxButton1Click(Sender: TObject);

   procedure IndirAnimation;
   procedure Start;
   procedure StartDownload(Url, FileName, FilePath: String);
   procedure FormCreate(Sender: TObject);
   procedure btn_silClick(Sender: TObject);
   procedure doVisibile;
   procedure whatisnewClick(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 FrmUpdate: TFrmUpdate;
 BlogUrl: String = 'https://blog.yakupulutas.com/uzak-masaustu-baglantisi-remote-desktop-connection-uygulamasi/';
 DownloadUrl: String = 'https://blog.yakupulutas.com/wp-content/uploads/Uzakv3.zip';
 Animation: TThread;
 Terminated: boolean = False;

implementation

{$R *.dfm}

uses MainForm;

procedure TFrmUpdate.btn_silClick(Sender: TObject);
begin
 doVisibile;
 btn_sil.Enabled := False;
 cxButton1.Enabled := False;
 Start;
 StartDownload(DownloadUrl, 'Uzakv3.zip', ExtractFileDir(Application.ExeName) + '\');
end;

procedure TFrmUpdate.cxButton1Click(Sender: TObject);
begin
 Close;
end;

procedure TFrmUpdate.doVisibile;
begin
 LabelVersion.Visible := not LabelVersion.Visible;
 Image3.Visible := not Image3.Visible;
 Label1.Visible := not Label1.Visible;
 whatisnew.Visible := not whatisnew.Visible;
 Image4.Visible := not Image4.Visible;
 Image5.Visible := not Image5.Visible;
end;

procedure TFrmUpdate.FormCreate(Sender: TObject);
begin
 Animation := TThread.CreateAnonymousThread(
   procedure
   var
     i: integer;
   begin
     while Terminated do
     begin
       TThread.Queue(nil,
         procedure
         begin
           IndirAnimation;
         end);
       Sleep(250);
     end;
   end);
end;

procedure TFrmUpdate.IndirAnimation;
var
 lbl: TLabel;
begin
 lbl := TLabel.Create(Self);
 lbl.Parent := Image1.Parent;
 lbl.Left := RandomRange(160, 240);
 lbl.Top := 200;
 lbl.Width := 31;
 lbl.Height := 13;
 lbl.Caption := Inttostr(Random(2));
 TThread.CreateAnonymousThread(
   procedure
   var
     i: integer;
     ilbl: TLabel;
   begin
     ilbl := lbl;
     for I := ilbl.Top to 410 do
     begin
       TThread.Queue(nil,
         procedure
         begin
           ilbl.Top := i;
           if i > 408 then
             ilbl.Visible := False;
         end);
       Sleep(10);
     end;
   end).Start;
end;

procedure TFrmUpdate.Start;
begin
 if Terminated = False then
 begin
   Terminated := True;
   Animation.Start;
 end
 else
 begin
   Terminated := False;
 end;
end;

procedure TFrmUpdate.StartDownload(Url, FileName, FilePath: String);
var
 Down: TclDownLoader;
begin
 Down := TclDownLoader.Create(nil);
 try
   try
     Down.Url := StringReplace(Url, '\', '/', [rfReplaceAll]);
     Down.LocalFile := FilePath + FileName;
     Down.Start(False);
     if FileExists(FilePath + FileName) then
     begin
       TThread.CreateAnonymousThread(
         procedure
         var
           Zip: TZipFile;
         begin
           Sleep(500);
           Zip := TZipFile.Create;
           if FileExists(ExtractFileDir(Application.ExeName) + '\' + Application.ExeName + '_old') then
             Deletefile(ExtractFileDir(Application.ExeName) + '\' + Application.ExeName + '_old');

           RenameFile(Application.ExeName, Application.ExeName + '_old');
           Zip.Open(ExtractFileDir(Application.ExeName) + '\' + 'Uzakv3.zip', zmRead);
           Sleep(500);
           Zip.ExtractAll(ExtractFileDir(Application.ExeName) + '\');

           if FileExists(ExtractFileDir(Application.ExeName) + '\' + 'Uzakv3.zip') then
             Deletefile(ExtractFileDir(Application.ExeName) + '\' + 'Uzakv3.zip');
           Terminated := False;
           TThread.Queue(nil,
             procedure
             begin
               ShowMessage('Güncelleme tamamlandı, bir sonraki açılışta güncel uygulama açılacak');
               Close;
             end);

           if Assigned(Zip) then
             Zip.Free;
         end).Start;
     end
     else
     begin
       ShowMessage('Güncelleme esnasında hata meydana geldi.');
     end;
   except
     on E: Exception do
     begin
       ShowMessage(E.Message);
     end;
   end;
 finally
   Down.Free;
 end;
end;

procedure TFrmUpdate.whatisnewClick(Sender: TObject);
begin
ShellExecute(Handle, 'open', PWideChar(BlogUrl), nil, nil, SW_SHOW);
end;

end.

(23-05-2019, Saat: 02:14)crowlin Adlı Kullanıcıdan Alıntı: Hayır bir sıkıntı yaşamazsınız o konuda timer le de yapsanız aynı işlevi görücektir. Ama bi ayrıntı
Delphi de bilmiyorum ama c# da TThread.Sleep komutu çalışırken programın tüm fonksiyonları devre dışı kalır yani programı komple donduruyor diye biliyorum timer ise programı dondurmadan çalışıyor diye biliyorum.

aynen öyle MainThreadı durduruyorsun bu durumda kullanıcı girişlerini yakalayamazsın bu sleepi 5 saniye ve üzerinde olursa windows tarafında not respondinge düşersin
WWW
Cevapla


Bu Konudaki Yorumlar
Timer -Procedure ? - Yazar: Mr.Developer - 21-05-2019, Saat: 18:04
Timer -Procedure ? - Yazar: crowlin - 23-05-2019, Saat: 02:14
Cvp: Timer -Procedure ? - Yazar: Mr.Developer - 23-05-2019, Saat: 08:48
Cvp: Timer -Procedure ? - Yazar: Fesih ARSLAN - 23-05-2019, Saat: 09:16
Cvp: Timer -Procedure ? - Yazar: Mr.Developer - 23-05-2019, Saat: 13:21
Cvp: Timer -Procedure ? - Yazar: yhackup - 23-05-2019, Saat: 12:06
Timer -Procedure ? - Yazar: yhackup - 23-05-2019, Saat: 14:19
Cvp: Timer -Procedure ? - Yazar: Mr.Developer - 23-05-2019, Saat: 17:01
Timer -Procedure ? - Yazar: nguzeller - 23-05-2019, Saat: 17:04
Cvp: Timer -Procedure ? - Yazar: Mr.Developer - 23-05-2019, Saat: 17:32

Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  Timer Interval değerini verme - Çözüldü Altıner 1 1.748 31-03-2022, Saat: 22:47
Son Yorum: barutali
  Firemonkeydeki nesnelere yeni procedure ekleme emozgun 0 1.145 03-07-2020, Saat: 07:01
Son Yorum: emozgun
  FMX Timer Kullanım 3ddark 1 2.297 25-04-2020, Saat: 17:24
Son Yorum: Abdullah ILGAZ
  procedure bilgi alma ekank 4 3.853 29-03-2020, Saat: 00:47
Son Yorum: ekank
  bileşen - timer vs kalabalığıdan kurtulma ? Mr.Developer 13 11.168 18-07-2018, Saat: 15:35
Son Yorum: Mr.Developer



Konuyu Okuyanlar: 1 Ziyaretçi