Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 19 - Project ToDoFile

Project Structure

ToDoFile.dpr
program ToDoFile;

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

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TToDoFileForm, ToDoFileForm);
  Application.Run;
end.
ToDoForm.pas
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.
ToDoForm.dfm
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