Home: Code Repository: Mastering Delphi 5

Project TODOFILE

Project Structure

TODOFILE.DPR
TODOFORM.PAS
TODOFORM.DFM

program ToDoFile;

uses
  Forms,
  ToDoForm in 'ToDoForm.pas' {ToDoFileForm};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TToDoFileForm, ToDoFileForm);
  Application.Run;
end.

unit ToDoForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, DBGrids, Db, DBTables, StdCtrls, DBCtrls, ExtCtrls;

type
  TToDoFileForm = class(TForm)
    Splitter1: TSplitter;
    Panel1: TPanel;
    DBNavigator1: TDBNavigator;
    DBMemo1: TDBMemo;
    Table1: TTable;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    procedure DropFiles (var Msg: TWmDropFiles);
      message wm_DropFiles;
    procedure CopyData (var Msg: TWmCopyData);
      message wm_CopyData;
  end;

var
  ToDoFileForm: TToDoFileForm;

implementation

{$R *.DFM}

uses
  ShellApi;

procedure TToDoFileForm.FormCreate(Sender: TObject);
begin
  // eventually create the table
  if not Table1.Exists then
    Table1.CreateTable;
  // activate the table
  Table1.Open;
  // accept dragging to the form
  DragAcceptFiles (Handle, True);
end;

procedure TToDoFileForm.DropFiles(var Msg: TWmDropFiles);
var
  nFiles, I: Integer;
  Filename: string;
begin
  // get the number of dropped files
  nFiles := DragQueryFile (Msg.Drop, $FFFFFFFF, nil, 0);
  // for each file
  try
    for I := 0 to nFiles - 1 do
    begin
      // allocate memory
      SetLength (Filename, 80);
      // read the file name
      DragQueryFile (Msg.Drop, I, PChar (Filename), 80);
      // normalize file
      Filename := PChar (Filename);
      // add a new record
      Table1.InsertRecord ([Filename, '']);
    end;
  finally
    DragFinish (Msg.Drop);
  end;
  // open the (last) record in edit mode
  Table1.Edit;
  // move the input focus to the memo
  DBMemo1.SetFocus;
end;

procedure TToDoFileForm.CopyData(var Msg: TWmCopyData);
var
  Filename: string;
begin
  // restore the window if minimized
  if IsIconic (Application.Handle) then
    Application.Restore;

  // extract the filename from the data
  Filename := PChar (Msg.CopyDataStruct.lpData);
  // insert a new record
  Table1.Insert;
  // set up the file name
  Table1.FieldByName ('Filename').AsString := Filename;
  // move the input focus to the memo
  DBMemo1.SetFocus;
end;

end.

object ToDoFileForm: TToDoFileForm
  Left = 122
  Top = 158
  Width = 607
  Height = 406
  Caption = 'Files To Do'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Splitter1: TSplitter
    Left = 225
    Top = 0
    Width = 4
    Height = 379
    Cursor = crHSplit
  end
  object Panel1: TPanel
    Left = 229
    Top = 0
    Width = 370
    Height = 379
    Align = alClient
    BevelOuter = bvNone
    TabOrder = 0
    object DBNavigator1: TDBNavigator
      Left = 0
      Top = 0
      Width = 370
      Height = 25
      DataSource = DataSource1
      VisibleButtons = [nbFirst, nbPrior, nbNext, nbLast, nbDelete, nbEdit, nbPost, nbCancel]
      Align = alTop
      TabOrder = 0
    end
    object DBMemo1: TDBMemo
      Left = 0
      Top = 25
      Width = 370
      Height = 354
      Align = alClient
      DataField = 'Notes'
      DataSource = DataSource1
      TabOrder = 1
    end
  end
  object DBGrid1: TDBGrid
    Left = 0
    Top = 0
    Width = 225
    Height = 379
    Align = alLeft
    DataSource = DataSource1
    Options = [dgTitles, dgColLines, dgRowLines, dgTabs, dgConfirmDelete, dgCancelOnExit]
    TabOrder = 1
    TitleFont.Charset = DEFAULT_CHARSET
    TitleFont.Color = clWindowText
    TitleFont.Height = -11
    TitleFont.Name = 'MS Sans Serif'
    TitleFont.Style = []
    Columns = <
      item
        Expanded = False
        FieldName = 'Filename'
        ReadOnly = True
        Visible = True
      end>
  end
  object Table1: TTable
    FieldDefs = <
      item
        Name = 'Filename'
        DataType = ftString
        Size = 80
      end
      item
        Name = 'Notes'
        DataType = ftMemo
        Size = 1
      end>
    StoreDefs = True
    TableName = 'todolist.db'
    TableType = ttParadox
    Left = 32
    Top = 88
  end
  object DataSource1: TDataSource
    DataSet = Table1
    Left = 32
    Top = 144
  end
end