mainform.pas

Delphi Kylix Database Development 附书代码

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DBActns, StdActns, ActnList, ImgList, ActnCtrls, ToolWin,
  ActnMan, ActnMenus, ComCtrls, BandActn, ExtCtrls, Menus, Grids, DBGrids,
  DB, StdCtrls, DBCtrls, Mask, ExtDlgs;

type
  TfrmMain = class(TForm)
    StatusBar1: TStatusBar;
    ImageList1: TImageList;
    MainMenu1: TMainMenu;
    ActionList1: TActionList;
    FileExit1: TFileExit;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    EditSelectAll1: TEditSelectAll;
    EditUndo1: TEditUndo;
    EditDelete1: TEditDelete;
    DataSetFirst1: TDataSetFirst;
    DataSetPrior1: TDataSetPrior;
    DataSetNext1: TDataSetNext;
    DataSetLast1: TDataSetLast;
    DataSetInsert1: TDataSetInsert;
    DataSetDelete1: TDataSetDelete;
    DataSetEdit1: TDataSetEdit;
    DataSetPost1: TDataSetPost;
    DataSetCancel1: TDataSetCancel;
    DataSetRefresh1: TDataSetRefresh;
    File1: TMenuItem;
    Exit1: TMenuItem;
    Edit1: TMenuItem;
    Copy1: TMenuItem;
    Cut1: TMenuItem;
    Paste1: TMenuItem;
    SelectAll1: TMenuItem;
    Delete1: TMenuItem;
    Undo1: TMenuItem;
    N1: TMenuItem;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    pnlClient: TPanel;
    PageControl1: TPageControl;
    tabGrid: TTabSheet;
    tabForm: TTabSheet;
    gridContacts: TDBGrid;
    pnlTodos: TPanel;
    dsContacts: TDataSource;
    dsTodos: TDataSource;
    PageControl2: TPageControl;
    tabTodos: TTabSheet;
    tabNotes: TTabSheet;
    gridTodos: TDBGrid;
    memoNotes: TDBMemo;
    Dataset1: TMenuItem;
    First1: TMenuItem;
    Prior1: TMenuItem;
    Next1: TMenuItem;
    Last1: TMenuItem;
    N2: TMenuItem;
    Insert1: TMenuItem;
    Edit2: TMenuItem;
    Post1: TMenuItem;
    Delete2: TMenuItem;
    Cancel1: TMenuItem;
    N3: TMenuItem;
    Refresh1: TMenuItem;
    FileConnect1: TAction;
    ConnecttoDatabaseServer1: TMenuItem;
    N4: TMenuItem;
    DataSetNumUpdates: TAction;
    DataSetApplyUpdates: TAction;
    DataSetCancelUpdates: TAction;
    N5: TMenuItem;
    ApplyUpdates1: TMenuItem;
    CancelUpdates1: TMenuItem;
    popupTodos: TPopupMenu;
    Markdone1: TMenuItem;
    TodoMarkDone1: TAction;
    TodoAdd: TAction;
    AddTodo1: TMenuItem;
    N6: TMenuItem;
    btnLoadImage: TButton;
    btnClearImage: TButton;
    ImageLoad1: TAction;
    ImageClear1: TAction;
    OpenPictureDialog1: TOpenPictureDialog;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    ToolButton14: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    imgPhoto: TImage;
    TodoEdit: TAction;
    TodoDelete: TAction;
    EditTodo1: TMenuItem;
    PageControl3: TPageControl;
    tabClientGeneral: TTabSheet;
    tabClientAddress: TTabSheet;
    tabClientPhones: TTabSheet;
    Label1: TLabel;
    ecCompanyName: TDBEdit;
    Label2: TLabel;
    ecFirst: TDBEdit;
    Label3: TLabel;
    ecLast: TDBEdit;
    Label4: TLabel;
    ecDear: TDBEdit;
    Label5: TLabel;
    ecTitle: TDBEdit;
    Label6: TLabel;
    ecAddress1: TDBEdit;
    ecAddress2: TDBEdit;
    Label7: TLabel;
    Label8: TLabel;
    ecCity: TDBEdit;
    ecState: TDBEdit;
    Label9: TLabel;
    Label10: TLabel;
    ecPostalCode: TDBEdit;
    ecCountry: TDBEdit;
    Label11: TLabel;
    Label12: TLabel;
    ecPhone: TDBEdit;
    Label13: TLabel;
    ecFax: TDBEdit;
    ecCellular: TDBEdit;
    Label14: TLabel;
    Label15: TLabel;
    ecPager: TDBEdit;
    ecEmail: TDBEdit;
    Label16: TLabel;
    DeleteTodo1: TMenuItem;
    procedure FileConnect1Update(Sender: TObject);
    procedure FileConnect1Execute(Sender: TObject);
    procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
      Panel: TStatusPanel; const Rect: TRect);
    procedure DataSetNumUpdatesUpdate(Sender: TObject);
    procedure DataSetApplyUpdatesExecute(Sender: TObject);
    procedure DataSetCancelUpdatesExecute(Sender: TObject);
    procedure OnHaveUpdates(Sender: TObject);
    procedure TodoMarkDone1Execute(Sender: TObject);
    procedure TodoAddExecute(Sender: TObject);
    procedure TodoMarkDone1Update(Sender: TObject);
    procedure ImageLoad1Execute(Sender: TObject);
    procedure ImageClear1Execute(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure dsContactsDataChange(Sender: TObject; Field: TField);
    procedure FormCreate(Sender: TObject);
    procedure TodoEditExecute(Sender: TObject);
    procedure TodoEditUpdate(Sender: TObject);
    procedure TodoDeleteExecute(Sender: TObject);
  private
    procedure DoConnectDisconnect(Sender: TObject);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

uses DataModule, TodoForm;

resourcestring
  SConnect    = '&Connect to Database Server';
  SDisconnect = '&Disconnect from Database Server';

  SOneUpdate  = '1 update pending';
  SUpdates    = '%d updates pending';

  SOnline     = 'Online';
  SOffline    = 'Offline';

  SChangesPending = 'The current contact has been changed.  ' +
    'Do you want to save changes to this record?';

{$R *.dfm}

// Form event handlers

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  DM.SocketConnection1.AfterConnect := DoConnectDisconnect;
  DM.SocketConnection1.AfterDisconnect := DoConnectDisconnect;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if DM.cdsContacts.State <> dsBrowse then begin
    case MessageDlg(SChangesPending, mtWarning, [mbYes, mbNo, mbCancel], 0) of
      mrYes:    DM.cdsContacts.Post;
      mrNo:     DM.cdsContacts.Cancel;
      mrCancel: CanClose := False;
    end;
  end;
end;

procedure TfrmMain.DoConnectDisconnect(Sender: TObject);
begin
  // Repaint the status bar to reflect the new connection status
  StatusBar1.Invalidate;
end;

// Status bar event handlers

procedure TfrmMain.StatusBar1DrawPanel(StatusBar: TStatusBar;
  Panel: TStatusPanel; const Rect: TRect);
begin
  if Panel.Index = 0 then begin
    if DM.SocketConnection1.Connected then begin
      StatusBar.Canvas.Font.Color := clGreen;
      StatusBar.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 1, SOnline);
    end else begin
      StatusBar.Canvas.Font.Color := clRed;
      StatusBar.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 1, SOffline);
    end;
  end;
end;

// Database component event handlers

procedure TfrmMain.dsContactsDataChange(Sender: TObject; Field: TField);
var
  BlobStream: TStream;
begin
  if (Field = nil) or (Field = DM.cdsContactsIMAGE) then begin
    BlobStream := DM.cdsContacts.CreateBlobStream(DM.cdsContactsIMAGE, bmRead);
    try
      if BlobStream.Size = 0 then
        imgPhoto.Picture := nil
      else
        imgPhoto.Picture.Bitmap.LoadFromStream(BlobStream);
    finally
      BlobStream.Free;
    end;
  end;
end;

// Image controls

procedure TfrmMain.ImageLoad1Execute(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then begin
    DM.cdsContacts.Edit;
    DM.cdsContactsIMAGE.LoadFromFile(OpenPictureDialog1.FileName);
  end;
end;

procedure TfrmMain.ImageClear1Execute(Sender: TObject);
begin
  DM.cdsContacts.Edit;
  DM.cdsContactsIMAGE.Clear;
end;

// File menu

procedure TfrmMain.FileConnect1Execute(Sender: TObject);
begin
  DM.SocketConnection1.Connected := not DM.SocketConnection1.Connected;
end;

procedure TfrmMain.FileConnect1Update(Sender: TObject);
begin
  with Sender as TAction do begin
    if DM.SocketConnection1.Connected then
      Caption := SDisconnect
    else
      Caption := SConnect
  end;
end;

// Dataset menu

procedure TfrmMain.DataSetApplyUpdatesExecute(Sender: TObject);
begin
  if DM.cdsContacts.ApplyUpdates(0) = 0 then
    DM.cdsContacts.Refresh;
end;

procedure TfrmMain.DataSetCancelUpdatesExecute(Sender: TObject);
begin
  DM.cdsContacts.CancelUpdates;
end;

procedure TfrmMain.OnHaveUpdates(Sender: TObject);
begin
  (Sender as TAction).Enabled := (DM.cdsContacts.ChangeCount > 0);
end;

procedure TfrmMain.DataSetNumUpdatesUpdate(Sender: TObject);
begin
  if DM.cdsContacts.ChangeCount = 1 then
    StatusBar1.Panels[1].Text := SOneUpdate
  else
    StatusBar1.Panels[1].Text := Format(SUpdates,
      [DM.cdsContacts.ChangeCount]);
end;

// Todo popup menu

procedure TfrmMain.TodoAddExecute(Sender: TObject);
var
  frmTodo: TfrmTodo;
  DT: TDateTime;
begin
  frmTodo := TfrmTodo.Create(nil);
  try
    if frmTodo.ShowModal = mrOk then begin
      DM.cdsTodos.Append;
      DM.cdsTodosDescription.AsString := frmTodo.ecDescription.Text;
      DT := frmTodo.dtDate.Date;
      ReplaceTime(DT, frmTodo.dtTime.Time);
      DM.cdsTodosScheduled.AsDateTime := DT;
      DM.cdsTodos.Post;
    end;
  finally
    frmTodo.Free;
  end;
end;

procedure TfrmMain.TodoEditExecute(Sender: TObject);
var
  frmTodo: TfrmTodo;
  DT: TDateTime;
begin
  frmTodo := TfrmTodo.Create(nil);
  try
    frmTodo.ecDescription.Text := DM.cdsTodosDescription.AsString;
    frmTodo.dtDate.Date := DM.cdsTodosScheduled.AsDateTime;
    frmTodo.dtTime.Time := DM.cdsTodosScheduled.AsDateTime;
    if frmTodo.ShowModal = mrOk then begin
      DM.cdsTodos.Edit;
      DM.cdsTodosDescription.AsString := frmTodo.ecDescription.Text;
      DT := frmTodo.dtDate.Date;
      ReplaceTime(DT, frmTodo.dtTime.Time);
      DM.cdsTodosScheduled.AsDateTime := DT;
      DM.cdsTodos.Post;
    end;
  finally
    frmTodo.Free;
  end;
end;

procedure TfrmMain.TodoEditUpdate(Sender: TObject);
begin
  (Sender as TAction).Enabled := not DM.cdsTodos.IsEmpty;
end;

procedure TfrmMain.TodoDeleteExecute(Sender: TObject);
begin
  DM.cdsTodos.Delete;
end;

procedure TfrmMain.TodoMarkDone1Execute(Sender: TObject);
begin
  DM.cdsTodos.Edit;
  DM.cdsTodosCompleted.AsDateTime := Now;
  DM.cdsTodos.Post;
end;

procedure TfrmMain.TodoMarkDone1Update(Sender: TObject);
begin
  (Sender as TAction).Enabled := (not DM.cdsContacts.IsEmpty) and
    (not DM.cdsTodos.IsEmpty) and DM.cdsTodosCompleted.IsNull;
end;

end.