jvlistview.pas

East make Tray Icon in delphi

                  except
                    Result := First > Second;
                  end;
                end
                else
                  Result := First > Second;
              end;
          end;
        end;
    end;

  begin
    Parm := TParamSort(Pointer(ParamSort)^);
    i1 := TListItem(Item1);
    i2 := TListItem(Item2);
    I := Parm.Index;

    // (Salvatore)
    SortKind := TJvListView(Parm.Sender).SortMethod;
    if Assigned(TJvListView(Parm.Sender).OnAutoSort) then
      TJvListView(Parm.Sender).OnAutoSort(Parm.Sender, Parm.Index, SortKind);

    case I of
      {sort by caption}
      0:
        begin
          S1 := i1.Caption;
          S2 := i2.Caption;

          if IsBigger(S1, S2, SortKind) then
            Result := 1
          else
            if IsBigger(S2, S1, SortKind) then
              Result := -1
            else
              Result := 0;
        end;
    else
      {sort by Column}
      begin
        if I > i1.SubItems.Count then
        begin
          if I > i2.SubItems.Count then
            Result := 0
          else
            Result := -1;
        end
        else
          if I > i2.SubItems.Count then
            Result := 1
          else
          begin
            S1 := i1.SubItems[I - 1];
            S2 := i2.SubItems[I - 1];
            if IsBigger(S1, S2, SortKind) then
              Result := 1
            else
              if IsBigger(S2, S1, SortKind) then
                Result := -1
              else
                Result := 0;
          end;
      end;
    end;
  end;

  function CustomCompare2(Item1, Item2, ParamSort: Integer): Integer; stdcall;
  begin
    Result := -CustomCompare1(Item1, Item2, ParamSort);
  end;

begin
  inherited ColClick(Column);
  if FSortOnClick then
  begin
    Parm.Index := Column.Index;
    Parm.Sender := Self;
    if FLast = Column.Index then
    begin
      FLast := -1;
      CustomSort(TLVCompare(@CustomCompare2), Integer(@Parm));
    end
    else
    begin
      FLast := Column.Index;
      CustomSort(TLVCompare(@CustomCompare1), Integer(@Parm));
    end;
  end;
end;

function TJvListView.CreateListItem: TListItem;
begin
  Result := TJvListItem.CreateEnh(Items, Self.PopupMenu);
end;

function TJvListView.CreateListItems: TListItems;
begin
  Result := TJvListItems.Create(Self);
end;

function TJvListView.GetItemPopup(Node: TListItem): TPopupMenu;
begin
  Result := TJvListItem(Node).PopupMenu;
end;

procedure TJvListView.SetItemPopup(Node: TListItem; Value: TPopupMenu);
begin
  TJvListItem(Node).PopupMenu := Value;
end;

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

// (rom) a 100 char buffer is silly

procedure TJvListView.LoadFromStream(Stream: TStream);
var
  Buf: array [0..100] of Char;
  Start: Integer;

  procedure LoadOldStyle(Stream: TStream);
  var
    I, J, K: Integer;
    Buf: array [0..100] of Byte;
    st: string;
    ch1, checks: Boolean;
    t: TListItem;
  begin
    I := Stream.Position;
    t := nil;
    st := '';
    Items.Clear;
    if Assigned(FOnLoadProgress) then
      FOnLoadProgress(Self, 0, Stream.Size - Start);
    checks := False;
    ch1 := CheckBoxes;
    while I < Stream.Size do
    begin
      J := Stream.Read(Buf, 100);
      if Assigned(FOnLoadProgress) then
        FOnLoadProgress(Self, J, Stream.Size - Start);
      I := I + J;
      K := 0;
      while K < J do
      begin
        while (K < J) and (Buf[K] <> 0) and (Buf[K] <> 1) do
        begin
          st := st + Char(Buf[K]);
          Inc(K);
        end;

        if K < J then
        begin
          if t <> nil then
            t.SubItems.Add(st)
          else
          begin
            t := Items.Add;
            checks := checks or (st[1] = 'T');
            t.Checked := st[1] = 'T';
            st := Copy(st, 2, Length(st));
            t.Caption := st;
          end;
          if Buf[K] = 1 then
            t := nil;
          st := '';
        end;
        Inc(K);
      end;
    end;
    if (not ch1) and (not checks) then
      CheckBoxes := False;
  end;

  procedure LoadNewStyle(Stream: TStream);
  const
    LV_HASCHECKBOXES = $80;
    // hs-    LV_CHECKED = $8000;
  var
    Count, I, J: SmallInt;
    Options: Byte;
    st: string;
    t: TListItem;
    Buf: array [0..2048] of Char;
  begin
    try
      Self.Items.BeginUpdate;
      Self.Items.Clear;
      Self.Items.EndUpdate;

      Stream.Read(Options, SizeOf(Options));
      CheckBoxes := (Options and LV_HASCHECKBOXES) = LV_HASCHECKBOXES;

      //Read all lines
      while Stream.Position < Stream.Size do
      begin
        Stream.Read(Count, SizeOf(Count));

        //statistics
        if Assigned(FOnLoadProgress) then
          FOnLoadProgress(Self, Stream.Position, Stream.Size - Start);

        //Read all columns
        t := Self.Items.Add;
        for I := 1 to Count do
        begin
          // hs-
          if I = 1 then
          begin
            Stream.Read(Options, SizeOf(Options));
            if CheckBoxes then
              t.Checked := Boolean(Options and Ord(True));
          end;
          // -hs

          (* hs-
                    Stream.Read(J, SizeOf(I));
          -hs *)
          Stream.Read(J, SizeOf(J));

          //Read the string
          FillChar(Buf, SizeOf(Buf), #0);
          Stream.Read(Buf, J);
          st := Buf;

          if I = 1 then
          begin
            t.Caption := st;
            (* hs-
                        if CheckBoxes then
                          t.Checked := (I and LV_CHECKED) = LV_CHECKED;
            -hs *)
          end
          else
            t.SubItems.Add(st);
        end;
      end;
    except
    end;
  end;

begin
  Start := Stream.Position;
  Stream.Read(Buf, 10);
  Buf[10] := #0;
  if Buf <> cLISTVIEW01 then
  begin
    Stream.Position := Start;
    LoadOldStyle(Stream);
  end
  else
    LoadNewStyle(Stream);
end;

procedure TJvListView.SaveToFile(FileName: string; ForceOldStyle: Boolean);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
  try
    SaveToStream(Stream, ForceOldStyle);
  finally
    Stream.Free;
  end;
end;

procedure TJvListView.SaveToStream(Stream: TStream; ForceOldStyle: Boolean);

  procedure SaveOldStyle(Stream: TStream);
  var
    I, J, K: Integer;
    b, c, d, e: Byte;
    st: string;
    Buf: array [0..1000] of Byte;
  begin
    b := 0;
    c := 1;
    d := Ord('T'); //checked
    e := Ord('F'); //not checked
    if Assigned(FOnSaveProgress) then
      FOnSaveProgress(Self, 0, Self.Items.Count);
    for I := 0 to Self.Items.Count - 1 do
    begin
      if Assigned(FOnSaveProgress) then
        FOnSaveProgress(Self, I + 1, Self.Items.Count);
      st := Self.Items[I].Caption;
      for K := 1 to Length(st) do
        Buf[K - 1] := Byte(st[K]);
      K := Length(st);
      //write checked,not
      if Self.Items[I].Checked then
        Stream.Write(d, 1)
      else
        Stream.Write(e, 1);
      Stream.Write(Buf, K);
      if Self.Items[I].SubItems.Count = 0 then
        Stream.Write(c, 1)
      else
      begin
        Stream.Write(b, 1);
        for J := 0 to Self.Items[I].SubItems.Count - 2 do
        begin
          st := Self.Items[I].SubItems[J];
          for K := 1 to Length(st) do
            Buf[K - 1] := Byte(st[K]);
          K := Length(st);
          Stream.Write(Buf, K);
          Stream.Write(b, 1);
        end;
        J := Self.Items[I].SubItems.Count - 1;
        st := Self.Items[I].SubItems[J];
        for K := 1 to Length(st) do
          Buf[K - 1] := Byte(st[K]);
        K := Length(st);
        Stream.Write(Buf, K);
        Stream.Write(c, 1);
      end;
    end;
  end;

  procedure SaveNewStyle(Stream: TStream);
  const
    LV_HASCHECKBOXES = $80;
    // hs-    LV_CHECKED = $8000;
  var
    Buf: array [0..100] of Char;
    // hs-    I, J: Word;
    I: Integer;
    J: SmallInt;

    // hs    Options : Byte;
    Options, IsChecked: Byte;

    procedure WriteString(const Txt: string);
    var
      I: Word;
    begin
      I := Length(Txt);
      Stream.Write(I, SizeOf(I));
      if I > 0 then
        Stream.Write(Txt[1], I);
    end;

  begin
    Buf := cLISTVIEW01;
    Stream.Write(Buf, 10);
    if CheckBoxes then
      Options := LV_HASCHECKBOXES
    else
      Options := 0;
    Stream.Write(Options, SizeOf(Options));
    for I := 0 to Items.Count - 1 do
      with Items[I] do
      begin
        J := SubItems.Count + 1;
        Stream.Write(J, SizeOf(J));
        // hs-
        IsChecked := Options or (Byte(Ord(Checked)));
        Stream.Write(IsChecked, SizeOf(IsChecked));
        // -hs
        WriteString(Items[I].Caption);
        for J := 0 to Items[I].SubItems.Count - 1 do
          WriteString(SubItems[J]);
      end;
  end;

begin
  if ForceOldStyle then
    SaveOldStyle(Stream)
  else
    SaveNewStyle(Stream);
end;

procedure TJvListView.SaveToStrings(Strings: TStrings; Separator: Char);
var
  I, J: Integer;
  TmpStr: string;
begin
  if Assigned(FOnSaveProgress) then
    FOnSaveProgress(Self, 0, Items.Count);
  for I := 0 to Items.Count - 1 do
  begin
    if Assigned(FOnSaveProgress) then
      FOnSaveProgress(Self, I + 1, Items.Count);
    TmpStr := AnsiQuotedStr(Items[I].Caption, '"');
    for J := 0 to Items[I].SubItems.Count - 1 do
      TmpStr := TmpStr + Separator + AnsiQuotedStr(Items[I].SubItems[J], '"');
    Strings.Add(TmpStr);
  end;
end;

procedure TJvListView.LoadFromStrings(Strings: TStrings; Separator: Char);
var
  I: Integer;
  Start, Stop, TmpStart: PChar;
  TmpStr: string;
  Li: TListItem;
begin
  for I := 0 to Strings.Count - 1 do
  begin
    Li := nil;
    Start := PChar(Strings[I]);
    Stop := Start + Length(Strings[I]);
    if (Start <> Stop) and (Start <> nil) and (Start^ <> #0) then
    begin
      if Start^ = '"' then
      begin
        Li := Items.Add;
        TmpStr := AnsiExtractQuotedStr(Start, '"'); // this moves the PChar pointer
        Li.Caption := TmpStr;
      end
      else
      begin
        TmpStart := Start;
        while Start^ <> Separator do
        begin
          if Start = Stop then
            Break;
          Inc(Start);
        end;
        SetString(TmpStr, Start, Start - TmpStart);
        Li := Items.Add;
        Li.Caption := TmpStr;
      end;
    end;
    if Li <> nil then
    begin
      while (Start <> Stop) and (Start <> nil) and (Start^ <> #0) do
      begin
        while Start^ = Separator do
          Inc(Start);
        if Start^ = '"' then
        begin
          TmpStr := AnsiExtractQuotedStr(Start, '"'); // this moves the PChar pointer
          Li.SubItems.Add(TmpStr);
        end
        else
        begin
          TmpStart := Start;
          while Start^ <> Separator do
          begin
            if Start = Stop then
              Break;
            Inc(Start);
          end;
          SetString(TmpStr, Start, Start - TmpStart);
          Li.SubItems.Add(TmpStr);
        end;
      end;
    end;
  end;
end;

procedure TJvListView.LoadFromCSV(FileName: string; Separator: Char);
var
  S: TStringList;
begin
  S := TStringList.Create;
  Items.BeginUpdate;
  try
    Items.Clear;
    S.LoadFromFile(FileName);
    LoadFromStrings(S, Separator);
  finally
    Items.EndUpdate;
    S.Free;
  end;
end;