konstantin.gussev wrote:
А почему ругается? Все сделано по вашему примеру.
Приложите пожалуйста ваш проект и сообщите версию используемой вами программы.
3,076 2017-08-09 09:39:02
Re: Содержимое папки во вкладке Page Control (13 replies, posted in Russian)
3,077 2017-08-09 09:37:44
Re: Index out of bounds Error (7 replies, posted in General)
Hello.
Unfortunately I have not received your e-mail.
3,078 2017-08-08 11:05:54
Re: Crosstab Sample (2 replies, posted in General)
Hello.
Check out this sql query
SELECT
SUM(CASE Category WHEN 'BMW' THEN Amount ELSE 0 END) "BMW"
,SUM(CASE Category WHEN 'KIA' THEN Amount ELSE 0 END) "KIA"
,SUM(CASE Category WHEN 'ISUZU' THEN Amount ELSE 0 END) "ISUZU"
FROM TableName 3,079 2017-08-08 10:40:38
Re: How can I show in combobox the values when i select from TableGrid? (21 replies, posted in General)
It's correct.
3,080 2017-08-08 10:20:40
Re: On MouseDown Event (5 replies, posted in General)
Hello.
Check it out
procedure Form1_TableGrid1_OnMouseDown (Sender: string; MouseLeft, MouseRight, MouseMiddle: boolean; Shift, Alt, Ctrl: boolean; X, Y: Integer);
begin
form1.memo1.Text := sqlexecute('select message from phonecalls where id =' +inttostr(Form1.TableGrid1.dbIndexToID(Form1.TableGrid1.GetRowAtPos(x,y))));
form1.panel1.Visible := true;
end;3,081 2017-08-08 10:12:13
Re: Example Create ToolBar,ToolButton In Form (1 replies, posted in Script)
Thank you for the example!
3,082 2017-08-08 09:55:52
Re: Email and sms (1 replies, posted in General)
Hello.
How to send email
http://myvisualdatabase.com/forum/viewtopic.php?id=1445
How to send sms
http://myvisualdatabase.com/forum/viewtopic.php?id=1418
3,083 2017-08-08 09:48:01
Re: Содержимое папки во вкладке Page Control (13 replies, posted in Russian)
в конце скрипта должны бить эти строки
begin
end.возможно вы их случайно удалили, т.е. в целом скрипт должен быть таким:
procedure FillGridFiles(Grid: TdbStringGridEx; path: string); // процедура чтения файлов в грид
var
sl: TStringList;
i,c: integer;
NxTextColumn: TNxTextColumn;
begin
sl := TStringList.Create;
sl.Text := GetFilesList(path);
Grid.Columns.Clear;
try
Grid.Columns.Add(TNxTextColumn);
except
end;
Grid.Columns[0].Color := clWhite;
c := sl.Count-1;
for i := 0 to c do
begin
Grid.AddRow;
Grid.Cells[0, Grid.RowCount-1] := sl[i];
end;
sl.Free;
end;
procedure Form1_Button1_OnClick (Sender: string; var Cancel: boolean);
begin
FillGridFiles(Form1.TableGrid1, 'C:\Backup'); // вызов процедуры, с указанием из какой папки и в какой грид выводить список файлов
end;
begin
end. 3,084 2017-08-08 09:39:38
Re: How to set OpenAfterExport := False (3 replies, posted in Reports)
try this:
Form1.frxXLSExport1.OpenExcelAfterExport := False;3,085 2017-08-08 09:14:28
Re: How To Fix Error SendMail function Time Out ! (4 replies, posted in Script)
I have checked your project, it's works, I don't get any error message.
3,086 2017-08-07 11:35:41
Re: Буфер обмена. (1 replies, posted in Russian)
Здравствуйте
Думаю нет нужды для этих целей использовать буфер обмена.
Вы можете текст комопнента присвоить другому компоненту, пример
Form2.Edit1.Text := frmAddSupplier.edSupplier.Text;3,087 2017-08-04 16:21:10
Re: Example Create CheckListBox ,Listview In Form (7 replies, posted in Script)
Thank you for your examples!
3,088 2017-08-04 14:04:55
Topic: [Script] Import-Export data (11 replies, posted in FAQ)
Completely universal script to export/import data from a table. Just specify database fields in parameters of procedure.
procedure Form1_bExport_OnClick (Sender: string; var Cancel: boolean);
begin
Export('SELECT lastname, firstname, salary, dateofbirth, isSmoke, comment FROM employees', '1.csv');
end;
procedure Form1_bImport_OnClick (Sender: string; var Cancel: boolean);
begin
Import('employees', 'lastname,firstname,salary,dateofbirth,isSmoke,comment', '1.csv');
end;
procedure Form1_bImportCheckDup_OnClick (Sender: string; var Cancel: boolean);
begin
Import('employees', 'lastname,firstname,salary,dateofbirth,isSmoke,comment', '1.csv', 'lastname,firstname');
end;
procedure Export (SQL: string; FileName: string);
var
Results: TDataSet;
i,c: integer;
sl: TStringList;
sValue, sValues: string;
begin
SQLQuery(sql, Results);
sl := TStringList.Create;
c := Results.FieldCount-1;
while not Results.eof do
begin
sValues := '';
for i := 0 to c do
begin
if not Results.Fields.Fields[i].isNull then
begin
sValue := Results.Fields.Fields[i].AsString;
if (Results.Fields.Fields[i].DataType = ftFloat) or (Results.Fields.Fields[i].DataType = ftLargeint) then
sValue := ReplaceStr(sValue, ',', '.')
else
begin
sValue := ReplaceStr(sValue, ',', ',');
sValue := ReplaceStr(sValue, #13#10, '|');
sValue := '''' + escape_special_characters(sValue) + '''';
end;
end else sValue := 'NULL';
sValues := sValues + sValue+',';
end;
if sValues <> '' then SetLength(sValues, Length(sValues)-1);
sl.Add(sValues);
Results.next;
end;
sl.SaveToFile(FileName);
sl.Free;
Results.Close;
end;
procedure Import(TableName, Fields: string; FileName: string; CheckDuplicateFields: string = '');
function ArrayInCheck(a: array of string; sValue: string): boolean;
var
i,c: integer;
begin
result := False;
c := Length(a)-1;
for i := 0 to c do
begin
if LowerCase(a[i])=LowerCase(sValue) then
begin
result := true;
break;
end;
end;
end;
var
iField, cField: integer;
iLine, cLine: integer;
sl: TStringList;
arrValues: array of string;
arrFields: array of string;
arrFieldsDuplicate: array of string;
sValue, sValues: string;
sWhereDuplicate: string;
begin
if CheckDuplicateFields <> '' then arrFieldsDuplicate := SplitString(CheckDuplicateFields, ',');
sl := TStringList.Create;
sl.LoadFromFile(FileName);
arrFields := SplitString(Fields, ',');
cLine := sl.Count-1;
for iLine := 0 to cLine do
begin
sValues := '';
arrValues := SplitString(sl[iLine], ',');
if Length(arrFields) <= Length(arrValues) then
begin
sWhereDuplicate := '';
cField := Length(arrFields)-1;
for iField := 0 to cField do
begin
sValue := arrValues[iField];
sValue := ReplaceStr(sValue, ',', ',');
sValue := ReplaceStr(sValue, '|', #13#10);
sValues := sValues + sValue+',';
if ArrayInCheck(arrFieldsDuplicate, arrFields[iField]) then
sWhereDuplicate := sWhereDuplicate +'('+ arrFields[iField]+'='+sValue + ') AND ';
end;
if sValues <> '' then
begin
SetLength(sValues, Length(sValues)-1);
if sWhereDuplicate <> '' then
begin
SetLength(sWhereDuplicate, Length(sWhereDuplicate)-5);
if SQLExecute('SELECT COUNT(id) FROM '+TableName+' WHERE '+sWhereDuplicate)=0 then
SQLExecute('INSERT INTO '+TableName+' ('+Fields+') VALUES ('+sValues+')');
end else
SQLExecute('INSERT INTO '+TableName+' ('+Fields+') VALUES ('+sValues+')');
end;
end;
end;
sl.Free;
end;Example: http://myvisualdatabase.com/forum/misc. … download=1
3,089 2017-08-04 14:02:14
Re: Link into button or label (2 replies, posted in General)
Hello.
Example:
// for a label
procedure Form1_Label1_OnClick (Sender: string);
begin
OpenURL('http://google.com');
end;
// for a button
procedure Form1_Button1_OnClick (Sender: string; var Cancel: boolean);
begin
OpenURL('http://google.com');
end;3,090 2017-08-04 13:59:05
Topic: [Скрипт] Импорт и Экспорт записей (29 replies, posted in FAQ)
Пример универсального скрипта для экспорта и импорта данных из таблиц (Import-Export.zip). Вам просто необходимо указать столбцы в параметрах процедуры, которые должны быть импортированы или экспортированы.
В файле "Import-Export with autofill dictionaries.zip" вы найдете проект с примером, который работает и со словарями, автоматически дополняя их, если значение отсутствует в таблице.
procedure Form1_bExport_OnClick (Sender: string; var Cancel: boolean);
begin
Export('SELECT lastname, firstname, salary, dateofbirth, isSmoke, comment FROM employees', '1.csv');
end;
procedure Form1_bImport_OnClick (Sender: string; var Cancel: boolean);
begin
Import('employees', 'lastname,firstname,salary,dateofbirth,isSmoke,comment', '1.csv');
end;
procedure Form1_bImportCheckDup_OnClick (Sender: string; var Cancel: boolean);
begin
Import('employees', 'lastname,firstname,salary,dateofbirth,isSmoke,comment', '1.csv', 'lastname,firstname');
end;
procedure Export (SQL: string; FileName: string);
var
Results: TDataSet;
i,c: integer;
sl: TStringList;
sValue, sValues: string;
begin
SQLQuery(sql, Results);
sl := TStringList.Create;
c := Results.FieldCount-1;
while not Results.eof do
begin
sValues := '';
for i := 0 to c do
begin
if not Results.Fields.Fields[i].isNull then
begin
sValue := Results.Fields.Fields[i].AsString;
if (Results.Fields.Fields[i].DataType = ftFloat) or (Results.Fields.Fields[i].DataType = ftLargeint) then
sValue := ReplaceStr(sValue, ',', '.')
else
begin
sValue := ReplaceStr(sValue, ',', ',');
sValue := ReplaceStr(sValue, #13#10, '|');
sValue := '''' + escape_special_characters(sValue) + '''';
end;
end else sValue := 'NULL';
sValues := sValues + sValue+',';
end;
if sValues <> '' then SetLength(sValues, Length(sValues)-1);
sl.Add(sValues);
Results.next;
end;
sl.SaveToFile(FileName);
sl.Free;
Results.Close;
end;
procedure Import(TableName, Fields: string; FileName: string; CheckDuplicateFields: string = '');
function ArrayInCheck(a: array of string; sValue: string): boolean;
var
i,c: integer;
begin
result := False;
c := Length(a)-1;
for i := 0 to c do
begin
if LowerCase(a[i])=LowerCase(sValue) then
begin
result := true;
break;
end;
end;
end;
var
iField, cField: integer;
iLine, cLine: integer;
sl: TStringList;
arrValues: array of string;
arrFields: array of string;
arrFieldsDuplicate: array of string;
sValue, sValues: string;
sWhereDuplicate: string;
begin
if CheckDuplicateFields <> '' then arrFieldsDuplicate := SplitString(CheckDuplicateFields, ',');
sl := TStringList.Create;
sl.LoadFromFile(FileName);
arrFields := SplitString(Fields, ',');
cLine := sl.Count-1;
for iLine := 0 to cLine do
begin
sValues := '';
arrValues := SplitString(sl[iLine], ',');
if Length(arrFields) <= Length(arrValues) then
begin
sWhereDuplicate := '';
cField := Length(arrFields)-1;
for iField := 0 to cField do
begin
sValue := arrValues[iField];
sValue := ReplaceStr(sValue, ',', ',');
sValue := ReplaceStr(sValue, '|', #13#10);
sValues := sValues + sValue+',';
if ArrayInCheck(arrFieldsDuplicate, arrFields[iField]) then
sWhereDuplicate := sWhereDuplicate +'('+ arrFields[iField]+'='+sValue + ') AND ';
end;
if sValues <> '' then
begin
SetLength(sValues, Length(sValues)-1);
if sWhereDuplicate <> '' then
begin
SetLength(sWhereDuplicate, Length(sWhereDuplicate)-5);
if SQLExecute('SELECT COUNT(id) FROM '+TableName+' WHERE '+sWhereDuplicate)=0 then
SQLExecute('INSERT INTO '+TableName+' ('+Fields+') VALUES ('+sValues+')');
end else
SQLExecute('INSERT INTO '+TableName+' ('+Fields+') VALUES ('+sValues+')');
end;
end;
end;
sl.Free;
end;Проект с примером:
3,091 2017-08-04 13:56:08
Re: Импорт и экспорт данных (9 replies, posted in Russian)
Сделал для вас проект с примером, скрипт является универсальным, вам просто нужно указать наименование столбцов для импорта или экспорта в параметрах процедур.
Насчет дублирования записей, вам нужно решить, по каким именно признакам будет определяться, что это дубликат записи, например создавать для каждой записи уникальный идентификатор, либо определять дубликат по сочетанию полей, например имя, фамиля, год рождения.
http://myvisualdatabase.com/forum/viewt … ?pid=21566
3,092 2017-08-04 12:20:18
Re: MDI form and Child Form sample (1 replies, posted in General)
Hello.
MDI forms is not support.
3,093 2017-08-03 13:18:33
Re: Содержимое папки во вкладке Page Control (13 replies, posted in Russian)
можно так
procedure FillGridFiles(Grid: TdbStringGridEx; path: string); // процедура чтения файлов в грид
var
sl: TStringList;
i,c: integer;
NxTextColumn: TNxTextColumn;
begin
sl := TStringList.Create;
sl.Text := GetFilesList(path);
Grid.Columns.Clear;
try
Grid.Columns.Add(TNxTextColumn);
except
end;
Grid.Columns[0].Color := clWhite;
c := sl.Count-1;
for i := 0 to c do
begin
Grid.AddRow;
Grid.Cells[0, Grid.RowCount-1] := sl[i];
end;
sl.Free;
end;
procedure Form1_Button1_OnClick (Sender: string; var Cancel: boolean);
begin
FillGridFiles(Form1.TableGrid1, 'C:\Backup'); // вызов процедуры, с указанием из какой папки и в какой грид выводить список файлов
end;3,094 2017-08-03 13:15:43
Re: Multiple tGrid focus on same form (5 replies, posted in General)
Check it out
procedure derekwhichsheetisactive; //*** highlight grid row in each tabsheet
begin
if form1.PageControl1.ActivePage = form1.tabsheet1 then
begin
if form1.gridemployees.selectedrow < 0 then form1.gridemployees.selectedrow := 0;
vrowid := form1.gridemployees.selectedrow;
if form1.gridemployees.selectedrow > -1 then form1.button1.click;
form1.gridemployees.selectedrow := vrowid;
form1.gridemployees.setfocus;
end;
if form1.PageControl1.ActivePage = form1.tabsheet2 then
begin
if form1.gridproducts.selectedrow < 0 then form1.gridproducts.selectedrow := 0;
vrowid := form1.gridproducts.selectedrow;
if form1.gridproducts.SelectedRow > -1 then form1.button5.click;
form1.gridproducts.selectedrow := vrowid;
form1.gridproducts.setfocus;
end;
end;3,095 2017-08-03 13:08:44
Re: Почему скрипт не отрабатывает? (6 replies, posted in Russian)
spectre
Увы но WinRAR пишет что архив поврежден.
3,096 2017-08-03 12:03:06
Re: Calculate field for Date (11 replies, posted in General)
For ComboBox1 set properties
ForeignKey = people.id_Status
FieldName = Status
3,097 2017-08-03 11:56:25
Re: How can I show in combobox the values when i select from TableGrid? (21 replies, posted in General)
v_pozidis wrote:
Updated, my new example is the attached file. I have added a new table Work. In the SQL Search button it should work also wih the edit boxex and the new combobox (Work).
Fixed project
3,098 2017-08-03 11:50:59
Re: How to set OpenAfterExport := False (3 replies, posted in Reports)
I have checked your project, it's work for me.
3,099 2017-08-03 11:04:03
Re: Index Problem, Script Editor problem (5 replies, posted in General)
teco049
please download latest beta version
https://www.dropbox.com/s/4rfukqr2r1awq … b.zip?dl=0
now you can enable code folding in the context menu of script editor.
3,100 2017-08-03 10:00:52
Re: Упростить логирование изменения записи. (2 replies, posted in Russian)
это можно сделать с помощью скриптов или тригеров
http://zametkinapolyah.ru/zametki-o-mys … qlite.html
http://souptonuts.sourceforge.net/readm … orial.html
постараюсь в ближайшее время сделать для вас пример.