home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 November / Chip_2003-11_cd1.bin / program / delphi / kompon / DIHtmlLabel.exe / Demos / DIHtmlLabel / Play.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2003-07-23  |  5.6 KB  |  206 lines
  1. { DIHtmlLabel example. }
  2.  
  3. unit Play;
  4.  
  5. {$I DI.inc}
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, Messages, StdCtrls, Controls, ExtCtrls, Classes, Forms,
  11.  
  12.   VirtualTrees,
  13.  
  14.   DIHtmlLabel, ComCtrls;
  15.  
  16. type
  17.   TfrmPlay = class(TForm)
  18.     LinkLabel: TDIHtmlLabel;
  19.     Splitter1: TSplitter;
  20.     Splitter2: TSplitter;
  21.     Treeview: TVirtualStringTree;
  22.     MemoHtml: TMemo;
  23.     ScrollBar: TScrollBar;
  24.     procedure FormCreate(Sender: TObject);
  25.     procedure MemoHtmlChange(Sender: TObject);
  26.     procedure btnRefreshClick(Sender: TObject);
  27.     procedure TreeViewInitNode(
  28.       Sender: TBaseVirtualTree;
  29.       ParentNode, Node: PVirtualNode;
  30.       var InitialStates: TVirtualNodeInitStates);
  31.     procedure TreeViewInitChildren(
  32.       Sender: TBaseVirtualTree;
  33.       Node: PVirtualNode;
  34.       var ChildCount: Cardinal);
  35.     procedure TreeViewGetText(
  36.       Sender: TBaseVirtualTree;
  37.       Node: PVirtualNode;
  38.       Column: TColumnIndex;
  39.       TextType: TVSTTextType;
  40.       var CellText: WideString);
  41.     procedure btnDownClick(Sender: TObject);
  42.     procedure btnUpClick(Sender: TObject);
  43.     procedure ScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode;
  44.       var ScrollPos: Integer);
  45.     procedure LinkLabelAfterPaint(Sender: TObject);
  46.   end;
  47.  
  48. implementation
  49.  
  50. {$R *.DFM}
  51.  
  52. uses
  53.   Graphics,
  54.   TypInfo,
  55.  
  56.   InfoStrings,
  57.  
  58.   DIHtmlRenderer,
  59.  
  60.   DIUtils;
  61.  
  62. procedure TfrmPlay.FormCreate(Sender: TObject);
  63. begin
  64.   LinkLabel.Caption := Lorem;
  65.   MemoHtml.Text := Lorem;
  66.   btnRefreshClick(Self);
  67.   { Prevents flickering during updates and resizes. We should eventually
  68.     implement a buffering mechanism into TDIHtmlLabel. Suggestions are welcome. }
  69.   DoubleBuffered := True;
  70. end;
  71.  
  72. { ---------------------------------------------------------------------------- }
  73.  
  74. procedure TfrmPlay.MemoHtmlChange(Sender: TObject);
  75. begin
  76.   Treeview.BeginUpdate;
  77.   Treeview.Clear;
  78.   LinkLabel.Caption := MemoHtml.Text;
  79.   Treeview.RootNodeCount := 1;
  80.   Treeview.FullExpand;
  81.   Treeview.EndUpdate;
  82. end;
  83.  
  84. { ---------------------------------------------------------------------------- }
  85.  
  86. procedure TfrmPlay.btnRefreshClick(Sender: TObject);
  87. begin
  88.   Treeview.BeginUpdate;
  89.   Treeview.Clear;
  90.   Treeview.RootNodeCount := 1;
  91.   Treeview.FullExpand;
  92.   Treeview.EndUpdate;
  93. end;
  94.  
  95. { ---------------------------------------------------------------------------- }
  96.  
  97. procedure TfrmPlay.TreeViewInitNode(Sender: TBaseVirtualTree; ParentNode,
  98.   Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
  99. var
  100.   NodeData, ParentNodeData: PNode;
  101. begin
  102.   NodeData := Sender.GetNodeData(Node);
  103.   if ParentNode = nil then
  104.     begin
  105.       NodeData^ := LinkLabel.NodeTree.Root;
  106.     end
  107.   else
  108.     begin
  109.       ParentNodeData := Sender.GetNodeData(ParentNode);
  110.       NodeData^ := TParentNode(ParentNodeData^).Children.Items[Node.Index];
  111.     end;
  112.   if (NodeData^ is TParentNode) and TParentNode(NodeData^).Children.IsNotEmpty then
  113.     Include(InitialStates, ivsHasChildren);
  114. end;
  115.  
  116. { ---------------------------------------------------------------------------- }
  117.  
  118. procedure TfrmPlay.TreeViewInitChildren(Sender: TBaseVirtualTree;
  119.   Node: PVirtualNode; var ChildCount: Cardinal);
  120. var
  121.   NodeData: PNode;
  122. begin
  123.   NodeData := Sender.GetNodeData(Node);
  124.   if NodeData^ is TParentNode then
  125.     ChildCount := TParentNode(NodeData^).Children.Count;
  126. end;
  127.  
  128. procedure TfrmPlay.TreeViewGetText(
  129.   Sender: TBaseVirtualTree;
  130.   Node: PVirtualNode;
  131.   Column: TColumnIndex;
  132.   TextType: TVSTTextType;
  133.   var CellText: WideString);
  134. var
  135.   NodeData: TNode;
  136. begin
  137.   NodeData := PNode(Sender.GetNodeData(Node))^;
  138.  
  139.   CellText := NodeData.ClassName;
  140.   case NodeData.GetNodeType of
  141.  
  142.     ntStyleNode: CellText := CellText + ' (' +
  143.       GetEnumName(TypeInfo(TFontStyle), Integer((NodeData as TStyleNode).Style)) + ')';
  144.  
  145.     ntLinkNode: CellText := CellText + ' (' +
  146.       GetEnumName(TypeInfo(TLinkState), Integer((NodeData as TLinkNode).State)) + ')';
  147.  
  148.     ntStringNode: CellText := CellText + ' ("' +
  149.       (NodeData as TStringNode).Text + '")';
  150.  
  151.     ntActionNode: CellText := CellText + ' (' +
  152.       GetEnumName(TypeInfo(TActionType), Integer((NodeData as TActionNode).Action)) + ')';
  153.  
  154.   end;
  155.  
  156.   if NodeData is TAreaNode then
  157.     CellText := CellText + ' [X: ' + IntToStrW(TAreaNode(NodeData).StartingPoint.x) +
  158.       ', Y: ' + IntToStrW(TAreaNode(NodeData).StartingPoint.y) + ']';
  159. end;
  160.  
  161. { ---------------------------------------------------------------------------- }
  162.  
  163. procedure TfrmPlay.btnDownClick(Sender: TObject);
  164. begin
  165.   with LinkLabel do
  166.     OffsetY := OffsetY + 20;
  167. end;
  168.  
  169. { ---------------------------------------------------------------------------- }
  170.  
  171. procedure TfrmPlay.btnUpClick(Sender: TObject);
  172. begin
  173.   with LinkLabel do
  174.     OffsetY := OffsetY - 20;
  175. end;
  176.  
  177. { ---------------------------------------------------------------------------- }
  178.  
  179. procedure TfrmPlay.ScrollBarScroll(Sender: TObject;
  180.   ScrollCode: TScrollCode; var ScrollPos: Integer);
  181. begin
  182.   if ScrollPos > (LinkLabel.TextHeight - LinkLabel.Height) then
  183.     ScrollPos := LinkLabel.TextHeight - LinkLabel.Height;
  184.   LinkLabel.OffsetY := -ScrollPos;
  185. end;
  186.  
  187. { ---------------------------------------------------------------------------- }
  188.  
  189. procedure TfrmPlay.LinkLabelAfterPaint(Sender: TObject);
  190. begin
  191.   if LinkLabel.TextHeight > LinkLabel.Height then
  192.     begin
  193.       ScrollBar.PAGESIZE := LinkLabel.Height;
  194.       ScrollBar.LargeChange := LinkLabel.Height;
  195.     end
  196.   else
  197.     begin
  198.       ScrollBar.PAGESIZE := LinkLabel.TextHeight;
  199.       ScrollBar.LargeChange := LinkLabel.TextHeight;
  200.     end;
  201.   ScrollBar.max := LinkLabel.TextHeight;
  202. end;
  203.  
  204. end.
  205.  
  206.