qimport3txtview.pas

在C++Builder中直接用于数据的输出

          Pen.Color := clWhite;
          Pen.Width := 1;
          MoveTo(0, 0);
          LineTo(Width - 1, 0);
          MoveTo(0, 0);
          LineTo(0, Height);

          Pen.Color := clBlack;
          Pen.Width := 1;
          MoveTo(Width - 1, 0);
          LineTo(Width - 1, Height - 1);
        end;
        raBottom: begin
          Pen.Color := clBlack;
          Pen.Width := 1;
          MoveTo(0, Height - 1);
          LineTo(Width - 1, Height - 1);


          Pen.Color := clBlack;
          Pen.Width := 1;
          MoveTo(0, 0);
          LineTo(Width - 1, 0);
          Pen.Color := clWhite;
          Pen.Width := 1;
          MoveTo(0, 1);
          LineTo(Width - 1, 1);

          Pen.Color := clWhite;
          Pen.Width := 1;
          MoveTo(0, 1);
          LineTo(0, Height - 1);

          Pen.Color := clBlack;
          Pen.Width := 1;
          MoveTo(Width - 1, 1);
          LineTo(Width - 1, Height);
        end;
      end;
    end;
  end;

var
  i, ASize: integer;
  HDivisor: byte;
begin
  inherited Paint;

  Canvas.Brush.Color := clBtnFace;
  Canvas.FillRect(Rect(0, 0, Width, Height));

  DrawBorder;

  if FStep > 0
    then ASize := (Width * 2 - 1) div FStep
    else ASize := 0;

  for i := 1 to ASize do begin
    if (i = FOffset) or ((i + FOffset - 1) mod 5 = 0)
      then HDivisor := 1
      else HDivisor := 2;
    case FAlign of
      raBottom : DrawVertTrack(i * FStep, 2,
                              (Height - 1) div HDivisor);
      raTop    : DrawVertTrack(i * FStep, Height - 3,
                               Height - (Height - 1) div HDivisor);
    end;
  end;
end;

procedure TViewRuler.SetAlign(const Value: TViewRulerAlign);
begin
  if FAlign <> Value then
    FAlign := Value;
  case FAlign of
    raBottom : inherited Align := alBottom;
    raTop    : inherited Align := alTop;
  end;
end;

procedure TViewRuler.SetOffset(Value: integer);
begin
  if FOffset <> Value then
  begin
    FOffset := Value;
    Invalidate;
  end;
end;

procedure TViewRuler.SetStep(Value: integer);
begin
  if FStep <> Value then
  begin
    FStep := Value;
    Invalidate;
  end;
end;

procedure TViewRuler.CMColorChanged(var Message: TMessage);
begin
  Canvas.Brush.Color := Color;
  inherited;
end;

{ TViewSelection }

constructor TViewSelection.Create(Viewer: TQImport3TXTViewer);
begin
  inherited Create;
  FViewer := Viewer;
  FLeftArrow := nil;
  FRightArrow := nil;
  FVisibleRect := Rect(0, 0, 0, 0);
  FInverted := False;
end;

procedure TViewSelection.Update;
var
  R: TRect;
begin
  if Assigned(FLeftArrow) and Assigned(FRightArrow) then
  begin
    if FRightArrow.Position > 0 then
    begin
     if FRightArrow.Position < FViewer.ClientWidth
       then R.Right := FRightArrow.Position
       else R.Right := FViewer.ClientWidth;
    end
    else R.Right := 0;

    if FLeftArrow.Position > 0 then
    begin
     if FLeftArrow.Position < FViewer.ClientWidth
       then R.Left := FLeftArrow.Position
       else R.Left := FViewer.ClientWidth;
    end
    else R.Left := 0;

    R.Top := FViewer.FTopRuler.Height;
    R.Bottom := FViewer.ClientHeight - FViewer.FBottomRuler.Height;

    if not Assigned(FViewer.FActiveArrow) then
    begin
      if (R.Right > FVisibleRect.Right) and
         (R.Left = FVisibleRect.Left) then
      begin
        InvertRect(FViewer.Canvas.Handle,
          Rect(R.Left, R.Top, R.Right - FVisibleRect.Right, R.Bottom));
        FInverted := True;
      end
      else if (R.Left < FVisibleRect.Left) and
          (R.Right = FVisibleRect.Right) then
      begin
        InvertRect(FViewer.Canvas.Handle,
        Rect(R.Right - (R.Left - FVisibleRect.Left), R.Top, R.Right, R.Bottom));
        FInverted := True;
      end;
    end
    else begin
      if (R.Right > FVisibleRect.Right) and
         (R.Left = FVisibleRect.Left) then
      begin
        InvertRect(FViewer.Canvas.Handle,
          Rect(FVisibleRect.Right, R.Top, R.Right, R.Bottom));
        FInverted := True;
      end
      else if (R.Right < FVisibleRect.Right) and
          (R.Left = FVisibleRect.Left) then
      begin
        InvertRect(FViewer.Canvas.Handle,
          Rect(R.Right, R.Top, FVisibleRect.Right, R.Bottom));
        FInverted := True;
      end
      else if (R.Left < FVisibleRect.Left) and
          (R.Right = FVisibleRect.Right) then
      begin
        InvertRect(FViewer.Canvas.Handle,
          Rect(R.Left, R.Top, FVisibleRect.Left, R.Bottom));
        FInverted := True;
      end
      else if (R.Left > FVisibleRect.Left) and
          (R.Right = FVisibleRect.Right) then
      begin
        InvertRect(FViewer.Canvas.Handle,
          Rect(FVisibleRect.Left, R.Top, R.Left, R.Bottom));
        FInverted := True;
      end;
    end;

    FVisibleRect := R;
    if not FInverted then
    begin
      InvertRect(FViewer.Canvas.Handle, FVisibleRect);
      FInverted := True;
    end;
  end
  else begin
    InvertRect(FViewer.Canvas.Handle, FVisibleRect);
    FVisibleRect := Rect(0, 0, 0, 0);
    FInverted := False;
  end;
  if Assigned(FOnChange) then FOnChange(Self);
end;

function TViewSelection.GetExists: boolean;
begin
  Result := Assigned(FLeftArrow) and Assigned(FRightArrow);
end;

procedure TViewSelection.SetSelection(Left, Right: TViewArrow);
begin
  if (FLeftArrow <> Left) or (FRightArrow <> Right) then
  begin
    FLeftArrow := Left;
    FRightArrow := Right;
    Update;
  end;
end;

{ TQImport3TXTViewer }

constructor TQImport3TXTViewer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  Height := sHeight;
  Width := sWidth;
  FScrollBars := ssNone;

  Color := clWhite;
  with Canvas do
  begin
    Brush.Color := Color;
    Pen.Color := clBlack;
    Canvas.Pen.Mode := pmNot;
    Font.Name := sFontName;
    Font.Size := sFontSize;
  end;

  FCharWidth := 0;
  FCharHeight := 0;
  FRealHeight := Height;
  FRealLeft := 0;
  FRealTop := 0;
  FRealWidth := Width;

  FTopRuler := CreateRuler(raTop);
  FBottomRuler := CreateRuler(raBottom);

  FLineCount := 100;
  FMaxLineLength := 0;
  FCodePage := -1;
{$IFDEF QI_UNICODE}
  FLinesW := TWideStringList.Create;
{$ELSE}
  FLines := TStringList.Create;
{$ENDIF}

  FArrows := TViewArrows.Create(Self);
  FActiveArrow := nil;

  FSelection := TViewSelection.Create(Self);
  FSelection.OnChange := ChangeSelection;
end;

destructor TQImport3TXTViewer.Destroy;
begin
  FSelection.Free;
  FArrows.Free;
{$IFDEF QI_UNICODE}
  FLinesW.Free;
{$ELSE}
  FLines.Free;
{$ENDIF}
  inherited;
end;

procedure TQImport3TXTViewer.LoadFromFile(const AFileName: string);
var
{$IFDEF QI_UNICODE}
  tf: TGpTextFile;
  wstr: WideString;
{$ELSE}
  F: TextFile;
  str: string;
{$ENDIF}
  i, l: integer;
begin
  if AFileName = EmptyStr then
    raise Exception.Create(QImportLoadStr(QIE_NoFileName));
  if not FileExists(AFileName) then
    raise Exception.CreateFmt(QImportLoadStr(QIE_FileNotExists), [AFileName]);

{$IFDEF QI_UNICODE}
  tf := TGpTextFile.Create(AFileName);
  try
    tf.Reset;
    if CodePage <> -1 then
      tf.Codepage := Codepage;
    FLinesW.Clear;
    FMaxLineLength := 0;
    i := 0;
    while not tf.EOF do
    begin
      if (FLineCount > 0) and (i >= LineCount) then Break;
      wstr := tf.Readln;
      ReplaceTabs(wstr);
      FLinesW.Add(wstr);
      l := Length(Trim(wstr));
      if l > FMaxLineLength then
        FMaxLineLength := l;
      Inc(i);
    end;
  finally
    tf.Free;
  end;
{$ELSE}
  AssignFile(F, AFileName);
  Reset(F);
  try
    FLines.Clear;
    FMaxLineLength := 0;
    i := 0;
    while not Eof(F) do
    begin
      if (FLineCount > 0) and (i >= LineCount) then Break;
      Readln(F, str);
      ReplaceTabs(str);
      FLines.Add(str);
      l := Length(Trim(str));
      if l > FMaxLineLength then
        FMaxLineLength := l;
      Inc(i);
    end;
  finally
    CloseFile(F);
  end;
{$ENDIF}

  Invalidate;

  try
    if FCharHeight = 0 then
    begin
{$IFDEF QI_UNICODE}
      FCharHeight := Canvas.TextHeightW('A');
{$ELSE}
      FCharHeight := Canvas.TextHeight('A');
{$ENDIF}
    end;
         
    if FCharWidth = 0 then
    begin
{$IFDEF QI_UNICODE}
      FCharWidth := Canvas.TextWidthW('A');
{$ELSE}
      FCharWidth := Canvas.TextWidth('A');
{$ENDIF}
    end;
  except
  end;
end;

procedure TQImport3TXTViewer.SetSelection(Pos, Size: integer);
var
  L, R, Al, Ar: integer;
begin
  FSelection.SetSelection(nil, nil);
  L := (Pos + 1) * FCharWidth + FRealLeft;
  R := (Pos + Size + 1) * FCharWidth + FRealLeft;

  if FArrows.FindBetweenExcept(L, L, -1, Al) and
     FArrows.FindBetweenExcept(R, R, -1, Ar) then
  begin
    FSelection.SetSelection(FArrows[Al], FArrows[Ar]);
  end;
end;

procedure TQImport3TXTViewer.GetSelection(var Pos, Size: integer);
begin
  if FSelection.Exists then
  begin
    Pos := ((FSelection.LeftArrow.Position - FRealLeft) div FCharWidth) - 1;
    Size := ((FSelection.RightArrow.Position - FRealLeft) div FCharWidth) - 1 - Pos;
  end
  else begin
    Pos := -1;
    Size := -1;
  end;
end;

procedure TQImport3TXTViewer.AddArrow(Pos: integer);
var
  Position: integer;
begin
  Position := (Pos + 1) * FCharWidth + FRealLeft;
  if not FArrows.FindByPosition(Position) then
    FArrows.Add.Position := Position;
end;

procedure TQImport3TXTViewer.DeleteArrows;
begin
  while FArrows.Count > 0 do
    FArrows[0].Free;
end;

procedure TQImport3TXTViewer.CreateParams(var Params: TCreateParams);
const
  ScrollBar: array[TScrollStyle] of DWORD = (0, WS_HSCROLL, WS_VSCROLL,
    WS_HSCROLL or WS_VSCROLL);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or ScrollBar[FScrollBars];
    if NewStyleControls and Ctl3D then
    begin
      Style := Style and (not WS_BORDER);
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end
    else
      Style := Style or WS_BORDER;