Как сделать калькулятор в Delphi?

Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.

Как Delphi реализует многоплатформенную разработку?

Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...

Записываем в Access используя ADO

Советы » Access » Записываем в Access используя ADO

// Читаем Access`овскую базу используя ADO 
// Проверяе являеться ли файл .mdb Access
// Записываем запись в базу 
// Нужны компаненты- 
//    TADOtable,TDataSource,TOpenDialog,TDBGrid, 
//    TBitBtn,TTimer,TEditTextBox 
program

ADOdemo; uses

Forms, uMain in

'uMain.pas' {frmMain}; {$R *.RES} begin

Application.Initialize; Application.CreateForm(TfrmMain, frmMain); Application.Run; end

. /////////////////////////////////////////////////////////////////// unit

uMain; interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Db, DBTables, ADODB, Grids, DBGrids, ExtCtrls, DBCtrls, StdCtrls, Buttons, ComObj; type

TfrmMain = class

(TForm) DBGridUsers: TDBGrid; BitBtnClose: TBitBtn; DSource1: TDataSource; EditTextBox: TEdit; BitBtnAdd: TBitBtn; TUsers: TADOTable; BitBtnRefresh: TBitBtn; Timer1: TTimer; Button1: TButton; procedure

FormCreate(Sender: TObject); procedure

ConnectToAccessDB(lDBPathName, lsDBPassword: string

); procedure

ConnectToMSAccessDB(lsDBName, lsDBPassword: string

); procedure

AddRecordToMSAccessDB; function

CheckIfAccessDB(lDBPathName: string

): Boolean; function

GetDBPath(lsDBName: string

): string

; procedure

BitBtnAddClick(Sender: TObject); procedure

BitBtnRefreshClick(Sender: TObject); procedure

Timer1Timer(Sender: TObject); function

GetADOVersion: Double; procedure

Button1Click(Sender: TObject); private

{ Private declarations } public

{ Public declarations } end

; var

frmMain: TfrmMain; Global_DBConnection_String: string

; const

ERRORMESSAGE_1 = 'No Database Selected'; ERRORMESSAGE_2 = 'Invalid Access Database'; implementation

{$R *.DFM} procedure

TfrmMain.FormCreate(Sender: TObject); begin

ConnectToMSAccessDB('ADODemo.MDB', '123'); // DBName,DBPassword end

; procedure

TfrmMain.ConnectToMSAccessDB(lsDBName, lsDBPassword: string

); var

lDBpathName: string

; begin

lDBpathName := GetDBPath(lsDBName); if

(Trim(lDBPathName) <> '') then

begin

if

CheckIfAccessDB(lDBPathName) then

ConnectToAccessDB(lDBPathName, lsDBPassword); end

else

MessageDlg(ERRORMESSAGE_1, mtInformation, [mbOK], 0); end

; function

TfrmMain.GetDBPath(lsDBName: string

): string

; var

lOpenDialog: TOpenDialog; begin

lOpenDialog := TOpenDialog.Create(nil

); if

FileExists(ExtractFileDir(Application.ExeName) + '' + lsDBName) then

Result := ExtractFileDir(Application.ExeName) + '' + lsDBName else

begin

lOpenDialog.Filter := 'MS Access DB|' + lsDBName; if

lOpenDialog.Execute then

Result := lOpenDialog.FileName; end

; end

; procedure

TfrmMain.ConnectToAccessDB(lDBPathName, lsDBPassword: string

); begin

Global_DBConnection_String := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' + lDBPathName + ';' + 'Persist Security Info=False;' + 'Jet OLEDB:Database Password=' + lsDBPassword; with

TUsers do

begin

ConnectionString := Global_DBConnection_String; TableName := 'Users'; Active := True

; end

; end

; // Check if it is a valid ACCESS DB File Before opening it. function

TfrmMain.CheckIfAccessDB(lDBPathName: string

): Boolean; var

UnTypedFile: file

of

Byte; Buffer: array

[0..19] of

Byte; NumRecsRead: Integer; i: Integer; MyString: string

; begin

AssignFile(UnTypedFile, lDBPathName); reset(UnTypedFile,1); BlockRead(UnTypedFile, Buffer, 19, NumRecsRead); CloseFile(UnTypedFile); for

i := 1 to

19 do

MyString := MyString + Trim(Chr(Ord(Buffer[i]))); Result := False

; if

Mystring = 'StandardJetDB' then

Result := True

; if

Result = False

then

MessageDlg(ERRORMESSAGE_2, mtInformation, [mbOK], 0); end

; procedure

TfrmMain.BitBtnAddClick(Sender: TObject); begin

AddRecordToMSAccessDB; end

; procedure

TfrmMain.AddRecordToMSAccessDB; var

lADOQuery: TADOQuery; lUniqueNumber: Integer; begin

if

Trim(EditTextBox.Text) <> '' then

begin

lADOQuery := TADOQuery.Create(nil

); with

lADOQuery do

begin

ConnectionString := Global_DBConnection_String; SQL.Text := 'SELECT Number from Users'; Open; Last; // Generate Unique Number (AutoNumber in Access) lUniqueNumber := 1 + StrToInt(FieldByName('Number').AsString); Close; // Insert Record into MSAccess DB using SQL SQL.Text := 'INSERT INTO Users Values (' + IntToStr(lUniqueNumber) + ',' + QuotedStr(UpperCase(EditTextBox.Text)) + ',' + QuotedStr(IntToStr(lUniqueNumber)) + ')'; ExecSQL; Close; // This Refreshes the Grid Automatically Timer1.Interval := 5000; Timer1.Enabled := True

; end

; end

; end

; procedure

TfrmMain.BitBtnRefreshClick(Sender: TObject); begin

Tusers.Active := False

; Tusers.Active := True

; end

; procedure

TfrmMain.Timer1Timer(Sender: TObject); begin

Tusers.Active := False

; Tusers.Active := True

; Timer1.Enabled := False

; end

; function

TfrmMain.GetADOVersion: Double; var

ADO: OLEVariant; begin

try

ADO := CreateOLEObject('adodb.connection'); Result := StrToFloat(ADO.Version); ADO := Null; except

Result := 0.0; end

; end

; procedure

TfrmMain.Button1Click(Sender: TObject); begin

ShowMessage(Format('ADO Version = %n', [GetADOVersion])); end

; end

.

Другое по теме:

Категории

Статьи

Советы

Copyright © 2024 - All Rights Reserved - www.delphirus.com