создание компонента

← →
maxon (2004-03-10 15:47) [0]

Здравствуйте, помогите с созданием компонента.
компонент на основе TShape, сигнализирует превышение какого то параметра каких то пределов, например
Alarm1.play:=i>10, здесь меняется цвет, и через 500 милисек возвращается на прежний, это изменение пытался всунуть в поток, но не получается, ругается нет доступа и т.п. ниже приведён текст компонента.

unit Alarm;

interface

uses
SysUtils, Classes, Controls, ExtCtrls, Graphics, Dialogs, Forms;

type
TAlarmType = (Low, High);
TAlarm = class(TShape)
private
{ Private declarations }
FPLay:boolean;
FAlarmType:TAlarmType;
FLowColor:TColor; //цвет сигнализации низа
FHighColor:TColor; //цвет сигнализации верха
FDefColor:TColor; //нормальный цвет
procedure SetPlay(Value: Boolean);
procedure SetDefColor(Value: TColor);
procedure SetAlarmType(Value: TAlarmType);
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
constructor Create(aowner:Tcomponent);override;
property Play:Boolean read FPLay write SetPlay default False;
property AlarmType:TAlarmType read FAlarmType write SetAlarmType default Low;
property ColorLow:TColor read FLowColor write FLowColor;
property ColorHigh:TColor read FHighColor write FHighColor;
property ColorDef:TColor read FDefColor write SetDefColor;
end;

var hThread:THandle;ThreadID: Cardinal; //сигнализируем

procedure Register;

implementation

procedure Register;
begin
RegisterComponents("ModEmerg", [TAlarm]);
end;

function Alarming(Point:pointer):boolean;
begin
with TAlarm(Point) do begin
if FAlarmType=Low then brush.color:=FLowColor
else brush.color:=FHighColor;
repaint;
sleep(500);
brush.color:=FDefColor;
repaint;
FPLay:=false; //отключаем признак
end;
end;

constructor TAlarm.Create(aowner:Tcomponent);
begin
inherited create(Aowner);
Shape:=stCircle;
Width:=17;
Height:=17;
ColorDef:=clgray;
ColorHigh:=clred;
ColorLow:=clblue;
end;

procedure TAlarm.SetPlay(Value: Boolean);
begin
if FPLay=true then exit;
FPLay:=Value;
if FPLay=true then hThread:=beginthread(nil,0,@Alarming,addr(self),0,ThreadID);
end;

procedure TAlarm.SetDefColor(Value: TColor);
begin
if Value <> FDefColor then begin
FDefColor := Value;
brush.color:=FDefColor;
end;
end;

procedure TAlarm.SetAlarmType(Value: TAlarmType);
begin
if Value<>FAlarmType then begin
FAlarmType:=Value;
end;
end;

end.

← →
maxon (2004-03-10 16:17) [1]

помогите пожалуста, целый день долблюсь

← →
WebErr © (2004-03-10 16:31) [2]

Сформулируйте вопрос поконкретнее - времени нет и желания во всём этом разбираться! :))))

1. поточная ф-ция Alarming(), адрес которой передается параметром в BeginThread(), обязана иметь прототип

type TThreadFunc = function(Parameter: Pointer): Integer;

2. Не приняты меры к синхронизации обращений из доп.код.потока к твоему VCL-контролу с осн.код.потоком

чем обоснован отказ от использования стандартного класса TThread ?

создание компонента Найти похожие ветки