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
?
rysować ręcznie
Szczerze, to liczyłem na przykład :/
Na OnGetText mam taki kod:
Delphi 
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ł :)
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ąć.
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?
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
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...
Dodałem:
TargetCanvas.Font.Color := $00454545;
TargetCanvas.Font.Size := 7;
i śmiga :)
Przeczyszczę kod, dopasuję i wrzucę efekt
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;
if TimeToStr(Data.WEJSCIE) = '00:00:00' then na if Frac(Data.WEJSCIE) = 0 thenVSTPaintText te ify na praca_zgodna zastąp case
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.
Zarejestruj się i dołącz do największej społeczności programistów w Polsce.
Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.