بخشی از مقاله
سیستم مکانیزه دبیرخانه
این برنامه یک دیتابیس ساده به زبان دلفی با کمک اکسس و دستورات Sql می باشد برای این کار ابتدا به برنامه اکسس رفته و یک Tabel با نام Dabir ایجاد می کنیم که مانند عکس شامل فیلد های زیر می باشد
Nno : شماره نامه ای که قرار است ثبت شود 
Subject : موضوع نامه ای که قرار است ثبت شود
Date : تاریخی که در آن نامه ثبت شذه
Name : نام صاحب نامه 
File : آدرس فایلی که نامه ذخیره می شود 
جدول را ذخیره می کنیم و به دلفی می رویم :
New project را انتخاب می کنیم 
مطابق شکل ابزار زیر را در صفحه قرار می دهیم
کد این یونیت به صورت زیر می باشد
unit Unit1;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, Buttons, StdCtrls, Menus;
type
 TForm1 = class(TForm)
 Button1: TButton;
 GroupBox1: TGroupBox;
 Button3: TButton;
 Button4: TButton;
 GroupBox2: TGroupBox;
 Button6: TButton;
 Button2: TButton;
 Button5: TButton;
 Button7: TButton;
 Label1: TLabel;
 Label2: TLabel;
 Label3: TLabel;
 PopupMenu1: TPopupMenu;
 N1: TMenuItem;
 N2: TMenuItem;
 ColorDialog1: TColorDialog;
 FontDialog1: TFontDialog;
 Label4: TLabel;
 Label5: TLabel;
 procedure Button1Click(Sender: TObject);
 procedure Button3Click(Sender: TObject);
 procedure Button4Click(Sender: TObject);
 procedure Button5Click(Sender: TObject);
 procedure Button6Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 procedure N1Click(Sender: TObject);
 procedure N2Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form1: TForm1;
implementation
uses Unit2, Unit3, Unit5, editor, Unit7, Unit4;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
form1.Close;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Form2.show;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
form3.show;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
form5.show;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
mainform.show;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
form7.show;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
if fontdialog1.Execute then
begin
form1.Font:= fontdialog1.Font;
form2.Font:= fontdialog1.Font;
form3.Font:= fontdialog1.Font;
form4.Font:= fontdialog1.Font;
form5.Font:= fontdialog1.Font;
form7.Font:= fontdialog1.Font;
end;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
 if colordialog1.Execute then
begin
form1.Color := colordialog1.Color;
form2.Color := colordialog1.Color;
form3.Color := colordialog1.Color;
form4.Color := colordialog1.Color;
form5.Color := colordialog1.Color;
form7.Color := colordialog1.Color;
end;
end;
end.
حال به سراغ طراحی فرم های دیگر برنامه می رویم
مانند شکل یک تیبل و یک کوری و یک دیتا ست و یک کانکشن بر روی صقحه می گذاریم و تنظیمات آنها را به فایل مربوطه در اکسس مربوط می نماییم و سه دکمه و 4 label , و 4 Edit box نیز قرار می دهیم کد این فرم برای سه دکمه به صورت زیر است که کد مهم آن کد دکمه ذخیره می باشد.
unit Unit2;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, DB, ADODB, DBCtrls, Mask, StdCtrls, ComCtrls, ExtCtrls, ToolWin,
 DBTables;
type
 TForm2 = class(TForm)
 GroupBox1: TGroupBox;
 Edit1: TEdit;
 Edit2: TEdit;
 Label1: TLabel;
 Label2: TLabel;
 Label3: TLabel;
 MaskEdit1: TMaskEdit;
 Label4: TLabel;
 DataSource1: TDataSource;
 ADOConnection1: TADOConnection;
 dabir: TADOTable;
 RichEdit1: TRichEdit;
 Splitter1: TSplitter;
 Button1: TButton;
 Button2: TButton;
 Edit3: TEdit;
 aq: TADOQuery;
 Label5: TLabel;
 Button3: TButton;
 procedure Button1Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 procedure Button3Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form2: TForm2;
 ll:string;
 oo:boolean;
implementation
 uses editor;
{$R *.dfm}
procedure TForm2.Button1Click(Sender: TObject);
var
e1,e2,e3,e4:boolean;
begin
e1 := false;
e2 := false;
e3 := false;
e4 := false;
if edit1.Text = '' then e1:=true;
if edit2.Text = '' then e2:=true;
if edit3.Text = '' then e4:=true;
if maskedit1.Text = '1384/__/__' then e3:=true;
if e1 or e2 or e3 or e4 then
 showmessage('اطلاعات کامل نيست')
 else
 begin
 ll := 'c:\dabir_khane\nameha\'+ edit3.Text;
 aq.Active :=false;
 aq.SQL.Clear ;
 aq.SQL.Add ('select * from dabir where nno='''+edit3.Text+'''');
 aq.Active :=true;
 if aq.IsEmpty=true then
 begin
 dabir.Insert ;
 dabir.FieldByName ('name').asstring:=edit1.text;
 dabir.FieldByName ('subject').asstring:=edit2.text;
 dabir.FieldByName (
'date').asstring:=maskedit1.text;
 dabir.FieldByName ('nno').asstring:=edit3.text;
 dabir.FieldByName ('file').asstring:=ll;
 dabir.Post;
 showmessage('اطلاعات ثبت شد');
 richedit1.Lines.SaveToFile(ll);
 edit1.Text :='';
 edit2.Text :='';
 edit3.Text :='';
 maskedit1.Text :='';
 end
 else
 begin
 showmessage('اطلاعات تکراري است');
 edit1.Text :='';
 edit2.Text :='';
 edit3.Text :='';
 maskedit1.Text :='';
 end;
 end;
 end;
procedure TForm2.Button2Click(Sender: TObject);
begin
adoconnection1.Connected:=false;
form2.Close;
end;
procedure TForm2.Button3Click(Sender: TObject);
begin
if edit3.Text = '' then showmessage ('ابتدا شماره نامه را وارد کنيد') else
begin
oo:=true;
ll := 'c:\dabir_khane\nameha\'+ edit3.Text;
RichEdit1.lines.savetofile(ll);
mainform.show;
end;
 end;
end.
فرم بعدی فرم ویرایش نامه ها می باشد با شکل زیر
ابزار های مورد نیاز این فرم برای ساخت عبارتند از
یک db navigation یک dbgrid یک دیتا سورس یک کوری یک دیتا ست و یک Ado Tabel که نامه های را که تایپ شده اند را نشان می دهد و ویرایش می کند که لازم برای طراحی این فرم به صورت زیر است :
unit Unit3;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, DB, ADODB;
type
 TForm3 = class(TForm)
 ADOConnection1: TADOConnection;
 ADOTable1: TADOTable;
 DataSource1: TDataSource;
 DBGrid1: TDBGrid;
 DBNavigator1: TDBNavigator;
 ADODataSet1: TADODataSet;
 procedure DBGrid1CellClick(Column: TColumn);
 procedure FormCreate(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form3: TForm3;
 jj,ss:string;
implementation
uses Unit4;
{$R *.dfm}
procedure TForm3.DBGrid1CellClick(Column: TColumn);
begin
ss:=dbgrid1.SelectedField.AsString;
 with ADODataSet1 do begin
 CommandType := cmdText;
 CommandText := 'select * from dabir where nno='''+ss+'''';
 Open;
 end;
 if ADODataSet1.IsEmpty=true then
 begin
 showmessage ('براي ويرايش متن بر روي شماره نامه کليک کنيد');
 ADODataSet1.Refresh;
 ADODataSet1.Active:=false;
 end
 else if ADODataSet1.IsEmpty= false then
 begin
 jj:= adodataset1.Fields.Fields[4].AsString;
 ADODataSet1.Refresh;
 ADODataSet1.Active:=false;
 form4.show;
 end;
end;
این فرم جهت نوشتن متن ایجاد شده که قابل اتصال به ویرایشگر هم هست برای ایجاد این صفحه از یک Rich edit و دو دکمه استفاده شده که کد این دو دکمه به صورت زیر است :
unit Unit4;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, ComCtrls,unit3;
type
 TForm4 = class(TForm)
 RichEdit1: TRichEdit;
 Button1: TButton;
 Button2: TButton;
 procedure FormActivate(Sender: TObject);
 procedure Button1Click(Sender: TObject);
 procedure Button2Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form4: TForm4;
 b:boolean;
implementation
 uses Unit2, editor;
{$R *.dfm}
procedure TForm4.FormActivate(Sender: TObject);
begin
richedit1.Lines.LoadFromFile(jj);
end;
procedure TForm4.Button1Click(Sender: TObject);
begin
b:=true;
mainForm.show;
end;
procedure TForm4.Button2Click(Sender: TObject);
begin
richedit1.Lines.SaveToFile(jj);
end;
end.
فرم بعدی فرمی است که جهت حذف یک ن
امه می باشد .
جهت ایجاد این فرم از دو دکمه و یک Edit Box یک یک Ado Data Set استفاده می نماییم .
کد ایجاد این فرم به صورت زیر می باشد .
unit Unit5;
interface
uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, DB, ADODB, StdCtrls;
type
 TForm5 = class(TForm)
 GroupBox1: TGroupBox;
 Edit1: TEdit;
 Button1: TButton;
 Button2: TButton;
 ADODataSet1: TADODataSet;
 procedure Button2Click(Sender: TObject);
 procedure Button1Click(Sender: TObject);
 private
 { Private declarations }
 public
 { Public declarations }
 end;
var
 Form5: TForm5;
 ss:string;
implementation
{$R *.dfm}
procedure TForm5.Button2Click(Sender: TObject);
begin
form5.close;
end;
procedure TForm5.Button1Click(Sender: TObject);
begin
if edit1.Text <> '' then
 begin
ss:=edit1.Text;
 with ADODataSet1 do begin
 CommandType := cmdText;
 CommandText := 'select * from dabir where nno = '''+ss+'''';
 Open;
 end;
 if ADODataSet1.IsEmpty then
 begin
 showmessage ('چنين نامه اي موجود نيست ');
 ADODataSet1.Refresh;
 ADODataSet1.Active:=false;
 end
 else if ADODataSet1.IsEmpty= false then
 begin
 ADODataSet1.Delete;
 ADODataSet1.Refresh;
 ADODataSet1.Active:=false;
 showmessage ('نامه يا پرونده موجود حذف شد') ;
 ADODataSet1.OPEN;
 end;
end;
 end;
end.
فرم هفتم یک فرم ساده با چهار Label است که توضیحات می باشد و فرم آخر هم یک ویرایش گر متن می باشد که برای طراحی آن از Help و 
Sampel های Delphi 7 استفاده شده است که شکل آن بدین صورت است
و کد این ویرایش گر زیبا با تغییرات به صورت زیر می باشد . 
unit editor;
interface
uses
 SysUtils, Windows, Messages, Classes, Graphics, Controls,
 Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, ComCtrls, ClipBrd,
 ToolWin, ActnList, ImgList,unit4,unit3,unit2;
type
 TMainForm = class(TForm)
 OpenDialog: TOpenDialog;
 SaveDialog: TSaveDialog;
 PrintDialog: TPrintDialog;
 Ruler: TPanel;
 FontDialog1: TFontDialog;
 FirstInd: TLabel;
 LeftInd: TLabel;
 RulerLine: TBevel;
 RightInd: TLabel;
 Editor: TRichEdit;
 StatusBar: TStatusBar;
 StandardToolBar: TToolBar;
 OpenButton: TToolButton;
 SaveButton: TToolButton;
 PrintButton: TToolButton;
 ToolButton5: TToolButton;
 UndoButton: TToolButton;
 CutButton: TToolButton;
 CopyButton: TToolButton;
 PasteButton: TToolButton;
 ToolButton10: TToolButton;
 FontName: TComboBox;
 FontSize: TEdit;
 ToolButton11: TToolButton;
 UpDown1: TUpDown;
 BoldButton: TToolButton;
 ItalicButton: TToolButton;
 UnderlineButton: TToolButton;
 ToolButton16: TToolButton;
 LeftAlign: TToolButton;
 CenterAlign: TToolButton;
 RightAlign: TToolButton;
 ToolButton20: TToolButton;
 BulletsButton: TToolButton;
 ToolbarImages: TImageList;
 ActionList1: TActionList;
 FileNewCmd: TAction;
 FileOpenCmd: TAction;
 FileSaveCmd: TAction;
 FilePrintCmd: TAction;
 FileExitCmd: TAction;
 ToolButton1: TToolButton;
 ToolButton2: TToolButton;
 Bevel1: TBevel;
 EditCutCmd: TAction;
 EditCopyCmd: TAction;
 EditPasteCmd: TAction;
 EditUndoCmd: TAction;
 EditFontCmd: TAction;
 FileSaveAsCmd: TAction;
procedure SelectionChange(Sender: TObject);
 pro
cedure FormCreate(Sender: TObject);
 procedure ShowHint(Sender: TObject);
 procedure FileNew(Sender: TObject);
 procedure FileOpen(Sender: TObject);
 procedure FileSave(Sender: TObject);
 procedure FileSaveAs(Sender: TObject);
 procedure FilePrint(Sender: TObject);
 procedure FileExit(Sender: TObject);
 procedure EditUndo(Sender: TObject);
 procedure EditCut(Sender: TObject);
 procedure EditCopy(Sender: TObject);
 procedure EditPaste(Sender: TObject);
procedure SelectFont(Sender: TObject);
 procedure RulerResize(Sender: TObject);
 procedure FormResize(Sender: TObject);
 procedure FormPaint(Sender: TObject);
 procedure BoldButtonClick(Sender: TObject);
 procedure ItalicButtonClick(Sender: TObject);
 procedure FontSizeChange(Sender: TObject);
 procedure AlignButtonClick(Sender: TObject);
 procedure FontNameChange(Sender: TObject);
 procedure UnderlineButtonClick(Sender: TObject);
 procedure BulletsButtonClick(Sender: TObject);
 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
 procedure RulerItemMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 procedure RulerItemMouseMove(Sender: TObject; Shift: TShiftState; X,
 Y: Integer);
 procedure FirstIndMouseUp(Sende
r: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 procedure LeftIndMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 procedure RightIndMouseUp(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
 procedure FormShow(Sender: TObject);
 procedure RichEditChange(Sender: TObject);
 procedure SwitchLanguage(Sender: TObject);
 procedure ActionList2Update(Action: TBasicAction;
 var Handled: Boolean);
 procedure FormActivate(Sender: TObject);
 private
 FFileName: string;
 FUpdating: Boolean;
 FDragOfs: Integer;
 FDragging: Boolean;
 function CurrText: TTextAttributes;
 procedure GetFontNames;
 procedure SetFileName(const FileName: String);
 procedure CheckFileSave;
 procedure SetupRuler;
 procedure SetEditRect;
 procedure UpdateCursorPos;
 procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
 procedure PerformFileOpen(const AFileName: string);
 procedure SetModified(Value: Boolean);
 end;
var
 MainForm: TMainForm;
implementation
uses RichEdit, ShellAPI, ReInit ;
resourcestring
 sSaveChanges = 'Save changes to %s?';
 sOverWrite = 'OK to overwrite %s';
 sUntitled = 'Untitled';
 sModified = 'Modified';
 sColRowInfo = 'Line: %3d Col: %3d';
 RulerAdj = 4/3;
 GutterWid = 6;
ENGLISH = (SUBLANG_ENGLISH_US shl 10) or LANG_ENGLISH;
 FRENCH = (SUBLANG_FRENCH shl 10) or LANG_FRENCH;
 GERMAN = (SUBLANG_GERMAN shl 10) or LANG_GERMAN;
{$R *.dfm}
procedure TMainForm.SelectionChange(Sender: TObject);
begin
 with Editor.Paragraph do
 try
 FUpdating := True;
 FirstInd.Left := Trunc(FirstIndent*RulerAdj)-4+GutterWid;
 LeftInd.Left := Trunc((LeftIndent+FirstIndent)*RulerAdj)-4+GutterWid;
 RightInd.Left := Ruler.ClientWidth-6-Trunc((RightIndent+GutterWid)*RulerAdj);
 BoldButton.Down := fsBold in Editor.SelAttributes.Style;
 ItalicButton.Down := fsItalic in Editor.SelAttributes.Style;
 UnderlineButton.Down := fsUnderline in Editor.SelAttributes.Style;
 BulletsButton.Down := Boolean(Numbering);
 FontSize.Text := IntToStr(Editor.SelAttributes.Size);
 FontName.Text := Editor.SelAttributes.Name;
 case Ord(Alignment) of
 0: LeftAlign.Down := True;
 1: RightAlign.Down := True;
 2: CenterAlign.Down := True;
 end;
 UpdateCursorPos;
 finally
 FUpdating := False;
 end;
end;
function TMainForm.CurrText: TTextAttributes;
begin
 if Editor.SelLength > 0 then Result := Editor.SelAttributes
 else Result := Editor.DefAttributes;
end;
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
 FontType: Integer; Data: Pointer): Integer; stdcall;
begin
 TStrings(Data).Add(LogFont.lfFaceName);
 Result := 1;
end;
procedure TMainForm.GetFontNames;
var
 DC: HDC;
begin
 DC := GetDC(0);
 EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
 ReleaseDC(0, DC);
 FontName.Sorted := True;
end;
procedure TMainForm.SetFileName(const FileName: String);
begin
 FFileName := FileName;
 Caption := Format('%s - %s', [ExtractFileName(FileName), Application.Title]);
end;
procedure TMainForm.CheckFileSave;
var
 SaveResp: Integer;
begin
 if not Editor.Modified then Exit;
 SaveResp := MessageDlg(Format(sSaveChanges, [FFileName]),
 mtConfirmation, mbYesNoCancel, 0);
 case SaveResp of
 idYes: FileSave(Self);
 idNo: {Nothing};
 idCancel: Abort;
 end;
end;
procedure TMainForm.SetupRuler;
var
 I: Integer;
 S: String;
begin
 SetLength(S, 201);
 I := 1;
 while I < 200 do
 begin
 S[I] := #9;
 S[I+1] := '|';
 Inc(I, 2);
 end;
 Ruler.Caption := S;
end;
procedure TMainForm.SetEditRect;
var
 R: TRect;
begin
 with Editor do
 begin
 R := Rect(GutterWid, 0, ClientWidth-GutterWid, ClientHeight);
 SendMessage(Handle, EM_SETRECT, 0, Longint(@R));
 end;
end;
{ Event Handlers }
procedure TMainForm.FormCreate(Sender: TObject);
begin
 Application.OnHint := ShowHint;
 OpenDialog.Ini
tialDir := ExtractFilePath(ParamStr(0));
 SaveDialog.InitialDir := OpenDialog.InitialDir;
 SetFileName(sUntitled);
 GetFontNames;
 SetupRuler;
 SelectionChange(Self);
CurrText.Name := DefFontData.Name;
 CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch);
end;
procedure TMainForm.ShowHint(Sender: TObject);
begin
 if Length(Application.Hint) > 0 then
 begin
 StatusBar.SimplePanel := True;
 StatusBar.SimpleText := Application.Hint;
 end
 else StatusBar.SimplePanel := False;
end;
procedure TMainForm.FileNew(Sender: TObject);
begin
 SetFileName(sUntitled);
 Editor.Lines.Clear;
 Editor.Modified := False;
 SetModified(False);
end;
procedure TMainForm.PerformFileOpen(const AFileName: string);
begin
 Editor.Lines.LoadFromFile(AFileName);
 SetFileName(AFileName);
 Editor.SetFocus;
 Editor.Modified := False;
 SetModified(False);
end;
procedure TMainForm.FileOpen(Sender: TObject);
begin
 CheckFileSave;
 if OpenDialog.Execute then
 begin
 PerformFileOpen(OpenDialog.FileName);
 Editor.ReadOnly := ofReadOnly in OpenDialog.Options;
 end;
end;
procedure TMainForm.FileSave(Sender: TObject);
begin
 if FFileName = sUntitled then
 FileSaveAs(Sender)
 else
 begin
 Editor.Lines.SaveToFile(FFileName);
 Editor.Modified := False;
 SetModified(False);
 end;
end;
procedure TMainForm.FileSaveAs(Sender: TObject);
begin
 if SaveDialog.Execute then
 begin
 if FileExists(SaveDialog.FileName) then
 if MessageDlg(Format(sOverWrite, [SaveDialog.FileName]),
 mtConfirmation, mbYesNoCancel, 0) <> idYes then Exit;
 Editor.Lines.Sa
veToFile(SaveDialog.FileName);
 SetFileName(SaveDialog.FileName);
 Editor.Modified := False;
 SetModified(False);
 end;
end;
procedure TMainForm.FilePrint(Sender: TObject);
begin
 if PrintDialog.Execute then
 Editor.Print(FFileName);
end;
procedure TMainForm.FileExit(Sender: TObject);
begin
 Close;
end;
procedure TMainForm.EditUndo(Sender: TObject);
begin
 with Editor do
 if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
end;
procedure TMainForm.EditCut(Sender: TObject);
begin
 Editor.CutToClipboard;
end;
procedure TMainForm.EditCopy(Sender: TObject);
begin
 Editor.CopyToClipboard;
end;











