开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
DBTreeSample1.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：11k
源码类别：

Delphi控件源码

开发平台：

Delphi

DBTreeSample1.pas：源码内容
  1. unit DBTreeSample1;
  3. interface
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Buttons, fcdbtreeview, Db, DBTables, Grids, fcTreeView, DBGrids,
  8.   ComCtrls, StdCtrls, Mask, DBCtrls, ExtCtrls, fcScrollBar, fcButton,
  9.   fcImgBtn, fcShapeBtn,
  10.   fcOutlookList, fcDemoRichEdit, fcImager;
  12. type
  13.   TDMTreeViewForm = class(TForm)
  14.     fcDBTreeView1: TfcDBTreeView;
  15.     CustomersDS: TDataSource;
  16.     CustomersTbl: TTable;
  17.     CustomersTblCustNo: TFloatField;
  18.     CustomersTblCompany: TStringField;
  19.     CustomersTblAddr1: TStringField;
  20.     CustomersTblAddr2: TStringField;
  21.     CustomersTblCity: TStringField;
  22.     CustomersTblState: TStringField;
  23.     CustomersTblZip: TStringField;
  24.     CustomersTblCountry: TStringField;
  25.     CustomersTblPhone: TStringField;
  26.     CustomersTblFAX: TStringField;
  27.     CustomersTblTaxRate: TFloatField;
  28.     CustomersTblContact: TStringField;
  29.     CustomersTblLastInvoiceDate: TDateTimeField;
  30.     CustomersTblLookupOrders: TIntegerField;
  31.     OrdersDS: TDataSource;
  32.     OrdersTbl: TTable;
  33.     OrdersTblOrderNo: TFloatField;
  34.     OrdersTblCustNo: TFloatField;
  35.     OrdersTblSaleDate: TDateTimeField;
  36.     OrdersTblShipDate: TDateTimeField;
  37.     OrdersTblEmpNo: TIntegerField;
  38.     OrdersTblShipToContact: TStringField;
  39.     OrdersTblShipToAddr1: TStringField;
  40.     OrdersTblShipToAddr2: TStringField;
  41.     OrdersTblShipToCity: TStringField;
  42.     OrdersTblShipToState: TStringField;
  43.     OrdersTblShipToZip: TStringField;
  44.     OrdersTblShipToCountry: TStringField;
  45.     OrdersTblShipToPhone: TStringField;
  46.     OrdersTblShipVIA: TStringField;
  47.     OrdersTblPO: TStringField;
  48.     OrdersTblTerms: TStringField;
  49.     OrdersTblPaymentMethod: TStringField;
  50.     OrdersTblItemsTotal: TCurrencyField;
  51.     OrdersTblTaxRate: TFloatField;
  52.     OrdersTblFreight: TCurrencyField;
  53.     OrdersTblAmountPaid: TCurrencyField;
  54.     ItemsDS: TDataSource;
  55.     ItemsTbl: TTable;
  56.     ItemsTblOrderNo: TFloatField;
  57.     ItemsTblItemNo: TFloatField;
  58.     ItemsTblPartNo: TFloatField;
  59.     ItemsTblQty: TIntegerField;
  60.     ItemsTblDiscount: TFloatField;
  61.     ItemsTblLookupPartDescription: TStringField;
  62.     ItemsTblLookupPartPrice: TFloatField;
  63.     LookupPartTbl: TTable;
  64.     LookupOrderTbl: TTable;
  65.     PageControl1: TPageControl;
  66.     CustomersTabSheet: TTabSheet;
  67.     OrdersTabSheet: TTabSheet;
  68.     ItemsTabSheet: TTabSheet;
  69.     Label1: TLabel;
  70.     Label2: TLabel;
  71.     EditCustNo: TDBEdit;
  72.     EditCompany: TDBEdit;
  73.     EditAddr: TDBEdit;
  74.     Label3: TLabel;
  75.     EditAddr2: TDBEdit;
  76.     Label4: TLabel;
  77.     EditZip: TDBEdit;
  78.     Label7: TLabel;
  79.     EditState: TDBEdit;
  80.     Label6: TLabel;
  81.     Label5: TLabel;
  82.     EditCity: TDBEdit;
  83.     Label8: TLabel;
  84.     EditCountry: TDBEdit;
  85.     EditPhone: TDBEdit;
  86.     Label9: TLabel;
  87.     Label10: TLabel;
  88.     EditFAX: TDBEdit;
  89.     EditLastInvoiceDate: TDBEdit;
  90.     Label13: TLabel;
  91.     EditContact: TDBEdit;
  92.     Label12: TLabel;
  93.     EditTaxRate: TDBEdit;
  94.     Label11: TLabel;
  95.     TreeStateLabel: TLabel;
  96.     ImageList1: TImageList;
  97.     Label14: TLabel;
  98.     EditOrderNo: TDBEdit;
  99.     DBEdit1: TDBEdit;
  100.     Label15: TLabel;
  101.     EditSaleDate: TDBEdit;
  102.     Label16: TLabel;
  103.     EditEmpNo: TDBEdit;
  104.     Label17: TLabel;
  105.     EditShipDate: TDBEdit;
  106.     Label18: TLabel;
  107.     EditShipVIA: TDBEdit;
  108.     Label25: TLabel;
  109.     EditPO: TDBEdit;
  110.     Label28: TLabel;
  111.     EditTerms: TDBEdit;
  112.     Label29: TLabel;
  113.     EditPaymentMethod: TDBEdit;
  114.     Label30: TLabel;
  115.     EditItemsTotal: TDBEdit;
  116.     Label31: TLabel;
  117.     EditAmountPaid: TDBEdit;
  118.     Label32: TLabel;
  119.     EditFreight: TDBEdit;
  120.     Label33: TLabel;
  121.     DBEdit2: TDBEdit;
  122.     Label34: TLabel;
  123.     EditDiscount: TDBEdit;
  124.     Label35: TLabel;
  125.     DBEdit3: TDBEdit;
  126.     Label36: TLabel;
  127.     Label37: TLabel;
  128.     EditItemNo: TDBEdit;
  129.     EditPartNo: TDBEdit;
  130.     Label38: TLabel;
  131.     EditQty: TDBEdit;
  132.     Label39: TLabel;
  133.     PartsDS: TDataSource;
  134.     PartsTbl: TTable;
  135.     GroupBox1: TGroupBox;
  136.     DBEdit6: TDBEdit;
  137.     Label42: TLabel;
  138.     DBEdit4: TDBEdit;
  139.     Label40: TLabel;
  140.     DBEdit5: TDBEdit;
  141.     Label41: TLabel;
  142.     DBEdit7: TDBEdit;
  143.     Label43: TLabel;
  144.     DBEdit8: TDBEdit;
  145.     Label44: TLabel;
  146.     DBEdit9: TDBEdit;
  147.     Label45: TLabel;
  148.     SpeedButton1: TSpeedButton;
  149.     PageControl2: TPageControl;
  150.     TabSheet1: TTabSheet;
  151.     TabSheet2: TTabSheet;
  152.     CheckBox1: TCheckBox;
  153.     ComboBox1: TComboBox;
  154.     Label19: TLabel;
  155.     CheckBox2: TCheckBox;
  156.     CheckBox3: TCheckBox;
  157.     FilterCombo: TComboBox;
  158.     Label20: TLabel;
  159.     CheckBox4: TCheckBox;
  160.     fcDemoRichEdit1: TfcDemoRichEdit;
  161.     fcDemoRichEdit2: TfcDemoRichEdit;
  162.     CheckBox5: TCheckBox;
  163.     fcImager1: TfcImager;
  164.     procedure fcDBTreeView1CalcNodeAttributes(TreeView: TfcDBCustomTreeView;
  165.       Node: TfcDBTreeNode);
  166.     procedure fcDBTreeView1Change(TreeView: TfcDBCustomTreeView;
  167.       Node: TfcDBTreeNode);
  168.     procedure PageControl1Change(Sender: TObject);
  169.     procedure ComboBox1Change(Sender: TObject);
  170.     procedure CheckBox1Click(Sender: TObject);
  171.     procedure CheckBox2Click(Sender: TObject);
  172.     procedure CheckBox3Click(Sender: TObject);
  173.     procedure FilterComboChange(Sender: TObject);
  174.     procedure CustomersTblFilterRecord(DataSet: TDataSet; var Accept: Boolean);
  175.     procedure CheckBox4Click(Sender: TObject);
  176.     procedure CheckBox5Click(Sender: TObject);
  177.     procedure fcDBTreeView1DrawText(TreeView: TfcDBCustomTreeView;
  178.       Node: TfcDBTreeNode; ARect: TRect; var DefaultDrawing: Boolean);
  179.   private
  180.     { Private declarations }
  181.   public
  182.     { Public declarations }
  183.   end;
  185. var
  186.   DMTreeViewForm: TDMTreeViewForm;
  188. implementation
  190. {$R *.DFM}
  192. procedure TDMTreeViewForm.fcDBTreeView1CalcNodeAttributes(TreeView: TfcDBCustomTreeView;
  193.   Node: TfcDBTreeNode);
  194. begin
  195.      //   TreeView.Canvas.Brush.Color:= clNone;
  196.    if Node.DataSet = CustomersTbl then begin
  198.       { Use lookupfield to determine if expand icon (+) should be displayed }
  199.       Node.HasChildren:= not node.dataset.fieldbyname('LookupOrders').isNull;
  201.       { Use US bitmap for US customers }
  202.       if Node.DataSet.FieldByname('Country').asString ='US' then
  203.          Node.StateIndex:= 0
  204.       else Node.StateIndex:= 1;
  207.    end
  208. end;
  210. procedure TDMTreeViewForm.fcDBTreeView1Change(TreeView: TfcDBCustomTreeView;
  211.   Node: TfcDBTreeNode);
  212. var s: string;
  213.     tempNode: TfcDBTreeNode;
  214. begin
  215.   { Compute label to indicate tree state }
  216.   s:= '';
  217.   tempNode:= node;
  218.   repeat
  219.      s:= tempNode.Text + #13 + s;
  220.      tempNode:= tempNode.parent;
  221.   until tempNode=nil;
  222.   TreeStateLabel.caption:= s;
  224.   { Select appropriate tab sheet based on active node }
  225.   if Node.dataset=CustomersTbl then PageControl1.activePage:= CustomersTabSheet
  226.   else if node.dataset=OrdersTbl then PageControl1.activePage:= OrdersTabSheet
  227.   else if node.dataset=ItemsTbl then PageControl1.activePage:= ItemsTabSheet;
  229. end;
  231. procedure TDMTreeViewForm.PageControl1Change(Sender: TObject);
  232. begin
  233.    { This code causes the treeview to highlight the
  234.      dataset associated with the ActivePage of the tab control }
  235.    if PageControl1.ActivePage = OrdersTabSheet then
  236.       fcDBTreeView1.MakeActiveDataSet(OrdersTbl, False)
  237.    else if PageControl1.ActivePage = ItemsTabSheet then
  238.       fcDBTreeView1.MakeActiveDataSet(ItemsTbl, False)
  239.    else if PageControl1.ActivePage = CustomersTabSheet then
  240.       fcDBTreeView1.MakeActiveDataSet(CustomersTbl, False)
  241. end;
  243. procedure TDMTreeViewForm.ComboBox1Change(Sender: TObject);
  244. begin
  245.    { Update treeview's fields based on active index }
  246.    with (Sender as TComboBox) do
  247.    begin
  248.       if text = 'By Company' then begin
  249.          CustomersTbl.indexname:= 'ByCompany';
  250.          fcDBTreeView1.DisplayFields[0]:= '"Company" ("CustNo")';
  251.       end
  252.       else begin
  253.          CustomersTbl.indexname:= '';
  254.          fcDBTreeView1.DisplayFields[0]:= '"CustNo", "Company"';
  255.       end;
  257.    end;
  258. end;
  260. procedure TDMTreeViewForm.CheckBox1Click(Sender: TObject);
  261. begin
  262.   with fcDBTreeView1 do begin
  263.      if dtvoExpandButtons3D in Options then
  264.         Options:= Options - [dtvoExpandButtons3D]
  265.      else Options:= Options + [dtvoExpandButtons3D]
  266.   end
  267. end;
  269. procedure TDMTreeViewForm.CheckBox2Click(Sender: TObject);
  270. begin
  271.   with fcDBTreeView1 do begin
  272.      if (Sender as TCheckBox).checked then
  273.         Options:= Options + [dtvoRowSelect]
  274.      else
  275.         Options:= Options - [dtvoRowSelect]
  276.   end
  277. end;
  279. procedure TDMTreeViewForm.CheckBox3Click(Sender: TObject);
  280. begin
  281.   if (Sender as TCheckBox).checked then
  282.   begin
  283.      with fcDBTreeView1.MultiSelectAttributes do begin
  284.         enabled:= True;
  285.         MultiSelectCheckbox:= true;
  286.      end
  287.   end
  288.   else begin
  289.      with fcDBTreeView1.MultiSelectAttributes do begin
  290.         enabled:= False;
  291.         MultiSelectCheckbox:= False;
  292.      end
  293.   end;
  294. end;
  296. procedure TDMTreeViewForm.FilterComboChange(Sender: TObject);
  297. begin
  298.   with (Sender as TComboBox) do
  299.   begin
  300.      if ItemIndex=0 then CustomersTbl.Filtered:= False
  301.      else if ItemIndex>0 then CustomersTbl.Filtered:= True
  302.   end
  303. end;
  305. procedure TDMTreeViewForm.CustomersTblFilterRecord(DataSet: TDataSet;
  306.   var Accept: Boolean);
  307. begin
  308.    if FilterCombo.ItemIndex=1 then
  309.       Accept:= DataSet.FieldByName('Country').asString = 'US'
  310.    else if FilterCombo.ItemIndex=2 then
  311.       Accept:= not (DataSet.FieldByName('Country').asString = 'US')
  312. end;
  314. procedure TDMTreeViewForm.CheckBox4Click(Sender: TObject);
  315. begin
  316.   with fcDBTreeView1 do begin
  317.      if (Sender as TCheckBox).checked then
  318.         Options:= Options + [dtvoHotTracking]
  319.      else
  320.         Options:= Options - [dtvoHotTracking]
  321.   end
  323. end;
  325. procedure TDMTreeViewForm.CheckBox5Click(Sender: TObject);
  326. begin
  327.   with fcDBTreeView1 do begin
  328.      if (Sender as TCheckBox).checked then
  329.      begin
  330.         Imager:= fcImager1;
  331.         LineColor:= clWhite;
  332.         Font.color:= clWhite;
  333.         Font.style:= Font.Style + [fsBold];
  334.         InactiveFocusColor:= clGray;
  335.      end
  336.      else begin
  337.         Imager:=nil;
  338.         LineColor:= clBtnShadow;
  339.         Font.color:= clBlack;
  340.         Font.style:= Font.Style - [fsBold];
  341.         InactiveFocusColor:= clBtnFace;
  342.      end
  343.   end
  344. end;
  346. procedure TDMTreeViewForm.fcDBTreeView1DrawText(
  347.   TreeView: TfcDBCustomTreeView; Node: TfcDBTreeNode; ARect: TRect;
  348.   var DefaultDrawing: Boolean);
  349. begin
  350. { Set hot-track color to yellow if imager in background }
  351.   if Node.Hot then
  352.   begin
  353.      if (TreeView.Imager<>nil) then
  354.         TreeView.Canvas.Font.Color:= clYellow
  355.      else begin
  356.         if Node.MultiSelected then
  357.            TreeView.Canvas.Font.Color:= clWhite
  358.      end
  359.   end
  360. end;
  362. end.