بخشی از مقاله

سیستم مکانیزه دبیرخانه

این برنامه یک دیتابیس ساده به زبان دلفی با کمک اکسس و دستورات 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;

در متن اصلی مقاله به هم ریختگی وجود ندارد. برای مطالعه بیشتر مقاله آن را خریداری کنید