?? tscomm.pas
字號:
end;
constructor TTSComm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
////////////////////////////////////////////////////////////////////////////////
FErrorOptions := TErrorOptions.Create(self);
FGeneralOption := TGeneralOption.Create(self);
FSendList := TRecordList.Create;
FReceiveList := TRecordList.Create;
FSendRecord := nil;
FHasSend := False;
FHasReceive := False;
TSComm1 := self;
{啟動多媒體定時器}
FTimeID := timeSetEvent(1, 0, @TimeProc, 0, TIME_PERIODIC);
end;
destructor TTSComm.Destroy;
begin
{關閉多謀體定時器}
timeKillEvent(FTimeID);
FReceiveList.Free;
FSendList.Free;
FErrorOptions.Free;
FGeneralOption.Free;
inherited Destroy;
end;
function TTSComm.SendAgain: boolean;
begin
Result := False;
if FSendList.Count > 0 then
begin
FSendRecord := FSendList.Items[0];
if Assigned(FOnTSSendData) then
begin
FOnTSSendData(self, FSendList.Items[0]);
Result := True;
end;
end;
end;
function TTSComm.SendNext: boolean;
begin
Result := False;
if not FGeneralOption.IsCumulateError then
ClearErrorOptionIndex;
if FSendList.Count > 0 then
begin
FSendList.Delete(0);
Result := SendAgain;
end;
end;
procedure TTSComm.SetDataBuffer(Value: string);
begin
FDataBuffer := Value;
end;
function TTSComm.AddToSendList(AItem: Pointer): Integer;
begin
Result := FSendList.Add(AItem);
if FSendList.Count = 1 then
begin
if FErrorOptions.OverTimeErrorOption <> nil then
FErrorOptions.OverTimeErrorOption.TimeIndex := 0;
FHasSend := SendAgain;
end;
end;
function TTSComm.AddToReceiveList(AItem: Pointer): Integer;
begin
Result := FReceiveList.Add(AItem);
end;
procedure TTSComm.DeleteReceiveList(Index: Integer);
begin
FReceiveList.Delete(Index);
end;
procedure TTSComm.SetErrorOptions(Value: TErrorOptions);
begin
FErrorOptions.Assign(Value);
end;
procedure TTSComm.ClearErrorOptionIndex;
var i: Integer;
begin
for i := 0 to ErrorOptions.Count - 1 do
begin
ErrorOptions[i].Index := 0;
end;
end;
procedure TTSComm.SetGeneralOption(const Value: TGeneralOption);
begin
FGeneralOption := Value;
end;
procedure TTSComm.ClearErrorOptionTimeIndex;
var i: Integer;
begin
for i := 0 to ErrorOptions.Count - 1 do
begin
ErrorOptions[i].TimeIndex := 0;
end;
end;
{ TCustomErrorOption }
function TCustomErrorOption.AddSendInfoValue(Value: Pointer): Integer;
begin
Result := FSendInfoList.Add(Value);
end;
procedure TCustomErrorOption.Assign(Source: TPersistent);
begin
if Source is TCustomErrorOption then
begin
self.FCount := TCustomErrorOption(Source).Count;
self.FDelay := TCustomErrorOption(Source).Delay;
end;
inherited Assign(Source);
end;
constructor TCustomErrorOption.Create(Collection: TCollection);
begin
inherited Create(Collection);
FErrorStyle := esOther;
FCount := 2;
FDelay := 2000;
FIndex := 0;
FSendinfoList := TRecordList.Create;
FDateTime := 0;
FText := '';
FEnabled := True;
end;
destructor TCustomErrorOption.Destroy;
begin
FSendinfoList.Free;
inherited Destroy;
end;
function TCustomErrorOption.GetDisplayName: string;
begin
Result := Text;
if Result = '' then Result := inherited GetDisplayName;
end;
procedure TCustomErrorOption.SetCount(const ACount: Word);
begin
if FCount <> ACount then
FCount := ACount;
end;
procedure TCustomErrorOption.SetDateTime(const ADateTime: TDateTime);
begin
if FDateTime <> ADateTime then
FDateTime := ADateTime;
end;
procedure TCustomErrorOption.SetDelay(const ADelay: Longword);
begin
if FDelay <> ADelay then
FDelay := ADelay;
end;
procedure TCustomErrorOption.SetEnabled(const AEnabled: Boolean);
begin
if FEnabled <> AEnabled then
FEnabled := AEnabled;
end;
procedure TCustomErrorOption.SetErrorStyle(
const AErrorStyle: TErrorStyle);
var i: Integer;
begin
if AErrorStyle = esOverTime then
begin
for i := 0 to Collection.Count - 1 do
if TCustomErrorOption(Collection.Items[i]).FErrorStyle = esOverTime then Exit;
if AErrorStyle = esOverTime then
begin
TErrorOptions(Collection).OverTimeErrorOption := Self;
if TErrorOptions(Collection).CurrentErrorOption = nil then
TErrorOptions(Collection).CurrentErrorOption := TErrorOptions(Collection).OverTimeErrorOption;
end;
end;
if FErrorStyle <> AErrorStyle then
begin
FErrorStyle := AErrorStyle;
end;
end;
procedure TCustomErrorOption.SetErrorIndex(const AIndex: Word);
begin
if FIndex <> AIndex then
FIndex := AIndex;
end;
procedure TCustomErrorOption.SetText(const AText: string);
begin
if FText <> AText then
FText := AText;
end;
procedure TCustomErrorOption.SetTimeIndex(const Value: Integer);
begin
if FTimeIndex <> Value then
FTimeIndex := Value;
end;
{ TRecordList }
procedure TRecordList.Notify(Ptr: Pointer; Action: TListNotification);
begin
if Action = lnDeleted then
Dispose(Ptr);
inherited;
end;
{ TErrorOptions }
function TErrorOptions.Add: TCustomErrorOption;
begin
Result := TCustomErrorOption(inherited Add);
end;
constructor TErrorOptions.Create(TSComm: TTSComm);
begin
inherited Create(TCustomErrorOption);
FTSComm := TSComm;
end;
function TErrorOptions.GetItem(Index: Integer): TCustomErrorOption;
begin
Result := TCustomErrorOption(inherited GetItem(Index));
end;
function TErrorOptions.GetOwner: TPersistent;
begin
Result := FTSComm;
end;
procedure TErrorOptions.SetCurrentErrorOption(
const Value: TCustomErrorOption);
begin
FCurrentErrorOption := Value;
end;
procedure TErrorOptions.SetItem(Index: Integer; Value: TCustomErrorOption);
begin
inherited SetItem(Index, Value);
end;
procedure TErrorOptions.SetOverTimeErrorOption(
const Value: TCustomErrorOption);
begin
FOverTimeErrorOption := Value;
end;
procedure TErrorOptions.Update(Item: TCollectionItem);
begin
inherited;
end;
{ TGeneralOption }
procedure TGeneralOption.AssignTo(Dest: TPersistent);
begin
if Dest is TGeneralOption then
begin
FIsSingleCountError := TGeneralOption(Dest).IsSingleCountError; //錯誤次數是否獨立
FIsSingleIndexError := TGeneralOption(Dest).IsSingleIndexError; //錯誤當前次數是否獨立
FIsSingleDelayError := TGeneralOption(Dest).IsSingleDelayError; //錯誤延遲時間是否獨立
FIsCumulateError := TGeneralOption(Dest).IsCumulateError; //錯誤是否累積
FErrorCount := TGeneralOption(Dest).ErrorCount; //錯誤總次數
FErrorDelay := TGeneralOption(Dest).ErrorDelay; //錯誤延遲時間
FSucceedDelay := TGeneralOption(Dest).SucceedDelay; //接收數據成功后延遲
FSucceedCount := TGeneralOption(Dest).SucceedCount; //成功次數
end;
inherited AssignTo(Dest);
end;
constructor TGeneralOption.Create(TSComm: TTSComm);
begin
inherited Create;
FTSComm := TSComm;
FIsSingleCountError := True; //錯誤次數是否獨立
FIsSingleIndexError := False; //錯誤當前次數是否獨立
FIsSingleDelayError := False; //錯誤延遲時間是否獨立
FIsCumulateError := False; //錯誤是否累積
FErrorCount := 2; //錯誤總次數
FErrorDelay := 2000; //錯誤延遲時間
FErrorIndex := 0; //錯誤次數
FSucceedDelay := 1000; //接收數據成功后延遲
FSucceedDelayIndex := 0; //接收數據成功后當前延遲
FSucceedCount := 0; //成功次數
FSucceedCountIndex := 0; //成功當前次數
end;
procedure TGeneralOption.SetErrorCount(const Value: Word);
begin
FErrorCount := Value;
end;
procedure TGeneralOption.SetErrorDelay(const Value: Cardinal);
begin
FErrorDelay := Value;
end;
procedure TGeneralOption.SetIsCumulateError(const Value: Boolean);
begin
FIsCumulateError := Value;
end;
procedure TGeneralOption.SetIsSingleCountError(const Value: Boolean);
begin
FIsSingleCountError := Value;
end;
procedure TGeneralOption.SetIsSingleDelayError(const Value: Boolean);
begin
FIsSingleDelayError := Value;
end;
procedure TGeneralOption.SetIsSingleIndexError(const Value: Boolean);
begin
FIsSingleIndexError := Value;
end;
procedure TGeneralOption.SetSucceedCount(const Value: Word);
begin
FSucceedCount := Value;
end;
procedure TGeneralOption.SetSucceedDelay(const Value: Cardinal);
begin
FSucceedDelay := Value;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -