⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 upublic.pas

📁 ACCESS 数据库管理工具
💻 PAS
字号:
unit uPublic;
interface

uses
  Windows, Messages,Sysutils, shlobj, Forms,DBClient, ADODB, DBGridEh;


function RegFileJoint(sCaption, sFile, sExeFile: string): Boolean;
function RegJointMe: Boolean;

function SortField(var Column: TColumnEh; var Query: TadoQuery): Boolean; overload;
function SortField(var Column: TColumnEh; var Table: TadoTable): Boolean; overload;
function SortField(var Column: TColumnEh; var DataSet: TadoDataSet): Boolean; overload;
function DBGridEHTitleClick(Column: TColumnEh; Table: TadoTable): Boolean; overload;
function DBGridEHTitleClick(Column: TColumnEh; Query: TadoQuery): Boolean; overload;
function DBGridEHTitleClick(Column: TColumnEh; DataSet: TadoDataSet): Boolean; overload;
function DBGridEHTitleClick(Column: TColumnEh; DataSet: TClientDataSet): Boolean; overload;
procedure DBGridEhTitleClick(Column: TColumnEh); overload;
var
  aPassWord: string;

implementation


const

  FileJoint_Caption = 'ACCESS 数据库';
  FileJoint_File = '.mdb';





function RegJointMe: Boolean;
begin
  Result := RegFileJoint(FileJoint_Caption, FileJoint_File, Application.ExeName)
end;

function RegFileJoint(sCaption, sFile, sExeFile: string): Boolean;
var
  lphKey: HKEY;
  sKeyName: string;
  sKeyValue: string;
begin
  Result := False;
  sKeyName := sCaption;
  sKeyValue := sCaption;
  if RegOpenKey(HKEY_CLASSES_ROOT, pchar(sKeyName), lphKey) = ERROR_SUCCESS then
    Exit;
  RegCreateKey(HKEY_CLASSES_ROOT, pchar(sKeyName), lphKey);
  RegSetValue(lphKey, '', REG_SZ, pchar(sKeyValue), 0);

  sKeyName := sFile;
  sKeyValue := sCaption;
  RegCreateKey(HKEY_CLASSES_ROOT, pchar(sKeyName), lphKey);
  RegSetValue(lphKey, '', REG_SZ, pchar(sKeyValue), 0);

  sKeyName := sCaption;
  sKeyValue := sExeFile + ',0';
  RegCreateKey(HKEY_CLASSES_ROOT, pchar(sKeyName), lphKey);
  RegSetValue(lphKey, 'DefaultIcon', REG_SZ, pchar(sKeyValue), MAX_PATH);

  sKeyName := sCaption;
  sKeyValue := sExeFile + ' %1';
  RegCreateKey(HKEY_CLASSES_ROOT, pchar(sKeyName), lphKey);
  RegSetValue(lphKey, 'shell\open\command', REG_SZ, pchar(sKeyValue), MAX_PATH);
  Result := True;
  SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);
end;



function SortField(var Column: TColumnEh; var Query: TadoQuery): Boolean;
begin
  Result := False;
  try
    if Pos(UpperCase(Column.FieldName + ' ASC'), UpperCase(Query.Sort)) <> 0
      then
      Query.Sort := Column.FieldName + ' DESC'
    else
      Query.Sort := Column.FieldName + ' ASC';

    Result := True;
  except
  end;
end;

function SortField(var Column: TColumnEh; var Table: TadoTable): Boolean;
begin
  Result := False;
  try
    if pos(UpperCase(Column.FieldName + ' ASC'), UpperCase(Table.Sort)) <> 0
      then
      Table.Sort := Column.FieldName + ' DESC'
    else
      Table.Sort := Column.FieldName + ' ASC';

    Result := True;
  except
  end;
end;

function SortField(var Column: TColumnEh;
  var DataSet: TadoDataSet): Boolean;
begin
  Result := False;
  try
    if pos(UpperCase(Column.FieldName + ' ASC'), UpperCase(DataSet.Sort)) <> 0
      then
      DataSet.Sort := Column.FieldName + ' DESC'
    else
      DataSet.Sort := Column.FieldName + ' ASC';

    Result := True;
  except
  end;
end;

function DBGridEHTitleClick(Column: TColumnEh;
  Table: TadoTable): Boolean;
begin
  Result := False;
  try
    SortField(Column, Table);
    if pos(UpperCase(Column.FieldName + ' DESC'), UpperCase(Table.Sort)) <> 0
      then
    begin
      Column.Title.SortMarker := smDownEh;
    end
    else
    begin
      Column.Title.SortMarker := smupEh;
    end;
    Result := True;
  except
  end;
end;

function DBGridEHTitleClick(Column: TColumnEh;
  Query: TadoQuery): Boolean;
begin
  Result := False;
  try
    SortField(Column, Query);
    if pos(UpperCase(Column.FieldName + ' DESC'), UpperCase(Query.Sort)) <> 0
      then
    begin
      Column.Title.SortMarker := smDownEh;
    end
    else
    begin
      Column.Title.SortMarker := smupEh;
    end;
    Result := True;
  except
  end;
end;

function DBGridEHTitleClick(Column: TColumnEh;
  DataSet: TadoDataSet): Boolean;
begin
  Result := False;
  try
    SortField(Column, DataSet);
    if pos(UpperCase(Column.FieldName + ' DESC'), UpperCase(DataSet.Sort)) <> 0
      then
    begin
      Column.Title.SortMarker := smDownEh;
    end
    else
    begin
      Column.Title.SortMarker := smupEh;
    end;
    Result := True;
  except
  end;
end;

function DBGridEHTitleClick(Column: TColumnEh;
  DataSet: TClientDataSet): Boolean;
var
  i: Integer;
begin
  Result := False;
  try
    if TClientDataSet(DataSet).indexfieldnames <> '' then
    begin
      i := TClientDataSet(DataSet).IndexDefs.IndexOf('i' + Column.FieldName);
      if i = -1 then
      begin
        with TClientDataSet(DataSet).IndexDefs.AddIndexDef do
        begin
          Name := 'i' + Column.FieldName;
          Fields := Column.FieldName;
          DescFields := Column.FieldName;
        end;
      end;
      TClientDataSet(DataSet).IndexFieldNames := '';
      TClientDataSet(DataSet).IndexName := 'i' + Column.FieldName;
      Column.Title.SortMarker := smDownEh;
    end
    else
    begin
      TClientDataSet(DataSet).IndexName := '';
      TClientDataSet(DataSet).IndexFieldNames := column.fieldname;
      Column.Title.SortMarker := smupEh;
    end;
    Result := True;
  except
  end;
end;

procedure DBGridEhTitleClick(Column: TColumnEh);
begin
  if Column.Grid.DataSource.DataSet is TadoTable then
  begin
    DBGridEHTitleClick(Column, TadoTable(Column.Grid.DataSource.DataSet));
  end
  else
    if Column.Grid.DataSource.DataSet is TadoQuery then
    begin
      DBGridEHTitleClick(Column, TadoQuery(Column.Grid.DataSource.DataSet));
    end
    else
      if Column.Grid.DataSource.DataSet is TadoDataSet then
      begin
        DBGridEHTitleClick(Column, TadoQuery(Column.Grid.DataSource.DataSet));
      end
      else
        if Column.Grid.DataSource.DataSet is TClientDataSet then
        begin
          DBGridEHTitleClick(Column,
            TClientDataset(Column.Grid.DataSource.DataSet));
        end;
end;


end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -