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

Выпуск № 1215
от 26.10.2008, 02:00

Вопрос № 147.879

Добрый день. Вот очень надо написать програму по переводу из Десятичной СС в восьмеричною и обратно. Если кто может помогите - очень надо. Заранее спасибо.

Отправлен: 20.10.2008, 17:04 Вопрос задал: Гречко Михаил Витальевич (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 1)

Отвечает: Командин Константин Евгениевич Здравствуйте, Гречко Михаил Витальевич! Могу предложить юнит взятый с http://www.delphisources.ru/pages/faq/base/translation_between_systems_of_calculus.html Обрати внимания на функции: function DEC2OCT(DEC: LONGINT): string; function OCT2DEC(OCT: string): LONGINT; Приложение: Автор: HЖkon Stordahl WEB сайт: http://stordahl.home.ml.org Хоpоший СисОп - пьяный СисОп... unit CONVUNIT; { CONVUNIT UNIT 1.1 } { Copyright (C) 1997 HЖkon Stordahl } { E-mail : stordahl@usa.net } { Homepage: http://stordahl.home.ml.org/ } interface function DEC2BIN(DEC: LONGINT): string; function BIN2DEC(BIN: string): LONGINT; function DEC2HEX(DEC: LONGINT): string; function HEX2DEC(HEX: string): LONGINT; function DEC2OCT(DEC: LONGINT): string; function OCT2DEC(OCT: string): LONGINT; function BIN2HEX(BIN: string): string; function HEX2BIN(HEX: string): string; function DEC2BASEN(BASE: INTEGER; DEC: LONGINT): string; { This function converts numbers from decimal (Base 10 notation) to different systems of notation. Valid systems are from Base 2 notation to Base 36 notation } function BASEN2DEC(BASE: INTEGER; NUM: string): LONGINT; { This function converts numbers from different systems of notation to decimal (Base 10 notation). Valid systems are from Base 2 notation to Base 36 notation } implementation function DEC2BIN(DEC: LONGINT): string; var BIN: string; I, J: LONGINT; begin if DEC = 0 then BIN := '0' else begin BIN := ''; I := 0; while (1 shl (I + 1)) < = DEC do I := I + 1; { (1 SHL (I + 1)) = 2^(I + 1) } for J := 0 to I do begin if (DEC shr (I - J)) = 1 then BIN := BIN + '1' { (DEC SHR (I - J)) = DEC DIV 2^(I - J) } else BIN := BIN + '0'; DEC := DEC and ((1 shl (I - J)) - 1); { DEC AND ((1 SHL (I - J)) - 1) = DEC MOD 2^(I - J) } end; end; DEC2BIN := BIN; end; function BIN2DEC(BIN: string): LONGINT; var J: LONGINT; Error: BOOLEAN; DEC: LONGINT; begin DEC := 0; Error := False; for J := 1 to Length(BIN) do begin if (BIN[J] < > '0') and (BIN[J] < > '1') then Error := True; if BIN[J] = '1' then DEC := DEC + (1 shl (Length(BIN) - J)); { (1 SHL (Length(BIN) - J)) = 2^(Length(BIN)- J) } end; if Error then BIN2DEC := 0 else BIN2DEC := DEC; end; function DEC2HEX(DEC: LONGINT): string; const HEXDigts: string[16] = '0123456789ABCDEF'; var HEX: string; I, J: LONGINT; begin if DEC = 0 then HEX := '0' else begin HEX := ''; I := 0; while (1 shl ((I + 1) * 4)) < = DEC do I := I + 1; { 16^N = 2^(N * 4) } { (1 SHL ((I + 1) * 4)) = 16^(I + 1) } for J := 0 to I do begin HEX := HEX + HEXDigts[(DEC shr ((I - J) * 4)) + 1]; { (DEC SHR ((I - J) * 4)) = DEC DIV 16^(I - J) } DEC := DEC and ((1 shl ((I - J) * 4)) - 1); { DEC AND ((1 SHL ((I - J) * 4)) - 1) = DEC MOD 16^(I - J) } end; end; DEC2HEX := HEX; end; function HEX2DEC(HEX: string): LONGINT; function Digt(Ch: CHAR): BYTE; const HEXDigts: string[16] = '0123456789ABCDEF'; var I: BYTE; N: BYTE; begin N := 0; for I := 1 to Length(HEXDigts) do if Ch = HEXDigts[I] then N := I - 1; Digt := N; end; const HEXSet: set of CHAR = ['0'..'9', 'A'..'F']; var J: LONGINT; Error: BOOLEAN; DEC: LONGINT; begin DEC := 0; Error := False; for J := 1 to Length(HEX) do begin if not (UpCase(HEX[J]) in HEXSet) then Error := True; DEC := DEC + Digt(UpCase(HEX[J])) shl ((Length(HEX) - J) * 4); { 16^N = 2^(N * 4) } { N SHL ((Length(HEX) - J) * 4) = N * 16^(Length(HEX) - J) } end; if Error then HEX2DEC := 0 else HEX2DEC := DEC; end; function DEC2OCT(DEC: LONGINT): string; const OCTDigts: string[8] = '01234567'; var OCT: string; I, J: LONGINT; begin if DEC = 0 then OCT := '0' else begin OCT := ''; I := 0; while (1 shl ((I + 1) * 3)) < = DEC do I := I + 1; { 8^N = 2^(N * 3) } { (1 SHL (I + 1)) = 8^(I + 1) } for J := 0 to I do begin OCT := OCT + OCTDigts[(DEC shr ((I - J) * 3)) + 1]; { (DEC SHR ((I - J) * 3)) = DEC DIV 8^(I - J) } DEC := DEC and ((1 shl ((I - J) * 3)) - 1); { DEC AND ((1 SHL ((I - J) * 3)) - 1) = DEC MOD 8^(I - J) } end; end; DEC2OCT := OCT; end; function OCT2DEC(OCT: string): LONGINT; const OCTSet: set of CHAR = ['0'..'7']; var J: LONGINT; Error: BOOLEAN; DEC: LONGINT; begin DEC := 0; Error := False; for J := 1 to Length(OCT) do begin if not (UpCase(OCT[J]) in OCTSet) then Error := True; DEC := DEC + (Ord(OCT[J]) - 48) shl ((Length(OCT) - J) * 3); { 8^N = 2^(N * 3) } { N SHL ((Length(OCT) - J) * 3) = N * 8^(Length(OCT) - J) } end; if Error then OCT2DEC := 0 else OCT2DEC := DEC; end; function BIN2HEX(BIN: string): string; function SetHex(St: string; var Error: BOOLEAN): CHAR; var Ch: CHAR; begin if St = '0000' then Ch := '0' else if St = '0001' then Ch := '1' else if St = '0010' then Ch := '2' else if St = '0011' then Ch := '3' else if St = '0100' then Ch := '4' else if St = '0101' then Ch := '5' else if St = '0110' then Ch := '6' else if St = '0111' then Ch := '7' else if St = '1000' then Ch := '8' else if St = '1001' then Ch := '9' else if St = '1010' then Ch := 'A' else if St = '1011' then Ch := 'B' else if St = '1100' then Ch := 'C' else if St = '1101' then Ch := 'D' else if St = '1110' then Ch := 'E' else if St = '1111' then Ch := 'F' else Error := True; SetHex := Ch; end; var HEX: string; I: INTEGER; Temp: string[4]; Error: BOOLEAN; begin Error := False; if BIN = '0' then HEX := '0' else begin Temp := ''; HEX := ''; if Length(BIN) mod 4 < > 0 then repeat BIN := '0' + BIN; until Length(BIN) mod 4 = 0; for I := 1 to Length(BIN) do begin Temp := Temp + BIN[I]; if Length(Temp) = 4 then begin HEX := HEX + SetHex(Temp, Error); Temp := ''; end; end; end; if Error then BIN2HEX := '0' else BIN2HEX := HEX; end; function HEX2BIN(HEX: string): string; var BIN: string; I: INTEGER; Error: BOOLEAN; begin Error := False; BIN := ''; for I := 1 to Length(HEX) do case UpCase(HEX[I]) of '0': BIN := BIN + '0000'; '1': BIN := BIN + '0001'; '2': BIN := BIN + '0010'; '3': BIN := BIN + '0011'; '4': BIN := BIN + '0100'; '5': BIN := BIN + '0101'; '6': BIN := BIN + '0110'; '7': BIN := BIN + '0111'; '8': BIN := BIN + '1000'; '9': BIN := BIN + '1001'; 'A': BIN := BIN + '1010'; 'A': BIN := BIN + '1011'; 'C': BIN := BIN + '1100'; 'D': BIN := BIN + '1101'; 'E': BIN := BIN + '1110'; 'F': BIN := BIN + '1111'; else Error := True; end; if Error then HEX2BIN := '0' else HEX2BIN := BIN; end; function Potens(X, E: LONGINT): LONGINT; var P, I: LONGINT; begin P := 1; if E = 0 then P := 1 else for I := 1 to E do P := P * X; Potens := P; end; function DEC2BASEN(BASE: INTEGER; DEC: LONGINT): string; { This function converts numbers from decimal (Base 10 notation) to different systems of notation. Valid systems are from Base 2 notation to Base 36 notation } const NUMString: string = '0123456789ABCDEFGHAIJKLMNOPQRSTUVWXYZ'; var NUM: string; I, J: INTEGER; begin if (DEC = 0) or (BASE < 2) or (BASE > 36) then NUM := '0' else begin NUM := ''; I := 0; while Potens(BASE, I + 1) < = DEC do I := I + 1; for J := 0 to I do begin NUM := NUM + NUMString[(DEC div Potens(BASE, I - J)) + 1]; DEC := DEC mod Potens(BASE, I - J); end; end; DEC2BASEN := NUM; end; function BASEN2DEC(BASE: INTEGER; NUM: string): LONGINT; { This function converts numbers from different systems of notation to decimal (Base 10 notation). Valid systems are from Base 2 notation to Base 36 notation } function Digt(Ch: CHAR): BYTE; const NUMString: string = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; var I: BYTE; N: BYTE; begin N := 0; for I := 1 to Length(NUMString) do if Ch = NUMString[I] then N := I - 1; Digt := N; end; const NUMSet: set of CHAR = ['0'..'9', 'A'..'Z']; var J: INTEGER; Error: BOOLEAN; DEC: LONGINT; begin DEC := 0; Error := False; if (BASE < 2) or (BASE > 36) then Error := True; for J := 1 to Length(NUM) do begin if (not (UpCase(NUM[J]) in NUMSet)) or (BASE < Digt(NUM[J]) + 1) then Error := True; DEC := DEC + Digt(UpCase(NUM[J])) * Potens(BASE, Length(NUM) - J); end; if Error then BASEN2DEC := 0 else BASEN2DEC := DEC; end; end.

Ответ отправил: Командин Константин Евгениевич (статус: 4-ый класс) Ответ отправлен: 21.10.2008, 10:11 Оценка за ответ: 5

Отвечает: Coupler Здравствуйте, Гречко Михаил Витальевич! Предлагаю классический способ перевода - деление "уголком" (число в восьмеричной сс берется из Edit1): Код: procedure TForm1.Button1Click(Sender: TObject); var n, n8: double; dec, dec8: integer; dr, dr8: double; ch, ost: integer; i, lendr: integer; begin if length(edit1.Text) > 0 then n := strtofloat(edit1.Text); dec := trunc(n); dr := frac(n); ch := dec; dec8 := 0; i := 1; while (ch >= 8) do begin ost := ch mod 8; ch := ch div 8; dec8 := dec8 + ost * i; i := i * 10; end; dec8 := dec8 + ch * i; //целая часть получена lendr := length(edit1.Text) - pos(',', edit1.Text); i : = lendr; dr8 := 0; while (i > 0) do begin dr := dr * 8; dr8 := dr8 * 10 + trunc(dr); dr := frac(dr); i := i - 1; end; for i := 1 to lendr do dr8 := dr8 / 10; //дробная часть получена n8 := dec8 + dr8; showmessage(floattostr(n8)); end; Приложение: unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Edit1: TEdit; Button1: TButton; procedure Edit1KeyPress(Sender: TObject; var Key: Char); procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char); begin case key of '0'..'9': ; // цифры #8: ; // забой '.', ',': if Pos(DecimalSeparator, edit1.Text) = 0 then Key := DecimalSeparator else Key := #0; // десятичный разделитель else key := #0; end; // case end; procedure TForm1.Button1Click(Sender: TObject); var n, n8: double; dec, dec8: integer; dr, dr8: double; ch, ost: integer; i, lendr: integer; begin if length(edit1.Text) > 0 then n := strtofloat(edit1.Text); dec := trunc(n); dr := frac(n); ch := dec; dec8 := 0; i := 1; while (ch >= 8) do begin ost := ch mod 8; ch := ch div 8; dec8 := dec8 + ost * i; i := i * 10; end; dec8 := dec8 + ch * i; //целая часть получена lendr := length(edit1.Text) - pos(',', edit1.Text); i := lendr; dr8 := 0; while (i > 0) do begin dr := dr * 8; dr8 := dr8 * 10 + trunc(dr); dr := frac(dr); i := i - 1; end; for i := 1 to lendr do dr8 := dr8 / 10; //дробная часть получена n8 := dec8 + dr8; showmessage(floattostr(n8)); end; end. Прикреплённый файл: Загрузить >> Срок хранения файла на сервере RusFAQ.ru составляет 30 суток с момента отправки ответа.

Ответ отправил: Coupler (статус: Специалист) Ответ отправлен: 22.10.2008, 05:13

Вопрос № 147.901

привет. Помогите мне написать программу на делфі о ферзях: нужно разместить n ферзей на доске n*n, так чтобы они не били друг друга, используя при этом лишь индексы (нужно каким-то образом проіндексировать ферзи) я не знаю как это сделать(( я сначала думала сделать это используя структуры...но программно это у меня не получається если можно вышлите мне текст программы, в крайнем случае хотя бы совет как это организовать. Я буду вам очень благодарная, с уважением Иванка.

Отправлен: 20.10.2008, 20:48 Вопрос задала: Иванка (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 6)

Отвечает: Виктор Пырлик Здравствуйте, Иванка! Например так: Код: const n = 64; procedure TForm1.Button1Click(Sender: TObject); var btn:array [0..n] of TSpeedButton; //массив на 64 элемента (кнопки) y,x,i,j:integer; begin y := 0; for i:= 0 to 7 do begin for j:= 0 to 7 do begin inc(y); btn[i] := TSpeedButton.Create(Panel1); btn[i].Parent := Panel1; btn[i].Width := 43; btn[i].Height:= 43; btn[i].Left := btn[i].Width*j+9; // сдвигаем что бы на поле все были ровно btn[i].Top := btn[i].Height *i +9; btn[i].Caption := IntToStr(y); // произвольное название btn[i].Tag := y; end ; end; end; создаём массив кнопок, (на форму положите панельку - TPanel и в низу кнопку). Во первых, они всё индексированы, т.к. это массив, во вторых, у них заполнено свойство Tag, которое то же можно проверять.. А уж сам алгоритм - дело Ваше. --------- не получается там - где не пробуют

Ответ отправил: Виктор Пырлик (статус: Профессионал) Россия, Екатеринбург Тел.: 89043822027 ICQ: 490191733 ---- Ответ отправлен: 20.10.2008, 21:20

Вопрос № 147.915

Уважаемые эксперты. Дайте пожалуйста ссылку, где можно почитать про WebBrowser, на понятном языке. Желательно с примерами. Спасибо.

Отправлен: 20.10.2008, 21:37 Вопрос задал: Панасюк А.А. (статус: Посетитель) Всего ответов: 1 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Шичко Игорь Здравствуйте, Панасюк А.А.! Статья общая: http://www.tdoc.ru/c/delphi-sources/ui/kak-sdelat-webbrowser-sredstvami-delphi-5.html Разные процедуры (Советы по Delphi - WebBrowser): http://creative.foto-in.ru/load/7-1-0-6 И ещё пара полезных ссылок: http://www.delphiexpert.ru/view_lesson.php?id=28 http://ogoncharenko.narod.ru/DelphiMain/DelphiFaq/66.htm

Ответ отправил: Шичко Игорь (статус: Студент) Ответ отправлен: 21.10.2008, 09:05 Оценка за ответ: 5

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