Хостинг Портала RusFAQ.ru:
MosHoster.ru - Профессиональный хостинг на Windows 2008

РАССЫЛКИ ПОРТАЛА RUSFAQ.RU

Чемпионы рейтинга экспертов в этой рассылке

Armad Статус: 3-й класс Рейтинг: 86 ∙ повысить рейтинг >>

Влaдимир Статус: 7-й класс Рейтинг: 67 ∙ повысить рейтинг >>

Абельхарисов Руслан/Marked One Статус: Практикант Рейтинг: 25 ∙ повысить рейтинг >>

/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Delphi

Выпуск № 1342
от 11.04.2009, 23:05

Вопрос № 164251: Уважаемые эксперты, решаю задачу - вычисление средней заработной платы сотрудников. ФИО сотрудников и зарплата каждого заносится в StringGrid. Я по этой задаче уже задавал вопрос.(за ответ спасибо!).Но у меня опять возникли проблемы. Не могу сообр...

Вопрос № 164.251

Уважаемые эксперты, решаю задачу - вычисление средней заработной платы сотрудников. ФИО сотрудников и зарплата каждого заносится в StringGrid. Я по этой задаче уже задавал вопрос.(за ответ спасибо!).Но у меня опять возникли проблемы. Не могу сообразить как из StringGrid данные записать в файл. (например с расширением dat.) В первом пункте меню данные сохранялись в памяти в массиве. Помогите, пожалуйста. (Код в приложении) Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, StdCtrls, Grids, ComCtrls, ExtCtrls; type TForm1 = class(TForm) Panel1: TPanel; StatusBar1: TStatusBar; StringGrid1: TStringGrid; ListBox1: TListBox; Label1: TLabel; Label2: TLabel; Edit1: TEdit; Label3: TLabel; MainMenu1: TMainMenu; OpenDialog1: TOpenDialog; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; N6: TMenuItem; N7: TMenuItem; N8: TMenuItem; procedure FormCreate(Sender: TObject); procedure N5Click(Sender: TObject); procedure N6Click(Sender: TObject); private { Private declarations } public { Public declarations } end; Type str=string[20]; sotrud=record fam_name:str; zarplata:integer; end; massiv=array of sotrud; var Form1: TForm1; mas:massiv; n:integer; implementation {$R *.dfm} procedure TForm1.FormCreate(Sender: TObject); begin StringGrid1.Cells[0,0]:='Familii'; StringGrid1.Cells[1,0]:='Zarabotna plata'; Edit1.Text:=' '; ListBox1.Clear; end; procedure TForm1.N5Click(Sender: TObject);// сохраняем данные в памяти var i:integer; begin i:=1; setlength(mas,1); while StringGrid1.Cells[0,i]<>'' do begin mas[i-1].fam_name:=StringGrid1.Cells[0,i]; mas[i-1].zarplata:=StrToInt(StringGrid1.Cells[1,i]); i:=i+1; Setlength(mas,i); end; n:=i-1; statusBar1.Panels.Items[0].Text:='n ='+ IntToStr(n); end; procedure TForm1.N6Click(Sender: TObject);// сохраняем данные в файл var i:integer; f:file of sotrud; begin assignfile(f,'sotrud.dat'); rewrite(f); // дальше для меня тупик end; end.

Отправлен: 06.04.2009, 10:51 Вопрос задал: Vlad9240 (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Armad Здравствуйте, Vlad9240! Примеры в приложении. Взято из DelphiWorld Приложение: // Save a TStringGrid to a file procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName); var f: TextFile; i, k: Integer; begin AssignFile(f, FileName); Rewrite(f); with StringGrid do begin // Write number of Columns/Rows Writeln(f, ColCount); Writeln(f, RowCount); // loop through cells for i := 0 to ColCount - 1 do for k := 0 to RowCount - 1 do Writeln(F, Cells[i, k]); end; CloseFile(F); end; // Load a TStringGrid from a file procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName); var f: TextFile; iTmp, i, k: Integer; strTemp: String; begin AssignFile(f, FileName); Reset(f); with StringGrid do begin // Get number of columns Readln(f, iTmp); ColCount := iTmp; // Get number of rows Readln(f, iTmp); RowCount := iTmp; // loop through cells & fill in values for i := 0 to ColCount - 1 do for k := 0 to RowCount - 1 do begin Readln(f, strTemp); Cells[i, k] := strTemp; end; end; CloseFile(f); end; // Save StringGrid1 to 'c: emp.txt': procedure TForm1.Button1Click(Sender: TObject); begin SaveStringGrid(StringGrid1, 'c: emp.txt'); end; // Load StringGrid1 from 'c: emp.txt': procedure TForm1.Button2Click(Sender: TObject); begin LoadStringGrid(StringGrid1, 'c: emp.txt'); end;

Ответ отправил: Armad (статус: 3-й класс) Ответ отправлен: 06.04.2009, 11:14 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246910 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Спасибо!

Отвечает: Влaдимир Здравствуйте, Vlad9240! А дальше for i:=0 to Length(mas)-1 do write(f,mas[i]); CloseFile(f); И чтение из файла соответственно i:=0; SetLenth(mas,FileSize(f)); while not EOF(f) do begin read(f,mas[i]); inc(i); end;

Ответ отправил: Влaдимир (статус: 7-й класс) Ответ отправлен: 06.04.2009, 11:40 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 246916 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Спасибо!

Вопрос № 164.253

Здравствуйте ув. эксперты Написал программу в которой используется линейная интерполяция(точками) в 2х мерном пространстве(это необходимо для передачи направления ЧПУ станку). А проблема в следующем - не могу переделать этот код в 3х мерную интерполяцию точками. Заранее спасибо за ответ PS если какие то переменные не объявлены в этом куске кода значит они объявлены глобальными Приложение: procedure TForm1.soedline(xx1, yy1, xx2, yy2, zz1, zz2:real); var i, x1, x2, y1, y2, z1, z2, nsh: longint; dy, yy:real; t:integer; begin //x2:=round((strtoint(Edit5.Text))/0.013); //x1:=round((strtoint(Edit7.Text))/0.013); //y2:=round((strtoint(Edit6.Text))/0.013); //y1:=round((strtoint(Edit8.Text))/0.013); x2:=round(xx1/0.013); x1:=round(xx2/0.013); y2:=round(yy1/0.013); y1:=round(yy2/0.013); z2:=round(zz1/0.013); z1:=round(zz2/0.013); if z1 < z2 then for i:=z1 to z2 do begin zd(); //по Z вниз // Label22.Caption:='X='+inttostr(i*13)+'мкм'; // Image1.Canvas.Pixels[round(i/10),round(tec_y/10)]:=clyellow; //sleep(1); // Refresh; end; if z1 > z2 then for i:=z1 downto z2 do begin zu(); //по Z вверх // Label22.Caption:='X='+inttostr(i*13)+'мкм'; // Image1.Canvas.Pixels[round(i/10),round(tec_y/10)]:=rgb(random(255),random(255),random(255)); //sleep(1); // Refresh; end; if ((x1<>x2)or(y1<>y2)) then if (((abs(x2-x1)>abs(y2-y1))or(y2=y1))and(x2<>x1)) then begin dy:=(y2-y1)/(x2-x1); if x2-x1<0 then dy:=-dy; yy:=y1; yt:=round(yy); t:=x1; if x2>x1 then nsh:=1 else nsh:=-1; // Image1.canvas.MoveTo(x1,y1); while(t<>x2+nsh)do begin yy:=yy+dy; // В ту сторону! if yt<>round(yy) then if yt<round(yy) then begin if CheckBox3.Checked then yu() else wri(4); //по Y вверх end else begin if CheckBox3.Checked then yd() else wri(3); //по Y вниз end; yt:=round(yy); Label26.Caption:='Y='+FloatToStr(yy); Label27.Caption:='t='+IntToStr(t); Image1.Canvas.Pixels[round(t/10),round(yy/10)]:=clblack; if CheckBox4.Checked then Repaint; t:=t+nsh; // В ту сторону! if nsh=1 then begin // по Х вправо if CheckBox3.Checked then xr() else wri(1); // по Х вправо end else begin // по Х влево if CheckBox3.Checked then xl() else wri(2); // по Х влево end; end; end else begin //вводить новые переменные лень,y и x поменяем местами(в смысле названия) dy:=(x2-x1)/(y2-y1); if y2-y1<0 then dy:=-dy; yy:=x1; yt:=round(yy); t:=y1; if y2>y1 then nsh:=1 else nsh:=-1; Image1.canvas.MoveTo(x1,y1); while(t<>y2)do begin yy:=yy+dy; if yt<>round(yy) then if yt<round(yy) then begin //Работает if CheckBox3.Checked then xr() else wri(1); // по Х вправо end else begin //Работает if CheckBox3.Checked then xl() else wri(2); // по Х влево end; yt:=round(yy); Label26.Caption:='Y='+FloatToStr(yy); Label27.Caption:='t='+IntToStr(t); // Image1.Canvas.LineTo(round(y),t+1); Image1.Canvas.Pixels[round(yy/10),round(t/10)]:=clred; // sleep(1); if CheckBox4.Checked then Repaint; t:=t+nsh; if nsh=1 then begin // Работает в нужном направлении if CheckBox3.Checked then yu() else wri(4); //по Y вверх end else begin // Работает в нужном направлении if CheckBox3.Checked then yd() else wri(3); //по Y вниз end; end; end; if CheckBox1.Checked then wri(7); // Отпустить моторы end;

Отправлен: 06.04.2009, 11:10 Вопрос задал: Шевченко Андрей Олегович (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Бизин Михаил Анатольевич Здравствуйте, Шевченко Андрей Олегович! Код в приложении. Ваша функция в этом коде называется DrawLine3D. Она простая, думаю, легко разберётесь, даже с минимумом комментариев. Остальной код поможет разобраться, как использовать функцию. У меня Вашего станка нет, поэтому результат в виде проекции на экран с перспективой трёхмерного изображения. Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Math; const MINSTEP = 0.013; //Шаг ЧПУ в миллиметрах type TPoint3D = record x,y,z: Double; end; TLine3D = record p1: TPoint3D; p2: TPoint3D; end; type TForm1 = class(TForm) Panel1: TPanel; Button1: TButton; Image1: TImage; EditX1: TEdit; EditY1: TEdit; EditZ1: TEdit; EditX2: TEdit; EditY2: TEdit; EditZ2: TEdit; Button2: TButton; Button3: TButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private declarations } public { Public declarations } procedure DrawLine3D(Line3D: TLine3D; isPainting: boolean); procedure MakeStep(dx,dy,dz: integer; isPainting: boolean); function DoLine3D(x1,y1,z1,x2,y2,z2: Double): TLine3D; procedure PutPixel(realX,realY,realZ: Double; isPainting: boolean); procedure Kub(a: Double); end; var Form1: TForm1; X, Y, Z: Double; implementation {$R *.dfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject); begin //Нарисовать центр координат Image1.Canvas.Pen.Color:=clSilver; Image1.Canvas.MoveTo(0,Image1.Height div 2); Image1.Canvas.LineTo(Image1.Width-1,Image1.Height div 2); Image1.Canvas.MoveTo(Image1.Width div 2,0); Image1.Canvas.LineTo(Image1.Width div 2,Image1.Height-1); end; procedure TForm1.DrawLine3D(Line3D: TLine3D; isPainting: boolean); var x1,y1,x2,y2,z1,z2: Double; dx,dy,dz,dt: Double; px,py,pz: Double; ix,iy,iz,dix,diy,diz: integer; begin x1:=round(Line3D.p1.x/MINSTEP); y1:=round(Line3D.p1.y/MINSTEP); z1:=round(Line3D.p1.z/MINSTEP); x2:=round(Line3D.p2.x/MINSTEP); y2:=round(Line3D.p2.y/MINSTEP); z2:=round(Line3D.p2.z/MINSTEP); dx:=x2-x1; dy:=y2-y1; dz:=z2-z1; if (dx=0)and(dy=0)and(dz=0) then exit; dt:=max(abs(dx),abs(dy)); dt:=max(dt,abs(dz)); //Извлекли самую длинную проекцию px:=dx/dt; py:=dy/dt; pz:=dz/dt; while dt>0 do begin ix:=Round(x1); iy:=Round(y1); iz:=Round(z1); x1:=x1+px; //Накопление координаты X y1:=y1+py; //Накопление координаты Y z1:=z1+pz; //Накопление координаты Z dix:=Round(x1)-ix; //Направление очередного шага по X diy:=Round(y1)-iy; //Направление очередного шага по Y diz:=Round(z1)-iz; //Направление очередного шага по Z MakeStep(dix,diy,diz,isPainting); //Шагнуть (команда для ЧПУ) dt:=dt-1; // Image1.Canvas.Pixels[round(x1/10)+100,round(y1/10)+100]:=clBlack; end; end; procedure TForm1.MakeStep(dx, dy, dz: integer; isPainting: boolean); begin X:=X+dx; if dx<>0 then PutPixel(X,Y,Z,isPainting); Y:=Y+dy; if dy<>0 then PutPixel(X,Y,Z,isPainting); Z:=Z+dz; if dz<>0 then PutPixel(X,Y,Z,isPainting); end; function TForm1.DoLine3D(x1, y1, z1, x2, y2, z2: Double): TLine3D; begin with Result do begin p1.x:=x1; p1.y:=y1; p1.z:=z1; p2.x:=x2; p2.y:=y2; p2.z:=z2; end; end; procedure TForm1.PutPixel(realX, realY, realZ: Double; isPainting: boolean); var screenX, screenY: integer; begin { screenX:=round(realX/10); screenY:=round(realY/10);} screenX:=round(realX*500/(2000+realZ))+ (Image1.Width div 2); screenY:=round(realY*500/(2000+realZ))+ (Image1.Height div 2); if isPainting then Image1.Canvas.Pixels[screenX,screenY]:=clBlack; end; //Рисует линию по вбитым координатам procedure TForm1.Button1Click(Sender: TObject); var Line1: TLine3D; begin Line1.p1.x:=StrToFloat(EditX1.Text); Line1.p1.y:=StrToFloat(EditY1.Text); Line1.p1.z:=StrToFloat(EditZ1.Text); Line1.p2.x:=StrToFloat(EditX2.Text); Line1.p2.y:=StrToFloat(EditY2.Text); Line1.p2.z:=StrToFloat(EditZ2.Text); With Line1 do begin X:=p1.x; Y:=p1.y; Z:=p1.z; end; DrawLine3D(Line1,True); end; //Рисует окружность procedure TForm1.Button2Click(Sender: TObject); var a: Double; begin a:=0; X:=0; Y:=0; Z:=0; while a<360 do begin {Для ЧПУ конец линии является началом следующей линии поэтому нарисуется окружность, а не звезда} DrawLine3D(DoLine3D(0,0,0,3*cos(a/180*3.14159),3*sin(a/180*3.14159),0),True); a:=a+22.5; end; end; //Рисует куб с из текущего места procedure TForm1.Kub(a: Double); begin DrawLine3D(DoLine3D(0,0,0, a, 0, 0),True); DrawLine3D(DoLine3D(0,0,0, 0,-a, 0),True); DrawLine3D(DoLine3D(0,0,0,-a, 0, 0),True); DrawLine3D(DoLine3D(0,0,0, 0, a, 0),True); DrawLine3D(DoLine3D(0,0,0, a,-a, 0),True); DrawLine3D(DoLine3D(0,0,0, 0, 0, a),True); DrawLine3D(DoLine3D(0,0,0, 0, a, 0),True); DrawLine3D(DoLine3D(0,0,0, 0, 0,-a),True); DrawLine3D(DoLine3D(0,0,0, 0,-a, a),True); DrawLine3D(DoLine3D(0,0,0,-a, 0, 0),True); DrawLine3D(DoLine3D(0,0,0, 0, a, 0),True); DrawLine3D(DoLine3D(0,0,0, a, 0, 0),True); DrawLine3D(DoLine3D(0,0,0,-a,-a, 0),True); DrawLine3D(DoLine3D(0,0,0, 0, 0,-a),True); DrawLine3D(DoLine3D(0,0,0, 0, a, a),True); DrawLine3D(DoLine3D(0,0,0, 0, 0,-a),True); end; //Рисует 4 куба в разных местах procedure TForm1.Button3Click(Sender: TObject); var a: Double; begin a:=5; X:=0; Y:=0; Z:=0; DrawLine3D(DoLine3D(0,0,0,a/2,-a,-a*2),False); //Смещаемся без рисования Kub(a); //Рисует куб с заданным ребром DrawLine3D(DoLine3D(0,0,0,-a*3, 0,a),False); Kub(a); DrawLine3D(DoLine3D(0,0,0,0,a*3,a),False); Kub(a); DrawLine3D(DoLine3D(0,0,0,a*3,0,a),False); Kub(a); end; end.

Ответ отправил: Бизин Михаил Анатольевич (статус: 3-й класс) Ответ отправлен: 10.04.2009, 22:48 Как сказать этому эксперту "спасибо"? Отправить SMS #thank 247241 на номер 1151 (Россия) | Еще номера >> Отправить WebMoney: Неплохо (10 руб.) Хорошо (15 руб.) Отлично (20 руб.) БЛЕСТЯЩЕ! (30 руб.) Вам помогли? Пожалуйста, поблагодарите эксперта за это! Оценка за ответ: 5 Комментарий оценки: Именно то что надо :) Огромное СПС Код понятен даже не вникая в алгоритм его работы и станок сразу поехал в нужное направление :)

© 2001-2009, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 5.13 от 01.12.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru RusIRC.ru | Kalashnikoff.ru | RadioLeader.ru