Due to a problem somewhere in my DCU file I'm unable at this time to use Derek's answer.


However, I have finally managed to get my code above to work by tweaking the for loops. At this time though I'm still unable to  include column headers in the spreadsheet, unless I put them at the bottom of the form, which would be a bit unusual! smile


The tweaked code is below - note the substitution of a for loop to an  inc(rownumber,1).


procedure frmMain_btnExcel_OnClick (Sender: TObject; var Cancel: boolean);
var
  xls, wb, range : Variant;
  arrData : Variant;
  rowCnt : integer;
 ExcelRowNum:integer;
begin
  if frmMain.tgOrderPlace.RowCount > 0 then
  begin
   
     {allocate 2d space to excel array}
     arrData := VarArrayCreate([0,frmMain.tgOrderPlace.RowCount , 0,frmMain.tgOrderPlace.Columns.Count ], varVariant);


    //excel format = row,column  table grid = column, row
     {row 0 contains tablegrid headers}
    { arrData[0,0] := frmMain.tgOrderPlace.Columns[1].Header.Caption;
     arrData[0,1] := frmMain.tgOrderPlace.Columns[2].Header.Caption;
     arrData[0,2] := frmMain.tgOrderPlace.Columns[4].Header.Caption; }

     ExcelRowNum := 0;

    {fill array with cell contents by row}
    for  rowCnt := 1 to frmMain.tgOrderPlace.RowCount  do
    begin
      arrData[ExcelRowNum,0] := frmMain.tgOrderPlace.Cells[1,rowCnt-1];
      arrData[ExcelRowNum,1] := frmMain.tgOrderPlace.Cells[2,rowCnt-1];
      arrData[ExcelRowNum,2] := frmMain.tgOrderPlace.Cells[4,rowCnt-1];
      inc (ExcelRowNum,1);
    end;


    xls := CreateOLEObject('Excel.Application');

    wb := xls.WorkBooks.add;

   range := wb.WorkSheets[1].Range[wb.WorkSheets[1].Cells[1,1],wb.WorkSheets[1].Cells[frmMain.tgOrderPlace.RowCount, frmMain.tgOrderPlace.Columns.Count]];

    Range.Value := arrData;
    Range.Columns.Autofit();  //In Excel columns must be filled first and then autofit called
    xls.Visible := true;
  end
  else
   MessageBox('Supplier has no items to order, unable to open spreadsheet.'+#13+'Please select a supplier with order items', 'INFORMATION', MB_OK);

  xls.Quit;
end;

I'm trying to add a tablegrid to an existing project.  The moment I attach a database to the grid I get an Access violation message box.


The program will compile and run, the tablegrid will link to the database, but in this case does not recognise any search criteria.


I've tried starting a new form and placing a tablegrid on that, same problem,


There is obviously a problem somewhere, but I can't see where. XML Notepad does not report an error when I look at the Form.xml, the DCU file appears OK, though as EditPad can't parse it properly that is difficult to tell.

The VDB file is, in actuality, nothing more than a settings file for hidden forms, so that leaves the settings or tables.ini files, I can't see a problem there either.


Not being able to run a debugger it is hard to see what the module referred too is unhappy with.


Any suggestions on where I might need to look to solve this problem?

Thanks Derek,


I had considered using your suggestion before I decided to go the difficult route.  I'm going to follow your suggestion.

I am attempting to write my own tablegrid to Excel function due to the fact I don't want all the columns exported to Excel as the inbuilt function does, and decided that hiding columns and then using the inbuilt function could raise further problems. How wrong I have been! smile


To that end I 'borrowed' some code I found on various websites by Mike Shkolnik ,



I am obviously not understanding something, as no matter what I try I can only get 1 item to appear in the spreadsheet in addition to the header.


I filter the table grid, so that only the rows (variable in number) are exported. The tablegrid row count reflects the current number of rows correctly.


procedure frmMain_btnNothing_OnClick (Sender: TObject; var Cancel: boolean);
var
  xls, wb, range : Variant;
  arrData : Variant;
  rowCnt : integer;
  numOfRows,numCol:integer;
begin
  if frmMain.tgOrderPlace.RowCount > 0 then
  begin
     numOfRows := frmMain.tgOrderPlace.RowCount ;
     arrData := VarArrayCreate([0,frmMain.tgOrderPlace.RowCount, 0,3], varVariant);


    //excel format = row,column  table grid = column, row

     {row 0 contains tablegrid headers}
     arrData[0,0] := frmMain.tgOrderPlace.Columns[1].Header.Caption;
     arrData[0,1] := frmMain.tgOrderPlace.Columns[2].Header.Caption;
     arrData[0,2] := frmMain.tgOrderPlace.Columns[4].Header.Caption;

    {fill array with cell contents by row}
    for  rowCnt := 1 to numOfRows do
    begin
      arrData[rowCnt,0] := frmMain.tgOrderPlace.Cells[1,rowCnt-1];
      arrData[rowCnt,1] := frmMain.tgOrderPlace.Cells[2,rowcnt-1];
      arrData[rowCnt,2] := frmMain.tgOrderPlace.Cells[4,rowcnt-1];
    end;

    xls := CreateOLEObject('Excel.Application');

    wb := xls.WorkBooks.add;

    range := wb.WorkSheets[1].Range[wb.WorkSheets[1].Cells[1,1],wb.WorkSheets[1].Cells[frmMain.tgOrderPlace.RowCount, 3]];

    Range.Value := arrData;
    Range.Columns.Autofit();  //In Excel columns must be filled first and then autofit called
    xls.Visible := true;
  end;
  //wb.Close;
  xls.Quit;
end;

The link to the original code is https://stackoverflow.com/questions/166 … d-to-excel .

I've attached a snipshot of what I want to appear in Excel and what actually appears in Excel.

I'm playing around converting my SQLite database into a mySQL one.

I've hit a problem where in SQLite I store the file path to some text documents in a field, to be recovered later in a tablegrid and then can be double clicked to pen the document. This works.


However, mySql strips the back slashes from the text (probably because \ is a reserved character in mySql).

I assume I'm going to have to use  ReplaceStr(filePath, \, smile along with code   along the lines of


var

fPath : string;
delimPath : string
begin
     fPath:=ExtractFilePath(ArrayOfFiles[0]);
     fPath:= fPath + ExtractFileName(ArrayOfFiles[0]);
     
     frmAddDatasheet.DBFile1.dbFileName := ReplaceStr(fPath, '\',':');
end;

My main question is, will using Save Record set to DBFile1  contain the altered path, and when loading the tablegrid  how do I intercept the value in the field - would I use a calculated field and use the REPLACE statement or somehow perhaps combine ReplaceString with a dbSQL statement?


Has anyone needed to do this with a mySQL/Maria database already?

I should mention, I've tried using a stored procedure in the DB, but I'm not sure how to call it from within MVD and while it works in mySQL Workbench to store the the file path, I'm unsure how to persuade MySQl to perform the opposite function.

Time is an existing method! Try changing time to myTime for example.

Here is my code that works:

var
Timer : TTimer;
iSeconds : integer;


procedure frmMain_On_Show(Sender: TObject; Action string);
begin

     Timer := TTimer.Create (frmMain);
     Timer.Interval := 20000;  //Reset every 20 seconds
     Timer.Enabled := True;
     Timer.OnTimer := @OnTimer;
end;

procedure OnTimer;
begin

     iSeconds := iSeconds + 1;
     frmMain.lbCounter.Caption := ' '+intToStr(iSeconds);
     AutocloseSet;
     if iSeconds > 30 then // This equals 10 minutes approx
     begin
         
          dbUpdateTimer;
          iSeconds := 0;
     end;
end;

procedure dbUpdateTimer;
var
    indx,cnt : integer;
begin

 {update all tables on main form
  cnt := frmMain.ComponentCount -1;
  for indx := 0 to cnt do
  begin
    if frmMain.Components[indx]  is TdbStringGridEx then
        TdbStringGridEx(frmMain.Components[indx]).dbUpdate;
  end; 
 
 {update tables on all other forms}                                                                                           
  frmOrderEntry.grdOrder.dbUpdate;
  frmEditAssemblies.tgMasterPart.dbUpdate;
  frmEditAssemblies.tgSubPart.dbUpdate;
  frmEditPart.grdEditPart.dbUpdate;
  
end;

Problem solved by deleting the DCU file and recompiling.  XMLEditor reported an invalid token in the dcu file.

I've attached a snipshot of the _user table. 

So myself 'admin', and 'kerian' can log in with no problem, if I impersonate any of the others I get the above runtime error.

I have made some minor alterations to a program that runs.


1. added a new form  and code for that form.


2. added code to an existing method that  reads and deletes an entry in the database.


Application compiles with no errors, and I can log on to the program using my login and one of the other users. However out of 12 users in the database only my login and one other now works.


If I try to log in as the other users I get the following two message boxes and two instances per user attempted login of the application appear in Task Manager with a CPU usage of 100%. 


Error message 1:
Exception EListError in module workshopPartsDB.exe at 000BC592.  List index out of bounds (7).  when I click OK, the second message pops up


Error message 2:
Access violation at address 00E3A5C8 in module 'workshopPartsDB.exe'. Read of address 00000000


Does anyone have any idea what list index the application is suddenly having a problem with?


It is really weird that the only two users that can log in are the first two in the database, user_ID 3 to 12 cause this problem.


The added code which is now commented out:

procedure frmMain_tgLogged_OnCellDoubleClick (Sender: TObject; ACol, ARow: Integer);
var
  logName : string;
begin
       logName := SQLExecute('SELECT username FROM user_log WHERE username ="' + Application.User.Username + '"'); 
      showmessage(logName);
      { if Application.User.Username = logName then
         MessageBox('You cannot FORCE your own logout ' +  #13#10#13#10 + 'Please select another user or close the program normally.','Logout Problem  ' + Application.User.Username,MB_OK+MB_ICONERROR)
       else
       begin  
         SqlExecute('Delete FROM user_log WHERE id = "' + frmMain.tgLogged.sqlValue + '"');
         frmMain.tgLogged.dbUpdate;
       end;}
end;

The code for  the new form:

procedure frmChangePartNumber_btnNewPartNo_OnClick (Sender: TObject; var Cancel: boolean);
begin
     sqlexecute('UPDATE products SET  LineNumber = "'+frmChangePartNumber.edtNewPartNo.text+'" WHERE id = '+IntToStr(frmEditPart.grdEditPart.dbItemID));
     frmEditPart.grdEditPart.dbUpdate;
     //showMessage('After update '+ frmEditPart.grdEditPart.Cells[0,rowSelect]);
     frmEditPart.lbLineNo.Caption := frmChangePartNumber.lbCurrentPartNo.Caption;
     frmChangePartNumber.Close;

end;

procedure  frmChangePartNumber_edtNewPartNo_OnExit(Sender: TObject);
var
    buttonSelected: integer;
    lngth : integer;
begin

  lngth :=  Length(frmChangePartNumber.edtNewPartNo.text); //check how many digits have been entered

  if (frmChangePartNumber.edtNewPartNo.Text = '') or (frmChangePartNumber.lbCurrentPartNo.Caption = frmChangePartNumber.edtNewPartNo.Text) then
  begin
   MessageBox('No Changes have been made','INFORMATION',0);
   frmChangePartNumber.edtNewPartNo.SetFocus;
   end
   else {entry must be a seven digit number}
   if lngth <> 7 then
   begin
     messageDlg('Part Number must be 7 digits long',mtError, mbCancel, 0);
     frmChangePartNumber.edtNewPartNo.SetFocus;
   end;
 

  if frmMain.edtInternalNumber.text = sqlexecute('SELECT  lineNumber FROM products WHERE lineNumber = "'+frmChangePartNumber.edtNewPartNo.text+'"') then
  begin
    buttonSelected := messageDlg('WARNING Part Number already exists',mtWarning, mbOK+mbRetry, 0);
    if buttonSelected = mrRetry then
     //frmMain.edtInternalNumber.Clear
      frmChangePartNumber.edtNewPartNo.SetFocus
    else
     exit;
  end;   
end;

procedure frmChangePartNumber_OnShow (Sender: TObject; Action: string);
begin
    frmChangePartNumber.edtNewPartNo.Clear;
    frmChangePartNumber.lbCurrentPartNo.Caption := frmEditPart.lbLineNo.Caption;
    frmChangePartNumber.edtNewPartNo.SetFocus;
end;

procedure frmEditPart_lbLineNo_OnDoubleClick (Sender: TObject);
begin
   if frmEditPart.lbLineNo.Caption <> 'LineNo' then
       frmChangePartNumber.Show;
end;

60

(2 replies, posted in Script)

iwkom,

Add the result if it is two digits and compare it with the last digit.

If the result is two digits, do they get subtracted from the nearest multiple of 10 to produce the check digit?

Are the numbers added as single digits or as actual numbers?


Using your formula for example, the eight digit number 83102340 = 8 + 6 + 3 + 0 + 10 + 18 + 28 + 0 = 73, if adding as actual numbers. But if added as single digits the number will be  8 + 6 + 3 +  0 +1 + 0 + 1 + 8 + 2 + 8 + 0 = 38.


Does the resulting number get deducted from the nearest value of 10  which in the above examples would either result in a check digit of either 7  or 2?


If you could clarify the above, a function could be written for you.

61

(5 replies, posted in Script)

Try using for i:=1 to (cCount-1) do begin .  Loops normally start at zero, though you do not say what result you are getting with the current code so pointing you in the right direction is a guess at best.

62

(4 replies, posted in General)

Hello Papafrank and Derek,


Derek I hope you don't mind, but I'd like to offer a minor difference to your code, which in its' present state no longer keeps the edit box on return from form 2, so of course doesn't quite do what Papafrank wants, but could be useful for someone else.

1. Click on the Form1 adn enable the property 'Key Preview'

2. Double Click on the Form1 event OnKeyPress  and add below code to the script

procedure Form1_OnKeyPress (Sender: TObject; var Key: Char);

begin
    if Key = #13 then
    begin     
        twincontrol(form1.findcomponent(vwherefrom)).setfocus;
      Key :=#0;
    end;

end;

3. Amend the Form1_EditXX_OnEnter code to:


Procedure Form1_Edit1_OnEnter (Sender: TObject);
begin
  vwherefrom := Form1.Edit2.Name; //'edit1';
  resetcolors;
  form1.edit1.Color := $00C0DCC1;
end;

Do that to all the 'OnEnter' code and then you also not only have the edit boxes change colour when you click in them  but you can now move from edit box to edit box just by pressing the Enter key.


The advantage to changing vwherefrom := 'EditXX' to vWhereFrom := Form1.EditXX.Name   is that if you change the EditBox name at anytime you won't have to change the script. It also allows for some cut and paste into other programs.


Note that each edit box vWhereFrom := Form1.EditXX.Name 'points to the next edit box , not the current one


I tried to see if there was a way to have 'intelligent code' which would recognise which edit box had been entered and automatically move to the next edit box but I couldn't get

if form1.Controls[i] is TEdit   

or

if form1.components[i] is TEdit

to work.

63

(4 replies, posted in General)

Keith,

You forgot to add the project to your post! smile

vanadu55 wrote:

Thanks. I've figure it out by myself.


What did you do to get it to work?

65

(4 replies, posted in General)

I did mine differently to Derek's,


         Form1.DateTimePicker1.DateTime := (Time + 1);

The above adds 1 hour to the DateTimePicker from the current PC system time.


I haven't tried adding minutes instead of hours, and, it might not be possible using the Time function.

66

(3 replies, posted in General)

unforgettable,

The full stop is the end of the complete program. All procedures and functions must be before the begin.....end..

A procedure or function must finish with a end;.


So for example:


procedure loadSettings;
var
  settingsIni : TStringlist;
  lngth : integer;
begin
   settingsIni := TStringList.Create;
   settingsIni.LoadFromFile ('Settings.ini');
   dbName := SettingsIni[4];
   SettingsIni.free;
   lngth := Length(dbName) - 7;
   dbName := copy(dbName, 8, lngth);
   FrmMain.lbDbPath.Caption := ExtractFilePath(Application.ExeName)+ dbName;
end;  //procedure ends with a semicolon

function CountBackups(dir: string) : string;
var
  fileList : TStringList;
 // count : integer;
begin
   result := '0';
   fileList := TStringList.Create;
   fileList.Text := GetFilesList(dir, '*.db',False);
   result := intToStr(fileList.Count -1);

   fileList.Free;
end; // Function ends with a semicolon


begin

end.   //complete program finishes here.

In MVD the begin-------end.  is used for any code that must run when your program first starts and before your form appears.  In most cases you will leave this part of the script blank.

67

(26 replies, posted in Script)

Hello Kofa and Brian,


You could try this:


procedure Form1_Button6_OnClick(Sender: TObject);
var
  buttonSelected : Integer;
begin

  buttonSelected := messagedlg('Confirmation',mtError, mbOK+mbCancel, 0);

  if buttonSelected = mrOK   then 
  
       ShowMessage('OK pressed') 
 else  
      buttonSelected = mrCancel then ShowMessage('Cancel pressed');
 end;
end;

Google Translate:

Это не совсем ответ на ваш вопрос, но 'FileOpen (FileName)' может открыть любой файл, зарегистрированный в Windows, или вы можете использовать FileOpen (FileName, расширение, которое вам нужно)



This is not really an answer to your question, but 'FileOpen (FileName)' can open any file registered in Windows, or you can use FileOpen (FileName, the extension you need)

69

(1 replies, posted in General)

There isn't a lot of extra help Keith. There is the help page  http://myvisualdatabase.com/help_en/  , there was a superior one in Russian but Dmitry seems to have taken it down.


Having said that, many of the functions are unaltered from Delphi (XE7) itself, though the message dialog ones work slightly differently to the same function in Delphi 10.x .

70

(4 replies, posted in Script)

Unforgettable,

Sorry I led you down the wrong path.  I hadn't realised it wasn't working properly until the other day.


I've just discovered that combobox.text  only works if you fill an edittbox with the combox text and then use the editbox in your SQL statement.

Make the editbox invisible.


So  place the code in the ONChange event.

Form2.edit1.text := Form2.combobox1.text;
SQLExecute(INSERT INTO sal (books) VALUES ("'+form2.Edit1.Text+'")');

71

(3 replies, posted in General)

salahnecibi,

Is it possible for you to attach your program so far to your post? It would make it much easier to give you a solution to your question.

72

(45 replies, posted in Script)

Kofa,

Do you want to remove the entry from display or completely from the database?

Sorry for the delay Agusec, 

Here is a bare bones example.  I've only used one date picker in this example, and the code is activated by the button click, rather than the on_exit in the sample code above.


The current code assumes you have set your Windows clock to display 24 hour time, otherwise this code will close your program twice a day

74

(45 replies, posted in Script)

Kofa,


I've been trying to get this to work for monitors of different resolutions and I have failed.


It seems there is a Windows magnification factor that MVD can't cope with. It might be due to the version of Delphi that is used to make MVD.



Here is what I've tried, but it fails if the monitor is set to 150%.


procedure ScaleForm  (F: TForm; ScreenWidth, ScreenHeight: LongInt) ;
begin

 F.Scaled := True;
 F.AutoScroll := False;
 F.Position := poDefaultPosOnly; //poScreenCenter;
 F.Font.Name := 'Arial';
 if (Screen.Width <> ScreenWidth) then
 begin
     F.Height :=  (F.Height * Screen.Height) div ScreenHeight;
     F.Width :=  (F.Width * Screen.Width) div ScreenWidth;
     F.ScaleBy(Screen.Width,ScreenWidth) ;
 end; 
end;

procedure CentreForm(Form: TForm);
begin
    with Form do
    begin
        Left := Application.frmMain.Left + (Application.frmMain.Width - Width) div 2;
        if Left < 0 then Left:=0;
        Top := Application.frmMain.Top + (Application.frmMain.Height - Height) div 2;
        if Top <0 then Top:=0;
   end;
end;

Called in the default begin...end by:

 ScaleForm(frmMain,1920,1080) ;

//OR

  CentreForm(frmMain);

I think your problem might be solved by changing your quotes.



 frmScore.ComboBox1.dbSQLExecute('SELECT name, id FROM Specification WHERE id_Dogovor="'+frmScore.dogovor.sqlValue+"'');

Note the " then '+ and at the end +' then " before the final '.

The double '' are speech quotes  and the single is the apostrophe.


Думаю, вашу проблему можно решить, изменив цитаты.


Обратите внимание на [color = red] "[/ color], затем [color = red] '[/ color] и в конце [color = red]' [/ color], затем [color = red]" [/ color] перед final [color = red] '[/ color].

Двойное «» - это речевые кавычки, а одинарное - апостроф.