Подскажите пожалуйста, почему lazarus таким образом заносит данные в таблицу. Некоторые строки повторяются. А в Delphi такого не происходит (на рис. таблица сверху), хотя код везде одинаковый. Как это можно исправить, чтобы было как в delphi?
- Код: Выделить всё
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
StdCtrls, math;
type
{ TForm1 }
TForm1 = class(TForm)
Button2: TButton;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
DecSeparator : Char = #9;
group:string;
implementation
{$R *.lfm}
function RandomExponent(ex: extended): extended;
{ экспотенциальное распределение }
begin
Result := -ex * Ln(Random)+1
end;
function RandomTovSum(const min,max:integer):integer;
var
i:integer;
sum,s:Extended;
label
state;
begin
goto state;
state:begin
Randomize;
i:=RandomRange(1,Form1.StringGrid2.RowCount-2);
if TryStrToFloat(Form1.StringGrid2.Cells[3,i] , s) then
begin
sum:=s;
if (sum > min) and (sum <= max) then
Result:=i else
goto state;
end else
Result:=RandomTovSum(min,max);
end;
end;
function GetTotalSum:double;
var
i:integer;
begin
Result:=0;
for i:=1 to Form1.StringGrid1.RowCount -1 do
begin
if Form1.StringGrid1.Cells[5,i] = '' then break;
Result:=Result+StrToFloat(Form1.StringGrid1.Cells[5,i] ) ;
end;
Result:=RoundTo( Result,-2);
end;
function GetKolTov(min,x:integer):integer;
begin
if x > 5 then
Result:=Randomrange(min,5) else
Result:=Random(x);
end;
procedure LoadSaveTable(flille:string);
var
L : TStringList;
j,col,pos,i:integer;
s:String;
begin
L := TStringList.Create;
L.LoadFromFile(flille); //Товары
form1.StringGrid1.RowCount := L.Count+2;
for i := 1 To L.Count-1 do
begin
S := L.Strings[i];
pos := 1;
col := 0;
for j := 1 to Length(S) do
begin
if S[j] = DecSeparator then
begin
form1.StringGrid1.Cells[col,i] := Copy(S, pos, j-pos);
pos := j+1;
inc(col);
end;
end;
form1.StringGrid1.Cells[col,i] := Copy(S, pos, Length(S)+1-pos);
end;
L.Free;
end;
procedure SortStringGrid(var MainStrGrid,NewStrGrid: TStringGrid);
const
TheSeparator = '@';
var
CountItem, I, J, K, ThePosition: integer;
MyList: TStringList;
col, MyString: string;
begin
CountItem := MainStrGrid.RowCount;
MyList := TStringList.Create;
MyList.Sorted := false;
try
for I := 1 to (CountItem - 1) do
if MainStrGrid.Cells[0,i] <> '' then
MyList.Add(FloatToSTr(StrToDate(MainStrGrid.Cells[0,i])) + TheSeparator + INtToSTr(i));
//Sort the List
Mylist.Sort;
for K := 0 to Mylist.Count-1 do
begin
MyString := MyList.Strings[K];
ThePosition := Pos(TheSeparator, MyString)-1;
col:= copy(MyString,ThePosition+2, length(MyString)-ThePosition+2);
for J := 0 to MainStrGrid.ColCount-1 do
NewStrGrid.Cells[J,k+1]:= MainStrGrid.Cells[j,StrToInt(col)];
end;
finally
MyList.Free;
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
//Открытие и заполнение компоненты stringgrid
var
i: Integer;
dt1, dt2, dtRandom : TDateTime;
L : TStringList;
ond: Integer;
ty:integer;
mintov,total:double;
front, a:integer;
quant:word;
depost :array[1..6] of integer;
sg:TStringGrid ;
const
tovdiapoz:array[0..6] of integer = (999999,30000,20000,10000,5000,1000, 0); // Минимальная сумма
koltovmax:array[1..6] of integer = ( 10, 20, 30, 40, 200,20000); // макс предел товаров
mintovaro:array[1..6] of integer = ( 2, 2, 2, 3, 10, 20); // мин предел товаров
maxtovarox = 10000;
label
load , generate, ends;
begin
if not FileExists(ExtractFilePath(paramstr(0))+'\Продажи.txt') then
goto generate else
goto load ;
load:begin
LoadSaveTable(ExtractFilePath(paramstr(0))+'\Продажи.txt');
goto ends;
end;
generate:begin
StringGrid1.RowCount:=maxtovarox+1; // Типа очистка
//заполнение таблицы из файла
Randomize;
total:=1000000;
mintov:= total / 3;
for a:= 1 to 6 do
if mintov > tovdiapoz[a] then
begin
front:=a;
break;
end;
for i := 1 to 5 do
depost[i]:= RandomRange(1,koltovmax[i]) ;
depost[6]:= maxtovarox;
ty:=1;
repeat
dt1 := EncodeDate(2010, 01, 02); {генерируем дату}
dt2 := EncodeDate(2011, 03, 03);
dtRandom:=RandomRange(trunc(dt1),trunc(dt2));
ond:=RandomTovSum(tovdiapoz[front],tovdiapoz[front-1]);
quant:= RandomRange(1,5);
dec(depost[front]) ;
if depost[front] = 0 then
begin
inc(front);
end;
if quant <> 0 then
begin
StringGrid1.Cells[0,ty] := DateToStr(dtRandom);
StringGrid1.Cells[1,ty] := StringGrid2.Cells[0,ond] ;
StringGrid1.Cells[2,ty] := InttoStr(1+Random(3));
StringGrid1.Cells[3,ty] := InttoStr(9+Random(11));;
StringGrid1.Cells[4,ty] := FloatToStr(quant);
StringGrid1.Cells[5,ty] := FloatToStr(StrToFloat(StringGrid2.Cells[3,ond])*quant);
inc(ty);
end;
until
ty > maxtovarox;
// сортировка по дате
sg:=TStringGrid.Create(nil);
sg.ColCount:=StringGrid1.ColCount;
sg.RowCount:=StringGrid1.RowCount;
sg.Left:=-1000;
sg.Top:=-1000;
sg.Visible:=False;
for i:=0 to StringGrid1.RowCount-1 do
for a:=0 to StringGrid1.ColCount-1 do
sg.Cells[a,i]:= StringGrid1.Cells [a,i];
SortStringGrid(sg,StringGrid1);
// сохряняем список
L := TStringList.Create;
L.Clear;
for i:=0 to StringGrid1.RowCount-1 do
begin
if StringGrid1.Cells[0,i] <> '' then
l.Add(StringGrid1.Cells[0,i]+#09+StringGrid1.Cells[1,i]
+#09+StringGrid1.Cells[2,i]+#09+StringGrid1.Cells[3,i]
+#09+StringGrid1.Cells[4,i]+#09+StringGrid1.Cells[5,i])
end;
sg.Free;
L.SaveToFile(ExtractFilePath(paramstr(0))+'\Продажи.txt' );
L.Free;
end;
ends:begin
i:=0;
for a:= 1 to StringGrid1.RowCount -1 do
if StringGrid1.Cells[0,a] <> '' then
inc(i);
// Label9.Caption:= INtToSTR(i);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
L : TStringList;
j,col,pos,i:integer;
s:string;
begin
StringGrid1.Cells[0,0]:='Дата продажи';
StringGrid1.Cells[1,0]:='Товар.Код';
StringGrid1.Cells[2,0]:='Отдел.Код';
StringGrid1.Cells[3,0]:='Час покупки';
StringGrid1.Cells[4,0]:='Количество';
StringGrid1.Cells[5,0]:='Сумма';
L := TStringList.Create;
L.LoadFromFile('items.txt');
StringGrid2.RowCount := L.Count+2;
StringGrid2.ColCount := 4;
for i := 0 To L.Count-1 do
begin
S := L.Strings[i];
pos := 1;
col := 0;
for j := 1 to Length(S) do
begin
if S[j] = DecSeparator then
begin
StringGrid2.Cells[col,i] := Copy(S, pos, j-pos);
pos := j+1;
inc(col);
end;
end;
StringGrid2.Cells[col,i] := Copy(S, pos, Length(S)+1-pos);
end;
L.Free;
end;
end.