Picproje Elektronik Sitesi

PROGRAMLAMA DİLLERİ => Delphi => Konuyu başlatan: z - 02 Kasım 2019, 08:09:03

Başlık: Delphi Thread
Gönderen: z - 02 Kasım 2019, 08:09:03
Bir tane image nesnemiz olsun.

Image nesnesine sin fonksiyonunun grafigi pixel pixel cizelim. Oyleki cizim hizi dusuk oldugu icin ekranda sinus adim adim cizilsin. Image nesnesinin en sagina pixel koyunca imagei silip tekrar sinus cizimi baslasin.

Bir tane de scrollbar olsun.

Bu scrollbari surukledigimizde sinusun genligi degissin.

Fakat scrollbari mousla tikladigimda sinus cizimi duraksamasin.

Bunun icin kod paylasabilirmisiniz?
Başlık: Ynt: Delphi Thread
Gönderen: Mehmet Salim GÜLLÜCE - 23 Kasım 2019, 22:25:45
Paskala pek aşina değilim.
Ancak daha yeni sıfırdan başladım.
RAD 10.3.3 ü daha dün kurdum.
Demo örneklere bakarken grafik değilde, animasyon türü scrollbar kontrollü programa rastladım.
Nasıl yapıldığını anlamaya çalıştıysamda pek anlamadım.

Önce Form Kodunu gönderip arkasından yazılım kodunu yollasam sen bişeyler elde edebilirsin diye düşünüyorum.

object ActivityIndicatorFormTActivityIndicatorForm
  Left 
0
  Top 
0
  Caption 
'TActivityIndicator'
  
ClientHeight 328
  ClientWidth 
452
  Color 
clBtnFace
  Font
.Charset DEFAULT_CHARSET
  Font
.Color clWindowText
  Font
.Height = -12
  Font
.Name 'Segoe UI'
  
Font.Style = []
  
OldCreateOrder False
  Position 
poScreenCenter
  OnCreate 
FormCreate
  DesignSize 
= (
    
452
    328
)
  
PixelsPerInch 96
  TextHeight 
15
  object lblFrameDelay
TLabel
    Left 
245
    Top 
55
    Width 
88
    Height 
15
    Anchors 
= [akLeftakTopakBottom]
    
Caption 'Frame Delay (50)'
    
OnClick lblFrameDelayClick
  end
  object lblVclStyle
TLabel
    Left 
20
    Top 
124
    Width 
49
    Height 
15
    Alignment 
taRightJustify
    Caption 
'VCL Style'
  
end
  object lblFormColor
TLabel
    Left 
245
    Top 
126
    Width 
176
    Height 
15
    Caption 
'Form Color (Windows Style Only)'
  
end
  object chkAnimate
TCheckBox
    Left 
245
    Top 
20
    Width 
96
    Height 
17
    Caption 
'Animate'
    
TabOrder 0
    OnClick 
chkAnimateClick
  end
  object trkFrameDelay
TTrackBar
    Left 
238
    Top 
74
    Width 
203
    Height 
28
    Max 
15
    Min 
3
    Position 
5
    TabOrder 
1
    OnChange 
trkFrameDelayChange
  end
  object grpIndicatorType
TRadioGroup
    Left 
20
    Top 
193
    Width 
145
    Height 
117
    Caption 
'Indicator Type'
    
ItemIndex 0
    Items
.Strings = (
      
'aitMomentumDots'
      'aitRotatingSector'
      'aitSectorRing'
)
    
TabOrder 4
    OnClick 
grpIndicatorTypeClick
  end
  object grpIndicatorSize
TRadioGroup
    Left 
184
    Top 
193
    Width 
125
    Height 
117
    Caption 
'Indicator Size'
    
ItemIndex 1
    Items
.Strings = (
      
'aisSmall'
      'aisMedium'
      'aisLarge'
      'aisXLarge'
)
    
TabOrder 5
    OnClick 
grpIndicatorSizeClick
  end
  object grpIndicatorColor
TRadioGroup
    Left 
328
    Top 
193
    Width 
105
    Height 
117
    Caption 
'Indicator Color'
    
ItemIndex 0
    Items
.Strings = (
      
'aicBlack'
      'aicWhite'
)
    
TabOrder 6
    OnClick 
grpIndicatorColorClick
  end
  object cbxVclStyles
TComboBox
    Left 
20
    Top 
145
    Width 
197
    Height 
23
    Style 
csDropDownList
    TabOrder 
2
    OnChange 
cbxVclStylesChange
  end
  object AI
TActivityIndicator
    Left 
20
    Top 
20
    Anchors 
= [akLeftakTopakRightakBottom]
  
end
  object cbxFormColor
TColorBox
    Left 
245
    Top 
147
    Width 
188
    Height 
22
    DefaultColorColor 
clBtnFace
    NoneColorColor 
clBtnFace
    Selected 
clBtnFace
    TabOrder 
3
    OnChange 
cbxFormColorChange
  end
end

(https://i.ibb.co/6R7B2yp/resim.png) (https://ibb.co/6R7B2yp)

//---------------------------------------------------------------------------

// This software is Copyright (c) 2015 Embarcadero Technologies, Inc.
// You may only use this software if you are an authorized licensee
// of an Embarcadero developer tools product.
// This software is considered a Redistributable as defined under
// the software license agreement that comes with the Embarcadero Products
// and is subject to that software license agreement.

//---------------------------------------------------------------------------
//345678901234567890123456789012345678901234567890123456789012345678901234567890
unit uActivityIndicator;

interface

uses
  Winapi
.Windows,
  
Winapi.Messages,
  
System.SysUtils,
  
System.Variants,
  
System.Classes,
  
System.ImageList,
  
Vcl.Graphics,
  
Vcl.Controls,
  
Vcl.Forms,
  
Vcl.Dialogs,
  
Vcl.WinXCtrls,
  
Vcl.StdCtrls,
  
Vcl.ImgList,
  
Vcl.ComCtrls,
  
Vcl.ExtCtrls;

type
  TActivityIndicatorForm 
= class(TForm)
    
chkAnimateTCheckBox;
    
trkFrameDelayTTrackBar;
    
lblFrameDelayTLabel;
    
grpIndicatorTypeTRadioGroup;
    
grpIndicatorSizeTRadioGroup;
    
grpIndicatorColorTRadioGroup;
    
cbxVclStylesTComboBox;
    
lblVclStyleTLabel;
    
AITActivityIndicator;
    
cbxFormColorTColorBox;
    
lblFormColorTLabel;
    
procedure FormCreate(SenderTObject);
    
procedure chkAnimateClick(SenderTObject);
    
procedure trkFrameDelayChange(SenderTObject);
    
procedure grpIndicatorTypeClick(SenderTObject);
    
procedure grpIndicatorSizeClick(SenderTObject);
    
procedure grpIndicatorColorClick(SenderTObject);
    
procedure cbxVclStylesChange(SenderTObject);
    
procedure cbxFormColorChange(SenderTObject);
    
procedure lblFrameDelayClick(SenderTObject);
  private
  public
  
end;

var
  
ActivityIndicatorFormTActivityIndicatorForm;

implementation

{$R *.dfm}

uses
  Vcl
.Themes;

procedure TActivityIndicatorForm.FormCreate(SenderTObject);                          //Form-Create in
var
  
StyleNamestring;
  
Namestring;
begin
  
for StyleName in TStyleManager.StyleNames do
  
cbxVclStyles.Items.Add(StyleName);

  
cbxVclStyles.ItemIndex := cbxVclStyles.Items.IndexOf(TStyleManager.ActiveStyle.Name);


end;

procedure TActivityIndicatorForm.cbxFormColorChange(SenderTObject);                  //Form-Color Selector
begin
  Color 
:= cbxFormColor.Selected;
end;

procedure TActivityIndicatorForm.cbxVclStylesChange(SenderTObject);                  //Form-Color Style Selector
begin
  TStyleManager
.SetStyle(cbxVclStyles.Text);
  
lblFormColor.Enabled := StyleServices.IsSystemStyle;
  
cbxFormColor.Enabled := StyleServices.IsSystemStyle;
end;

procedure TActivityIndicatorForm.grpIndicatorColorClick(SenderTObject);              //Indicator-Color Selector
begin
  AI
.IndicatorColor := TActivityIndicatorColor(grpIndicatorColor.ItemIndex);
end;

procedure TActivityIndicatorForm.grpIndicatorSizeClick(SenderTObject);               //Indicator-Size Selector
begin
  AI
.IndicatorSize := TActivityIndicatorSize(grpIndicatorSize.ItemIndex);
end;

procedure TActivityIndicatorForm.grpIndicatorTypeClick(SenderTObject);               //Indicator-Type Selector
begin
  AI
.IndicatorType := TActivityIndicatorType(grpIndicatorType.ItemIndex);
end;

procedure TActivityIndicatorForm.lblFrameDelayClick(SenderTObject);
begin
ShowMessage 
('Çıkmaaa...'+inttostr(25));
Exit
end;

procedure TActivityIndicatorForm.trkFrameDelayChange(SenderTObject);                 //Frame-Delay Selector
begin
  AI
.FrameDelay := trkFrameDelay.Position 10;
  
lblFrameDelay.Caption := 'Frame Delay (' IntToStr(AI.FrameDelay) + ')';
end;

procedure TActivityIndicatorForm.chkAnimateClick(SenderTObject);                     //Animate-Enable Selector
begin
  AI
.Animate := chkAnimate.Checked;
end;


end.

Umarım işine yarar. ;)
Başlık: Ynt: Delphi Thread
Gönderen: digiman - 24 Kasım 2019, 04:07:18
uzun olmus
Başlık: Ynt: Delphi Thread
Gönderen: digiman - 24 Kasım 2019, 04:08:07
unit Unit1;

interface

uses
  Windows
MessagesSysUtilsVariantsClassesGraphicsControlsForms,
  
DialogsExtCtrlsStdCtrlsComCtrls;

type
  Benim_thread
=class(TThread)
    protected
      
procedure executeoverride;
      
procedure AddLines;
    
end;

  
TForm1 = class(TForm)
    
Image1TImage;
    
Button1TButton;
    
Button3TButton;
    
Button6TButton;
    
TrackBar1TTrackBar;
    
procedure Button1Click(SenderTObject);
    
procedure Button3Click(SenderTObject);
    
procedure Button6Click(SenderTObject);
    
procedure FormClose(SenderTObject; var ActionTCloseAction);
  private
    { Private 
declarations }
  public
    { Public 
declarations }
    
thread_turet:Benim_thread;
  
end;

var
  
Form1TForm1;

implementation

procedure Benim_thread
.AddLines;
begin
  Sleep
(10);
  
Form1.Image1.Canvas.Pen.Width:=Form1.TrackBar1.Position;
  
Form1.Image1.Canvas.LineTo(Random(1000),Random(1000));
  
Form1.Image1.Refresh;
end;

procedure Benim_thread.execute;
begin
  repeat
    Synchronize
(AddLines);
  
until Terminated;
end;

{
$R *.dfm}

procedure TForm1.Button1Click(SenderTObject);
begin
thread_turet
:=Benim_thread.Create(False);
end;

procedure TForm1.Button3Click(SenderTObject);
begin
Image1
.Canvas.Pen.Width:=2;
end;

procedure TForm1.Button6Click(SenderTObject);
begin
Image1
.Picture:=nil;
end;

procedure TForm1.FormClose(SenderTObject; var ActionTCloseAction);
begin
  thread_turet
.Terminate;
end;

end.
Başlık: Ynt: Delphi Thread
Gönderen: z - 24 Kasım 2019, 09:50:42
Ornekler icin tesekkurler. RAD yuklu olmadigi icin Delphi 7 ile @digiman'in ornegini calistirdim.

Fakat form uzerine bir tane scrollbar ekledigimde thread calisirken scrollbar uzerinde fareyi tikli vaziyette tutarsam thread icinde grafik cizen fonksiyon  duruyor. Taaki scrollbari serbest birakana kadar.

Halbuki derdim bu tip durmalarin onune gecmek.

Not: Scrollbarla ilgili hic kod yazmadim. Oylesine form uzerinde duran bir scrollbar o.

Nerde hata yapiyorum?
Başlık: Ynt: Delphi Thread
Gönderen: digiman - 25 Kasım 2019, 00:34:08
@z hocam progressbar ile isimiz yok, Track bar ile deneyebiliriz; kodu duzenledim tekrar dener misiniz? Lakin yanlis hatirlamiyorsam Synchronize metodu verilerin guvenligini garanti etmez gibi bir ibare kalmis zihnimde, aklinizda bulunsun.
Başlık: Ynt: Delphi Thread
Gönderen: Kılıç - 25 Kasım 2019, 00:50:46
@digiman, sleepi execute dışında kullanırsanız donma yapar. execute dışında çalışan Thread'e ait prosedür ve fonksiyonlar hep ana thread(gui thread)de çalışır.
Sleep(1000) ile abartırsak donma durumunu rahatça görürüz.

 Böyle olması uygun. Donma yok

procedure Benim_thread.AddLines;
begin

  Form1
.Image1.Canvas.Pen.Width:=Form1.TrackBar1.Position;
  
Form1.Image1.Canvas.LineTo(Random(1000),Random(1000));
  
Form1.Image1.Refresh;
end;

procedure Benim_thread.execute;
begin
  repeat
  Sleep
(10);
    
Synchronize(AddLines);
  
until Terminated;
end;
Başlık: Ynt: Delphi Thread
Gönderen: digiman - 25 Kasım 2019, 01:07:26
sleep ile bir isimiz yok zaten kullanmak ta mantiksiz; sadece etkiyi gorebilmek icin biraz yavaslatmak gerekiyor du. benim anlamadigim madem delphi konusunda bu kadar bilgilisiniz neden daha once bizi aydinlatmadaniz?
Başlık: Ynt: Delphi Thread
Gönderen: Kılıç - 25 Kasım 2019, 03:33:30
 Execute içindeki sürekli döngü arasına sleep koymaz iseniz uygulama cpu kullanımı tavan yapacaktır. Çok çekirdekli makinede %50 gibi görünür. Döngü içinde sleep yoksa başka threadlere çalışacak zaman kalmamış olur. Dolayısıyla ana form thread de  çalışamaz.

Tek çekirdekli makinede ise komple donmuş olur.

Belki  synchronize  nedeniyle sleep e gerek yoktur