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

📄 main.pas

📁 AbsDataBase5.16 最新版
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  end;
    procedure MoveRow(Dataset: TDataSet; MoveUp: Boolean);

var
  frmMain:  TfrmMain;

implementation

uses uDatabase, uTable, ABSBase, Math, uTableName, StrUtils, uMemo,
  uFmtMemo, uBlob, uGraphic, uAbout, uTableStructRpt, uCopyTable,
  Types, uMakeExeDb, uExportExcel, uFieldList, uChangeLog, uQueryMaker;

{$R *.dfm}



{ TAppSettings }

constructor TAppSettings.Create(HistorySize: Integer);
begin
  SetLength(FFileNames, HistorySize);
  FLastSQMFile := '';
  FLastTableName := '';
  LoadSettings;
end;


destructor TAppSettings.Destroy;
begin
  //SaveSettings;
  inherited;
end;


procedure TAppSettings.ClearFileNames;
var
  i: Integer;
begin
  for i:=0 to Length(FFileNames)-1 do
    FFileNames[i] := '';
end;


function TAppSettings.GetFileName(Index: Integer): String;
begin
  Result := FFileNames[Index];
end;


function TAppSettings.GetFileNamesCount: Integer;
var i: Integer;
begin
  Result := 0;
  for i:=0 to Length(FFileNames)-1 do
   begin
    if (FFileNames[i] <> '') then
     Inc(Result)
    else
     Break;
   end;
end;


procedure TAppSettings.LoadSettings;
var
  reg:  TRegistry;
  i:    Integer;
begin
  reg := TRegistry.Create;
  try
   Reg.RootKey := HKEY_CURRENT_USER;

   // Read last openned files list
   if Reg.OpenKey(RegistryDBManagerPath + '\History', True) then
    begin
     for i:=0 to Length(FFileNames)-1 do
      begin
       FFileNames[i] := Reg.ReadString('File'+IntToStr((i+1)));
      end;
    end;
   Reg.CloseKey;

   // Read last openned table name
   if Reg.OpenKey(RegistryDBManagerPath, True) then
     begin
       FLastSQMFile := Reg.ReadString('SQMFile');
       FLastTableName := Reg.ReadString('TableName');
       //FLastSql := Reg.ReadString('SQL');
       if Reg.ValueExists('SQLLen') then
         begin
           SetLength(FLastSql, Reg.ReadInteger('SQLLen'));
           Reg.ReadBinaryData('SQLBin', pchar(FLastSql)^, Reg.ReadInteger('SQLLen'));
         end;
       if Reg.ValueExists('LastPageIndex') then
         FLastPageIndex := Reg.ReadInteger('LastPageIndex')
       else
         FLastPageIndex := 3;
       if Reg.ValueExists('LastPosition') then
         FLastPosition := Reg.ReadInteger('LastPosition')
       else
         FLastPosition := Integer(poScreenCenter);
       if Reg.ValueExists('LastWindowState') then
         FLastWindowState := Reg.ReadInteger('LastWindowState')
       else
         FLastWindowState := Integer(wsMaximized);
       if Reg.ValueExists('LastLeft') then
         FLastLeft := Reg.ReadInteger('LastLeft')
       else
         FLastLeft := 0;
       if Reg.ValueExists('LastTop') then
         FLastTop := Reg.ReadInteger('LastTop')
       else
         FLastTop := 0;
       if Reg.ValueExists('LastWidth') then
         FLastWidth := Reg.ReadInteger('LastWidth')
       else
         FLastWidth := 640;
       if Reg.ValueExists('LastHeight') then
         FLastHeight := Reg.ReadInteger('LastHeight')
       else
         FLastHeight := 480;
			 if Reg.ValueExists('LastQueryHeight') then
				 FLastQueryHeight := Reg.ReadInteger('LastQueryHeight')
			 else
				 FLastQueryHeight := Round(FLastHeight / 2);
			 if Reg.ValueExists('LastTreeWidth') then
				 FLastTreeWidth := Reg.ReadInteger('LastTreeWidth')
			 else
				 FLastTreeWidth := 185;
     end;
   Reg.CloseKey;

  finally
   reg.Free;
  end;
end;


procedure TAppSettings.SaveSettings;
var
  reg:  TRegistry;
  i:    Integer;
begin
  reg := TRegistry.Create;
  try
   Reg.RootKey := HKEY_CURRENT_USER;

   // Save last openned files list
   if Reg.OpenKey(RegistryDBManagerPath + '\History', True) then
    begin
     for i:=0 to Length(FFileNames)-1 do
      begin
       Reg.WriteString('File'+IntToStr((i+1)), FFileNames[i]);
      end;
    end;
   Reg.CloseKey;

   if Reg.OpenKey(RegistryDBManagerPath, True) then
    begin
     // Save last openned table name
     Reg.WriteString('SQMFile', FLastSQMFile);
     Reg.WriteString('TableName', FLastTableName);
     // Save Last SQL text
     if (length(FLastSql) < 2048) then
       begin
         Reg.WriteBinaryData('SQLBin', pchar(FLastSql)^, length(FLastSql));
         Reg.WriteInteger('SQLLen', length(FLastSql));
       end;
     //Reg.WriteString('SQL', FLastSql);
     Reg.WriteInteger('LastPageIndex', FLastPageIndex);
     Reg.WriteInteger('LastPosition', FLastPosition);
     Reg.WriteInteger('LastWindowState', FLastWindowState);
     Reg.WriteInteger('LastLeft', FLastLeft);
     Reg.WriteInteger('LastTop', FLastTop);
     Reg.WriteInteger('LastWidth', FLastWidth);
     Reg.WriteInteger('LastHeight', FLastHeight);
		 Reg.WriteInteger('LastQueryHeight', FLastQueryHeight);
		 Reg.WriteInteger('LastTreeWidth', FLastTreeWidth);
    end;
   Reg.CloseKey;

  finally
   reg.Free;
  end;
end;


procedure TAppSettings.AddFileName(FileName: String);
var i,n: Integer;
begin
  if FileName = '' then
    Exit;
  // Find
  n := -1;
  for i:=0 to Length(FFileNames)-1 do
   if ( AnsiUpperCase(trim(FFileNames[i])) = AnsiUpperCase(trim(FileName))) then
    begin
     n := i;
     Break;
    end;
  // Delete
  if (n <> -1) then
   begin
    // Delete FFileNames[n]
    for i:=n downto 1 do FFileNames[i] := FFileNames[i-1];
   end
  else
   begin
    // Delete Last
    for i:=Length(FFileNames)-1 downto 1 do FFileNames[i] := FFileNames[i-1];
   end;
  FFileNames[0] := FileName;
  SaveSettings;
end;



//==============================================================================


{ TSqlHistory }

constructor TSqlHistory.Create(ListBoxSqlHistory: TListBox; SqlHistorySize: Integer);
begin
  self.FListBoxSqlHistory := ListBoxSqlHistory;
  self.FSqlHistorySize    := SqlHistorySize;
  Clear;
end;

destructor TSqlHistory.Destroy;
begin
  Save;
end;

procedure TSqlHistory.Clear;
begin
  SetLength(FQueries,0);
  FListBoxSqlHistory.Clear;
  //FListBoxSqlHistory.Items.Add('');
  FListBoxSqlHistory.ItemIndex := -1;
end;

procedure TSqlHistory.Load;
begin

end;

procedure TSqlHistory.Save;
begin

end;

function TSqlHistory.FindSQL(SQL: String): integer;
var i,n: Integer;
begin
  SQL := Trim(SQL);
  n := -1;
  for i:=0 to Length(FQueries)-1 do
   if (SQL = FQueries[i].SQL) then
    begin
     n:=i;
     Break;
    end;
  Result := n;
end;

procedure TSqlHistory.AddQuery(SQL: String);
var i,n: Integer;
begin
  SQL := Trim(SQL);
  if SQL = '' then Exit;
  n := FindSQL(SQL);
  if ( n = -1 ) then
   begin
    SetLength(FQueries,Length(FQueries)+1);
    for i:=Length(FQueries)-1 downto 1 do
      FQueries[i] := FQueries[i-1];
    FQueries[0].SQL := SQL;
    for i:=0 to Length(FQueries)-1 do
      RepaintListBoxLine(i);
    FListBoxSqlHistory.ItemIndex := 0;
   end
  else
   FListBoxSqlHistory.ItemIndex := n;
end;

procedure TSqlHistory.DeleteCurrentQuery;
var Index,i: Integer;
begin
  Index := FListBoxSqlHistory.ItemIndex;
  if (Index < 0) or (Index > Length(FQueries)-1) then Exit;
  for i:=Index to Length(FQueries)-2 do
   begin
    FQueries[i] := FQueries[i+1];
   end;
  SetLength(FQueries,Length(FQueries)-1);
  FListBoxSqlHistory.DeleteSelected;
  FListBoxSqlHistory.ItemIndex := Index;
end;


procedure TSqlHistory.SetSQL(Index: Integer; Value: String);
begin
  if Index >= Length(FQueries) then
    AddQuery(Value)
  else
    FQueries[Index].SQL := Value;
  RepaintListBoxLine(Index);
end;

function TSqlHistory.GetSQL(Index: Integer): String;
begin
  if (Index >= Length(FQueries)) or (Index < 0) then
    Result := ''
  else
    Result := FQueries[Index].SQL;
end;


procedure TSqlHistory.RepaintListBoxLine(Index: Integer);
var s: String;
const MaxLen=50;
begin
  s := GetSQL(Index);
  if Length(s) > MaxLen then
    s := copy(s, 1, 50) + '...';
  s := StringReplace(s, #13, ' ', [rfReplaceAll,rfIgnoreCase]);
  s := StringReplace(s, #10, ' ', [rfReplaceAll,rfIgnoreCase]);
  s := StringReplace(s, '  ', ' ', [rfReplaceAll,rfIgnoreCase]);
  s := StringReplace(s, '  ', ' ', [rfReplaceAll,rfIgnoreCase]);
  FListBoxSqlHistory.Items[Index] := s;
end;


procedure TSqlHistory.SetDatabaseFileName(Name: String);
begin
  if FDatabaseFileName <> '' then
   begin
    Save;
    Clear;
   end;
  FDatabaseFileName := Name;
  Load;
end;

//==============================================================================



procedure TfrmMain.aExitExecute(Sender: TObject);
begin
  Close;
end;


procedure TfrmMain.aCloseDatabaseExecute(Sender: TObject);
begin
 if tvDatabase.Selected <> nil then
   Settings.LastTableName := tvDatabase.Selected.Text;
   
 db.Close;
 frmMain.Caption := FormCaption;
 aRefreshTableList.Execute;
 pMainPanel.Visible := False;

 SetAllDatabaseActionsEnabled(False);
 SetAllTableActionsEnabled(False);
end;


procedure TfrmMain.aOpenDatabaseExecute(Sender: TObject);
begin
  if odOpenDatabase.Execute then
   OpenDatabaseFile(odOpenDatabase.FileName);
end;


procedure TfrmMain.FormDestroy(Sender: TObject);
begin
 aCloseDatabase.Execute;
 reSQL.PlainText := True;
 Settings.LastSQL := reSQL.Text;
 Settings.LastPageIndex := pcTables.ActivePageIndex;
 Settings.LastPosition := Integer(poDesigned);
 Settings.LastWindowState := Integer(WindowState);
 Settings.LastLeft := Left;
 Settings.LastTop := Top;
 Settings.LastWidth := Width;
 Settings.LastHeight := Height;
 Settings.LastQueryHeight := pnlQuery.Height;
 Settings.LastTreeWidth := pnlTree.Width;
 Settings.SaveSettings;
 Settings.ClearFileNames;
 RefreshLastOpenedFiles;
 Settings.Free;
 SqlHistory.Free;
end;


procedure TfrmMain.aRefreshTableListExecute(Sender: TObject);
var
  OldName: String;
  sl: TStringList;
  i: Integer;
  Root: TTreeNode;
begin
  OldName := GetCurrentTableName;

  if db.Connected then
   begin
    tvDatabase.Items.Clear;
    Root := tvDatabase.Items.Add(nil, ExtractFileName(db.DatabaseFileName));
    tvDatabase.Items[0].ImageIndex := 0;
    tvDatabase.Items[0].SelectedIndex := 1;
    sl := TStringList.Create;
    try
     db.GetTablesList(sl);
     sl.Sort;
     for i:=0 to sl.Count-1 do
      begin
        tvDatabase.Items.AddChild(Root,sl[i]);
        tvDatabase.Items[tvDatabase.Items.Count-1].ImageIndex := 2;
        tvDatabase.Items[tvDatabase.Items.Count-1].SelectedIndex := 3;
      end;
     if OldName = '' then
       begin
         if tvDatabase.Items.Count >=2 then
           tvDatabase.Selected := tvDatabase.Items[1]
         else
           tvDatabase.Selected := tvDatabase.Items[0]

⌨️ 快捷键说明

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