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

📄 jvqstringgrid.pas

📁 East make Tray Icon in delphi
💻 PAS
📖 第 1 页 / 共 3 页
字号:
  begin
    if Fixed then
      I := 0
    else
      I := FixedRows;
    J := RowCount - 1;
    while I < J do
    begin
      ExchangeGridRows(I, J);
      Inc(I);
      Dec(J);
    end;
  end;

  function MoveBlankTop: Integer;
  var
    I, J: Integer;
  begin
    if Fixed then
      I := 0
    else
      I := FixedRows;
    Result := I;
    J := RowCount - 1;
    while I <= J do
    begin
      if Trim(Cells[Column, I]) = '' then
      begin
        ExchangeGridRows(Result, I);
        Inc(Result);
      end;
      Inc(I);
    end;
  end;

  procedure MoveBlankBottom;
  var
    I, J: Integer;
    DoSort: Boolean;
  begin
    if Fixed then
      I := 0
    else
      I := FixedRows;
    DoSort := False;
    // avoid empty columns
    for J := I to RowCount - 1 do
      if Cells[Column, J] <> '' then
      begin
        DoSort := True;
        Break;
      end;
    if not DoSort then
      Exit;
    // this is already sorted, so blank items should be at top
    while Trim(Cells[Column, I]) = '' do
    begin
      InsertRow(RowCount).Assign(Rows[I]);
      DeleteRow(I);
      Inc(J);
      if J >= RowCount then
        Exit;
    end;
  end;

begin
  // (p3) NB!! sorting might trigger the OnExitCell, OnGetEditText and OnSetEditText events!
  // make sure you don't do anything in these events
  if (Column >= 0) and (Column < ColCount) and (SortType <> stNone) then
  begin
    if Fixed then
      LStart := 0
    else
      LStart := FixedRows;
    LEnd := RowCount - 1;
    if BlankTop then
      LStart := MoveBlankTop;
    if LStart < LEnd then
    begin
      QuickSort(LStart, LEnd);
      if not BlankTop then
        MoveBlankBottom;
      if not Ascending then
        InvertGrid;
    end;
  end;
end;

procedure TJvStringGrid.LoadFromFile(FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  // (rom) secured
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TJvStringGrid.LoadFromCSV(FileName: string; Separator: Char = ';'; QuoteChar: Char = '"'; StripQuotes: Boolean = True);
var
  I: Longint;
  Lines, Fields: TStringList;

  procedure SplitLine(const Line: string; Result: TStrings; Delimiter, QuoteChar: Char; StripQuotes: Boolean);
  var
    I, SLen, QuoteCount: Integer;
    S: string;
    IgnoreDelim: Boolean;
    QuotedStr: PChar;
  begin
    S := '';
    SLen := Length(Line);
    IgnoreDelim := False;
    QuoteCount := 0;
    Result.Clear;
    for I := 1 to SLen do
    begin
      if Line[I] = QuoteChar then
      begin
        Inc(QuoteCount);
        {* A Delimiter surrounded by a pair of QuoteChar has to be ignored.
           See example above: "FirstName, LastName"
           therefor: *}
        IgnoreDelim := QuoteCount mod 2 <> 0;
      end;

      if IgnoreDelim then
        S := S + Line[I]
      else
      if Line[I] <> Delimiter then
        S := S + Line[I]
      else
      begin
        if S <> '' then
        begin
          if StripQuotes and (S[1] = QuoteChar) then
          begin
            QuotedStr := PChar(S);
            Result.Add(AnsiExtractQuotedStr(QuotedStr, QuoteChar));
          end
          else
            Result.Add(S);
        end
        else
          Result.Add(S);

        S := '';
      end;
    end;
    if S <> '' then
    begin
      if StripQuotes and (S[1] = QuoteChar) then
      begin
        QuotedStr := PChar(S);
        Result.Add(AnsiExtractQuotedStr(QuotedStr, QuoteChar));
      end
      else
        Result.Add(S);
    end
    else
      Result.Add(S);
  end;

begin
  Lines := TStringList.Create;
  Fields := TStringList.Create;
  try
    Lines.LoadFromFile(FileName);
    DoLoadProgress(0, Lines.Count);
    RowCount := Lines.Count;
    ColCount := FixedCols + 1;
    for I := 0 to Lines.Count - 1 do
    begin
      {* added John *}
      SplitLine(Lines[I], Fields, Separator, QuoteChar, StripQuotes);
      DoLoadProgress(I, Lines.Count);

      if Fields.Count > ColCount then
        ColCount := Fields.Count;
      Rows[I].Assign(Fields);
    end;
    DoLoadProgress(Lines.Count, Lines.Count);
  finally
    Fields.Free;
    Lines.Free;
  end;
end;

procedure TJvStringGrid.LoadFromStream(Stream: TStream);
var
  Col, Rom, I, Count: Integer;
  Buffer: array [0..BufSize - 1] of Byte;
  St: string;
begin
  Col := 0;
  Rom := 1;
  DoLoadProgress(0, Stream.Size);
  while Stream.Position < Stream.Size do
  begin
    Count := Stream.Read(Buffer, 1024);
    DoLoadProgress(Stream.Position, Stream.Size);
    for I := 0 to Count - 1 do
      case Buffer[I] of
        0:
          begin
            Inc(Col);
            if Rom > RowCount then
              RowCount := Rom;
            if Col > ColCount then
              ColCount := Col;
            Cells[Col - 1, Rom - 1] := St;
            St := '';
          end;
        1:
          begin
            Inc(Col);
            if Col > ColCount then
              ColCount := Col;
            Cells[Col - 1, Rom - 1] := St;
            Inc(Rom);
            if Rom > RowCount then
              RowCount := Row;
            Col := 0;
            St := '';
          end;
      else
        St := St + Char(Buffer[I]);
      end;
  end;
  RowCount := RowCount - 1;
  DoLoadProgress(Stream.Size, Stream.Size);
end;



procedure TJvStringGrid.ModifyScrollBar(ScrollBar: TScrollBarKind; ScrollCode: TScrollCode;
  Pos: Cardinal; UseRightToLeft: Boolean);
begin
  case ScrollBar of
    sbHorizontal:
      if Assigned(FOnHorizontalScroll) then
        FOnHorizontalScroll(Self);
    sbVertical:
      if Assigned(FOnVerticalScroll) then
        FOnVerticalScroll(Self);
  end;
end;


procedure TJvStringGrid.SaveToFile(FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate or fmShareDenyWrite);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TJvStringGrid.SaveToCSV(FileName: string; Separator: Char = ';'; QuoteChar: Char = '"');
var
  I, J: Longint;
  BufStr, Value: string;
  Lines: TStringList;
begin
  Lines := TStringList.Create;
  DoSaveProgress(0, RowCount);
  try
    Lines.Clear;
    for I := 0 to RowCount - 1 do
    begin
      BufStr := '';
      DoSaveProgress(I, RowCount);
      for J := 0 to ColCount - 1 do
      begin
        {* added John *}
        Value := Cells[J, I];
        if Pos(Separator, Value) > 0 then
          Value := AnsiQuotedStr(Value, QuoteChar);
        {* end added John *}

        BufStr := BufStr + Value;
        if J <> (ColCount - 1) then
          BufStr := BufStr + Separator;
      end;
      Lines.Add(BufStr);
    end;
    DoSaveProgress(RowCount, RowCount);
    Lines.SaveToFile(FileName);
  finally
    Lines.Free;
  end;
end;

procedure TJvStringGrid.SaveToStream(Stream: TStream);
var
  I, J, K, ATotal: Integer;
  St: array [0..BufSize - 1] of Char;
  Stt: string;
  A, B: Byte;
begin
  A := 0;
  B := 1; // A for end of string, B for end of line
  ATotal := RowCount * ColCount;
  DoSaveProgress(0, ATotal);
  for I := 0 to RowCount - 1 do
  begin
    for J := 0 to ColCount - 1 do
    begin
      DoSaveProgress(I * ColCount + J, ATotal);
      Stt := Cells[J, I];
      for K := 1 to Length(Stt) do
        St[K - 1] := Stt[K];
      Stream.Write(St, Length(Cells[J, I]));
      if J <> ColCount - 1 then
        Stream.Write(A, 1);
    end;
    Stream.Write(B, 1);
  end;
  DoSaveProgress(ATotal, ATotal);
end;

procedure TJvStringGrid.ActivateCell(AColumn, ARow: Integer);
begin
  PostMessage(Handle, GM_ACTIVATECELL, AColumn, ARow);
end;

procedure TJvStringGrid.CaptionClick(AColumn, ARow: Integer);
begin
  if Assigned(FCaptionClick) then
    FCaptionClick(Self, AColumn, ARow);
end;

function TJvStringGrid.CreateEditor: TInplaceEdit;
begin
  Result := TExInplaceEdit.Create(Self);
end;

procedure TJvStringGrid.DefaultDrawCell(AColumn, ARow: Integer; Rect: TRect;
  State: TGridDrawState);
const
  Flags: array [TAlignment] of DWORD = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  S: string;
begin
  if RowHeights[ARow] < CanvasMaxTextHeight(Canvas) then
    Exit;
  Canvas.FillRect(Rect);
  S := Cells[AColumn, ARow];
  if Length(S) > 0 then
  begin
    InflateRect(Rect, -2, -2);
    DrawText(Canvas, S, Length(S), Rect,
      DT_SINGLELINE or DT_NOPREFIX or DT_VCENTER or
      Flags[GetCellAlignment(AColumn, ARow, State)]);
  end;
end;

procedure TJvStringGrid.DrawCell(AColumn, ARow: Integer; Rect: TRect;
  State: TGridDrawState);
begin
  if (AColumn < FixedCols) or (ARow < FixedRows) then
    Canvas.Font := FixedFont;
  if Assigned(OnDrawCell) then
    inherited DrawCell(AColumn, ARow, Rect, State)
  else
  begin
    SetCanvasProperties(AColumn, ARow, Rect, State);
    DefaultDrawCell(AColumn, ARow, Rect, State);
    Canvas.Font := Font;
    Canvas.Brush := Brush;
  end;
end;

procedure TJvStringGrid.ExitCell(const EditText: string;
  AColumn, ARow: Integer);
begin
  if Assigned(FOnExitCell) then
    FOnExitCell(Self, AColumn, ARow, EditText);

⌨️ 快捷键说明

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