Форум: "Основная";
Текущий архив: 2002.08.29;
Скачать: [xml.tar.bz2];
Вниз
Как треду перед запуском передать/установить параметры/флаги? Найти похожие ветки
← →
Olorin (2002-08-16 14:22) [40]Нет его в доступных функциях, методах, параметрах... он вообще не виден! :o)
← →
Olorin (2002-08-16 14:24) [41]>Digitman ©
В принципе могу выложить исходники не такие они большие 2 экрана примерно...
← →
Digitman (2002-08-16 14:33) [42]ты флаговое поле-то хоть в разделе PUBLIC объявил ? или - куда кривая выведет ? Раздел объявления поля (равно как и любого иного члена класса) имеет оч.важное значение ! В данном примере флаговое поле д.б. объявлено как минимум в PUBLIC (но никак не в PROTECTED и уж тем более - в PRIVATE). Надеюсь, ты это понимаешь и выполнил эти условия ..
← →
panov (2002-08-16 14:38) [43]Вот пример тебе:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ThrList: TList;
implementation
uses Unit2;
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
var
index: Integer;
begin
ThrList := TList.Create;
for index := 0 to 99 do ThrList.Add(TMyThread.Create(False));
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
index: Integer;
begin
ThrList := TList.Create;
for index := ThrList.Count-1 downto 0 do
begin
TMyThread(ThrList[index]).Terminate;
end;
ThrList.Free;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
index: Integer;
begin
for index := 0 to 10 do
begin
if ThrList.Count>0 then
begin
TMyThread(ThrList[0]).Flag := True;
ThrList.Delete(0);
end;
end;
end;
end.
unit Unit2;
interface
uses
Classes,windows;
type
TMyThread = class(TThread)
private
FFlag: Boolean;
procedure SetFlag(aFlag: Boolean);
protected
procedure Execute; override;
public
property Flag: Boolean read FFlag write SetFlag;
constructor Create(aFlag: Boolean);
end;
implementation
constructor TMyThread.Create(aFlag: Boolean);
begin
inherited Create(True);
FFlag := aFlag;
FreeOnTerminate := True;
Resume;
end;
procedure TMyThread.SetFlag(aFlag: Boolean);
begin
FFlag := aFlag;
end;
procedure TMyThread.Execute;
begin
while not Terminated do
begin
if Terminated then break;
if FFlag then Break;
Sleep(1);
end;
end;
end.
← →
lenin (2002-08-16 14:39) [44]Вместо флага используй указатель на этот флаг, тогда все будет работать:
MyFlag: ^Boolean;
constructor Create(...; MyFlagInitialState: ^Boolean);
procedure TbtnMouseStart.Execute;
begin
...
if MyFlag^ then...
else ...
...
end;
TfrmMain:
private
MyFlg: ^Boolean;
...
procedure TfrmMain.btnMouseStartClick(Sender: TObject);
var
...
begin
...
// создаем код.поток с изначально сброшенным флагом
New(MyFlg);
MyFlg^:=false;
MouseStart1 := TbtnMouseStart.Create(..., MyFlg);
...
end;
...
//где-то далее по тексту, пока код.поток работает еще,
//меняем состояние флага, управляя тем самым ходом выполнения
//метода Execute()
...
MyFlg^ := True;
...
MyFlg^ := False;
...
и т.д. ....
Что то вроде этого.
← →
Digitman (2002-08-16 14:44) [45]>lenin
Это зачем еще по ссылке-то передавать параметр ? Да еще и - глобальную переменную (об отказе от которой, собссно, и речь идет) ? Будь так любезен, объясни ...
← →
Esu (2002-08-16 16:30) [46]panov: Может быть я чего-то не понимаю...
> procedure TForm1.FormCreate(Sender: TObject);
> var
> index: Integer;
> begin
> ThrList := TList.Create;
Тут создается список, нигде в коде не освобождается.
> procedure TForm1.FormClose(Sender: TObject; var Action:
> TCloseAction);
> var
> index: Integer;
> begin
> ThrList := TList.Create;
> for index := ThrList.Count-1 downto 0 do
> begin
> TMyThread(ThrList[index]).Terminate;
> end;
> ThrList.Free;
Тут список снова создается, тот не освободился - утечка. Count у этого явно 0. Зато освобождается.
Видимо опечатся :)
← →
Olorin (2002-08-19 06:04) [47]>Digitman ©
Естественно в PUBLIC ну нету его в списке и все тут... может все же выложить код полностью он не так и велик.. экран примерно...
← →
Olorin (2002-08-19 06:09) [48]Мдее все больше и больше убеждаюсь в неработоспособности предложенных методов... хотя идеи и не плохие :-)
Неужели нет других гибких путей? :-)
← →
Digitman (2002-08-19 08:48) [49]>Olorin
желательно , конечно, целиком видеть код
← →
Olorin (2002-08-19 10:14) [50]Вот главный модуль main.pas:
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ExtCtrls, Menus, StdCtrls, RxMenus, RXSpin, Placemnt,
HotKeyManager, Buttons;
type
TfrmMain = class(TForm)
mmMain: TMainMenu;
mmiScript: TMenuItem;
mmiOptions: TMenuItem;
mmiHelp: TMenuItem;
mmiNew: TMenuItem;
mmiSave: TMenuItem;
mmiSaveAs: TMenuItem;
mmiExit: TMenuItem;
pnlMain: TPanel;
pctrlMain: TPageControl;
tshMain: TTabSheet;
tshScript: TTabSheet;
gbxChMainW: TGroupBox;
cbxMMouse1: TComboBox;
cbxMKey1: TComboBox;
cbxMKey2: TComboBox;
cbxMKey3: TComboBox;
edtIMouse1: TEdit;
edtIKey1: TEdit;
edtIKey2: TEdit;
edtIKey3: TEdit;
gbxChOtherW: TGroupBox;
cbxMMouse2: TComboBox;
cbxMKey4: TComboBox;
cbxMKey5: TComboBox;
cbxMKey6: TComboBox;
edtIMouse2: TEdit;
edtIKey4: TEdit;
edtIKey5: TEdit;
edtIKey6: TEdit;
gbxSShot: TGroupBox;
mmiMacros: TMenuItem;
tshOther: TTabSheet;
tshSettings: TTabSheet;
cbxSSDate: TCheckBox;
rbtnSSbmp: TRadioButton;
rbtnSSjpg: TRadioButton;
RxSpnSSjpgPerc: TRxSpinEdit;
edtSSpath: TEdit;
frmPlacement: TFormPlacement;
hkmMain: THotKeyManager;
btnMouseStart1: TSpeedButton;
btnMStart1: TSpeedButton;
btnMStart2: TSpeedButton;
btnMStart3: TSpeedButton;
btnMouseStart2: TSpeedButton;
btnMStart4: TSpeedButton;
btnMStart5: TSpeedButton;
btnMStart6: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure btnMouseStartClick(Sender: TObject);
procedure MouseStop(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
ProcHWND: HWND;
const
KeyCodes: array[0..27] of Integer = (
VK_F1, VK_F2, VK_F3, VK_F4, VK_F5, VK_F6, VK_F7, VK_F8, VK_F9, VK_F10, VK_F11, VK_F12,
VK_UP, VK_DOWN, VK_LEFT, VK_RIGHT, VK_ESCAPE, VK_TAB, VK_INSERT, VK_DELETE,
VK_HOME, VK_END, VK_PRIOR, VK_NEXT, VK_BACK, VK_RETURN, VK_PAUSE, VK_SCROLL );
KeyLabels: array[0..27] of string = (
"F1", "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9", "F10", "F11", "F12",
"Up", "Down", "Left", "Right", "Escape", "Tab", "Insert", "Delete",
"Home", "End", "PageUp", "PageDown","Backspace","Enter","Pause", "ScrolLsock");
implementation
uses uothreads;
{$R *.dfm}
procedure TfrmMain.FormCreate(Sender: TObject);
var
i : Integer;
begin
cbxMKey1.Clear;
for i := 0 to High(KeyLabels) do
cbxMKey1.Items.Add(KeyLabels[i]);
cbxMKey2.Items := cbxMKey1.Items;
cbxMKey3.Items := cbxMKey1.Items;
cbxMKey4.Items := cbxMKey1.Items;
cbxMKey5.Items := cbxMKey1.Items;
cbxMKey6.Items := cbxMKey1.Items;
end;
procedure TfrmMain.btnMouseStartClick(Sender: TObject);
function GetIndexFromName(const AName : String) : String;
var
ii : Integer;
begin
Result := EmptyStr;
if AName = EmptyStr then Exit;
for ii := Length(AName) downto 1 do begin
if AName[ii] in ["A".."Z", "a".."z"] then Exit;
Result := AName[ii] + Result;
end;
end;
var
MouseStart1: TbtnMouseStart;
AComboBox : TComboBox;
AEdit : TEdit;
AIndex : String;
begin
//------------------------
if TSpeedButton(Sender).Down then begin
AIndex := GetIndexFromName(TSpeedButton(Sender).Name);
if AIndex <> EmptyStr then begin
AComboBox := TComboBox(FindComponent("cbxMMouse"+ AIndex));
AEdit := TEdit(FindComponent("edtIMouse"+ AIndex));
// if (AComboBox <> nil) and (AEdit = nil) then ShowMessage("0");
if (AEdit.Text = "") or (StrToInt(AEdit.Text) = 0) then begin
ShowMessage("
← →
Olorin (2002-08-19 10:15) [51]Вот модуль с определениями потоков:
unit uothreads;
interface
uses
Classes, Windows, Messages;
type
TClickType = (MDOUBLE, MSINGLE);
TButtonType = (MLEFT, MRIGHT);
TbtnMouseStart = class(TThread)
private
FClickType: TClickType;
FButtonType: TButtonType;
FIterval: Integer;
FProcHWND: HWND;
FX: Integer;
FY: Integer;
protected
FTerminate: Boolean;
procedure Execute; override;
public
constructor Create(Sender: TObject; AClickType: TClickType;
AButtonType: TButtonType; AIterval: Integer;
AProcHWND: HWND; AX: Integer; AY: Integer;
ATerminate: Boolean);
end;
implementation
constructor TbtnMouseStart.Create(Sender: TObject; AClickType: TClickType;
AButtonType: TButtonType; AIterval: Integer;
AProcHWND: HWND; AX: Integer; AY: Integer;
ATerminate: Boolean);
begin
FClickType := AClickType;
FButtonType := AButtonType;
FIterval := AIterval;
FProcHWND := AProcHWND;
FX := AX;
FY := AY;
FTerminate := ATerminate;
FreeOnTerminate := True;
inherited Create(False);
end;
procedure TbtnMouseStart.Execute;
begin
while not FTerminate do
case FClickType of
MDOUBLE: begin
case FButtonType of
MLEFT: begin
PostMessage(FProcHWND, WM_LBUTTONDOWN, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_LBUTTONDOWN));
PostMessage(FProcHWND, WM_LBUTTONUP, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_LBUTTONUP));
PostMessage(FProcHWND, WM_LBUTTONDOWN, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_LBUTTONDOWN));
PostMessage(FProcHWND, WM_LBUTTONUP, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_LBUTTONUP));
PostMessage(FProcHWND, WM_LBUTTONDOWN, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_LBUTTONDBLCLK));
PostMessage(FProcHWND, WM_LBUTTONUP, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_LBUTTONUP));
end;
MRIGHT: begin
PostMessage(FProcHWND, WM_RBUTTONDOWN, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_RBUTTONDOWN));
PostMessage(FProcHWND, WM_RBUTTONUP, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_RBUTTONUP));
PostMessage(FProcHWND, WM_RBUTTONDOWN, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_RBUTTONDOWN));
PostMessage(FProcHWND, WM_RBUTTONUP, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_RBUTTONUP));
PostMessage(FProcHWND, WM_RBUTTONDOWN, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_RBUTTONDBLCLK));
PostMessage(FProcHWND, WM_RBUTTONUP, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_RBUTTONUP));
end;
end;
end;
MSINGLE: begin
case FButtonType of
MLEFT: begin
PostMessage(FProcHWND, WM_LBUTTONDOWN, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_LBUTTONDOWN));
PostMessage(FProcHWND, WM_LBUTTONUP, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_LBUTTONUP));
end;
MRIGHT: begin
PostMessage(FProcHWND, WM_RBUTTONDOWN, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_RBUTTONDOWN));
PostMessage(FProcHWND, WM_RBUTTONUP, 0, MakeLong(FX, FY));
PostMessage(FProcHWND, WM_SETCURSOR, FProcHWND, MakeLong(HTCLIENT, WM_RBUTTONUP));
end;
end;
end;
end;
end;
end.
← →
Olorin (2002-08-19 10:16) [52]поправка:
protected
FTerminate: Boolean;
Вписал щас в ручную и промазал в реале оно было в секции public
← →
Digitman (2002-08-19 10:41) [53]ну так - а где у тебя обращение к public-полю FTerminate по записи ? Оно закомментарено в вызывающем коде
Это раз.
Во-вторых, велосипед ты изобретаешь. Класс TThread уже имеет защищенное флаговое свойство Terminated и public-метод Terminate, взводящий флаг Terminated (при старте потока флаг всегда сброшен по-умолчанию).
Все , что от тебя требуется - стартовать код.поток и в нужный момент времении вызвать метод Terminate, в рез-те чего выполняющийся метод Execute() (периодически опрашивающий св-во Terminated на равенство True) получает возможность корректно прервать свое выполнение, если обнаружено данное условие.
← →
Olorin (2002-08-19 10:54) [54]
> Digitman © (19.08.02 10:41)
> ну так - а где у тебя обращение к public-полю FTerminate
> по записи ? Оно закомментарено в вызывающем коде
Потому и закоментированно что вызывает ошибку :o)
> Это раз.
> Во-вторых, велосипед ты изобретаешь. Класс TThread уже имеет
> защищенное флаговое свойство Terminated и public-метод Terminate,
> взводящий флаг Terminated (при старте потока флаг всегда
> сброшен по-умолчанию).
> Все , что от тебя требуется - стартовать код.поток и в нужный
> момент времении вызвать метод Terminate, в рез-те чего выполняющийся
> метод Execute() (периодически опрашивающий св-во Terminated
> на равенство True) получает возможность корректно прервать
> свое выполнение, если обнаружено данное условие.
Хм я думал об этом... но при вызове:
MouseStart1.Terminate
Поток просто прервется как я понял и проверка в методе Executed флага Terminated не спасет... я не прав?
← →
Digitman (2002-08-19 11:14) [55]
> Потому и закоментированно что вызывает ошибку :o)
Ты модуль-то uothreads объяви на всякий случай в разделе USES модуля main). Модуль Main ничего не знает о существовании в проекте модуля uothreads, отсюда и ошибка.
И возьми себе за правило описывать ошибку и ее окружение детально, если хочешь получить помощь максимально быстро и без пустой болтовни. Если это ошибка времени компиляции (как в данном случае), так и говори : ошибка такая-то, с таким-то сообщением , указывающая на такую-то строку ...
> Поток просто прервется как я понял и проверка в методе Executed
> флага Terminated не спасет... я не прав?
Не прав. С какой стати он прервется-то ? Мало ли какое состояние имеет некая переменная или поле класса ! Тело метода Execute() вправе вообще не обращать на это внимание и выполняться до тех пор, пока того потребует внутренняя его логика, а не требование "завершиться" внешнего по отношению к нему кода. Св-во Terminated, установленное в True - лишь признак, указывающий заинтересованному в нем методу Execute(), что внешний по отн. к нему код ожидает с этого момента, что тело метода должно плавненько "закруглиться", корректно освободив все занятые им ресурсы
← →
Olorin (2002-08-19 11:21) [56]>Digitman ©
Стоп мы походу о несколько разных вещах :o)
Я о методе:
MouseStart1.Terminate
А вы о встроенном флаге:
MouseStart1.Terminated:=true
Кстати щас почитал внимательно первое как раз ОНО.... СПАСИБА АГРОМНОЕ... хоть я и сам докопался практически... главное внимание... :o)
← →
Digitman (2002-08-19 11:32) [57]Извини, я проглядел USES uothreads в Main.pas IMPLEMENTATION.
Знаешь, перенеси-ка ты USES uothreads в Main.pas INTERFACE-секцию - оно не помешает для коррекной работы инспектора объектов : область видимости INTERFACE USES не дает повода для сомнений в видимости любого public-идентификатора в любом подключенном именнго таким образом модуле
Тем не менее : интересует-таки, что же за ошибку ты получаешь от компилятора и на какой строке , если убрать комментарии... разумеется, если FTerminate - это действительно public-поле
← →
Digitman (2002-08-19 11:41) [58]>Olorin
Единственное, что делает тело метода Terminate при вызове, это:
FTerminated := True;
поле FTerminated - приватное и недоступно для непосредственной записи со стороны любого кода вне модуля classes.pas
св-во же Terminated - публичное (и недоступное), при его вызове просто считывается тек.значение поля FTerminated. Как раз то, что тебе и нужно делать теле Execute() (while/if Terminated ...) , дабы как можно оперативней реагировать на требование внешнего кода к корректному завершению данного кодового потока
← →
Olorin (2002-08-19 11:43) [59]
> Знаешь, перенеси-ка ты USES uothreads в Main.pas INTERFACE-секцию
> - оно не помешает для коррекной работы инспектора объектов
> : область видимости INTERFACE USES не дает повода для сомнений
> в видимости любого public-идентификатора в любом подключенном
> именнго таким образом модуле
Перенес, флаг FTerminate стал доступен :o)
> Тем не менее : интересует-таки, что же за ошибку ты получаешь
> от компилятора и на какой строке , если убрать комментарии...
> разумеется, если FTerminate - это действительно public-поле
Если не переносить ругается на неопределенный идентификатор FTerminate...
И решил я таки воспользоваться связкой ...Terminate .... & if Terminated then
:o)
← →
Digitman (2002-08-19 11:49) [60]>Olorin
> решил я таки воспользоваться связкой ...Terminate .... &
> if Terminated
И правильно поступил. Ни к чему "захламлять" класс и память, занятую его экземплярами, лишними полями, назначение которых дублирует уже реализованную Борландом функц-ть класса.
Страницы: 1 2 вся ветка
Форум: "Основная";
Текущий архив: 2002.08.29;
Скачать: [xml.tar.bz2];
Память: 0.59 MB
Время: 0.016 c
