Recent

Author Topic: TProcess Thread handing HOW TO?  (Read 26635 times)

Leledumbo

  • Hero Member
  • *****
  • Posts: 8111
  • Programming + Glam Metal + Tae Kwon Do = Me
Re: TProcess Thread handing HOW TO?
« Reply #30 on: February 02, 2014, 02:35:35 pm »
I think talking about my code would be too broad, after all the thread support was not designed from the start, so I kinda hijack the code in order to make it work, which is why it looks ugly though works.

Let's just see your threading code now, the relevant parts only, of course. Though if you want, attaching a complete project source could help.

userx-bw

  • Full Member
  • ***
  • Posts: 178
Re: TProcess Thread handing HOW TO?
« Reply #31 on: February 02, 2014, 03:55:52 pm »
I think talking about my code would be too broad, after all the thread support was not designed from the start, so I kinda hijack the code in order to make it work, which is why it looks ugly though works.

Let's just see your threading code now, the relevant parts only, of course. Though if you want, attaching a complete project source could help.

any good or just starting programmer should know when to "hijack" code.  if it works then why waist all ones time in trying to reinvent another way of doing it? Just copy that code and incorporate it into what ever you are doing.

If someone is building something and finds that their is a part already made that he can use for what ever he is building the wise one would just go and get that part to use instead of waisting a lot of time trying to make one from scratch to use. It saves a lot of time and stress, and with some code it just has to be written a certain way in order for it to work, no matter what, the steps are all the same. so that is not really stealing code it is just the way it has to be done and copy and past is a lot faster the typing everything all out again, that is why they invented copy, and paste.

I do believe that is part of what this  GNU is about and  reusing code to falls into that ideology

mod:
added:
I put the thread code back inside of my whole program to see if I could get a bit further on it. I didn't data passing and it seeing the Objects like the RadioGroup it doesn't see or like the loop I had inside of it.

so this is as far as I got so far

both "programs" are in the first zip too

my code is me now stating the program all over again all over again so it is a shell of a program

mhsetroot the external program too if you have Linux then you can run my gmhsetroot to see it work too

you probably have to change the code a bit for it to see where mhsetroot is to run it

main form unit
Code: [Select]

type
       TShowStatusEvent = procedure(Status: String) of Object;
  { TForm1 }

  TForm1 = class( TForm)
    Button1: TButton;
    Label1: TLabel;
    Process: TProcess;
    setImgDir_bn: TButton;
    procedure Button1Click( Sender: TObject) ;
    procedure setImgDir_bnClick( Sender: TObject) ;
  private
    { private declarations }
  public
    { public declarations }

  end;
..........
var
  Form1: TForm1;
  //ImageFile:string;
  chosenDir:string;
  FindImageFiles:TStringList;
  // Threads
  CycleScreenThread:TCycleScreenThread;



implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.setImgDir_bnClick( Sender: TObject) ;
begin
    SelectDirectory(chosenDir,[sdPrompt],0);
    SetCurrentDir(ChosenDir);
    //TStringList
    FindImageFiles := FindAllFiles(chosenDir, '*.*', false);
    FindImageFiles.Sort;
    Form1.Caption:=ChosenDir;
    Label1.Caption:=IntToStr(FindImageFiles.Count);
end;

procedure TForm1.Button1Click( Sender: TObject) ;
begin
   // FindImage(FindImageFiles);

    CycleScreenThread := TCycleScreenThread.Create(true) ;
    CycleScreenThread.Start;

end;
                                       




that is the thread unit
Code: [Select]
unit Onethread;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, process, LCLType,
  LCLIntf, ExtDlgs, Buttons, LCLProc, LazHelpHTML, FileUtil;
  {CycleThread}
     type
        TShowStatusEvent = procedure(Status: String) of Object;


   TCycleScreenThread = class(TThread)
    private
      FResultMsg: String;
      fStatusText : string;
      FOnShowStatus: TShowStatusEvent;
      procedure ShowStatus;
    protected

      procedure Execute; override;
    public
      Constructor Create(CreateSuspended : boolean);
      property ResultMsg: String read FResultMsg;
      property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;

 //      function FindImage(FindImageFiles: TStringList):string;
    end;

   var
    ImageFile:string;
  chosenDir:string;
  FindImageFiles:TStringList;

implementation



constructor TCycleScreenThread.Create(CreateSuspended : boolean);
 begin
   FreeOnTerminate := True;
   inherited Create(CreateSuspended);
 end;

{function goes here}

function FindImage(FindImageFiles: TStringList):string;
var
    i:integer;

begin
    i := 0;
    while i < FindImageFiles.Count do
      begin
        if (CompareFileExt(FindImageFiles.Strings[i], 'jpg') = 0 ) or
           (CompareFileExt(FindImageFiles.Strings[i], 'png') = 0 )
            then
            begin
             imageFile := FindImageFiles.Strings[i];
             result := ImageFile;
             i := i + 1;
             sleep(3000);
             end;
        if i = FindImageFiles.Count then i := 0;
      end;
 end;
 procedure TCycleScreenThread.ShowStatus;
 // this method is executed by the mainthread and can therefore access all GUI elements.
 begin
   if Assigned(FOnShowStatus) then
   begin
     FOnShowStatus(fStatusText);
   end;
 end;

 procedure TCycleScreenThread.Execute;
 var
 i:integer;
 begin
   try
          // function freezes up the whole systhem inm debug.

     //   ImageFile := form1.FindImage(FindImageFiles);
   //  while not Terminated do begin

              with Tprocess.Create(nil) do
               try
                begin
                Executable:= 'mhsetroot';

                Parameters.Add('-center');
                Parameters.Add(ImageFile);

               {  Commented out for testing }
               {
               if SetColorsRG.ItemIndex > -1 then
               begin
                case SetColorsRG.ItemIndex of
                 0:
                 begin
              .............
         end;
         7:
         begin
              Parameters.Add('-dtilehv');
              Parameters.Add(imgWidth);
              Parameters.Add(FindImageFiles.Strings[i]);
         end;
    end;
       }
       {end of comment out code for now }


       // BProcess.Options := BProcess.Options + [poWaitOnExit, poUsePipes];
       

          Execute;

         if ExitStatus <> 0 then begin
          with TStringList.Create do
            try
              LoadFromStream(StdErr);
              FResultMsg := Text;
            finally
              Free;
            end;
          end;
        Free;      // free process
     //  Application.ProcessMessages;
    //   sleep(3000);
        end;

                //end compaire file types
               finally
                free;
                end;
      except
        on e: Exception do
          FResultMsg := e.Message;
      end;  // end second try

      FindImageFiles.Free;
   end; //end first try

end.

I think now I am going to have to go with more then one thread , one for TProcess, one for getting a Image loop, and one for picking  one color, and one for picking two colors to be sent to the "main" thread running TProdcess making that 4 threads and 1 thread to keep track of them making it 5 so far. I only got one wrote up ...

the zip has all the code files and mhsetroot is you are using Linux to put in the code where that is and see how far I got because it calls it then clears the screen
« Last Edit: February 02, 2014, 11:13:40 pm by userx-bw »
My Finished Projects
https://sourceforge.net/projects/mhsetroot/
https://sourceforge.net/projects/gmhsetrootfreepascalfrontend/

HP Elitetbook 6930p Dual Core Intel vPro 2.66 gHz
VOID (Linux) 64bit