unit AOSU interface uses Winapi Windows Winapi Messages System SysUtil

Anonymous
Text only
23 Apr 2014
unit AOSU;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,
  //
  DBGridEhGrouping, ToolCtrlsEh, DBGridEhToolCtrls, DynVarsEh, GridsEh,
  DBAxisGridsEh, DBGridEh, DBVertGridsEh, EhLibADO, DBGridEhImpExp,
  //
  ShellApi, Vcl.ExtCtrls, sPanel, Vcl.Menus, Vcl.Buttons, sSkinProvider,
  sSkinManager, sSpeedButton, sLabel, Vcl.StdCtrls, sDBText, cxGraphics,
  cxControls, cxLookAndFeels, cxLookAndFeelPainters, cxContainer, cxEdit,
  Vcl.DBCtrls, sDBMemo, acTitleBar, acSlider;

type
  TAOS = class(TForm)
    Menu: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    P1: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    Skin: TsSkinManager;
    NewEdit: TsSpeedButton;
    Delete: TsSpeedButton;
    Edit: TsSpeedButton;
    sSpeedButton1: TsSpeedButton;
    GRID: TDBGridEh;
    Find: TsSpeedButton;
    sSpeedButton3: TsSpeedButton;
    sPanel1: TsPanel;
    VGrid: TDBVertGridEh;
    N9: TMenuItem;
    N10: TMenuItem;
    H1: TMenuItem;
    sSpeedButton2: TsSpeedButton;
    PrintQR: TsSpeedButton;
    spdbtn2: TsSpeedButton;
    Y1: TMenuItem;
    procedure NewEditClick(Sender: TObject);
    procedure EditClick(Sender: TObject);
    procedure DeleteClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure sSpeedButton1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N7Click(Sender: TObject);
    procedure P1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure H1Click(Sender: TObject);
    procedure FindClick(Sender: TObject);
    procedure sSpeedButton3Click(Sender: TObject);
    procedure spdbtn2Click(Sender: TObject);
    procedure GRIDSelectionChanged(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure PrintQRClick(Sender: TObject);
    procedure Y1Click(Sender: TObject);
  private
    mS: TMemoryStream;

    { Private declarations }
  public
    { Public declarations }
  end;

var
  AOS: TAOS;
  NewBit: Boolean; // бит нового документа
  BDString: string;
implementation

{$R *.dfm}

uses DMU, NEditU, SEditU, SedU, About, QuricolCode, QuricolAPI;

// Подсчет выделенных элементов и страниц...
procedure select;
var
  sumselrow, Page: Integer;
begin
  sumselrow := AOS.GRID.SelectedRows.Count;
  AOS.GRID.Columns[1].Footer.Value := ('Выделено:' + IntToStr(sumselrow));
  Page := (sumselrow + 23) div 24;
  AOS.GRID.Columns[2].Footer.Value := 'Страниц на печать:' + IntToStr(Page);
end;

procedure TAOS.FormActivate(Sender: TObject);
begin
  select
end;

procedure TAOS.GRIDSelectionChanged(Sender: TObject);
begin
  select
end;

// Визуализация/Скрытие колонок
procedure ColVisible(a: Boolean);
begin
  if a = True then
    AOS.GRID.StartLoadingStatus('Пожалуйста подождите...', -1)
  else
    AOS.GRID.FinishLoadingStatus;
  AOS.GRID.Columns[0].Visible := a;
  AOS.GRID.Columns[8].Visible := a;
  AOS.GRID.Columns[9].Visible := a;
end;

procedure TAOS.spdbtn2Click(Sender: TObject);
begin
  ColVisible(True);
  DM.PGrid.Preview;
  ColVisible(False)
end;

// Удаление элементов БД
procedure TAOS.DeleteClick(Sender: TObject);
begin
  if GRID.SelectedRows.CurrentRowSelected = False then
    MessageBox(Handle, PChar('Не выбранно ни одной строки'),
      PChar('Информация'), MB_ICONINFORMATION + MB_OK)
  else if Application.MessageBox
    (PChar('Вы действительно хотите удалить выделенные строки ?'),
    'Внимание!!!', MB_OKCANCEL + MB_ICONWARNING) = id_OK then
    GRID.SelectedRows.Delete;
end;

// Выбор действий при закрытии программы
procedure TAOS.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  if DM.AOST.HasCachedChanges then
    case Application.MessageBox('Сохранить изменения перед выходом ?',
      'Предупреждение', MB_YESNOCANCEL + MB_ICONWARNING) of
      IDYes:
        begin
          DM.AOST.ApplyUpdates(0);
          CanClose := True;
        end;
      IDNo:
        CanClose := True;
      IDCancel:
        CanClose := False;
    end;
end;

procedure TAOS.N2Click(Sender: TObject);
begin
  Close;
end;

// ---- Перходы на форму редактирования списков
procedure TAOS.N4Click(Sender: TObject);
begin
  Vkl := 2;
  SEd.ShowModal;
end;

procedure TAOS.N5Click(Sender: TObject);
begin
  Vkl := 1;
  SEd.ShowModal;
end;

procedure TAOS.N6Click(Sender: TObject);
begin
  Vkl := 0;
  SEd.ShowModal;
end;

procedure TAOS.N7Click(Sender: TObject);
begin
  Vkl := 3;
  SEd.ShowModal;
end;

procedure TAOS.sSpeedButton1Click(Sender: TObject);
begin
  Vkl := 0;
  SEd.ShowModal;
end;

// ---- Перходы на форму About
procedure TAOS.N8Click(Sender: TObject);
begin
  About.ShowAboutForm;
end;

// ----  Новая запись и редактирование
procedure TAOS.NewEditClick(Sender: TObject);
begin
  NEdit.Caption := 'Новая Запись';
  NewBit := True;
  DM.AOST.Insert;
  NEdit.ShowModal;
end;

procedure TAOS.EditClick(Sender: TObject);
begin
  NEdit.Caption := 'Редактирование записи';
  NewBit := False;
  DM.AOST.Edit;
  NEdit.ShowModal;
end;

// ----  Открытие БД
procedure TAOS.P1Click(Sender: TObject);
begin
  GRID.StartLoadingStatus('Загрузка БД...', -1);
  if DM.OpenDB.Execute then
    With DM.CON do
    begin
      Close;
      ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;' + 'Data Source=' +
        DM.OpenDB.FileName + ';Persist Security Info=false';
      Open;
    end;
  DM.AOST.Active := True;
  DM.ITT.Active := True;
  DM.CabT.Active := True;
  DM.OST.Active := True;
  DM.SotrT.Active := True;
  DM.DevT.Active := True;
  DM.DSD.KeyFields := 'Код';
  DM.AOST.Refresh;
  GRID.FinishLoadingStatus;
end;

// Сохранение элементов БД...
procedure TAOS.sSpeedButton3Click(Sender: TObject);
begin
  DM.AOST.ApplyUpdates(0)
end;

// Организация функции поиска и фильрации элементов
procedure TAOS.FindClick(Sender: TObject);
begin
  if GRID.STFilter.Visible = False then
  begin
    GRID.STFilter.Visible := True;
    Find.ImageIndex := 3;
  end
  else
  begin
    GRID.STFilter.Visible := False;
    Find.ImageIndex := 4;
  end;
end;

end.





unit DMU;

interface

uses
  System.SysUtils, System.Classes, EhLibMTE, MemTableDataEh, Data.DB,
  MemTableEh, DataDriverEh, Data.Win.ADODB, MemDS, VirtualTable, Vcl.ImgList,
  Vcl.Controls,   acAlphaImageList, Vcl.Menus, Vcl.Dialogs, sDialogs,
  ToolCtrlsEh, DBGridEhToolCtrls, ADODataDriverEh, DynVarsEh, sSkinManager,
  PrnDbgeh, frxClass, frxDBSet, frxExportPDF,  ADODB2010, comobj, ADOX_TLB;

type
  TDM = class(TDataModule)
    VPT: TVirtualTable;
    VPS: TDataSource;
    AOSS: TDataSource;
    CabS: TDataSource;
    OSS: TDataSource;
    SotrS: TDataSource;
    DevS: TDataSource;
    CON: TADOConnection;
    ITT: TADOTable;
    CabT: TADOTable;
    OST: TADOTable;
    SotrT: TADOTable;
    DevT: TADOTable;
    DSD: TDataSetDriverEh;
    AOST: TMemTableEh;
    AOSTКод: TAutoIncField;
    AOSTCOD: TIntegerField;
    AOSTИНВ: TIntegerField;
    AOSTУстройство: TIntegerField;
    AOSTКабинет: TIntegerField;
    AOSTОС: TIntegerField;
    AOSTСотрудник: TIntegerField;
    AOSTДатаучета: TDateTimeField;
    AOSTUpgrade: TDateTimeField;
    AOSTSN: TWideStringField;
    AOSTКонфигурация: TWideMemoField;
    AOSTDev: TStringField;
    AOSTCab: TStringField;
    AOSTOS: TStringField;
    AOSTSotr: TStringField;
    VPTКод: TAutoIncField;
    VPTKabinet: TWideStringField;
    VPTINB: TWideStringField;
    VPTName: TWideStringField;
    VPTQRCOD: TBlobField;
    MImage: TsAlphaImageList;
    ITTКод: TAutoIncField;
    ITTCOD: TIntegerField;
    ITTИНВ: TIntegerField;
    ITTУстройство: TIntegerField;
    ITTКабинет: TIntegerField;
    ITTОС: TIntegerField;
    ITTСотрудник: TIntegerField;
    ITTДатаучета: TDateTimeField;
    ITTUpgrade: TDateTimeField;
    ITTSN: TWideStringField;
    ITTКонфигурация: TWideMemoField;
    CabTКод: TAutoIncField;
    CabTКабинет: TWideStringField;
    OSTКод: TAutoIncField;
    OSTОС: TWideStringField;
    SotrTКод: TAutoIncField;
    SotrTСотрудник: TWideStringField;
    DevTКод: TAutoIncField;
    DevTУстройство: TWideStringField;
    OpenDB: TsOpenDialog;
    sSkinManager1: TsSkinManager;
    SFile: TsSaveDialog;
    AImage: TsAlphaImageList;
    PGrid: TPrintDBGridEh;
    QRDS: TfrxDBDataset;
    QRPrint: TfrxReport;
    frxPDFExport1: TfrxPDFExport;
    SQL: TADODataDriverEh;
    Query: TADOQuery;
    procedure DataModuleCreate(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DM: TDM;
   procedure NewDB(FileName : String);
   procedure Connect;
implementation

uses AOSU;

{ %CLASSGROUP 'Vcl.Controls.TControl' }

{$R *.dfm}

procedure NewDB(FileName : String);

begin
   //
end;

procedure Connect;
var
  FilePath: String;
begin
  AOS.GRID.StartLoadingStatus('Загрузка БД...', -1);
  if FileExists(ExtractFilePath(ParamStr(0))+ GetCurrentDir + '\db.mdb') then
    FilePath := ExtractFilePath(ParamStr(0))+ GetCurrentDir + '\db.mdb'
  else if FileExists(ExtractFilePath(ParamStr(0)) + GetCurrentDir +  '\DB\db.mdb') then
    FilePath := ExtractFilePath(ParamStr(0))+ GetCurrentDir  + '\DB\db.mdb'
  else if FileExists(ExtractFilePath(ParamStr(0))+ '..\..\DB\db.mdb') then
    FilePath := ExtractFilePath(ParamStr(0)) + '..\..\DB\db.mdb'
  else if FileExists(ExtractFilePath(ParamStr(0)) + '..\..\..\DB\db.mdb') then
    FilePath := ExtractFilePath(ParamStr(0)) + '..\..\..\DB\db.mdb'
  else if DM.OpenDB.Execute then
    FilePath := DM.OpenDB.FileName else exit;

  DM.CON.ConnectionString := ('Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;'
    + 'Data Source=' + FilePath + ';' +
    'Mode=Share Deny None;Jet OLEDB:System database="";');
  AOS.Caption := 'Инвентаризация оборудования';
  DM.AOST.Active := True;
  DM.ITT.Active := True;
  DM.CabT.Active := True;
  DM.OST.Active := True;
  DM.SotrT.Active := True;
  DM.DevT.Active := True;
  DM.DSD.KeyFields:='Код';
  DM.AOST.Refresh;
  AOS.GRID.FinishLoadingStatus;
  AOS.Show;
end;

procedure TDM.DataModuleCreate(Sender: TObject);
begin
  CON.Connected:=False;
 Connect;
  CON.Connected:=True;
end;

end.




unit NEditU;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxControls, cxLookAndFeels,
  cxLookAndFeelPainters, cxContainer, cxEdit, cxDBLookupEdit,
  cxDBLookupComboBox, cxDBEdit, cxTextEdit, cxMaskEdit,
  Vcl.StdCtrls, Vcl.Mask, Vcl.DBCtrls, sDBEdit, sDBLookupComboBox, sMaskEdit,
  sCustomComboEdit, sToolEdit, sDBDateEdit, sDBMemo, Vcl.Buttons, sSpeedButton;

type
  TNEdit = class(TForm)
    CodEdit: TsDBEdit;
    InvEdit: TsDBEdit;
    SNEdit: TsDBEdit;
    sDBMemo1: TsDBMemo;
    DevLookup: TsDBLookupComboBox;
    CabLookup: TsDBLookupComboBox;
    SotrLookup: TsDBLookupComboBox;
    OSLookup: TsDBLookupComboBox;
    DateEdit: TsDBDateEdit;
    sDBDateEdit1: TsDBDateEdit;
    Edit: TsSpeedButton;
    procedure EditClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  NEdit: TNEdit;
procedure colorR;

implementation

{$R *.dfm}

uses DMU, AOSU;

procedure colorR;
begin
  NEdit.SotrLookup.BoundLabel.Font.Color := $004D352B;
  NEdit.InvEdit.BoundLabel.Font.Color := $004D352B;
  NEdit.DateEdit.BoundLabel.Font.Color := $004D352B;
  NEdit.CabLookup.BoundLabel.Font.Color := $004D352B;
  NEdit.DevLookup.BoundLabel.Font.Color := $004D352B;
end;

procedure TNEdit.EditClick(Sender: TObject);
begin
  colorR;
  if InvEdit.Text = '' then
    InvEdit.BoundLabel.Font.Color := clRed
  else if VarIsNull(DevLookup.KeyValue) = true then
    DevLookup.BoundLabel.Font.Color := clRed
  else if VarIsNull(SotrLookup.KeyValue) = true then
    SotrLookup.BoundLabel.Font.Color := clRed
  else if VarIsNull(CabLookup.KeyValue) = true then
    CabLookup.BoundLabel.Font.Color := clRed
  else if DateEdit.Date = 0 then
    DateEdit.BoundLabel.Font.Color := clRed
  else
  begin
    DM.AOST.Post;
    NewBit := False;
    Close;
  end;
end;

procedure TNEdit.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  colorR;
  if NewBit = true then
    DM.AOST.Delete;
end;

end.



unit SedU;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, DBGridEhGrouping, ToolCtrlsEh,
  DBGridEhToolCtrls, DynVarsEh, Vcl.Buttons, sSpeedButton, GridsEh,
  DBAxisGridsEh, DBGridEh, Vcl.StdCtrls, sBitBtn;

type
  TSEd = class(TForm)
    BtSotr: TsBitBtn;
    BtCab: TsBitBtn;
    BtDev: TsBitBtn;
    BtOS: TsBitBtn;
    SGrid: TDBGridEh;
    SIns: TsSpeedButton;
    Sdel: TsSpeedButton;
    SOk: TsSpeedButton;
    procedure FormActivate(Sender: TObject);
    procedure BtSotrClick(Sender: TObject);
    procedure BtCabClick(Sender: TObject);
    procedure BtDevClick(Sender: TObject);
    procedure BtOSClick(Sender: TObject);
    procedure SInsClick(Sender: TObject);
    procedure SOkClick(Sender: TObject);
    procedure SdelClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  SEd: TSEd;
  Vkl: integer;
procedure Activ;

implementation

{$R *.dfm}

uses DMU, AOSU;

procedure Activ;
begin
  case Vkl of
    0:
      begin
        DM.SotrT.Cancel;
        SEd.SGrid.DataSource := DM.SotrS;
        SEd.Caption := 'Сотрудник';
        SEd.BtSotr.SetFocus;
      end;
    1:
      begin

        DM.CabT.Cancel;
        SEd.SGrid.DataSource := DM.CabS;
        SEd.Caption := 'Кабинет';
        SEd.BtCab.SetFocus;
      end;
    2:
      begin
        DM.DevT.Cancel;
        SEd.SGrid.DataSource := DM.DevS;
        SEd.Caption := 'Устройство';
        SEd.BtDev.SetFocus;
      end;
    3:
      begin
        DM.OST.Cancel;
        SEd.SGrid.DataSource := DM.OSS;
        SEd.Caption := 'ОС';
        SEd.BtOS.SetFocus;
      end;
  end;
end;

procedure TSEd.BtCabClick(Sender: TObject);
begin
  Vkl := 1;
  Activ;
end;

procedure TSEd.BtDevClick(Sender: TObject);
begin
  Vkl := 2;
  Activ;
end;

procedure TSEd.BtOSClick(Sender: TObject);
begin
  Vkl := 3;
  Activ;
end;

procedure TSEd.BtSotrClick(Sender: TObject);
begin
  Vkl := 0;
  Activ;
end;

procedure TSEd.FormActivate(Sender: TObject);
begin
  Activ;
end;

procedure TSEd.SdelClick(Sender: TObject);
begin
  case Vkl of
    0:
      if Application.MessageBox(PChar('Вы действительно хотите удалить: ' +
        DM.SotrTСотрудник.AsString + '?' + #13 + #10 +
        'Изменения будут необратимы!'), 'Внимание!!!',
        MB_OKCANCEL + MB_ICONWARNING) = id_OK then
        DM.SotrT.Delete;
    1:
      if Application.MessageBox(PChar('Вы действительно хотите удалить: ' +
        DM.CabTКабинет.AsString + '?' + #13 + #10 +
        'Изменения будут необратимы!'), 'Внимание!!!',
        MB_OKCANCEL + MB_ICONWARNING) = id_OK then
        DM.CabT.Delete;
    2:
      if Application.MessageBox(PChar('Вы действительно хотите удалить: ' +
        DM.DevTУстройство.AsString + '?' + #13 + #10 +
        'Изменения будут необратимы!'), 'Внимание!!!',
        MB_OKCANCEL + MB_ICONWARNING) = id_OK then
        DM.DevT.Delete;
    3:
      if Application.MessageBox(PChar('Вы действительно хотите удалить: ' +
        DM.OSTОС.AsString + '?' + #13 + #10 + 'Изменения будут необратимы!'),
        'Внимание!!!', MB_OKCANCEL + MB_ICONWARNING) = id_OK then
        DM.OST.Delete;
  end;
end;

procedure TSEd.SInsClick(Sender: TObject);
begin
  case Vkl of
    0:
      DM.SotrT.Insert;
    1:
      DM.CabT.Insert;
    2:
      DM.DevT.Insert;
    3:
      DM.OST.Insert;
  end;
end;

procedure TSEd.SOkClick(Sender: TObject);
begin
  case Vkl of
    0:
      if DM.SotrT.Modified then
        DM.SotrT.Post;
    1:
      if DM.CabT.Modified then
        DM.CabT.Post;
    2:
      if DM.DevT.Modified then
        DM.DevT.Post;
    3:
      if DM.OST.Modified then
        DM.OST.Post;
  end;
end;

end.
← newer dump
older dump →