⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 jvgstringgrid.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 2 页
字号:
begin
  FCaptionTextAlignment := Value;
  Repaint;
end;

procedure TJvgStringGrid.SetCaptionFont(Value: TFont);
begin
  FCaptionFont.Assign(Value);
  Repaint;
end;

function TJvgStringGrid.GetBitmap: TBitmap;
begin
  if not Assigned(FBitmap) then
    FBitmap := TBitmap.Create;
  Result := FBitmap;
end;

procedure TJvgStringGrid.SetBitmap(Value: TBitmap);
begin
  if Assigned(FBitmap) then
    FBitmap.Free;
  FBitmap := TBitmap.Create;
  FBitmap.Assign(Value);
  if Assigned(Value) then
    FBmp := FBitmap
  else
  if Assigned(FImage) and Assigned(FImage.Picture) and
    Assigned(FImage.Picture.Bitmap) then
    FBmp := FImage.Picture.Bitmap
  else
    FBmp := nil;
  Invalidate;
end;

procedure TJvgStringGrid.SetImage(Value: TImage);
begin
  FImage := Value;
  if Assigned(FImage) and Assigned(FImage.Picture) and
    Assigned(FImage.Picture.Bitmap) then
    FBmp := FImage.Picture.Bitmap
  else
  if Assigned(FBitmap) then
    FBmp := FBitmap
  else
    FBmp := nil;
  Invalidate;
end;

function TJvgStringGrid.GetCaptions: TStrings;
begin
  Result := FCaptions;
end;

procedure TJvgStringGrid.SetCaptions(Value: TStrings);
begin
  FCaptions.Assign(Value);
  VertCaptions := fsgVertCaptions in FExtOptions;
end;

//-------------------------------------------------------------------------------

procedure TJvgStringGrid.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  R: TRect;
  ACol, ARow: Longint;
begin
  inherited MouseMove(Shift, X, Y);
  if not (fsgHottrack in FExtOptions) then
    Exit;
  MouseToCell(X, Y, ACol, ARow);
  if (ACol >= FixedCols) and (ARow >= FixedRows) then
  begin
    SetCursor(Screen.Cursors[crCross]);
    Exit;
  end;
  SetCursor(Screen.Cursors[crDefault]);

  if ((ACol <> AHottrackCol) or (ARow <> AHottrackRow)) then
  begin
    if (AHottrackCol < FixedCols) or (AHottrackRow < FixedRows) then
    begin
      R := CellRect(AHottrackCol, AHottrackRow);
      InvalidateRect(Handle, @R, False); //DefaultDrawing := False;
    end
    else
    if FHottrackThrought then
    begin
      if (ACol <> AHottrackCol) and (FixedCols > 0) then
      begin
        R := CellRect(AHottrackCol, 0); //DefaultDrawing := False;
        InvalidateRect(Handle, @R, False);
      end;
      if (ARow <> AHottrackRow) and (FixedRows > 0) then
      begin
        R := CellRect(0, AHottrackRow); //DefaultDrawing := False;
        InvalidateRect(Handle, @R, False);
      end;
    end;

    if (ACol < FixedCols) or (ARow < FixedCols) then
    begin
      R := CellRect(ACol, ARow); //DefaultDrawing := False;
      InvalidateRect(Handle, @R, False);
    end
    else
    if FHottrackThrought then
    begin
      if (ACol <> AHottrackCol) and (FixedCols > 0) then
      begin
        R := CellRect(ACol, 0); //DefaultDrawing := False;
        InvalidateRect(Handle, @R, False);
      end;
      if (ARow <> AHottrackRow) and (FixedRows > 0) then
      begin
        R := CellRect(0, ARow); //DefaultDrawing := False;
        InvalidateRect(Handle, @R, False);
      end;
    end;
    AHottrackCol := ACol;
    AHottrackRow := ARow;
  end;
end;

procedure TJvgStringGrid.CMMouseLeave(var Msg: TMessage);
var
  R: TRect;
begin
  inherited;
  if not (fsgHottrack in FExtOptions) then
    Exit;
  R := CellRect(AHottrackCol, AHottrackRow);
  AHottrackCol := -1;
  //DefaultDrawing := False;
  InvalidateRect(Handle, @R, False);
end;

procedure TJvgStringGrid.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  GridCoord: TGridCoord;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (not (goEditing in Options)) or (csDesigning in ComponentState) then
    Exit;

  if Assigned(OnMouseDown) then
    OnMouseDown(Self, Button, Shift, X, Y);
  if Memo.Focused then
    Cells[MemoCell.X, MemoCell.Y] := Memo.Text;
  GridCoord := MouseCoord(X, Y);
  if (GridCoord.X = 1) and Assigned(OnDrawCell) then
    OnDrawCell(Self, GridCoord.X, GridCoord.Y, CellRect(GridCoord.X,
      GridCoord.Y), [gdFocused]);
  //  ClearSelection;
  ShowEditorAtCell(GridCoord.X, GridCoord.Y);
end;

procedure TJvgStringGrid.ShowEditorAtCell(X, Y: Longint);
var
  R: TRect;
  GridRect: TGridRect;
begin
  if not (fsgMemoEditor in FExtOptions) then
    Exit;
  if (X >= FixedCols) and (Y >= FixedRows) then
  begin

    if (GridRect.Left <> X) or (GridRect.Top <> Y) then
    begin
      GridRect.Left := X;
      GridRect.Top := Y;
      GridRect.Right := X;
      GridRect.Bottom := Y;
      Selection := GridRect;
    end;
    Application.ProcessMessages;
    R := CellRect(X, Y);
    Memo.SetBounds(R.Left, R.Top, R.Right - R.Left, R.Bottom - R.Top);
    MemoCell.X := X;
    MemoCell.Y := Y;
    Memo.Text := Cells[MemoCell.X, MemoCell.Y];
    Memo.Visible := True;
    Memo.SetFocus;
    Memo.OnChange := OnMemoChange;
    Memo.Color := EditorColor;
    Memo.Font.Assign(EditorFont);
  end;
end;

procedure TJvgStringGrid.OnMemoChange(Sender: TObject);
var
  R: TRect;
  maxHeight, h, I: Integer;
begin
  /// need handle it -> if Assigned(OnSetEditText) then ...
  if (MemoCell.X < FixedCols) or (MemoCell.Y < FixedRows) then
    Exit;

  MemoUpdateTimer.Enabled := False;
  Cells[MemoCell.X, MemoCell.Y] := Memo.Text;

  if (fsgCellHeightAutoSize in ExtOptions) and (MemoCell.Y <> 0) then
  begin
    Canvas.Font.Assign(Font);
    maxHeight := DefaultRowHeight;
    for I := FixedCols to ColCount - 1 do
    begin
      R := CellRect(I, MemoCell.Y);
      if length(Cells[I, MemoCell.Y]) = 0 then
        continue;

      Windows.DrawText(Canvas.Handle, PChar(Cells[I, MemoCell.Y]), length(Cells[I,
        MemoCell.Y]), R, DT_WORDBREAK or DT_CALCRECT);
      h := R.Bottom - R.Top;
      if h > maxHeight then
        maxHeight {RowHeights[MemoCell.Y]} := h;
    end;
    RowHeights[MemoCell.Y] := maxHeight;
    Memo.Height := maxHeight;
  end;
end;

procedure TJvgStringGrid.OnMemoExit(Sender: TObject);
begin
  //  Cells[MemoCell.X, MemoCell.Y] := Memo.Text;
  Memo.Visible := False;
end;

procedure TJvgStringGrid.ClearSelection;
var
  GR: TGridRect;
begin
  GR.Left := 0;
  GR.Top := 0;
  GR.Right := 1;
  GR.Bottom := 1;
  Selection := GR;
end;

procedure TJvgStringGrid.CMChildKey(var Msg: TMessage);
begin
  if Msg.WParam = VK_TAB then
  begin
    if fsgTabThroughCells in ExtOptions then
    begin
      if Memo.Focused then
        Cells[MemoCell.X, MemoCell.Y] := Memo.Text;
      GetNextCell(MemoCell.X, MemoCell.Y);
      ShowEditorAtCell(MemoCell.X, MemoCell.Y);
      Msg.Result := 1;
    end
    else
      inherited;
  end
  else
  begin
    inherited;
    Application.ProcessMessages;
    if Msg.WParam > VK_ESCAPE then
    begin
      if not (goEditing in Options) then
        Exit;

      if (MemoCell.X < FixedCols) or (MemoCell.Y < FixedRows) then // show editor first time
        ShowEditorAtCell(Selection.Left, Selection.Top);

      MemoUpdateTimer.Enabled := True;
    end;
  end;
end;

procedure TJvgStringGrid.GetNextCell(var X, Y: Longint);
begin
  if X < ColCount - 1 then
    Inc(X)
  else
  begin
    X := FixedCols;
    if Y < RowCount - 1 then
      Inc(Y)
    else
      Y := FixedRows;
  end;
end;

procedure TJvgStringGrid.GetPriorCell(var X, Y: Longint);
begin
  if X > 0 then
    dec(X)
  else
  begin
    X := ColCount - 1;
    if Y > 0 then
      dec(Y)
    else
      Y := RowCount - 1;
  end;
end;

procedure TJvgStringGrid.WMSize(var Msg: TWMSize);
var
  I, W: Integer;
begin
  inherited;
  W := 0;
  for I := 0 to ColCount - 2 do
    Inc(W, ColWidths[I]);
  ColWidths[ColCount - 1] := Width - W;
end;

procedure TJvgStringGrid.GetCellGradientParams(Sender: TObject; ACol,
  ARow: Integer; var CellRect: TRect; var Gradient: TJvgGradient);
begin
  if Assigned(OnGetCellGradientParams) then
    OnGetCellGradientParams(Self, ACol, ARow, CellRect, Gradient);
end;

procedure TJvgStringGrid.GetCellStyle(Sender: TObject; var ACol, ARow: Integer;
  var Style: TglGridCellStyle);
begin
  if Assigned(OnGetCellStyle) then
    OnGetCellStyle(Self, ACol, ARow, Style);
end;

procedure TJvgStringGrid.UpdateCaptions(Sender: TObject);
begin
  SetVertCaptions(fsgVertCaptions in FExtOptions);
end;

procedure TJvgStringGrid.SetHottrack(const Value: Boolean);
begin
  if Value then
    Include(FExtOptions, fsgHottrack)
  else
    Exclude(FExtOptions, fsgHottrack);
end;

procedure TJvgStringGrid.SetMemoEditor(const Value: Boolean);
begin
  if Value then
    Include(FExtOptions, fsgMemoEditor)
  else
    Exclude(FExtOptions, fsgMemoEditor);
end;

procedure TJvgStringGrid.SetWordWrap(const Value: Boolean);
begin
  if Value then
    Include(FExtOptions, fsgWordWrap)
  else
    Exclude(FExtOptions, fsgWordWrap);
end;

procedure TJvgStringGrid.SetVertCaptions(Value: Boolean);
var
  I: Integer;
begin
  if Value then
    Include(FExtOptions, fsgVertCaptions)
  else
    Exclude(FExtOptions, fsgVertCaptions);
  try
    for I := 0 to Captions.Count - 1 do
      if fsgVertCaptions in FExtOptions then
        Cells[0, I] := Captions[I]
      else
        Cells[I, 0] := Captions[I];
  except
  end;
end;

procedure TJvgStringGrid.SetExtOptions(const Value: TglStringGridExtOptions);
begin
  FExtOptions := Value;
end;

procedure TJvgStringGrid.SetTextAlignment(const Value: TAlignment);
begin
  FTextAlignment := Value;
  Repaint;
end;

{ disallow default editor }

function TJvgStringGrid.CanEditShow: Boolean;
begin
  Result := inherited CanEditShow;
  if fsgMemoEditor in FExtOptions then
    Result := False;
end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -