main.pas

来自「MysqlFront的源码」· PAS 代码 · 共 1,179 行 · 第 1/3 页

PAS
1,179
字号
    TMDIChild(Mainform.ActiveMDIChild).MenuLimit.Checked := CheckBoxLimit.Checked;
end;

procedure TMainForm.LimitPanelEnter(Sender: TObject);
begin
  // Entering Data-Toolbar
  ButtonOK.Default := true;
end;

procedure TMainForm.LimitPanelExit(Sender: TObject);
begin
  // Exiting Data-Toolbar
  ButtonOK.Default := false;
end;

procedure TMainForm.menuclearClick(Sender: TObject);
begin
  // Clear SynMemo
  with TMDIChild(Mainform.ActiveMDIChild) do begin
    if SynMemo3.Focused then
      SynMemo3.Lines.Clear
    else
      SynMemo1.Lines.Clear;
  end;
end;


procedure TMainForm.ButtonSaveSQLClick(Sender: TObject);
var f : TextFile;
begin
  // Save SQL
  if SaveDialog1.Execute then begin
    Screen.Cursor := crHourGlass;
    AssignFile(f, SaveDialog1.FileName);
    Rewrite(f);
    Write(f, TMDIChild(Mainform.ActiveMDIChild).SynMemo1.Text);
    CloseFile(f);
    Screen.Cursor := crDefault;
  end;
end;

procedure TMainForm.ButtonLoadSQLFile(Sender: TObject);
var
  menuitem        : Tmenuitem;
  m,i             : Integer;
  filename        : String;
  dontadd         : Boolean;
begin
  // Load file
  if OpenDialog1.Execute then
  begin
    Screen.Cursor := crHourGlass;
    TMDIChild(ActiveMDIChild).SynMemo1.Lines.LoadFromFile(OpenDialog1.FileName);
    Screen.Cursor := crDefault;
    TMDIChild(ActiveMDIChild).SynMemo1Change(self);

    // don't get one filename more than one time
    dontadd := false;
    for m:=0 to PopUpMenu6.Items.Count-1 do begin
      filename := PopUpMenu6.Items[m].Caption;
      i := 0;
      while filename[i] <> ' ' do
        inc(i);
      filename := copy(filename, i+1, length(filename));
      filename := stringreplace(filename, '&', '', [rfReplaceAll]);
      if filename = OpenDialog1.FileName then
        dontadd := true;
    end;

    if not dontadd then begin
      with TRegistry.Create do begin
        openkey(regpath, true);
        for i:=1 to 20 do
        begin
          if not ValueExists('SQLFile'+inttostr(i)) then
            break;
        end;
        while i > 1 do
        begin
          WriteString('SQLFile'+inttostr(i), ReadString('SQLFile'+inttostr(i-1)));
          dec(i);
        end;
        WriteString('SQLFile1', OpenDialog1.FileName);

        i := 1;
        PopUpMenu6.Items.Clear;
        while ValueExists('SQLFile'+inttostr(i)) do
        begin
          menuitem := Tmenuitem.Create(self);
          menuitem.Caption := inttostr(PopUpMenu6.Items.count+1) + ' ' + ReadString('SQLFile'+inttostr(i));
          menuitem.OnClick := LoadSQLFile;
          PopUpMenu6.Items.Add(menuitem);
          inc(i);
        end;
      end;
    end;

  end;
end;



procedure TMainForm.SQLFunctionsPopup(Sender: TObject);
begin

  if TMDIChild(ActiveMDIChild).SynMemo3.focused then begin // set Filter with F9
    MenuRun.ShortCut := TextToShortCut('');
    MenuSetFilter.ShortCut := TextToShortCut('F9');
    MenuSetFilter.Visible := true;
    MenuRun.Visible := false;
    MenuRunSelection.Visible := false;
    MenuCopy.Visible := false;
    MenuPaste.Visible := false;
    MenuLoad.Visible := false;
    MenuSave.Visible := false;
    MenuFind.Visible := false;
    searchreplace.Visible := false;
  end
  else begin // Exec SQL with F9
    MenuRun.ShortCut := TextToShortCut('F9');
    MenuSetFilter.ShortCut := TextToShortCut('');
    MenuSetFilter.Visible := false;
    MenuRun.Visible := true;
    MenuRunSelection.Visible := true;
    MenuCopy.Visible := true;
    MenuPaste.Visible := true;
    MenuLoad.Visible := true;
    MenuSave.Visible := true;
    MenuFind.Visible := true;
    searchreplace.Visible := true;
  end;

end;

procedure TMainForm.MenuSetFilterClick(Sender: TObject);
begin
  TMDIChild(ActiveMDIChild).SetFilter(self);
end;


procedure TMainForm.OpenURL(Sender: TObject);
var url :  Pchar;
begin
  // open url (hint)
  if sender is TMenuItem then
    url := pchar(TMenuItem(Sender).Hint)
  else
    url := pchar(TControl(Sender).Hint);
  shellexecute(0, 'open', url, Nil, Nil, sw_shownormal);
end;




// mask tablenames, dbs and so on with backtick
function TMainform.mask(str: String) : String;
begin
  if TMDIChild(ActiveMDIChild).mysql_version >= 32300 then
    result := '`' + str + '`'
  else
    result := str;
end;


procedure TMainForm.FindDialog1Find(Sender: TObject);
var foundat: Longint;
begin
  with TMDIChild(ActiveMDIChild).SynMemo1 do begin
    FoundAt := pos(FindDialog1.FindText, copy(Text, SelEnd, Length(Text)));
    if FoundAt > 0 then begin
      SetFocus;
      SelStart := FoundAt + SelEnd -1;
      SelEnd := SelStart + Length(FindDialog1.FindText);
    end else
      messagebeep(0);
  end;
end;

procedure TMainForm.ExportSettings1Click(Sender: TObject);
begin
  // Export settings to .reg-file
  if SaveDialog2.Execute then begin
    if winexec(pchar('regedit.exe /e "'+SaveDialog2.FileName+'" HKEY_CURRENT_USER\'+regpath), SW_SHOW) = ERROR_FILE_NOT_FOUND then
      MessageDlg('File not found: regedit.exe', mtError, [mbOK], 0);
  end;
end;

procedure TMainForm.Importsettings1Click(Sender: TObject);
begin
  // Import settings from .reg-file
  if OpenDialog2.Execute then begin
    if winexec(pchar('regedit.exe "'+OpenDialog2.FileName+'"'), SW_SHOW) = ERROR_FILE_NOT_FOUND then
      MessageDlg('File not found: regedit.exe', mtError, [mbOK], 0);
  end;
end;

procedure TMainForm.ExecuteQueryExecute(Sender: TObject);
begin
  TMDIChild(ActiveMDIChild).ExecSqlClick(sender, false);
end;

procedure TMainForm.ExecuteSelectionExecute(Sender: TObject);
begin
  TMDIChild(ActiveMDIChild).ExecSqlClick(sender, true);
end;

procedure TMainForm.MenuFindClick(Sender: TObject);
begin
  TMDIChild(ActiveMDIChild).ToolButton15Click(sender);
end;

procedure TMainForm.ExecuteLineExecute(Sender: TObject);
begin
  TMDIChild(ActiveMDIChild).ExecSqlClick(sender, false, true);
end;

procedure TMainForm.Save2XMLExecute(Sender: TObject);
begin
  // Save data in actual dataset as HTML
  with TMDIChild(Application.Mainform.ActiveMDIChild) do begin

    with TSaveDialog.Create(self) do begin
      Filter := 'XML-Files (*.xml)|*.xml|All files (*.*)|*.*';
      DefaultExt := 'xml';
      if PageControl1.ActivePage = SheetData then
        FileName := ActualTable
      else
        FileName := sstr(ZQuery1.Sql[0], 20);
      Options := [ofOverwritePrompt,ofEnableSizing];

      if Execute and (FileName <> '') then begin
      end;
    end;

  end;
end;

procedure TMainForm.Copy2XMLExecute(Sender: TObject);
begin
  // Copy data in actual dataset as XML
  with TMDIChild(Application.Mainform.ActiveMDIChild) do begin
  end;
end;

procedure TMainForm.DBNavigator1BeforeAction(Sender: TObject;
  Button: TNavigateBtn);
begin
  if Button = nbdelete then begin
    TMDIChild(Application.Mainform.ActiveMDIChild).Delete1Click(sender);
    abort;
  end;
end;

procedure TMainForm.ExportDataExecute(Sender: TObject);
var
  titel : String;
begin
  // Save data in actual dataset as CSV, HTML or XML
end;

procedure TMainForm.SearchReplaceExecute(Sender: TObject);
begin
  ReplaceDialog1.Execute;
end;


{ Replace Text with replace-dialog }
procedure TMainForm.ReplaceDialog1Replace(Sender: TObject);
var
  SelPos: Integer;
  m : TSynMemo;
begin
  m := TMDIChild(Mainform.ActiveMDIChild).synmemo1;
  with TReplaceDialog(Sender) do begin
    if not (frReplaceAll in options) then begin
      { Perform a global case-sensitive search for FindText in Memo1 }
      SelPos := Pos(FindText, m.Lines.Text);
      if SelPos > 0 then
      begin
        m.SetFocus;
        m.SelStart := SelPos;
        m.SelEnd := m.SelStart + Length(FindText);
        { Replace selected text with ReplaceText }
        m.SelText := ReplaceText;
      end
      else
        messagebeep(0);
    end
    else
      m.SearchReplace(FindText, ReplaceText, [ssoReplaceAll, ssoEntireScope]);
  end;
end;

{ Find Text with replace-dialog }
procedure TMainForm.ReplaceDialog1Find(Sender: TObject);
begin
  FindDialog1.FindText := ReplaceDialog1.FindText;
  FindDialog1Find (ReplaceDialog1);
end;

procedure TMainForm.ImportWizardExecute(Sender: TObject);
begin
end;


// copy field-contents to clipboard
procedure TMainForm.ManualCopyExecute(Sender: TObject);
var g : TSMDBGrid;
begin
  with TMDIChild(Mainform.ActiveMDIChild) do begin
    case PageControl1.ActivePageIndex of
    3: g := DBGrid1;
    4: g := DBGrid2;
    else begin messagebeep(MB_ICONASTERISK); exit; end;
    end;
  end;
  if g.datasource.State <> dsInactive then
    clipboard.AsText := g.SelectedField.AsString
  else
    messagebeep(MB_ICONASTERISK);
end;


// view HTML
procedure TMainForm.HTMLviewExecute(Sender: TObject);
var
  g              : TSMDBGrid;
  filename,extension   : String;
  f              : Textfile;
  buffer         : array[0..MAX_PATH] of char;
begin
  with TMDIChild(Mainform.ActiveMDIChild) do begin
    case PageControl1.ActivePageIndex of
    3: g := DBGrid1;
    4: g := DBGrid2;
    else begin messagebeep(MB_ICONASTERISK); exit; end;
    end;
  end;
  if g.datasource.State = dsInactive then begin
    messagebeep(MB_ICONASTERISK);
    exit;
  end;
  Screen.Cursor := crHourGlass;
  showstatus('Saving contents to file...', 2, 51);
  GetTempPath(MAX_PATH, buffer);
  if g.SelectedField.IsBlob and (pos('JFIF', copy(g.SelectedField.AsString, 0, 20)) <> 0) then
    extension := 'jpg'
  else if g.SelectedField.IsBlob and StrCmpBegin('GIF', g.SelectedField.AsString) then
    extension := 'gif'
  else if g.SelectedField.IsBlob and StrCmpBegin('BM', g.SelectedField.AsString) then
    extension := 'bmp'
  else
    extension := 'html';
  filename := buffer+'\heidisql-preview.'+extension;
  AssignFile(f, filename);
  Rewrite(f);
  Write(f, g.SelectedField.AsString);
  CloseFile(f);
  showstatus('Ready', 2);
  Screen.Cursor := crDefault;
  ShellExecute(0, 'open', pchar(filename), nil, nil, SW_SHOWNORMAL);
end;

procedure TMainForm.InsertFilesExecute(Sender: TObject);
begin
  FrmInsertFiles.showmodal;
end;

procedure TMainForm.debug( msg : String = '' );
var
  debugfilename : String;
begin
  debugfilename := ExtractFilePath(paramstr(0)) + 'debug.txt';
  if fileexists(debugfilename) then
  begin
    try
      // MessageDlg(msg, mtInformation, [mbok], 0);
      AssignFile(debugfile, debugfilename);
      Append(debugfile);
      //Reset(debugfile);
      Writeln( debugfile, datetimetostr(date()) + ' ' + timetostr(time()) + ': ' + msg );
      closefile( debugfile );
    except
      raise exception.Create( 'Problem with debug-file: ' + debugfilename );
    end;
  end;
end;




end.

⌨️ 快捷键说明

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