cportmonitor.pas

Cport3.0最好的使用例子

begin
	inherited Notification(AComponent, Operation);
	if (AComponent = FComPort) and (Operation = opRemove) then
		ComPort := nil;
end;

procedure TCPortMonitor.AddLineToBuffer(const ALine:string;const AType:integer);
begin
	inc(FUpdating);
	try
		if FReverse then
		begin
			if FLines.Count >= fMaxLines then
			begin
				FLines.Delete(fLines.Count-1);
				inherited Lines.Delete(inherited Lines.Count -1);
			end;
			FLines.Insert(0,ALine);
			FLines.Objects[0]:=pointer(AType);
			inherited Lines.Insert(0,GetDisplayValue(ALine,AType));
		end
		else
		begin
			if FLines.Count >= fMaxLines then
			begin
				FLines.Delete(0);
				inherited Lines.Delete(0);
			end;
			FLines.AddObject(ALine,pointer(AType));
			inherited Lines.Add(GetDisplayValue(ALine,AType));
		end;
	finally
		Dec(FUpdating);
	end;
end;

function TCPortMonitor.GetDisplayValue(const AValue:string;const AType:integer):string;
var
	HH,MM,SS,MS:word;
begin
		case FMonitorStyle of
		msAscii:
			Result :=StrToPrint(AValue,fSpacing);
		msHex:
			Result :=StrToHex(AValue,fSpacing,'');    // NO style Hex
		msHexC:
			Result :=StrToHex(AValue,fSpacing,'0x');  // C style Hex
		msHexVB:
			Result :=StrToHex(AValue,fSpacing,'h');   // VB Style Hex
		msHexPascal:
			Result :=StrToHex(AValue,fSpacing,'$');   // Pascal Style Hex
		msBinary:
			Result :=StrToBinary(AValue,fSpacing);		// Binary
		msDecimal:
			Result :=StrToDecimal(AValue,fSpacing);		// Decimal
		end;
		if fMonitorShow <> [] then
			Result:=': '+Result;
		if (miTime in fMonitorShow) then
		begin
			DecodeTime(Now,HH,MM,SS,MS);
			Result:=Format('%.2d:%.2d:%.2d:%.3d ',[HH,MM,SS,MS])+Result;
		end;
		if (miDate in fMonitorShow) then
			Result:=DateToStr(Now)+' '+Result;
		if (miCommPort in fMonitorShow) then
			Result:=fComPort.Port+' '+Result;
		if (miDirection in fMonitorShow) then
		begin
			if AType <> 0 then
				Result:='-> '+Result
			else
				Result:='<- '+Result;
			end;
		if AType <> 0 then
		begin
			if Assigned(FOnOutput) then
				fOnOutput(Result,AValue,fComPort);
		end
		else
		begin
			if Assigned(FOnInput) then
				fOnInput(Result,AValue,fComPort);
		end;
end;

procedure TCPortMonitor.SetLines(AValue:TStringList);
var
	i:integer;
	S:string;
	iType:integer;
begin
	SelStart	:= SendMessage(handle, EM_LINEINDEX,0,0);
	SendMessage(handle,EM_SCROLLCARET,0,0);
	inc(FUpdating);
	inherited Lines.BeginUpdate;
	FLines.BeginUpdate;
	try
		for i:=0 to FLines.count -1 do
		begin
			S:=FLines[i];
			iType:=integer(FLines.Objects[i]);
			inherited Lines[i]:=GetDisplayValue(S,iType);
		end;
	finally
		FLines.EndUpdate;
		inherited Lines.EndUpdate;
		dec(FUpdating);
	end;
end;

procedure TCPortMonitor.LinesChanging(Sender:TObject);
begin
	if FUpdating <= 0 then
	begin
		SetLines(FLines);
		FUpdating:=0;
	end;
end;

procedure TCPortMonitor.WMLBUTTONDOWN (var Message: TMessage);
begin
	{ nada }
	inherited;
	refresh;
end;

procedure TCPortMonitor.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
	{ nada }
	inherited;
	refresh;
end;

{ **************************************************************************** }

procedure TCPortMonitor.Change;
// When the text changes adjust the highlighted line, if
// necessary, and repaint the control.
begin
	inherited Change;
  if HandleAllocated then begin
		FRowIncrement := GetScrollPos (Handle, SB_VERT);
		FColIncrement := GetScrollPos (Handle, SB_HORZ);
  end;
	Refresh;
end;

{ **************************************************************************** }

procedure TCPortMonitor.WMPAINT (var Message: TMessage);
// Repaint the control ...
var
  DC: HDC;
	RowHeight: integer;
	TextString: string;
	TextMargin: integer;
	ThisFont: TFont;
	iType:integer;
	i:integer;
begin
	inherited;
	// Get a DC for the canvas, and the current font
	DC := GetDC (Handle);
	ThisFont := Font;
	// Paint the highlighted text
	with TCanvas.Create do
	begin
		Handle := DC;
		Font := ThisFont;
		for i:=FRowIncrement to FLines.Count-1 do
		begin
			TextString:=inherited Lines[i];
			// Save the existing font color, then invert the colour
			iType:=integer(FLines.objects[i]);
			if iType <> 0 then
			//if strtointdef(Lines[i],0) mod 2 <> 0 then
			begin
				Font.Color  := FForeColorOutput;//ColorToRGB(FBackColorOutput) xor $02FFFFFF; // $02 value of high order byte is used to
				Brush.Color := FBackColorOutput;
			end
			else
			begin
				Font.Color := FForeColorInput;
				Brush.Color := FBackColorInput;
			end;
			RowHeight := TextHeight (TextString);                 // Get the height of the text
			TextMargin := Integer(Perform (EM_GETMARGINS, 0, 0)); // Offset from left edge of client area
			FillRect (Rect (0, ((i-FRowIncrement)*RowHeight)+1, ClientWidth, (((i-FRowIncrement) + 1)*RowHeight) + 1));
			TextOut (TextMargin + FColIncrement + 1, (i-FRowIncrement)*RowHeight + 1, TextString);
			if ((i-FRowIncrement)+1)*RowHeight > ClipRect.Bottom then
				break;
		end;
		Handle := 0;
		Free;
	end;
	// Release the DC when finished
	ReleaseDC(Handle, DC);

end;

{ **************************************************************************** }

procedure TCPortMonitor.SetBackColorOutput (Value: TColor);
begin
	FBackColorOutput := Value;
	Refresh;
end;

procedure TCPortMonitor.SetBackColorInput (Value: TColor);
begin
	FBackColorInput := Value;
	Refresh;
end;

procedure TCPortMonitor.SetForeColorOutput (Value: TColor);
begin
	FForeColorOutput := Value;
	Refresh;
end;

procedure TCPortMonitor.SetForeColorInput (Value: TColor);
begin
	FForeColorInput := Value;
	Refresh;
end;

procedure TCPortMonitor.SetMonitorStyle(Value:TMonitorStyle);
begin
	FMonitorStyle := Value;
	SetLines(FLines);
end;

procedure TCPortMonitor.SetSpacing(Value:integer);
begin
	if FSpacing >= 0 then
	begin
		FSpacing := Value;
		SetLines(FLines);
	end;
end;

procedure TCPortMonitor.SetEnclosed(Value:boolean);
begin
	FEnclosed := Value;
	SetLines(FLines);
end;

procedure TCPortMonitor.SetMonitorShow(Value:TMonitorInfoSet);
begin
	FMonitorShow := Value;
	SetLines(FLines);
end;

procedure TCPortMonitor.SetComPort(Value:TComPort);
begin
	if Value <> FComPort then
	begin
		if FComPort <> nil then
			FComPort.UnRegisterLink(FComLink);
		FComPort := Value;
		if FComPort <> nil then
		begin
			FComPort.FreeNotification(Self);
			FComPort.RegisterLink(FComLink);
		end;
		if not (csDesigning in ComponentState) then
			FLines.Clear;
	end;
end;

procedure TCPortMonitor.SetMaxLines(Value:integer);
begin
	if Value <> FMaxLines then
	begin
		FMaxLines:=Value;
		if not (csDesigning in ComponentState) then
			FLines.Clear;
	end;
end;

procedure TCPortMonitor.SetReverse(Value:boolean);
begin
	if Value <> FReverse then
	begin
		FReverse:=Value;
		if not (csDesigning in ComponentState) then
			FLines.Clear;
	end;
end;

procedure TCPortMonitor.TxBuf(Sender: TObject; const Buffer; Count: Integer);
var
	S:string;
begin
	SetLength(S,Count);
	Move(Buffer,s[1],Count);
	AddLineToBuffer(S,1);
end;

procedure TCPortMonitor.RxBuf(Sender: TObject; const Buffer; Count: Integer);
var
	S:string;
begin
	SetLength(S,Count);
	Move(Buffer,s[1],Count);
	AddLineToBuffer(S,0);
end;

{ **************************************************************************** }

procedure TCPortMonitor.WMVSCROLL (var Message: TMessage);
// Set the row increment according to the scroll bar position
begin
  inherited;
	FRowIncrement := GetScrollPos (Handle, SB_VERT);
	Refresh;
end;

{ **************************************************************************** }

procedure TCPortMonitor.WMHSCROLL (var Message: TMessage);
// Set the column increment according to the scroll bar position
begin
	inherited;
	FColIncrement := -GetScrollPos (Handle, SB_HORZ);
	Refresh;
end;



end.