tnemulvt.pas

Delphi 网络通信协议代码,是多种网络协议的实现代码

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnEmulVT.RestoreOptions;
var
    IniFile  : TIniFile;
    xFont    : TFont;
begin
    if Length(FHostname) <= 0 then
        Exit;

    IniFile  := TIniFile.Create(IniFilename);
    xFont := TFont.Create;
    IniToFont(xFont, IniFile, HostName);
    Font := xFont;
    xFont.Free;

    LineHeight  := IniFile.ReadInteger(HostName, 'LineHeight',  12);
    Rows        := IniFile.ReadInteger(HostName, 'Rows',        25);
    Cols        := IniFile.ReadInteger(HostName, 'Cols',        80);
    FKeys       := IniFile.ReadInteger(HostName, 'FKeys',       0);
    AutoCr      := IniFile.ReadInteger(HostName, 'AutoCR',      0) <> 0;
    AutoLF      := IniFile.ReadInteger(HostName, 'AutoLF',      0) <> 0;
    LocalEcho   := IniFile.ReadInteger(HostName, 'LocalEcho',   0) <> 0;
    MonoChrome  := IniFile.ReadInteger(HostName, 'MonoChrome',  0) <> 0;
    UpperLock   := IniFile.ReadInteger(HostName, 'UpperLock',   0) <> 0;
    Xlat        := IniFile.ReadInteger(HostName, 'Xlat',        0) <> 0;
    GraphicDraw := IniFile.ReadInteger(HostName, 'GraphicDraw', 0) <> 0;
    CharZoom    := StrToFloat(IniFile.ReadString(HostName, 'CharZoom', '1'));
    LineZoom    := StrToFloat(IniFile.ReadString(HostName, 'LineZoom', '1'));
    IniFile.Free;
end;


{* * * * * * * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * *}
procedure TTnEmulVT.Connect;
var
{$IFDEF VER100}   { Delphi 3 }
    Form : TCustomForm;
{$ELSE}
{$IFDEF VER120}   { Delphi 4 }
    Form : TCustomForm;
{$ELSE}
{$IFDEF VER125}   { BCB4     }
    Form : TCustomForm;
{$ELSE}
{$IFDEF VER110}   { BCB3     }
    Form : TCustomForm;
{$ELSE}
    Form : TForm;
{$ENDIF}
{$ENDIF}
{$ENDIF}
{$ENDIF}
begin
    if Length(FHostname) <= 0 then
        Exit;

    Clear;
    TnCnx.Port  := FPort;
    TnCnx.Host  := FHostName;
    TnCnx.Connect;
    Display('Connecting to ''' + HostName + '''' + #13 + #10);
    //Form := GetParentForm(Self);
    //Form.ActiveControl := Self;
end;


{* * * * * * * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * *}
procedure TTnEmulVT.Disconnect;
begin
    TnCnx.Close;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TTnEmulVT.Send(Data : Pointer; Len : Integer) : integer;
begin
    Result := TnCnx.Send(Data, Len);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TTnEmulVT.SendStr(Data : String) : integer;
begin
    Result := TnCnx.SendStr(Data);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TTnEmulVT.IsConnected : Boolean;
begin
    Result := TnCnx.IsConnected;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnEmulVT.EditOptions;
var
    IniFile : TIniFile;
begin
    if Length(FHostname) <= 0 then
        Exit;

    if OptForm = nil then
        OptForm := TOptForm.Create(Self);

    OptForm.IniFileName  := FIniFileName;
    OptForm.OnNamesClick := FOnNamesClick;

    RestoreOptions;
    OptForm.AFont.Assign(Font);
    OptForm.LineHeight  := LineHeight;
    OptForm.AutoCR      := AutoCr;
    OptForm.AutoLF      := AutoLF;
    OptForm.LocalEcho   := LocalEcho;
    OptForm.MonoChrome  := MonoChrome;
    OptForm.UpperLock   := UpperLock;
    OptForm.Xlat        := Xlat;
    OptForm.GraphicDraw := GraphicDraw;
    OptForm.Rows        := Rows;
    OptForm.Cols        := Cols;
    OptForm.HostName    := FHostName;
    OptForm.FKeys       := FKeys;
    OptForm.CharZoom    := CharZoom;
    OptForm.LineZoom    := LineZoom;
    if OptForm.ShowModal = IDOK then begin
        Font        := OptForm.AFont;
        LineHeight  := OptForm.LineHeight;
        AutoCR      := OptForm.AutoCr;
        AutoLF      := OptForm.AutoLF;
        LocalEcho   := OptForm.LocalEcho;
        MonoChrome  := OptForm.MonoChrome;
        UpperLock   := OptForm.UpperLock;
        Xlat        := OptForm.Xlat;
        GraphicDraw := OptForm.GraphicDraw;
        Rows        := OptForm.Rows;
        Cols        := OptForm.Cols;
        FKeys       := OptForm.FKeys;
        LineZoom    := OptForm.LineZoom;
        CharZoom    := OptForm.CharZoom;
        IniFile     := TIniFile.Create(FIniFilename);
        FontToIni(OptForm.AFont, IniFile, FHostName);
        IniFile.WriteInteger(FHostName, 'LineHeight',  LineHeight);
        IniFile.WriteInteger(FHostName, 'Rows',        Rows);
        IniFile.WriteInteger(FHostName, 'Cols',        Cols);
        IniFile.WriteInteger(FHostName, 'AutoCR',      ord(AutoCR));
        IniFile.WriteInteger(FHostName, 'AutoLF',      ord(AutoLF));
        IniFile.WriteInteger(FHostName, 'LocalEcho',   ord(LocalEcho));
        IniFile.WriteInteger(FHostName, 'MonoChrome',  ord(MonoChrome));
        IniFile.WriteInteger(FHostName, 'UpperLock',   ord(UpperLock));
        IniFile.WriteInteger(FHostName, 'Xlat',        ord(Xlat));
        IniFile.WriteInteger(FHostName, 'GraphicDraw', ord(GraphicDraw));
        IniFile.WriteInteger(FHostName, 'FKeys',       FKeys);
        IniFile.WriteString(FHostName, 'LineZoom',     Format('%5.3f', [LineZoom]));
        IniFile.WriteString(FHostName, 'CharZoom',     Format('%5.3f', [CharZoom]));
        IniFile.Free;
        Repaint;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * *}
procedure TTnEmulVT.KeyPress(var Key: Char);
begin
    inherited KeyPress(Key);
    if FUpperLock and (Key in ['a'..'z']) then
        Key := chr(ord(Key) and $DF);
    if Key <> #0 then begin
        try
            if FLocalEcho then
                WriteChar(Key);
            TnCnx.Send(@Key, 1);
        except
            { Ignore any exception ! }
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * *}
procedure TTnEmulVT.DoKeyBuffer(Buffer : PChar; Len : Integer);
begin
    try
        if FLocalEcho then
             WriteBuffer(Buffer, Len);
        TnCnx.Send(Buffer, Len);
    except
        { Ignore exception ! }
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * *}
procedure DrawFocusRectangle(Wnd: HWnd; Rect: TRect);
var
    DC : HDC;
begin
    DC := GetDC(Wnd);
    DrawFocusRect(DC, Rect);
    ReleaseDC(Wnd, DC);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TTnEmulVT.MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
begin
    inherited MouseDown(Button, Shift, X, Y);
    FMouseDown := TRUE;
    if FFocusDrawn then begin
        DrawFocusRectangle(Handle, FFocusRect);
        FFocusDrawn := FALSE;
    end;
    if SelectRect.Top <> -1 then begin
        FFocusRect.Top := -1;
        SelectRect := FFocusRect;
        Repaint;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * *}
procedure TTnEmulVT.MouseMove(Shift: TShiftState; X, Y: Integer);
var
    Rect  : TRect;
    Point : TPoint;
begin
    inherited MouseMove(Shift, X, Y);
    if not FMouseDown then
        Exit;

    if not FMouseCaptured then begin
        SetCapture(Handle);
        FMouseCaptured    := TRUE;
        FMouseTop         := SnapPixelToRow(Y);
        FMouseLeft        := SnapPixelToCol(X);

        Point.X          := 0;
        Point.Y          := 0;
        Rect.TopLeft     := ClientToScreen(Point);
        Point.X          := Width - 16;
        Point.Y          := Height;
        Rect.BottomRight := ClientToScreen(Point);
        ClipCursor(@Rect);
    end
    else if (FMouseTop <> Y) or (FMouseLeft <> X) then begin
        if FFocusDrawn then
            DrawFocusRectangle(Handle, FFocusRect);
        Rect.Top    := FMouseTop;
        Rect.Left   := FMouseLeft;
        Rect.Bottom := SnapPixelToRow(Y) + LineHeight + 4;
        Rect.Right  := SnapPixelToCol(X) + CharWidth;
        DrawFocusRectangle(Handle, Rect);
        FFocusRect   := Rect;
        FFocusDrawn  := TRUE;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * *}
procedure TTnEmulVT.MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer);
begin
    inherited MouseUp(Button, Shift, X, Y);
    FMouseDown := FALSE;
    if FMouseCaptured then begin
        ReleaseCapture;
        FMouseCaptured := FALSE;
        ClipCursor(nil);
    end;
    if FFocusDrawn then begin
        DrawFocusRectangle(Handle, FFocusRect);
        FFocusDrawn := FALSE;
        if (FFocusRect.Right - FFocusRect.Left) < CharWidth then
            FFocusRect.Top := -1;
        if (FFocusRect.Bottom - FFocusRect.Top) < LineHeight then
            FFocusRect.Top := -1;
        SelectRect  := FFocusRect;
        Repaint;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * *}
function TTnEmulVT.GetSelTextBuf(Buffer: PChar; BufSize: Integer): Integer;
var
    StartRow : Integer;
    StopRow  : Integer;
    StartCol : Integer;
    StopCol  : Integer;
    nRow     : Integer;
    nCol     : Integer;
    Line     : TLine;
    nCnt     : Integer;
begin
    nCnt := 0;
    if (SelectRect.Top = -1) or (BufSize < 1) then begin
        if BufSize > 0 then
            Buffer[0] := #0;
        Result := nCnt;
        Exit;
    end;

    StartRow := PixelToRow(SelectRect.Top);
    StopRow  := PixelToRow(SelectRect.Bottom) - 1;
    StartCol := PixelToCol(SelectRect.Left);
    StopCol  := PixelToCol(SelectRect.Right) - 1;

    for nRow := StartRow to StopRow do begin
        if BufSize < 2 then
            Break;
        Line := Screen.FLines^[nRow];
        for nCol := StartCol to StopCol do begin
            Buffer[0] := Line.Txt[nCol];
            Inc(Buffer);
            Dec(BufSize);
            Inc(nCnt);
            if BufSize < 2 then
                Break;
        end;
        if nRow < StopRow then begin
            if BufSize < 4 then
                Break;
            Buffer[0] := #13;
            Buffer[1] := #10;
            Inc(Buffer);
            Inc(Buffer);
            Dec(BufSize);
            Dec(BufSize);
            Inc(nCnt);
            Inc(nCnt);
        end;
    end;

    Buffer[0] := #0;
    Result := nCnt;
end;


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


end.