Здравствуйте, уважаемые эксперты. Помогите, пожалуйста, решить задачу на Delphi.


Составить две программы с использованием типов "запись" и "файл" для решения задачи.

Телефонный справочник содержит данные об абонентах: фамилия, номер телефона (число формата xxyy), годе установки телефона (формат аабб). Вывести данные об абонентах, у которых yy=бб.


Заранее спасибо.

Отправлен: 17.04.2010, 12:16
Вопрос задал: Пятаев Алексей Иванович, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
program rf5; {$APPTYPE CONSOLE} uses SysUtils; type Tel = record sn: String; num: String; year: String; end; TelAr = array[1..1] of Tel; var inpFile: TextFile; pTelAr, pTelAr2: ^TelAr; telArLen, telArLen2: byte; i: Byte; cBuf: char; procedure er1(line: Byte); begin Write(\'Incorrect file structure at line \', line); FreeMem(pTelAr, telArLen * SizeOf(Tel)); Readln; Halt; end; procedure er2(line: Byte); begin Write(\'Incorrect file data at line \', line); FreeMem(pTelAr, telArLen * SizeOf(Tel)); Readln; Halt; end; begin Assign(inpFile, \'Input.txt\'); try Reset(inpFile); except Writeln(\'File "Input.txt not found"\'); Readln; Exit; end; telArLen := 0; while not Eof(inpFile) do begin Readln(inpFile); Inc(telArLen); end; if telArLen = 0 then begin Write(\'File is empty\'); Readln; Exit; end else Reset(inpFile); GetMem(pTelAr, telArLen * SizeOf(Tel)); telArLen := 0; while not Eof(inpFile) do begin Inc(telArLen); pTelAr[telArLen].sn := \'\'; Read(inpFile, cBuf); while cBuf <> \' \' do begin if (cBuf = #13) or (cBuf = #10) or Eof(inpFile) then er1(telArLen); pTelAr[telArLen].sn := pTelAr[telArLen].sn + cbuf; Read(inpFile, cBuf); end; if pTelAr[telArLen].sn = \'\' then er1(telArLen); pTelAr[telArLen].num := \'\'; Read(inpFile, cBuf); while cBuf <> \' \' do begin if (cBuf = #13) or (cBuf = #10) or Eof(inpFile) then er1(telArLen); pTelAr[telArLen].num := pTelAr[telArLen].num + cBuf; Read(inpFile, cBuf); end; if pTelAr[telArLen].num = \'\' then er1(telArLen); pTelAr[telArLen].year := \'\'; Read(inpFile, cBuf); while (cBuf <> #13) and (cBuf <> #10) do begin if cBuf = \' \' then er1(telArLen); pTelAr[telArLen].year := pTelAr[telArLen].year + cbuf; if Eof(inpFile) then break; Read(inpFile, cBuf); end; if pTelAr[telArLen].year = \'\' then er1(telArLen); Readln(inpFile) end; for i := 1 to telArLen do if (Length(pTelAr[telArLen].num) <> 4) or (Length(pTelAr[telArLen].year) <> 4) then er2(i); telArLen2 := 0; for i := 1 to telArLen do if (pTelAr[i].num[3] = pTelAr[i].year[3]) and (pTelAr[i].num[4] = pTelAr[i].year[4]) then Inc(telArLen2); if telArLen2 = 0 then begin Write(\'Matching records not found\'); FreeMem(pTelAr, telArLen * SizeOf(Tel)); Readln; Exit; end; GetMem(pTelAr2, telArLen2); telArLen2 := 0; for i := 1 to telArLen do if (pTelAr[i].num[3] = pTelAr[i].year[3]) and (pTelAr[i].num[4] = pTelAr[i].year[4]) then begin Inc(telArLen2); pTelAr2[telArLen2].sn := pTelAr[i].sn; pTelAr2[telArLen2].num := pTelAr[i].num; pTelAr2[telArLen2].year := pTelAr[i].year; end; FreeMem(pTelAr, telArLen * SizeOf(Tel)); for i := 1 to telArLen2 do begin Write(pTelAr2[i].sn, \' \'); Write(pTelAr2[i].num, \' \'); Writeln(pTelAr2[i].year); end; FreeMem(pTelAr2, telArLen2 * SizeOf(Tel)); Readln; end.

Ответ отправил: Алексей S, 3-й класс
Ответ отправлен: 18.04.2010, 05:10
Номер ответа: 260893

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 260893 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Здравствуйте!!!
Помогите,пожалуйста,построить график функции по точкам
(в проекте должна отрисовываться координатная сетка, и на ней график строго определенными координатами сетки). При изменении размеров окна график тоже должен перерисовываться вместе с сеткой
Координат построения графика может быть сколько угодно до 25 (т.е. должна быть возможность задать кол-во точек)

Спасибо!

Отправлен: 17.04.2010, 21:46
Вопрос задал: Миронычев Виталий, Посетитель
Всего ответов: 1
Страница вопроса »

Приложение:
//pas unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, ExtCtrls; type TForm1 = class(TForm) Panel1: TPanel; Image1: TImage; Panel2: TPanel; StringGrid1: TStringGrid; Panel3: TPanel; Button1: TButton; Edit1: TEdit; Label1: TLabel; Button2: TButton; procedure axes; procedure graph; procedure Panel3Resize(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Panel1Resize(Sender: TObject); procedure Button1Click(Sender: TObject); procedure StringGrid1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; const field = 36; step = 50; pointRad = 5; var Form1: TForm1; scaleX, scaleY: single; implementation {$R *.dfm} procedure TForm1.axes; var rowsCount, colsCount: Byte; startX, startY: Word; i: Byte; begin rowsCount := Trunc((Panel1.Height - 2 * field) / step); colsCount := Trunc((Panel1.Width - 2 * field) / step); if rowsCount mod 2 = 1 then Dec(rowsCount); if colsCount mod 2 = 1 then Dec(colsCount); startX := Round((Image1.Width - colsCount * step) / 2); startY := Round((Image1.Height - rowsCount * step) / 2); Image1.Canvas.Pen.Width := 1; Image1.Canvas.Pen.Color := clBlack; Image1.Canvas.Brush.Color := clWhite; for i := 0 to rowsCount do begin Image1.Canvas.MoveTo(field, startY + i * step); Image1.Canvas.LineTo(Image1.Width - field, startY + i * step); Image1.Canvas.TextOut(Round(Image1.Width / 2) + 5, startY + i * step + 5, IntToStr(Round((startY + i * step - Image1.Height / 2) * -scaleY))); end; for i := 0 to colsCount do begin Image1.Canvas.MoveTo(startX + i * step, field); Image1.Canvas.LineTo(startX + i * step, Image1.Height - field); Image1.Canvas.TextOut(startX + i * step + 5, Round(Image1.Height / 2) + 5, IntToStr(Round((startX + i * step - Image1.Width / 2) * scaleX))); end; Image1.Canvas.Pen.Width := 5; Image1.Canvas.MoveTo(field, Round(Image1.Height / 2)); Image1.Canvas.LineTo(Image1.Width - field, Round(Image1.Height / 2)); Image1.Canvas.MoveTo(Round(Image1.Width / 2), field); Image1.Canvas.LineTo(Round(Image1.Width / 2), Image1.Height - field); end; procedure TForm1.graph; var i: Byte; minX, minY, maxX, maxY: Integer; ofsX, ofsY: Integer; begin if (Image1.Height / 2 - field = 0) or (Image1.Width / 2 - field = 0) then Exit; for i := 0 to StringGrid1.RowCount - 1 do begin if StringGrid1.Cells[0, i] = \'\' then StringGrid1.Cells[0, i] := \'0\'; if StringGrid1.Cells[1, i] = \'\' then StringGrid1.Cells[1, i] := \'0\'; if (StringGrid1.Cells[0, i] = \'-\') or (StringGrid1.Cells[1, i] = \'-\') then Exit; end;; minX := StrToInt(StringGrid1.Cells[0, 0]); maxX := StrToInt(StringGrid1.Cells[0, 0]); minY := StrToInt(StringGrid1.Cells[1, 0]); maxY := StrToInt(StringGrid1.Cells[1, 0]); for i := 1 to StringGrid1.RowCount - 1 do begin if minX > StrToInt(StringGrid1.Cells[0, i]) then minX := StrToInt(StringGrid1.Cells[0, i]); if maxX < StrToInt(StringGrid1.Cells[0, i]) then maxX := StrToInt(StringGrid1.Cells[0, i]); if minY > -StrToInt(StringGrid1.Cells[1, i]) then minY := -StrToInt(StringGrid1.Cells[1, i]); if maxY < -StrToInt(StringGrid1.Cells[1, i]) then maxY := -StrToInt(StringGrid1.Cells[1, i]); end; Image1.Picture.Bitmap.FreeImage(); Image1.Picture.Bitmap := nil; if (maxX - minX = 0) or (maxY - minY = 0) then Exit; if Abs(minX) > Abs(maxX) then begin scaleX := Abs(minX) / (Image1.Width / 2 - field); ofsX := field - Round(minX / scaleX); end else begin scaleX := Abs(maxX) / (Image1.Width / 2 - field); ofsX := Image1.Width - field - Round((maxX) / scaleX); end; if Abs(minY) > Abs(maxY) then begin scaleY := Abs(minY) / (Image1.Height / 2 - field); ofsY := field - Round(minY / scaleY); end else begin scaleY := Abs(maxY) / (Image1.Height / 2 - field); ofsY := Image1.Height - field - Round((maxY) / scaleY); end; Image1.Canvas.Pen.Width := 2; Image1.Canvas.Pen.Color := clGreen; Image1.Canvas.MoveTo(Round((StrToInt(StringGrid1.Cells[0,0])) / scaleX) + ofsX, Round((StrToInt(StringGrid1.Cells[1,0])) / -scaleY) + ofsY); Image1.Canvas.Brush.Color := clGreen; Image1.Canvas.Ellipse(Round((StrToInt(StringGrid1.Cells[0,0])) / scaleX) + ofsX - pointRad, Round((StrToInt(StringGrid1.Cells[1,0])) / -scaleY) + ofsY - pointRad, Round((StrToInt(StringGrid1.Cells[0,0])) / scaleX) + ofsX + pointRad, Round((StrToInt(StringGrid1.Cells[1,0])) / -scaleY) + ofsY + pointRad); for i := 1 to StringGrid1.RowCount - 1 do begin Image1.Canvas.LineTo(Round((StrToInt(StringGrid1.Cells[0,i])) / scaleX) + ofsX, Round((StrToInt(StringGrid1.Cells[1,i])) / -scaleY) + ofsY); Image1.Canvas.Ellipse(Round((StrToInt(StringGrid1.Cells[0,i])) / scaleX) + ofsX - pointRad, Round((StrToInt(StringGrid1.Cells[1,i])) / -scaleY) + ofsY - pointRad, Round((StrToInt(StringGrid1.Cells[0,i])) / scaleX) + ofsX + pointRad, Round((StrToInt(StringGrid1.Cells[1,i])) / -scaleY) + ofsY + pointRad); end; end; procedure TForm1.Panel3Resize(Sender: TObject); begin Button1.Left := Round((Panel3.Width - Button1.Width) / 2); end; procedure TForm1.Button2Click(Sender: TObject); var i: Byte; begin for i := 0 to StringGrid1.RowCount - 1 do begin StringGrid1.Cells[0, i] := IntToStr(Random(60000) - 30000); StringGrid1.Cells[1, i] := IntToStr(Random(60000) - 30000); end; graph; axes; end; procedure TForm1.Panel1Resize(Sender: TObject); begin graph; axes; end; procedure TForm1.Button1Click(Sender: TObject); begin StringGrid1.RowCount := StrToInt(Edit1.Text); end; procedure TForm1.StringGrid1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin graph; axes; end; procedure TForm1.FormCreate(Sender: TObject); begin Randomize; end; end. //dfm object Form1: TForm1 Left = 264 Top = 202 Width = 811 Height = 558 Caption = \'Form1\' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = \'MS Sans Serif\' Font.style="[]" OldCreateOrder = False OnCreate = FormCreate PixelsPerInch = 96 TextHeight = 13 object Panel1: TPanel Left = 0 Top = 0 Width = 671 Height = 520 Align = alClient TabOrder = 0 OnResize = Panel1Resize object Image1: TImage Left = 1 Top = 1 Width = 669 Height = 518 Align = alClient end end object Panel2: TPanel Left = 671 Top = 0 Width = 124 Height = 520 Align = alRight TabOrder = 1 object StringGrid1: TStringGrid Left = 1 Top = 1 Width = 122 Height = 401 Align = alClient ColCount = 2 DefaultColWidth = 50 FixedCols = 0 FixedRows = 0 Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing] TabOrder = 0 OnKeyUp = StringGrid1KeyUp end object Panel3: TPanel Left = 1 Top = 402 Width = 122 Height = 117 Align = alBottom TabOrder = 1 object Label1: TLabel Left = 16 Top = 8 Width = 90 Height = 13 Caption = #1050#1086#1083#1080#1095#1077#1089#1090#1074#1086\' \'#1090#1086#1095#1077#1082 end object Button1: TButton Left = 8 Top = 48 Width = 105 Height = 25 Caption = #1055#1088#1080#1085#1103#1090#1100 TabOrder = 0 OnClick = Button1Click end object Edit1: TEdit Left = 8 Top = 24 Width = 105 Height = 21 TabOrder = 1 Text = \'5\' end object Button2: TButton Left = 8 Top = 80 Width = 105 Height = 25 Caption = #1057#1083#1091#1095#1072#1081#1085#1099#1077\' \'#1090#1086#1095#1082#1080 TabOrder = 2 OnClick = Button2Click end end end end

Ответ отправил: Алексей S, 3-й класс
Ответ отправлен: 19.04.2010, 04:09
Номер ответа: 260907

Оценка ответа: 5
Комментарий к оценке:
Спасибо вам огромное за труд!!!

Вам помог ответ? Пожалуйста, поблагодарите эксперта за это! Как сказать этому эксперту "спасибо"?

Отправить SMS #thank 260907 на номер 1151 (Россия) | Еще номера »

Отправить WebMoney: Неплохо (30 руб.) Хорошо (40 руб.) Отлично (55 руб.) БЛЕСТЯЩЕ! (80 руб.)

Оценить выпуск »
Нам очень важно Ваше мнение об этом выпуске рассылки!

Задать вопрос экспертам этой рассылки »