Листинг программных модулей

unituCommon;

interface

uses DB, ADODB, DBGrids, Windows, SysUtils, ShellAPI, Forms, Variants, Dialogs;

procedureClearMemory (Obj : TObject);

procedureDataSetLocateKey (DS : TDataSet; KeyName : Variant; KeyValue : Variant);

procedureDataSetReload (DS : TDataSet);

proceduredbgTitleClick (Column: TColumn);

functionGetTempDir : WideString; stdcall;

functionExecuteFile(constFileName, Params, DefaultDir: string; ShowCmd: Integer): THandle;

implementation

procedureClearMemory (Obj : TObject);

begin

//

if (Obj<> nil) then Obj.Free;

end;

procedureDataSetLocateKey (DS : TDataSet; KeyName : Variant; KeyValue : Variant);

begin

//

if (DS.Locate(KeyName, KeyValue, []) = false) then

raiseException.Create('Не удалось найти строку с сохраненным значением ключа');

end;

procedureDataSetReload (DS : TDataSet);

var

//

KeyName, KeyValue : Variant;

I : Integer;

F :TField;

begin

//

KeyName := '';

KeyValue := NULL;

for I := 0 to DS.FieldCount - 1 do

begin

//

F :=DS.Fields.FieldByNumber (I);

if (F is TAutoIncField) then

begin

//

KeyName :=F.FieldName;

KeyValue :=F.Value;

end;

end;

DS.Close;

DS.Open;

if (KeyName<> '') then

begin

if (DS.Locate(KeyName, KeyValue, []) = false) then

raiseException.Create('Не удалось найти строку с сохраненным значением ключа');

end;

end;

proceduredbgTitleClick (Column: TColumn);

var

//

T :TADOTable;

SortType : String;

procedureClearAllTags ();

var

I : Integer;

C :TDBGridColumns;

begin

//

C := (Column.Grid as TDBGrid).Columns;

for I := 0 to C.Count - 1 do

begin

//

if (C[I].Field.FieldName<>Column.Field.FieldName) then

begin

//

C[I].Field.Tag := 0;

C[I].Title.Caption := C[I].Field.DisplayName;

end

else

begin

//

end;

end;

end;

begin

//

T :=Column.Field.DataSet as TADOTable;

Column.Field.Tag := Column.Field.Tag + 1;

ClearAllTags ();

if (Column.Field.Tag = 1) then

begin

SortType := ' ASC';

Column.Title.Caption := Column.Field.DisplayName + ' (повозр.)';

end;

if (Column.Field.Tag = 2) then

begin

SortType := ' DESC';

Column.Title.Caption := Column.Field.DisplayName + ' (поубыв.)';

end;

if (Column.Field.FieldKind = fkData) then

begin

T.Sort := Column.Field.FieldName + SortType;

end;

if (Column.Field.FieldKind = fkLookup) then

begin

T.Sort := Column.Field.KeyFields + SortType;

end;

if (Column.Field.Tag>= 2) then Column.Field.Tag := 0;

end;

functionGetTempDir : WideString; stdcall;

var

Buffer : array[0..1023] of Char;

begin

//

GetTempPath (1024 - 1, &Buffer);

SetString(Result, Buffer, Length(Buffer));

Result := Trim (Result);

end;

functionExecuteFile(constFileName, Params, DefaultDir: string; ShowCmd: Integer): THandle;

var

zFileName, zParams, zDir: array[0..79] of Char;

begin

Result :=ShellExecute(Application.MainForm.Handle, nil,

StrPCopy(zFileName, FileName), StrPCopy(zParams, Params),

StrPCopy(zDir, DefaultDir), ShowCmd);

end;

end.

unitufClientDoc;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Vcl.DBGrids,

Vcl.ExtCtrls, Vcl.DBCtrls, Vcl.DBActns, Vcl.ActnList,

Vcl.PlatformDefaultStyleActnCtrls, Vcl.ActnMan;

type

TfClientDoc = class(TForm)

Panel3: TPanel;

DBGrid9: TDBGrid;

bOk: TButton;

bShowDoc: TButton;

bSaveDoc: TButton;

Panel1: TPanel;

Label1: TLabel;

DBText1: TDBText;

bLoad: TButton;

bClear: TButton;

amClientDoc: TActionManager;

DataSetInsert1: TDataSetInsert;

DataSetDelete1: TDataSetDelete;

DataSetEdit1: TDataSetEdit;

DataSetPost1: TDataSetPost;

DataSetCancel1: TDataSetCancel;

Button1: TButton;

Button2: TButton;

Panel2: TPanel;

Panel4: TPanel;

procedureFormKeyPress(Sender: TObject; var Key: Char);

procedure DBGrid9TitleClick(Column: TColumn);

procedureFormActivate(Sender: TObject);

procedureFormCreate(Sender: TObject);

procedurebSaveDocClick(Sender: TObject);

procedurebShowDocClick(Sender: TObject);

procedurebLoadClick(Sender: TObject);

procedureFormClose(Sender: TObject; var Action: TCloseAction);

private

{ Private declarations }

FServiceID : Integer;

public

{ Public declarations }

propertyServiceID : Integer read FServiceID write FServiceID;

end;

var

fClientDoc: TfClientDoc;

implementation

{$R *.dfm}

usesufData, uCommon;

procedureTfClientDoc.bLoadClick(Sender: TObject);

begin

//

fData.tClientDoc.Insert;

if (LoadFBF (fData.tClientDocФайл, fData.tClientDocИмя_файла) = false) then

begin

//

fData.tClientDoc.Cancel;

end;

end;

procedureTfClientDoc.bSaveDocClick(Sender: TObject);

begin

//

SaveFBF (fData.tClientDocФайл, fData.tClientDocИмя_файла);

end;

procedureTfClientDoc.bShowDocClick(Sender: TObject);

begin

//

PreviewFBF (fData.tClientDocФайл, fData.tClientDocИмя_файла);

end;

procedure TfClientDoc.DBGrid9TitleClick(Column: TColumn);

begin

dbgTitleClick (Column);

end;

procedureTfClientDoc.FormActivate(Sender: TObject);

begin

//

bLoad.Enabled := not fData.tClientDoc.ReadOnly;

fData.tDocForService.Filter := 'Код_Услуга = ' + IntToStr (FServiceID);

fData.tDocForService.Filtered := true;

end;

procedureTfClientDoc.FormClose(Sender: TObject; var Action: TCloseAction);

begin

//

fData.tClientDoc.Cancel;

end;

procedureTfClientDoc.FormCreate(Sender: TObject);

begin

FServiceID := 0;

end;

procedureTfClientDoc.FormKeyPress(Sender: TObject; var Key: Char);

begin

if (Key = #27) then Close;

end;

end.

unitufDocEditor;

interface

uses

Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,

Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, DB, Vcl.DBCtrls, Vcl.Mask,

Vcl.PlatformDefaultStyleActnCtrls, Vcl.ActnList, Vcl.ActnMan;

type

TfDocEditor = class(TForm)

Button1: TButton;

Button2: TButton;

DBEdit1: TDBEdit;

DBMemo1: TDBMemo;

DBEdit2: TDBEdit;

odDocEditor: TOpenDialog;

sdDocEditor: TSaveDialog;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

cbFileLoaded: TCheckBox;

Button3: TButton;

Button4: TButton;

Button5: TButton;

amDocEditor: TActionManager;

aLoad: TAction;

aSave: TAction;

aClear: TAction;

aSetState: TAction;

Label4: TLabel;

DBEdit3: TDBEdit;

Button6: TButton;

aPreview: TAction;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedureFormClose(Sender: TObject; var Action: TCloseAction);

procedureaSetStateExecute(Sender: TObject);

procedureFormShow(Sender: TObject);

procedureaLoadExecute(Sender: TObject);

procedureaSaveExecute(Sender: TObject);

procedureFormKeyPress(Sender: TObject; var Key: Char);

procedureaClearExecute(Sender: TObject);

procedureaPreviewExecute(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

fDocEditor: TfDocEditor;

implementation

{$R *.dfm}

usesufData;

procedureTfDocEditor.aClearExecute(Sender: TObject);

begin

//

ClearFBF (fData.tDocОбразец, fData.tDocИмя_файла);

aSetState.Execute;

end;

procedureTfDocEditor.aLoadExecute(Sender: TObject);

begin

//

if (LoadFBF (fData.tDocОбразец, fData.tDocИмя_файла) = true) then

begin

//

aSetState.Execute;

end;

end;

procedureTfDocEditor.aPreviewExecute(Sender: TObject);

begin

//

PreviewFBF (fData.tDocОбразец, fData.tDocИмя_файла);

end;

procedureTfDocEditor.aSaveExecute(Sender: TObject);

begin

//

SaveFBF(fData.tDocОбразец, fData.tDocИмя_файла);

end;

procedureTfDocEditor.aSetStateExecute(Sender: TObject);

begin

//

cbFileLoaded.Checked := not fData.tDocОбразец.IsNull;

if (cbFileLoaded.Checked = false) then

begin

//

aLoad.Enabled := true;

aSave.Enabled := false;

aClear.Enabled := false;

aPreview.Enabled := false;

end

else

begin

//

aLoad.Enabled := false;

aSave.Enabled := true;

aClear.Enabled := true;

aPreview.Enabled := true;

end;

end;

procedure TfDocEditor.Button1Click(Sender: TObject);

begin

//

if (fData.tDoc.State = dsInsert) or

(fData.tDoc.State = dsEdit) then

begin

//

fData.tDoc.Post;

end;

Close;

end;

procedure TfDocEditor.Button2Click(Sender: TObject);

begin

Close;

end;

procedureTfDocEditor.FormClose(Sender: TObject; var Action: TCloseAction);

begin

//

fData.tDoc.Cancel;

end;

procedureTfDocEditor.FormKeyPress(Sender: TObject; var Key: Char);

begin

//

if (Key = #27) then Close;

end;

procedureTfDocEditor.FormShow(Sender: TObject);

begin