qimport2txtview.pas

Delphi Advanced Import Component_v2.48.With Full Source.

            LineTo(X, Y2);
            Pen.Color := clWhite;
            MoveTo(X + 1, Y1);
            LineTo(X + 1, Y2);
          end;
          raBottom: begin
            Pen.Color := clBlack;
            Pen.Width := 1;
            MoveTo(X, Y1);
            LineTo(X, Y2 - 1);
            Pen.Color := clWhite;
            MoveTo(X + 1, Y1);
            LineTo(X + 1, Y2 - 1);
          end
        end;
  end;

  procedure DrawBorder;
  begin
    with Canvas do begin
      case Align of
        raTop: begin
          Pen.Color := clBlack;
          Pen.Width := 1;
          MoveTo(0, Height - 1);
          LineTo(Width - 1, Height - 1);

          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: TQImport2TXTViewer);
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;

{ TQImport2TXTViewer }

constructor TQImport2TXTViewer.Create(AOwner: TComponent);
begin
  inherited;
  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);

  FLines := TStringList.Create;
  FLineCount := 20;
  FMaxLineLength := 0;

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

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

destructor TQImport2TXTViewer.Destroy;
begin
  FSelection.Free;
  FArrows.Free;
  FLines.Free;
  inherited;
end;

procedure TQImport2TXTViewer.LoadFromFile(const AFileName: string);
var
  F: TextFile;
  i, l: integer;
  str: string;
begin
  if AFileName = EmptyStr then
    raise Exception.Create({$IFDEF WIN32}QImportLoadStr(QIE_NoFileName){$ENDIF}
                           {$IFDEF LINUX}QIE_NoFileName{$ENDIF});
  if not FileExists(AFileName) then
    raise Exception.CreateFmt({$IFDEF WIN32}QImportLoadStr(QIE_FileNotExists){$ENDIF}
                              {$IFDEF LINUX}QIE_FileNotExists{$ENDIF}, [AFileName]);

  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);
      FLines.Add(str);
      l := Length(Trim(str));
      if l > FMaxLineLength then
        FMaxLineLength := l;
      Inc(i);
    end;
  finally
    CloseFile(F);
  end;
  Invalidate;

  try
    if FCharHeight = 0 then FCharHeight := Canvas.TextHeight('A');
    if FCharWidth = 0 then FCharWidth := Canvas.TextWidth('A');
  except
  end;
end;

procedure TQImport2TXTViewer.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 TQImport2TXTViewer.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 TQImport2TXTViewer.AddArrow(Pos: integer);
var
  Position: integer;
begin
  Position := (Pos + 1) * FCharWidth + FRealLeft;
  if not FArrows.FindByPosition(Position) then
    FArrows.Add.Position := Position;
end;

procedure TQImport2TXTViewer.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;
    WindowClass.Style := WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW);