RusFAQ.ru: Программирование на Delphi

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

Выпуск № 261
от 10.10.2005, 18:33

Вопрос № 27.263

Здравствуйте ! 1. У меня есть программа по вычислению матриц, после вычислений она сохранят результаты в файл см пр. Подскажите каким способом можно прочитать весь этот файл и записать результаты обратно в массив, размерность матриц различная. 2. Какая функция преобразует строку в массив? 3. В языке VBasic есть оператор 'with', есть ли аналог ему в Delphi? Если есть, тот каков его синтаксис? Приложение: A[3,3]{ 024 025 036 011 000 001 154 254 234} B[3, 2]{ 024 025 011 000 154 254} C[4,3]{ 024 025 036 011 000 001 154 254 234 008 127 512}

Отправлен: 05.10.2005, 11:46 Вопрос задал: 007Makc (статус: Посетитель) Всего ответов: 6 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Lector Здравствуйте, 007Makc! 1. AssignFile(F, OpenDialog1.FileName); { File selected in dialog } Reset(F); Readln(F, S); { Read first line of file } Edit1.Text := S; { Put string in a TEdit control } CloseFile(F); В вашем случае следует использовать цикл по условию eof(F) для определения конца файла. 2. Для этого можно использовать свойство Commatext класса TStringList и его свойство CommaText для преобразования в массив строк строку с запятыми или его же свойство DelimetedText с значению Delimeter, равным вашему разделителю. 3. Есть. Синтаксис такой: with something do begin end; она импортирует пространство имен выбранной вами переменной или нескольких переменных в следующий за ним логический блок. --------- Хочешь помочь дураку - сам дурак

Ответ отправил: Lector (статус: 4-ый класс) Отправлен: 05.10.2005, 12:50

Отвечает: Delphin Здравствуйте, 007Makc! 1. Вопервых непонятно что вы написали!! {} - Это ведь коментарии!!! Или настройки компилятора. Потом на каком языке вы написали??? Рассылка по Delphi. Всмысле сохранить??? Как вы сохраняете?? 2. Может скопировать посимвольно? 3. А что надо сделать??? Вот допустим смотри пр. Из всего этого следует: Вы неописали проблему. Вы написали "Помогите мне я не знаю как сделать то незнаю что" Приложение: With TButton(Sender) do begin Caption := 'gg'; Left := Left+5; Top := Top+5; end; --------- Обращаться в ICQ: 66550088 (Ally) или E-Mail: delphinster@gmail.com

Ответ отправил: Delphin (статус: Студент) Отправлен: 05.10.2005, 13:39 Оценка за ответ: 2

Отвечает: sir henry Здравствуйте, 007Makc! 1. Точно таким же способом, каким Вы записывали в файл. Только вместо оператора Write использовать Read. 2. Нет таких функций. Потому что строка это и есть массив - массив символов. Убедиться Вы сможете так: const s = 'Это строка!'; Begin WriteLn('Выводится в консоль вся строка: ', s); WriteLn('Выводится пятый символ строки: ', s[5]); End. 3. В Дельфи есть точно такой же оператор. Использование его ограничивается программными скобками Begin ... End, так же как в Бэйсике With ... EndWith.

Ответ отправил: sir henry (статус: Профессор) Отправлен: 05.10.2005, 14:47 Оценка за ответ: 3

Отвечает: Татьяна Здравствуйте, 007Makc! 1. Прочитать можно с помощью read, либо, если вы хотите совсем просто, с помощью объекта TStringList. 2. Для преобразования строки в массив из контекста именно вашей задачи можно использовать тот же TStringList (см. пример в приложении) Приложение: 1) var s : TStrings; begin s := TStringList.Create; s.loadFromfile(nameoffile); { получим набор строк вашего файла} ... end; 2) var s : TStrings; i : integer; a : array of integer; begin s := TStringList.Create; s.Delimiter := ' '; s.DelimitedText := '024 025 036 011 000 001 154 254 234'; SetLength(a,s.Count); //выделяем память динам. массиву for i := 0 to s.Count - 1 a[i] := strtoint(a[i]); end; --------- Нет ничего невозможного!!!

Ответ отправила: Татьяна (статус: 3-ий класс) Отправлен: 05.10.2005, 18:42 Оценка за ответ: 4 Комментарий оценки: Понятно, спасибо.

Отвечает: Romodos 1)Пример чтения матриц их файла в приложении (надо доработать) 2)А строка - это и так массив 3)Есть функция with - не знаю такая же как в бейсике али нет. Например есть объект object, у него есть св-ва x и y with object do begin x:=1; y:=2; end; То же самое, что object.x:=1; object.y:=2; Приложение: type matrix=record a:array[1..N,1..N] of integer; m,n:integer; end; var f:text; m:array[1..10] of char; // список имён матриц mat:array[1..10] of matrix;//массив матриц c:char; begin i:=1; assign(f,'matrix.mat'); reset(f); while not eof begin readln; read(m[i]);//читаем имя матрицы read(c);//читаем '[' read(mat[i].n);//читаем длину матрицы read(c);//читаем ',' read(mat[i].m);//читаем высоту матрицы readln;//переводим на другую строку for j:=1 to n do for k:=1 to m do read(mat[i].a[j,k]); //читаем эл-ты матрицы readln;//перевод строки inc(i); end; --------- FAQ me off!

Ответ отправил: Romodos (статус: 9-ый класс) Отправлен: 05.10.2005, 19:41 Оценка за ответ: 5 Комментарий оценки: Удачное решение, спасибо.

Отвечает: Warrior Если размерность матриц разная, то необходимо использовать динамический масив. Я подправил ответ Татьяны, исправил ошибку. Теперь этот кусок программы: 1. Определяет динамический масив; 2. Считывает файл, определяет количество строк в файле. 3. Считывает Каждую строку и заполняет динамический массив. Таким образом теперь не надо задумываться о размерности матрицы. Процедура проверена и рабочая. Приложение: procedure TForm1.Button1Click(Sender: TObject); var st, st_stroka: TStrings; i, j: integer; stroka: string; matrix_rezina: array of array of integer; begin st:=TStringList.Create; st.LoadFromFile('d:matrix.txt'); //st.Count; количество сток в файле SetLength(matrix_rezina,st.Count); st_stroka:= TStringList.Create; st_stroka.Delimiter:= ' '; for i:=0 to st.Count-1 do begin st_stroka.DelimitedText:= st.Strings[i]; SetLength(matrix_rezina[i],st_stroka.Count); for j:=0 to st_stroka.Count-1 do begin matrix_rezina[i,j]:= StrToInt(st_stroka[j]); Memo1.Lines.Add('matrix['+IntToStr(i)+','+IntToStr(j)+']= '+IntToStr(matrix_rezina[i,j])); end; end; st.Free; st_stroka.Free; end;

Ответ отправил: Warrior (статус: 1-ый класс) Отправлен: 05.10.2005, 21:00

Вопрос № 27.269

Как при помощи idFTP узнать сущетвует ли данный файл на сервере или нет. Я пробовал использовать вызовы метода List() и последующим ковырянием в коллекции DirectoryListing, но это очень медленно работает, поэтому данный метод совершенно не подходит.

Отправлен: 05.10.2005, 13:25 Вопрос задал: Валерий Кравцов (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 4)

Отвечает: sir henry Здравствуйте, Валерий Кравцов! "медленно работает" - в каком смысле? Вы медленно получаете данные для TStrings? Или медленно идет поиск в TStrings? С первым ничего поделать нельзя. Скорость зависит от скорости соединения. Со вторым - надо знать методику поиска, которую Вы применяете. Если для хранения списка Вы используете объект типа TStringList, то у него есть метод Find(), которым можно искать строку в списке. Только список должен быть предварительно ОТСОРТИРОВАН - TStringList.Sort.

Ответ отправил: sir henry (статус: Профессор) Отправлен: 05.10.2005, 15:08

Отвечает: Delphin Здравствуйте, Валерий Кравцов! Есть 2 теории: 1. Получить список файлов и смотреть есть ли в нем нужный тебе файл/папка. 2. Попробовать начать загрузку файла и потом оборвать. Если файла нету то тебе скажут ошибку. --------- Обращаться в ICQ: 66550088 (Ally) или E-Mail: delphinster@gmail.com

Ответ отправил: Delphin (статус: Студент) Отправлен: 05.10.2005, 22:20

Отвечает: Bob Johnson Здравствуйте, Валерий Кравцов! Протокол FTP подробно описан в RFC 959. И насколько я понимаю, там ЕСТЬ возможность получить информацию по одному конкретному файлу. Вот выдержка из RFC на команду LIST: LIST (LIST) This command causes a list to be sent from the server to the passive DTP. If the pathname specifies a directory or other group of files, the server should transfer a list of files in the specified directory. If the pathname specifies a file then the server should send current information on the file. A null argument implies the user's current working or default directory. The data transfer is over the data connection in type ASCII or type EBCDIC. (The user must ensure that the TYPE is appropriately ASCII or EBCDIC). Since the information on a file may vary widely from system to system, this information may be hard to use automatically in a program, but may be quite useful to a human user.

Ответ отправил: Bob Johnson (статус: Академик) Отправлен: 07.10.2005, 01:50

Вопрос № 27.279

Здравствуйте. Как можно изменить разрешение рисунка. Например у меня есть два рисунка 800*600 и 1024*768, мне нужно загнать оба в размеры 800*600 и сравнить. Если открывать рисунки при помощи image1.picture, то невозможно получить пиксели канвы. Как мне поступить?

Отправлен: 05.10.2005, 16:41 Вопрос задал: Schmak (статус: Посетитель) Всего ответов: 3 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: sir henry Здравствуйте, Schmak! В смысле изменить размеры? Для уменьшения - см. приложение 1. Для увеличения - см. приложение 2. Приложение: Приложение 1 ***************************** var x, y: integer; i, j: integer; r, g, b: integer; begin Form1.Canvas.Font.Size := 24; Form1.Canvas.TextOut(0, 0, 'Text'); for y := 0 to 10 do begin for x := 0 to 25 do begin r := 0; for i := 0 to 3 do for j := 0 to 3 do r := r + GetRValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]); r := round(r / 16); g := 0; for i := 0 to 3 do for j := 0 to 3 do g := g + GetGValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]); g := round(g / 16); b := 0; for i := 0 to 3 do for j := 0 to 3 do b := b + GetBValue(Form1.Canvas.Pixels[4*x+i, 4*y+j]); b := round(b / 16); Form1.Canvas.Pixels[x,y+50] := RGB(r, g, b) end; Application.ProcessMessages; end; end; ************************** Приложение 2 ************************** procedure Interpolate(var bm: TBitMap; dx, dy: single); var bm1: TBitMap; z1, z2: single; k, k1, k2: single; x1, y1: integer; c: array [0..1, 0..1, 0..2] of byte; res: array [0..2] of byte; x, y: integer; xp, yp: integer; xo, yo: integer; col: integer; pix: TColor; begin bm1 := TBitMap.Create; bm1.Width := round(bm.Width * dx); bm1.Height := round(bm.Height * dy); for y := 0 to bm1.Height - 1 do begin for x := 0 to bm1.Width - 1 do begin xo := trunc(x / dx); yo := trunc(y / dy); x1 := round(xo * dx); y1 := round(yo * dy); for yp := 0 to 1 do for xp := 0 to 1 do begin pix := bm.Canvas.Pixels[xo + xp, yo + yp]; c[xp, yp, 0] := GetRValue(pix); c[xp, yp, 1] := GetGValue(pix); c[xp, yp, 2] := GetBValue(pix); end; for col := 0 to 2 do begin k1 := (c[1,0,col] - c[0,0,col]) / dx; z1 := x * k1 + c[0,0,col] - x1 * k1; k2 := (c[1,1,col] - c[0,1,col]) / dx; z2 := x * k2 + c[0,1,col] - x1 * k2; k := (z2 - z1) / dy; res[col] := round(y * k + z1 - y1 * k); end; bm1.Canvas.Pixels[x,y] := RGB(res[0], res[1], res[2]); end; Form1.Caption := IntToStr(round(100 * y / bm1.Height)) + '%'; Application.ProcessMessages; if Application.Terminated then Exit; end; bm := bm1; end; const dx = 5.5; dy = 5.5; procedure TForm1.Button1Click(Sender: TObject); const w = 50; h = 50; var bm: TBitMap; can: TCanvas; begin bm := TBitMap.Create; can := TCanvas.Create; can.Handle := GetDC(0); bm.Width := w; bm.Height := h; bm.Canvas.CopyRect(Bounds(0, 0, w, h), can, Bounds(0, 0, w, h)); ReleaseDC(0, can.Handle); Interpolate(bm, dx, dy); Form1.Canvas.Draw(0, 0, bm); Form1.Caption := 'x: ' + FloatToStr(dx) + ' y: ' + FloatToStr(dy) + ' width: ' + IntToStr(w) + ' height: ' + IntToStr(h); end; procedure TForm1.Button2Click(Sender: TObject); var bm: TBitMap; begin if OpenDialog1.Execute then bm.LoadFromFile(OpenDialog1.FileName); Interpolate(bm, dx, dy); Form1.Canvas.Draw(0, 0, bm); Form1.Caption := 'x: ' + FloatToStr(dx) + ' y: ' + FloatToStr(dy) + ' width: ' + IntToStr(bm.Width) + ' height: ' + IntToStr(bm.Height); end;

Ответ отправил: sir henry (статус: Профессор) Отправлен: 05.10.2005, 17:06 Оценка за ответ: 5 Комментарий оценки: Это действительно то, что мне было нужно. Огромное спасибо!!

Отвечает: Силантьев Евгений Александрович Здравствуйте, Schmak! Вот два исходника: Приложение 1 для bmp Приложение 2 для jpeg Успехов! Приложение: #--------------------# # bmp # #--------------------# procedure TFormConvertir.ResizeBitmap(imgo, imgd: TBitmap; nw, nh: Integer); var xini, xfi, yini, yfi, saltx, salty: single; x, y, px, py, tpix: integer; PixelColor: TColor; r, g, b: longint; function MyRound(const X: Double): Integer; begin Result := Trunc(x); if Frac(x) >= 0.5 then if x >= 0 then Result := Result + 1 else Result := Result - 1; // Result := Trunc(X + (-2 * Ord(X < 0) + 1) * 0.5); end; begin // Set target size imgd.Width := nw; imgd.Height := nh; // Calcs width & height of every area of pixels of the source bitmap saltx := imgo.Width / nw; salty := imgo.Height / nh; yfi := 0; for y := 0 to nh - 1 do begin // Set the initial and final Y coordinate of a pixel area yini := yfi; yfi := yini + salty; if yfi >= imgo.Height then yfi := imgo.Height - 1; xfi := 0; for x := 0 to nw - 1 do begin // Set the inital and final X coordinate of a pixel area xini := xfi; xfi := xini + saltx; if xfi >= imgo.Width then xfi := imgo.Width - 1; // This loop calcs del average result color of a pixel area // of the imaginary grid r := 0; g := 0; b := 0; tpix := 0; for py := MyRound(yini) to MyRound(yfi) do begin for px := MyRound(xini) to MyRound(xfi) do begin Inc(tpix); PixelColor := ColorToRGB(imgo.Canvas.Pixels[px, py]); r := r + GetRValue(PixelColor); g := g + GetGValue(PixelColor); b := b + GetBValue(PixelColor); end; end; // Draws the result pixel imgd.Canvas.Pixels[x, y] := rgb(MyRound(r / tpix), MyRound(g / tpix), MyRound(b / tpix) ); end; end; end; #--------------------# # jpeg # #--------------------# procedure TForm1.Button1Click(Sender: TObject); var bmp: TBItmap; jpg: TJpegImage; scale: Double; begin if opendialog1.execute then begin jpg := TJpegImage.Create; try jpg.Loadfromfile( opendialog1.filename ); if jpg.Height > jpg.Width then scale := 50 / jpg.Height else scale := 50 / jpg.Width; bmp:= Tbitmap.Create; try {Create thumbnail bitmap, keep pictures aspect ratio} bmp.Width := Round( jpg.Width * scale ); bmp.Height:= Round( jpg.Height * scale ); bmp.Canvas.StretchDraw( bmp.Canvas.Cliprect, jpg ); {Draw thumbnail as control} Self.Canvas.Draw( 100, 10, bmp ); {Convert back to JPEG and save to file} jpg.Assign( bmp ); jpg.SaveToFile(ChangeFileext( opendialog1.filename, '_thumb.JPG' )); finally bmp.free; end; finally jpg.free; end; end; end; --------- The world is mine! :)

Ответ отправил: Силантьев Евгений Александрович (статус: 6-ой класс) Отправлен: 05.10.2005, 19:09 Оценка за ответ: 5 Комментарий оценки: Это действительно то, что мне было нужно. Особенно пригодилась процедура StretchDraw. Огромное спасибо!!

Отвечает: Denisss Здравствуйте, Schmak! Приблизительный пример того, как сравнивать я привел в приложении. Особо его не тестировал, но на тех изображениях, на которых тестировал получил хорошие результаты. Единственное, о чем хочу предупредить: к пикселам канвы я не обращался, т.к. это очень медленно (дело в том, что обращение к пикселам канвы {TCanvas.Pixel[x,y]} идет через библиотеку gdi32.dll, что заметно увеличивает время доступа к пикселам изображения). Вместо этого я обращался напрямую к пикселам изображения (BMP.ScanLine). Удачи! Приложение: procedure TForm1.Button1Click(Sender: TObject); var JPG1, JPG2: TJPEGImage; BMP1, BMP2, tmpBMP: TBitmap; type // 24 бита - это три байта... P24BitArr = ^T24BitArr; T24BitArr = array[0..2] of Byte; var h, w, // Временная переменная tmpPerc: Integer; // Процент похожести fPerc: Byte; // Сравниваем два байта в процентах function BytePerc(b1, b2: Byte): Byte; begin if (b1 > b2) then Result:= (((b1 + b2) * 100) shr 1) div b1 else if (b2 > b1) then Result:= (((b1 + b2) * 100) shr 1) div b2 else Result:= 100; end; // Сравниваем два цвета (24 бита) function ColorPerc(Col1, Col2: P24BitArr): Byte; var p1, p2, p3: Byte; begin p1:= BytePerc(Col1^[0], Col2^[0]); p2:= BytePerc(Col1^[1], Col2^[1]); p3:= BytePerc(Col1^[2], Col2^[2]); Result:= (p1 + p2 + p3) div 3; end; // Сравниваем две строки изображения function LinePerc(Line1, Line2: P24BitArr): Byte; var i: Integer; fLinePerc: Integer; begin fLinePerc:= ColorPerc(Line1, Line2); for i:= 0 to (w - 2) do begin inc(Line1); inc(Line2); fLinePerc:= fLinePerc + ColorPerc(Line1, Line2); end; Result:= fLinePerc div w; end; begin JPG1:= TJPEGImage.Create; JPG2:= TJPEGImage.Create; BMP1:= TBitmap.Create; BMP2:= TBitmap.Create; tmpBMP:= TBitmap.Create; try JPG1.LoadFromFile('try.jpg'); JPG2.LoadFromFile('try1.jpg'); // Сравнение размеров if (JPG1.Width >= JPG2.Width) and (JPG1.Height >= JPG2.Height) then // первый рисунок больше и по ширине и по высоте begin BMP2.Assign(JPG2); tmpBMP.Assign(JPG1); BMP1.Width:= BMP2.Width; BMP1.Height:= BMP2.Height; with BMP1.Canvas do StretchDraw(ClipRect, tmpBMP); end else if (JPG1.Width < JPG2.Width) and (JPG1.Height < JPG2.Height) // первый рисунок меньше второго then begin BMP1.Assign(JPG1); tmpBMP.Assign(JPG2); BMP2.Width:= BMP1.Width; BMP2.Height:= BMP1.Height; with BMP2.Canvas do StretchDraw(ClipRect, tmpBMP); end else // если один из рисунков шире, другой выше begin // Сначала выравниваем по ширине if (JPG1.Width > JPG2.Width) then // Первый рисунок шире begin tmpBMP.Assign(JPG1); BMP1.Width:= JPG2.Width; BMP1.Height:= JPG1.Height; with BMP1.Canvas do StretchDraw(ClipRect, tmpBMP); // Теперь по высоте tmpBMP.Assign(JPG2); BMP2.Width:= JPG2.Width; BMP2.Height:= BMP1.Height; with BMP2.Canvas do StretchDraw(ClipRect, tmpBMP); end else // Второй рисунок шире begin tmpBMP.Assign(JPG2); BMP2.Width:= JPG1.Width; BMP2.Height:= JPG2.Height; with BMP2.Canvas do StretchDraw(ClipRect, tmpBMP); // Теперь по высоте tmpBMP.Assign(JPG1); BMP1.Width:= JPG1.Width; BMP1.Height:= BMP2.Height; with BMP1.Canvas do StretchDraw(ClipRect, tmpBMP) end; end; // выравнивание закончилось - // теперь у нас два рисунка с одинаковыми размерами // Пора сравнивать... // Для этого, первым делом преобразуем (на всякий случай) // изображения к 24 битам BMP1.PixelFormat:= pf24bit; BMP2.PixelFormat:= pf24bit; // Ну и пошли сравнивать... // fPerc:= 100; tmpPerc:= 0; // ширина изображений w:= BMP1.Width; // сравниваем построчно for h:= 0 to Pred(BMP1.Height) do tmpPerc:= tmpPerc + LinePerc(BMP1.ScanLine[h], BMP2.ScanLine[h]); // получаем результат fPerc:= tmpPerc div BMP1.Height; Label1.Caption:= IntToStr(fPerc); finally FreeAndNil(JPG1); FreeAndNil(JPG2); FreeAndNil(BMP1); FreeAndNil(BMP2); FreeAndNil(tmpBMP); end; end;

Ответ отправил: Denisss (статус: Практикант) Отправлен: 08.10.2005, 13:11 Оценка за ответ: 5 Комментарий оценки: Спасибо. Мне это помогло.

© 2001-2005, RusFAQ.ru, Россия, Москва. Все права защищены.
Идея, дизайн, программирование, авторское право: Калашников О.А.