vcdemomainform.pas

delphi编程控件

unit VCDemoMainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, TreeVwEx, dbTree, DB, DBTables, Grids, DBGrids, StdCtrls,
  DBCtrls, Mask, ExtCtrls, dbTreeCBox;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheetDepartments: TTabSheet;
    TableDepartment: TTable;
    TableDepartmentDepartmentID: TStringField;
    TableDepartmentDescription: TStringField;
    TableDepartmentDateEstablished: TDateField;
    TableDepartmentOwnerDept: TStringField;
    DataSourceDepartment: TDataSource;
    TableStaff: TTable;
    TableStaffEmpNo: TStringField;
    TableStaffLastName: TStringField;
    TableStaffFirstName: TStringField;
    TableStaffPhoneExt: TStringField;
    TableStaffHireDate: TDateTimeField;
    TableStaffSalary: TFloatField;
    TableStaffDisplayName: TStringField;
    TableStaffDepartment: TStringField;
    DataSourceStaff: TDataSource;
    TableStaffUnassigned: TTable;
    TableStaffUnassignedEmpNo: TStringField;
    TableStaffUnassignedLastName: TStringField;
    TableStaffUnassignedFirstName: TStringField;
    TableStaffUnassignedPhoneExt: TStringField;
    TableStaffUnassignedHireDate: TDateTimeField;
    TableStaffUnassignedSalary: TFloatField;
    TableStaffUnassignedDepartment: TStringField;
    TableStaffUnassignedDisplayName: TStringField;
    DataSourceStaffUnassigned: TDataSource;
    dbtvDepartment: TDBTreeView;
    dbtvStaff: TDBTreeView;
    dbtvUnassigned: TDBTreeView;
    DBEdit2: TDBEdit;
    DBEdit1: TDBEdit;
    DBNavigator1: TDBNavigator;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Label3: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    TabSheetPeople: TTabSheet;
    TablePeople: TTable;
    TablePeopleEmpNo: TStringField;
    TablePeopleLastName: TStringField;
    TablePeopleFirstName: TStringField;
    TablePeoplePhoneExt: TStringField;
    TablePeopleHireDate: TDateTimeField;
    TablePeopleSalary: TFloatField;
    TablePeopleDepartment: TStringField;
    DataSourcePeople: TDataSource;
    DBGrid1: TDBGrid;
    DBNavigator2: TDBNavigator;
    DBEdit3: TDBEdit;
    DBEdit4: TDBEdit;
    DBEdit5: TDBEdit;
    DBEdit6: TDBEdit;
    DBEdit7: TDBEdit;
    DBEdit8: TDBEdit;
    DbTreeLookupComboBox1: TDbTreeLookupComboBox;
    Button2: TButton;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label11: TLabel;
    procedure FormShow(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure PageControl1Changing(Sender: TObject;
      var AllowChange: Boolean);
    procedure Button1Click(Sender: TObject);
    procedure DataSourceDepartmentDataChange(Sender: TObject; Field: TField);
    procedure TableDepartmentBeforeDelete(DataSet: TDataSet);
    procedure TableStaffCalcFields(DataSet: TDataSet);
    procedure TableStaffUnassignedCalcFields(DataSet: TDataSet);
    procedure dbtvDepartmentDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure dbtvDepartmentDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure dbtvStaffDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure dbtvStaffDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure dbtvUnassignedDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure dbtvUnassignedDragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure TableDepartmentAfterDelete(DataSet: TDataSet);
  private
    DeletedDepartment: string;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure OpenTable(Table: TTable);
var
  TableName: String;
begin
  if Table.Active then
    exit;
  if (Table.DatabaseName = '') then
  begin
    TableName := Table.TableName;
    if (Pos('.DB', UpperCase(TableName)) = 0) then
      TableName := TableName + '.DB';
    if FileExists(ExtractFilePath(Application.ExeName) +
                  TableName) then
      Table.DatabaseName := ExtractFileDir(Application.ExeName)
    else
    begin
      ShowMessage(
        'Please set ' + Table.Name + '.DatabaseName to the location of ' +
        TableName + ' or copy ' + TableName +
        ' to the location of ' + Application.ExeName);
      halt;
    end;
  end;
  Table.Open;
end;

function PostQuery(Table: TTable): Boolean;
begin
  result := true;
  with Table do
    if (State in [dsEdit, dsInsert]) then
      case MessageDlg(TableName + ' is still in edit-mode.' + #10 +
                      'Save changes ?',
                      mtConfirmation, mbYesNoCancel, 0) of
        mrYes: Post;
        mrNo: Cancel;
        else result := false;
      end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  OpenTable(TableDepartment);
  OpenTable(TableStaff);
  OpenTable(TableStaffUnassigned);
  OpenTable(TablePeople);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CanClose := PostQuery(TableDepartment) and PostQuery(TablePeople);
end;

procedure TForm1.PageControl1Changing(Sender: TObject;
  var AllowChange: Boolean);
begin
  AllowChange := PostQuery(TableDepartment) and PostQuery(TablePeople);
{ Refresh would not be needed if we would use TSelfRefreshTables: }
  TableStaffUnassigned.Refresh;
  TableStaff.Refresh;
  TablePeople.Refresh;
end;

procedure TForm1.TableStaffCalcFields(DataSet: TDataSet);
begin
  TableStaffDisplayName.AsString :=
    TableStaffLastName.AsString + ', ' +
    TableStaffFirstName.AsString
end;

procedure TForm1.TableStaffUnassignedCalcFields(DataSet: TDataSet);
begin
  TableStaffUnassignedDisplayName.AsString :=
    TableStaffUnassignedLastName.AsString + ', ' +
    TableStaffUnassignedFirstName.AsString
end;

procedure TForm1.DataSourceDepartmentDataChange(Sender: TObject; Field: TField);
begin
  dbtvStaff.RebuildTree;
end;

procedure TForm1.dbtvDepartmentDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
{ We set dtAutoDragMove in dbtvDepartment.Options, so the items of
  dbtvDepartment can get moved. But if we use the DragOver-event, we
  could stop it anyway by setting Accept to false - so we have to
  set Accept to true if Source = dbtvDepartment: }
  Accept := (Source = dbtvDepartment) or
            (Source = dbtvStaff) or
            (Source = dbtvUnassigned);
end;

procedure TForm1.dbtvDepartmentDragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if (dbtvDepartment.GetNodeAt(X, Y) <> nil) and
     (dbtvDepartment.IDOfNode(dbtvDepartment.GetNodeAt(X, Y)) <> '') then
  begin
    if (Source = dbtvStaff) then
    begin
      dbtvStaff.SynchronizeCurrentRecordToSelectedNode;
      TableStaff.Edit;
      TableStaffDepartment.AsString :=
        dbtvDepartment.IDOfNode(dbtvDepartment.GetNodeAt(X, Y));
      TableStaff.Post;
      TableStaffUnassigned.Refresh;
    end;
    if (Source = dbtvUnassigned) then
    begin
      dbtvUnassigned.SynchronizeCurrentRecordToSelectedNode;
      TableStaffUnassigned.Edit;
      TableStaffUnassignedDepartment.AsString :=
        dbtvDepartment.IDOfNode(dbtvDepartment.GetNodeAt(X, Y));
      TableStaffUnassigned.Post;
      TableStaff.Refresh;
    end;
  end;
end;

procedure TForm1.dbtvUnassignedDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := (Source = dbtvStaff);
end;

procedure TForm1.dbtvUnassignedDragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if (Source = dbtvStaff) then
  begin
    dbtvStaff.SynchronizeCurrentRecordToSelectedNode;
    TableStaff.Edit;
    TableStaffDepartment.AsString := '';
    TableStaff.Post;
    TableStaffUnassigned.Refresh;
  end;
end;

procedure TForm1.dbtvStaffDragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
begin
  Accept := (Source = dbtvUnassigned);
end;

procedure TForm1.dbtvStaffDragDrop(Sender, Source: TObject; X,
  Y: Integer);
begin
  if (Source = dbtvUnassigned) then
  begin
    dbtvUnassigned.SynchronizeCurrentRecordToSelectedNode;
    TableStaffUnassigned.Edit;
    TableStaffUnassignedDepartment.AsString :=
      TableDepartmentDepartmentID.AsString;
    TableStaffUnassigned.Post;
    TableStaff.Refresh;
  end;
end;

procedure TForm1.TableDepartmentBeforeDelete(DataSet: TDataSet);
begin
  DeletedDepartment := TableDepartmentDepartmentID.AsString;
end;

procedure TForm1.TableDepartmentAfterDelete(DataSet: TDataSet);
begin
  if (DeletedDepartment = '') then
    exit;
  TableStaffUnassigned.DisableControls;
  TableStaffUnassigned.Filter :=
    'Department = ''' + DeletedDepartment + '''';
  TableStaffUnassigned.Last;
  while not TableStaffUnassigned.BOF do
  begin
    TableStaffUnassigned.Edit;
    TableStaffUnassignedDepartment.AsString := '';
    TableStaffUnassigned.Post;
  end;
  TableStaffUnassigned.Filter := 'Department = ''''';
  TableStaffUnassigned.EnableControls;
  dbtvUnassigned.RebuildTree;
end;

end.