jveditor.pas

数据表对拷程序。 做这个程序的本意是

function TJvEditorClient.Width: Integer;
begin
  Result := Max(FJvEditor.ClientWidth - Left, 0);
end;

function TJvEditorClient.ClientWidth: Integer;
begin
  Result := Width;
end;

function TJvEditorClient.ClientHeight: Integer;
begin
  Result := Height;
end;

function TJvEditorClient.ClientRect: TRect;
begin
  Result := Bounds(Left, Top, Width, Height);
end;

function TJvEditorClient.BoundsRect: TRect;
begin
  Result := Bounds(0, 0, Width, Height);
end;
//=== TJvGutter ==============================================================

procedure TJvGutter.Invalidate;
{var
  R : TRect;}
begin
  //  Owner.Invalidate;
  //  R := Bounds(0, 0, FJvEditor.GutterWidth, FJvEditor.Height);
  //  InvalidateRect(FJvEditor.Handle, @R, False);
  Paint;
end;

procedure TJvGutter.Paint;
begin
  with FJvEditor, Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := FGutterColor;
    FillRect(Bounds(0, EditorClient.Top, GutterWidth, EditorClient.Height));
    Pen.Width := 1;
    Pen.Color := Color;
    MoveTo(GutterWidth - 2, EditorClient.Top);
    LineTo(GutterWidth - 2, EditorClient.Top + EditorClient.Height);
    Pen.Width := 2;
    MoveTo(GutterWidth + 1, EditorClient.Top);
    LineTo(GutterWidth + 1, EditorClient.Top + EditorClient.Height);
    Pen.Width := 1;
    Pen.Color := clGray;
    MoveTo(GutterWidth - 1, EditorClient.Top);
    LineTo(GutterWidth - 1, EditorClient.Top + EditorClient.Height);
  end;
  with FJvEditor do
    GutterPaint(Canvas);
end;
//=== TJvCustomEditor ========================================================
{ TJvCustomEditor }

constructor TJvCustomEditor.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csClickEvents {, csOpaque}, csDoubleClicks,
    csReplicatable];
{$IFDEF JVCLThemesEnabled}
  ControlStyle := ControlStyle + [csNeedsBorderPaint];
{$ENDIF}
  FInsertMode := True;
  FLines := TJvEditorStrings.Create;
  FLines.FJvEditor := Self;
  FKeyboard := TJvKeyboard.Create;
  FRows := 1;
  FCols := 1;
  FUndoBuffer := TUndoBuffer.Create;
  FUndoBuffer.FJvEditor := Self;
  FGroupUndo := True;
  FRightMarginVisible := True;
  FRightMargin := 80;
  FBorderStyle := bsSingle;
  Ctl3D := True;
  Height := 40;
  Width := 150;
  ParentColor := False;
  Cursor := crIBeam;
  TabStop := True;
  FTabStops := '3 5';
  FSmartTab := True;
  FBackSpaceUnindents := True;
  FAutoIndent := True;
  FKeepTrailingBlanks := False;
  FCursorBeyondEOF := False;
  FBlockOverwrite := True;
  FPersistentBlocks := False;
  FScrollBars := ssBoth;
  scbHorz := TJvControlScrollBar95.Create;
  scbVert := TJvControlScrollBar95.Create;
  scbVert.Kind := sbVertical;
  scbHorz.OnScroll := ScrollBarScroll;
  scbVert.OnScroll := ScrollBarScroll;
  Color := clWindow;
  FGutterColor := clBtnFace;
  FclSelectBC := clHighLight;
  FclSelectFC := clHighLightText;
  FRightMarginColor := clSilver;
  EditorClient := TJvEditorClient.Create;
  EditorClient.FJvEditor := Self;
  FGutter := TJvGutter.Create;
  FGutter.FJvEditor := Self;
  FLeftCol := 0;
  FTopRow := 0;
  FSelection.Selected := False;
  FCaretX := 0;
  FCaretY := 0;
  TimerScroll := TTimer.Create(Self);
  TimerScroll.Enabled := False;
  TimerScroll.Interval := 100;
  TimerScroll.OnTimer := ScrollTimer;
  FKeyboard.SetDefLayout;
  FCompletion := TJvCompletion.Create(Self);
  FSelection.SelBlockFormat := bfNonInclusive;
  if BlockTypeFormat = 0 then
    BlockTypeFormat := RegisterClipboardFormat('Borland IDE Block Type');
  { we can change font only after all objects are created }
  Font.Name := 'Courier New';
  Font.Size := 10;
  FFontCache := TList.Create;
end;

destructor TJvCustomEditor.Destroy;
begin
  FLines.Free;
  scbHorz.Free;
  scbVert.Free;
  EditorClient.Free;
  FKeyboard.Free;
  FUndoBuffer.Free;
  FCompletion.Free;
  FGutter.Free;
  FontCacheClear; // free cached font instances
  FFontCache.Free;
  inherited Destroy;
end;

procedure TJvCustomEditor.Loaded;
begin
  inherited Loaded;
  UpdateEditorSize;
  {  Rows := FLines.Count;
    Cols := Max_X; }
end;
{************** Handle otrisovkoj [translated] ***************}

procedure TJvCustomEditor.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of Cardinal = (0, WS_BORDER);
  ScrollStyles: array[TScrollStyle] of Cardinal = (0, WS_HSCROLL, WS_VSCROLL,
    WS_HSCROLL or WS_VSCROLL);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[FBorderStyle] or ScrollStyles[FScrollBars];
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
    WindowClass.style := WindowClass.style and not (CS_HREDRAW or CS_VREDRAW);
  end;
end;
{$IFNDEF COMPILER4_UP}

procedure TJvCustomEditor.WMSize(var Msg: TWMSize);
begin
  inherited;
  if not (csLoading in ComponentState) then
    Resize;
end;
{$ENDIF COMPILER4_UP}

procedure TJvCustomEditor.Resize;
begin
  UpdateEditorSize;
end;

procedure TJvCustomEditor.CreateWnd;
begin
  inherited CreateWnd;
  if FScrollBars in [ssHorizontal, ssBoth] then
    scbHorz.Handle := Handle;
  if FScrollBars in [ssVertical, ssBoth] then
    scbVert.Handle := Handle;
  FAllRepaint := True;
end;

procedure TJvCustomEditor.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TJvCustomEditor.CMFontChanged(var Msg: TMessage);
begin
  inherited;
  FontChanged;
end;

procedure TJvCustomEditor.WMEraseBkgnd(var Msg: TWMEraseBkgnd);
begin
{  inherited;
  Msg.Result := 1;}
  Msg.Result := 0; // no background erase
end;

procedure TJvCustomEditor.WMSetCursor(var Msg: TWMSetCursor);
var
  P: TPoint;
begin
  GetCursorPos(P);
  P := ScreenToClient(P);
  if (P.X < GutterWidth) and (Cursor = crIBeam) then
  begin
    Msg.Result := 1;
    Windows.SetCursor(Screen.Cursors[crArrow])
  end
  else
    inherited;
end;

procedure TJvCustomEditor.WMSetFocus(var Msg: TWMSetFocus);
begin
  inherited;
  DoEnter;
end;

procedure TJvCustomEditor.WMKillFocus(var Msg: TWMSetFocus);
begin
  inherited;
  DoExit;
end;

procedure TJvCustomEditor.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
  Msg.Result := DLGC_WANTARROWS or DLGC_WANTTAB or DLGC_WANTCHARS or DLGC_WANTMESSAGE;
end;

procedure TJvCustomEditor.WMHScroll(var Msg: TWMHScroll);
begin
  scbHorz.DoScroll(Msg);
end;

procedure TJvCustomEditor.WMVScroll(var Msg: TWMVScroll);
begin
  scbVert.DoScroll(Msg);
end;

procedure TJvCustomEditor.WMMouseWheel(var Msg: TWMMouseWheel);
var Shift: TShiftState;
begin
  Shift := [];
  if Msg.Keys and MK_SHIFT <> 0 then Include(Shift, ssShift);
  if Msg.Keys and MK_CONTROL <> 0 then Include(Shift, ssCtrl);
  if Msg.Keys and MK_LBUTTON <> 0 then Include(Shift, ssLeft);
  if Msg.Keys and MK_RBUTTON <> 0 then Include(Shift, ssRight);
  if Msg.Keys and MK_MBUTTON <> 0 then Include(Shift, ssMiddle);
  MouseWheel(Msg.XPos, Msg.YPos, Msg.WheelDelta, Shift);
end;

procedure TJvCustomEditor.DoCopy;
begin
  PostCommand(ecClipboardCopy);
end;

procedure TJvCustomEditor.DoCut;
begin
  if not FReadOnly then
    PostCommand(ecClipboardCut);
end;

procedure TJvCustomEditor.DoPaste;
begin
  if not FReadOnly then
    PostCommand(ecClipboardPaste);
end;

procedure TJvCustomEditor.DoEnter;
begin
  inherited;
  CreateCaret(Handle, 0, 2, CellRect.Height - 2);
  PaintCaret(True);
end;

procedure TJvCustomEditor.DoExit;
begin
  inherited;
  if FCompletion.FVisible then
    FCompletion.CloseUp(False);
  DestroyCaret;
end;

procedure TJvCustomEditor.CursorChanged;
var
  P: TPoint;
begin
{$IFDEF VisualCLX}
  inherited;
{$ENDIF}
  GetCursorPos(P);
  P := ScreenToClient(P);
  if (P.X < GutterWidth) and (Cursor = crIBeam) then
    SetCursor(Screen.Cursors[crArrow]);
end;

procedure TJvCustomEditor.FontChanged;
begin
{$IFDEF VisualCLX}
  inherited;
{$ENDIF}
  if HandleAllocated then
    UpdateEditorSize;
end;
{############## Handle otrisovkoj [translated] ###############}
{************** Otrisovka [translated] ***************}
{
function IsRectEmpty(R: TRect): Boolean;
begin
  Result := (R.Top = R.Bottom) and (R.Left = R.Right);
end;
}

function TJvCustomEditor.CalcCellRect(X, Y: Integer): TRect;
begin
  Result := Bounds(
    EditorClient.Left + X * FCellRect.Width + 1,
    EditorClient.Top + Y * FCellRect.Height,
    FCellRect.Width,
    FCellRect.Height)
end;

procedure TJvCustomEditor.Paint;
var
  I: Integer;
  ECR: TRect;
  BX, EX, BY, EY: Integer;
begin
  if FUpdateLock > 0 then
    Exit;
//  FAllRepaint := True; { no optimized painting }
  { It is optimized - otrisovyvayetsya only necessary part  [translated] }
  PaintCaret(False);
  ECR := EditorClient.Canvas.ClipRect;
  OffsetRect(ECR, -FGutterWidth, 0);
  if FAllRepaint then
    ECR := EditorClient.BoundsRect;
  BX := ECR.Left div FCellRect.Width - 1;
  EX := ECR.Right div FCellRect.Width + 1;
  BY := ECR.Top div FCellRect.Height;
  EY := ECR.Bottom div FCellRect.Height + 1;
  for I := BY to EY do
    PaintLine(FTopRow + I, FLeftCol + BX, FLeftCol + EX);
  PaintCaret(True);
  FGutter.Paint;
  FAllRepaint := False;
end;

procedure TJvCustomEditor.BeginUpdate;
begin
  Inc(FUpdateLock);
end;

procedure TJvCustomEditor.EndUpdate;
begin
  Assert(FUpdateLock > 0); { Error }
  Dec(FUpdateLock);
  if FUpdateLock = 0 then
  begin
    FAllRepaint := True;
    UpdateEditorSize;
    StatusChanged;
    Invalidate;
  end;
end;

procedure TJvCustomEditor.UpdateEditorSize;
const
  BiggestSymbol