jvstringgrid.pas

East make Tray Icon in delphi

      CurrValue: Currency;
      DateValue: TDateTime;
    begin
      if TextToFloat(PChar(S1), ExtValue, fvExtended) and TextToFloat(PChar(S2), ExtValue, fvExtended) then
        Result := stNumeric
      else
      if TextToFloat(PChar(S1), CurrValue, fvCurrency) and TextToFloat(PChar(S2), CurrValue, fvCurrency) then
        Result := stCurrency
      else
      if TryStrToDateTime(S1, DateValue) and TryStrToDateTime(S2, DateValue) then
        Result := stDate
      else
        Result := stClassic;
    end;
  begin
    case DetectType(First, Second) of
      stNumeric:
        Result := StrToFloat(First) < StrToFloat(Second);
      stCurrency:
        Result := StrToCurr(First) < StrToCurr(Second);
      stDate:
        Result := StrToDateTime(First) < StrToDateTime(Second);
      stClassic:
        Result := AnsiCompareText(First, Second) < 0;
    else
      Result := First > Second;
    end;
  end;

  function IsBigger(First, Second: string): Boolean;
  begin
    Result := IsSmaller(Second, First);
  end;
  // (rom) A HeapSort has no worst case for O(X)
  // (rom) I donated one a long time ago to JCL
  // (p3) maybe implemented a secondary sort index when items are equal?
  // (p3) ...or use another stable sort method, like heapsort

  procedure QuickSort(L, R: Integer);
  var
    I, J, m: Integer;
  begin
    repeat
      I := L;
      J := R;
      m := (L + R) div 2;
      St := Cells[Column, m];
      repeat
        case SortType of
          stClassic:
            begin
              while AnsiCompareText(Cells[Column, I], St) < 0 do
                Inc(I);
              while AnsiCompareText(Cells[Column, J], St) > 0 do
                Dec(J);
            end;
          stCaseSensitive:
            begin
              while AnsiCompareStr(Cells[Column, I], St) < 0 do
                Inc(I);
              while AnsiCompareStr(Cells[Column, J], St) > 0 do
                Dec(J);
            end;
          stNumeric:
            begin
              TmpF := StrToFloat(St);
              while StrToFloat(Cells[Column, I]) < TmpF do
                Inc(I);
              while StrToFloat(Cells[Column, J]) > TmpF do
                Dec(J);
            end;
          stDate:
            begin
              TmpD := StrToDateTime(St);
              while StrToDateTime(Cells[Column, I]) < TmpD do
                Inc(I);
              while StrToDateTime(Cells[Column, J]) > TmpD do
                Dec(J);
            end;
          stCurrency:
            begin
              TmpC := StrToCurr(St);
              while StrToCurr(Cells[Column, I]) < TmpC do
                Inc(I);
              while StrToCurr(Cells[Column, J]) > TmpC do
                Dec(J);
            end;
          stAutomatic:
            begin
              while IsSmaller(Cells[Column, I], St) do
                Inc(I);
              while IsBigger(Cells[Column, J], St) do
                Dec(J);
            end;
        end;
        if I <= J then
        begin
          if I <> J then
            ExchangeGridRows(I, J);
          Inc(I);
          Dec(J);
        end;
      until (I > J);
      if L < J then
        QuickSort(L, J);
      L := I;
    until I >= R;
  end;

  procedure InvertGrid;
  var
    I, J: Integer;
  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;

{$IFDEF VCL}
procedure TJvStringGrid.WMHScroll(var Msg: TWMHScroll);
begin
  inherited;
  if Assigned(FOnHorizontalScroll) then
    FOnHorizontalScroll(Self);
end;

procedure TJvStringGrid.WMVScroll(var Msg: TWMVScroll);
begin
  inherited;
  if Assigned(FOnVerticalScroll) then
    FOnVerticalScroll(Self);
end;
{$ENDIF VCL}
{$IFDEF VisualCLX}
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;
{$ENDIF VisualCLX}

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 := TExInplaceEditList.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;