Jak przenieść StaticText niżej w VirtualStringTree?

0

Witam,

W VirtualStringTree mam kilka wierszy, które wyświetlają nazwy użytkowników oraz ich opisy statusu w formie StaticText.
Problem w tym, że statictext wyświetla domyślnie tekst tuż obok nazwy użytkownika w tym samym wierszu mimo, że dynamicznie ustawiam szerokość Noda w zależności od tego czy jest opis czy nie.

Pytanie brzmi, jak przenieść StaticText do nowej linii, tak aby uzyskać efekt jak na obrazku
?

1

Zrobić ten tekst jako węzeł podrzędny
Nadpisać rysowanie na własne.

1

rysować ręcznie

0

Szczerze, to liczyłem na przykład :/

Na OnGetText mam taki kod:

var
  Data: PCzat;
begin
  Data := Sender.GetNodeData(Node);
  CellText := '';

  case Column of
    0: // Main column
      begin
        CellText := Data.Login + ' (' + IntToStr(Data.Ile_Zgloszen) + ')';
        if (TextType = ttStatic) and (Column = 0) then
          CellText := Data.Czat_Opis; // podstawienie opisu do Static

      end;
  end;
end;

A na OnPlaintText

var
  Data: PCzat;
begin
  Data := Sender.GetNodeData(Node);

  if TextType = ttStatic then
  begin
    TargetCanvas.Font.Color := $00454545;
    TargetCanvas.Font.Size := 7;
  end
  else
  begin
   // normalny tekst
  end;
end;

Ktoś robił już coś takiego wcześniej? Być może nie trzeba rysować a jedynie wykorzystać jakieś parametry o których nie wiem?
Z rysowania nigdy nie byłem dobry, jakby ktoś coś doradził :)

0

Ja się zastanawiam czemu jak dasz początkującemu dwie opcje, taką którą da się zaimplementować w dwie sekundy oraz taką która potrzebuje sporo doświadczenia to zawsze wybiera ta drugą?
Weź dodaj to jako węzeł podrzędny.
Rysowania nikt za ciebie nie zrobi ponieważ jest to rzeźbienie przy którym trzeba mieć doświadczenie oraz przemyślaną wizje tego co chcesz osiągnąć.

0

Nie chciałem robić tego na drugim węźle, gdyż miałem tak wcześniej i nie chcę mieć możliwości klikania w ten węzeł ani też go zaznaczenia - jest to ostateczność, gdy nikt z tego forum nie będzie w stanie pomóc.

@_13th_Dragon znasz b. dobrze ten komponent, że twierdzisz iż nie ma innej opcji oprócz rysowania i oprogramowania tego wszystkiego?

0

Są tylko dwie opcje.

5

user image

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VirtualTrees, ImgList;

type
  TForm1 = class(TForm)
    vstLista: TVirtualStringTree;
    ilList: TImageList;
    procedure vstListaGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
    procedure vstListaGetImageIndex(Sender: TBaseVirtualTree;
      Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
      var Ghosted: Boolean; var ImageIndex: Integer);
    procedure vstListaGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer);
    procedure vstListaInitNode(Sender: TBaseVirtualTree; ParentNode,
      Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
    procedure vstListaPaintText(Sender: TBaseVirtualTree;
      const TargetCanvas: TCanvas; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType);
    procedure vstListaMeasureItem(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer);
    procedure FormCreate(Sender: TObject);
    procedure vstListaAfterItemPaint(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect);
    procedure vstListaBeforeCellPaint(Sender: TBaseVirtualTree;
      TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
      CellPaintMode: TVTCellPaintMode; CellRect: TRect;
      var ContentRect: TRect);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Math, Types;

type
  TListData = record
    ImageIndex: Integer;
    Login: string;
    Info: string;
    Projekt: string;
    Klient: string;
  end;
  PListData = ^TListData;

const
  cImie: array[0..3] of string = ('Józek', 'Edek', 'Zdzisiek', 'Franek');
  cNazwisko: array[0..3] of string = ('Kowalski', 'Iksiński', 'Ygrekowski', 'Doe');

{$R *.dfm}

procedure TForm1.vstListaGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
  Data: PListData;
begin
  Data := Sender.GetNodeData(Node);
  case Column of
    0: CellText := Data.Login;
    1: CellText := Data.Projekt;
    2: CellText := Data.Klient
  end;
end;

procedure TForm1.vstListaGetImageIndex(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
  var Ghosted: Boolean; var ImageIndex: Integer);
var
  Data: PListData;
begin
  if Column = 0 then
  begin
    Data := Sender.GetNodeData(Node);
    ImageIndex := Data.ImageIndex;
  end;
end;

procedure TForm1.vstListaGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize := SizeOf(TListData);
end;

procedure TForm1.vstListaInitNode(Sender: TBaseVirtualTree; ParentNode,
  Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var
  Data: PListData;
begin
  Data := Sender.GetNodeData(Node);
  Data.ImageIndex := Max(0, Random(10) - 6);
  Data.Login := cImie[Random(4)] + ' ' + cNazwisko[Random(4)];
  if Random(10) > 5 then
  begin
    Data.Info := 'Jakieś bardzo długie info nr ' + IntToStr(Random(100)) + ' z dodatkowym dłuższym info';
    Node.States := Node.States + [vsMultiline];
  end
  else
    Data.Info := '';
  Data.Projekt := 'Projekt ' + IntToStr(Random(50));
  Data.Klient := cImie[Random(4)] + ' ' + cNazwisko[Random(4)];
end;

procedure TForm1.vstListaPaintText(Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType);
var
  Data: PListData;
begin
  if Column = 0 then
  begin
    TargetCanvas.Font.Color := clRed;
    TargetCanvas.Font.Name := 'Lucida Console';
    TargetCanvas.Font.Size := 7;
    TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold];
  end;
end;

procedure TForm1.vstListaMeasureItem(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer);
var
  Data: PListData;
begin
  Data := Sender.GetNodeData(Node);
  if Data.Info = '' then
    NodeHeight := TVirtualStringTree(Sender).DefaultNodeHeight
  else
    NodeHeight := TVirtualStringTree(Sender).DefaultNodeHeight * 2;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
  vstLista.RootNodeCount := 20 + Random(30);
end;

procedure TForm1.vstListaAfterItemPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect);
var
  Data: PListData;
begin
  Data := Sender.GetNodeData(Node);
  if Data.Info <> '' then
  begin
    TargetCanvas.TextOut(ItemRect.Left + 26, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top) div 2, Data.Info);
  end;
end;

procedure TForm1.vstListaBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
  Data: PListData;
begin
  Data := Sender.GetNodeData(Node);
  if Data.Info <> '' then
  begin
    ContentRect.Bottom := ContentRect.Top + (ContentRect.Bottom - ContentRect.Top) div 2;
  end;
end;

end.

Na formie ImageList z pięcioma obrazkami, z czego pierwszy cały "pusty" i ustawiony jako 'Images' dla VST. Ważne ustawienie VST to MiscOptions.toVariableNodeHeight na True

0

Super! Właśnie o to chodzi! Pytanie tylko w jaki sposób zrealizowałeś to, że opis ma inny kolor od głównego węzła? W kodzie jest tylko ustawienie koloru czerwonego, u mnie koloruje wszystko...

@Edit

Dodałem:

TargetCanvas.Font.Color := $00454545;
TargetCanvas.Font.Size := 7;

i śmiga :)

Przeczyszczę kod, dopasuję i wrzucę efekt

0

Wszystko działa dokładnie tak jak chciałem. Śliczne dzięki @abrakadaber.

procedure TfrmChatList.VSTGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
var
  Data: PCzat;
begin
  Data := Sender.GetNodeData(Node);
  CellText := '';

  case Column of
    0: // Main column
      begin
        CellText := Data.Login + ' (' + IntToStr(Data.Ile_Zgloszen) + ')';
      end;

    1: // Wejscie
      begin
        if TimeToStr(Data.WEJSCIE) = '00:00:00' then
          CellText := ''
        else
          CellText := FormatDateTime('hh:mm', Data.WEJSCIE);
      end;

    2: // Projekt
    begin
      cellText := Data.NAZWA_PROGRAMU;
    end;

    3: // Klient
      begin
        cellText := Data.NAZWA_KLIENTA;
      end;
  end;
end;

procedure TfrmChatList.VSTMeasureItem(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; var NodeHeight: Integer);
var
  Data: PCzat;
begin
  Data := Sender.GetNodeData(Node);
  if Data.Czat_Opis = '' then
    NodeHeight := TVirtualStringTree(Sender).DefaultNodeHeight
  else
    NodeHeight := TVirtualStringTree(Sender).DefaultNodeHeight + 15;
end;

procedure TfrmChatList.VSTPaintText(Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType);
var
  Data: PCzat;
begin
  Data := Sender.GetNodeData(Node);

  if Column = 0 then
  begin

    if Data.Zalogowany = 1 then
    begin
      if Data.NAZWA_KLIENTA = '-' then
      begin
        TargetCanvas.Font.Color := clRed;
        Data.Hint := '';
      end;

      if Data.Praca_Zgodna = 0 then
      begin
        TargetCanvas.Font.Color := clRed;
        Data.Hint := 'Użytkownik nie pracuje wg. przydzielonych zgłoszeń.';
      end
      else
      begin
        if Data.Praca_Zgodna = 1 then
        begin
          TargetCanvas.Font.Color := clBlack;
          Data.Hint := 'Użytkownik pracuje zgodnie z przydzielonymi zgłoszeniami.';
        end
        else
        begin
          if Data.Praca_Zgodna = 3 then
          begin
            TargetCanvas.Font.Color := clBlue;
            Data.Hint := 'Użytkownik nie ma przydzielonych zgłoszeń.';
          end;
        end;
      end;
    end;
  end;
end;

procedure TfrmChatList.VSTGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize := SizeOf(TCzat);
end;

procedure TfrmChatList.VSTGetImageIndexEx(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
  var Ghosted: Boolean; var ImageIndex: Integer;
  var ImageList: TCustomImageList);
var
  Data: PCzat;
begin
  // For this demo only the normal image is shown, you can easily
  // change this for the state and overlay images.
  ImageList := ImageList_Czat;
  case Kind of
    ikNormal, ikSelected:
      begin
        Data := Sender.GetNodeData(Node);
        Ghosted := Node.Index = 1;

        case Column of
          -1, // general case
          0:  // main column
            begin
              ImageIndex := Data.Status;
            end;
        end;
      end;
    ikOverlay:
      begin
        // Enable this code to show an arbitrary overlay for each image.
        // Note the high overlay index. Standard overlays only go up to 15.
        // Virtual Treeview allows for any number.
        // ImageList := ImageList1;
        // ImageIndex := 58;
      end;
  end;
end;

procedure TfrmChatList.VSTGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode;
  Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle;
  var HintText: string);
var
  data: PCzat;
begin
  data := Sender.GetNodeData(Node);

  if (Column = 2) or (Column = 3) then
  begin
    if Data.Opis = '' then
      HintText := 'Brak opisu'
    else
      HintText := Data.Opis;
  end
  else
    if Column = 1 then
      HintText := 'Wersja SKP: ' + Data.Wersja
    else
      HintText := data.Hint;
end;

procedure TfrmChatList.VSTBeforeCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
var
  Data: PCzat;
begin
  Data := Sender.GetNodeData(Node);
  if Data.Czat_Opis <> '' then
  begin
    ContentRect.Bottom := ContentRect.Top + (ContentRect.Bottom - ContentRect.Top) div 2 + 7;
  end;
end;

procedure TfrmChatList.VSTAfterItemPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; ItemRect: TRect);
var
  Data: PCzat;
begin
  Data := Sender.GetNodeData(Node);
  if Data.Czat_Opis <> '' then
  begin
    TargetCanvas.Font.Color := $00454545;
    TargetCanvas.Font.Size := 7;
    TargetCanvas.TextOut(ItemRect.Left + 26, ItemRect.Top + (ItemRect.Bottom - ItemRect.Top) div 2 + 3, Data.Czat_Opis);
  end;
end;

1

zamień if TimeToStr(Data.WEJSCIE) = '00:00:00' then na if Frac(Data.WEJSCIE) = 0 then
w metodzie VSTPaintText te ify na praca_zgodna zastąp case

0

pytanie do user322:
piszesz klienta ggpodobnego (patrząc po słoneczkach)?
Protokół GG? Jeżeli tak to jaki komponent wspiera obecnie komunikację, bo za dawnych lat był to THGG, teraz nie wiem.

0

Ja odpowiem, że jedyny działający jako tako jaki znam to TEasyGG. Ma on wady. Potrafi się wywalić przy większej ilości kontaktów (tak od okołó 150, o ile pamiętam). I nie jest rozwijany. A tak to musisz liczyć, że user faktycznie coś napisał od zera. Albo na bazie dokumentacji od libgg próbować stworzyć jakiś od zera.

Jak przenieść StaticText niżej w VirtualStringTree?

1 użytkowników online, w tym zalogowanych: 0, gości: 1

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami