[xBlackBird]

Здравствуйте! Есть у меня 3 задачки, но сам я не в силах их решить. Может, найдётся добрый умелец!

1 задача.
На форме расположены текстовые поля, в которые вводятся наименование товара, цена в рублях и копейках. При нажатии на соответствующую кнопку информация добавляется в многострочный редактор "Магазин". Предусматривается контроль правильности заполнения всех полей (пустые поля рассматриваются как ошибка ввода).

2 задача.
Написать приложение, состоящее из двух форм. На первой форме расположить:
a) два текстовых поля, в которых задаются размеры второй формы;
b) кнопку "Форма 2", при нажатии на которую открывается открывается вторая форма заданного размера;
c) кнопку "Уменьшить", при нажатии на которую Форма 2 уменьшается по ширине и высоте.

3 задача.
1) Определить массу содержимого бочки радиусом r и высотой H при плотности вещества G.
2) Дана строка. Определить кол-во пробелов, предшествующих первому восклицательному знаку.
3) Дана строка. Удалить из неё всё группы букв "abcd".

Спасибо!

[lmikle]

Дело было вечером, делать было нечего...

1.

Код:

procedure Form1.Button1Click(Sender: TObject);
var
  sName : String;
  iRub, iKop : Integer;
begin
  Try
    // Пошли проверки
    If Trim(Edit1.Text) = '' then Raise Exception.Create('Нимнеование товара не введено.');
    If Trim(Edit2.Text) = '' then Raise Exception.Create('Цена товара руб не введена.');
    If Trim(Edit3.Text) = '' then Raise Exception.Create('Цена товара коп не введена.');

    sName := Trim(Edit1.Text);

    If Not TryStrToInt(Trim(Edit2.Text),iRub) Then Raise Exception.Create('Цена товара руб не является числом.');
    If Not TryStrToInt(Trim(Edit3.Text),iRub) Then Raise Exception.Create('Цена товара коп не является числом.');

    // Все ОК - добавляем в Memo
    Memo1.Lines.Add(Format('%s - %d руб %d коп',[sName, iRub, iKop]));
  Except
    On E : Exception Do MessageDlg(E.Message,mtError,[mbOK],0);
  End;
end;

2. Тут есть 2 формы - form1 и form2. Все кнопки и поля ввода на Form1. Обе формы должны создаваться автоматически (такое, вроде, по умолчанию)

Код:

uses Unit2;

// Показ формы
procedure Form1.Button1Click(Sender : TObject);
var
  W, H : Integer;
begin
  If tryStrToInt(Edit1.Text,W) And tryStrToInt(Edit2.Text,H) then
    begin
      Form2.Width := W;
      Form2.Height := H;
      Form2.Show;
    end
  else
    MessageDlg('Указанные ширина и/или высота не являются целым числом.',mtError,[mbOK],0);
end;

// уменьшение размера
procedure Form1.Button2Click(Sender : TObject);
var
  W, H : Integer;
begin
  W := Form2.Width;
  H := Form2.Height;
  If (W < 11) Or (H < 11) Then MessageDlg('Ширина и/или высота формы меньше мин значения.',mtError,[mbOK],0)
  else
    begin
       W := W - 10;
       H := H - 10;
       Form2.Width := W;
       Form2.Height := H;
    end;
end;

3.1.
V = H*Pi*R^2
m = V*G

Код:

procedure Form1.Button1Click(Sender : TObject);
var
  H, R, G : Double; // на всякий случай
begin
  If TryStrToFloat(Edit1.Text,R) And TryStrToFloat(Edit2.Text,H) And TryStrToFloat(Edit3.Text,G) 
    Then MessageDlg(Format('m = %.2f',[G*H*sqr(R)*3.14]),mtInformation,[mbOK],0)
    Else MessageDlg('Ошибка в исходных данных.',mtError,[mbOK],0);
end;

3.2.

Код:

procedure Form1.Button1Click(Sender : TObject);
var
  S : String;
  I : Integer;
  C : Integer;
begin
  S := Edit1.Text;
  C := 0;
  I := 1;
  While (S[i] <> '!') And (I <= Length(S)) Do
  begin
    If S[i] = ' ' Then Inc(C);
    Inc(I);
  end;
  If I > Length(S) 
    Then ShowMessage('В строке нет воскл. знака.')
    Else ShowMessage(format('В строке %d символов до воскл. знака.',[C]));
end;

3.3.

Код:

procedure Form1.Button1Click(Sender : TObject);
var
  S1, S2  : String;
begin
  S1 := Edit1.Text;
  S2 := StringReplace(S1,'abcd','',[rfReplaceAll]);
  ShowMessage('Строка до: ' + S1 + #13#10 + 'Строка после: ' + S2);
end;

ЗЫ. Только с такими решенями препод скорее всего догадается, что это делал не ты...

[@Rafa3L]

Тогда нужно как можно проще, чтоб не догадалси

[lmikle]

2 @Rafa3L
Тогда StringReplace сам реализуй

[xBlackBird]

Спасибо большое!

[@Rafa3L]

2 lmikle
Вот, только без проверки вылета из диапазона len

Код:

procedure TForm1.Button4Click(Sender: TObject);
var
 i: integer;
 s: string;
begin
  s:= Edit5.Text; // := StringReplace(Edit5.Text,'abcd','',[rfReplaceAll]);
  for i:= Length(s) downto 1 do
   if s[i-3] + s[i-2] + s[i-1] + s[i] = 'abcd' then Delete(s, i-3, 4);
  Edit5.Text:= s;
end;

[lmikle]

2 @Rafa3L

А теперь попробуй на такой строке: '1abcd'
Или, еще лучше, на такой: 'abcd'

Подсказка: В цикле For условие вычисляется один раз.

Если уж делать, то как-то так:

Код:

function MystringReplace(ASrc, ASearchFor, AReplaceBy : String) : String;
begin
  Result := ASrc;
  Idx := Pos(ASearchFor,Result);
  While Idx > 0 Do
    Begin
      Delete(Result,Idx,Length(ASearchFor));
      Insert(AReplaceBy,Result,Idx);
      Idx := Pos(ASearchFor,Result);
    End;
end;

И это еще без флагов.

[@Rafa3L]

2 lmikle

...И это еще без флагов.

Что ж ты тогда флаги не отработал, при таком-то педантиизмие :-)
Дело Принципа - стрелять, и "Если уж делать, то как-то так":

Код:

function MyStringReplace(S, OldPattern, NewPattern: string;
 Flags: TReplaceFlags = [rfReplaceAll]): string;
var
 UpperFindStr: string;
 pS: PChar;
 i, j, Idx: integer;
 IsEqual, CanReplace: bool;
begin
 if OldPattern = '' then
  begin
   Result:= S;
   Exit;
  end;
 Result:= '';
 if S = '' then Exit;
 if rfIgnoreCase in Flags then
  begin
   OldPattern:= AnsiUpperCase(OldPattern);
   UpperFindStr:= AnsiUpperCase(S);
   pS:= PChar(UpperFindStr);
  end else pS:= PChar(s);
 if Length(OldPattern) >= Length(NewPattern) then
  SetLength(Result,Length(s)) else
   SetLength(Result,(Length(s)+Length(OldPattern)+Length(NewPattern))*2);
 i:= 1;
 Idx:= 0;
 CanReplace:= true;
 while i <= Length(s) do
  begin
   IsEqual:= false;
   if CanReplace then
    begin
     if pS[i-1] = OldPattern[1] then
      begin
       IsEqual:= true;
       for j := 2 to Length(OldPattern) do
        begin
         if pS[i+j-2] <> OldPattern[j] then
          begin
           IsEqual:= false;
           Break;
          end;
        end;
       if IsEqual then
        begin
         for j := 1 to Length(NewPattern) do
          begin
           Inc(Idx);
           if Idx > Length(Result) then
            SetLength(Result,Length(Result)*2);
           Result[Idx]:= NewPattern[j];
          end;
         Inc(i, Length(OldPattern));
         if not (rfReplaceAll in Flags) then
          CanReplace:= false;
        end;
      end;
    end;
   if not IsEqual then
    begin
     Inc(Idx);
     if Idx > Length(Result) then
      SetLength(Result,Length(Result)*2);
     Result[Idx] := S[i];
     Inc(i);
    end;
  end;
 SetLength(Result, Idx);
end;

[lmikle]

2 @Rafa3L

Ну, коль пошла такая пьянка - режь последний огурец:

Код:

function MyStringReplace(ASrc, ASearchFor, AReplaceBy : String; AFlags : TReplaceFlags) : String;

  function GetStrIndex(AStr, APattern : String; AIgnoreCase : Boolean) : Integer;
  begin
    If AIgnoreCase
      Then Result := Pos(UpperCase(APattern),UpperCase(AStr))
      Else Result := Pos(APattern,AStr);
  end;

var
  Idx : Integer;
begin
  Result := ASrc;
  Idx := GetStrIndex(Result,ASearchFor,rfIgnoreCase in AFlags);
  While Idx > 0 Do
    Begin
      Delete(Result,Idx,Length(ASearchFor));
      Insert(AReplaceBy,Result,Idx);
      Idx := GetStrIndex(Result,ASearchFor,rfIgnoreCase in AFlags);
      If Not (rfReplaceAll in AFlags) Then Break;
    End;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    Memo1.Lines.Text :=
    MyStringReplace('abcd','abcd','{Replaced}',[]) + #13#10 +
    MyStringReplace('abcdabcd','abcd','{Replaced}',[]) + #13#10 +
    MyStringReplace('abcdabcd','abcd','{Replaced}',[rfReplaceAll]) + #13#10 +
    MyStringReplace('abcdABCD','abcd','{Replaced}',[rfReplaceAll]) + #13#10 +
    MyStringReplace('abcdABCD','abcd','{Replaced}',[rfReplaceAll,rfIgnoreCase]);
end;

Выдача:

Код:

{Replaced}
{Replaced}abcd
{Replaced}{Replaced}
{Replaced}ABCD
{Replaced}{Replaced}

Вроде, у меня с примером получилось короче, чем у тебя

[Alegun]

Надоело под Рафой3L скрываться затянулся спор больно, bro lmikle, у ТС в задании указано

3) Дана строка. Удалить из неё всё группы букв "abcd".

поэтому, "чтоб препод не догадался" достаточно и банального

Код:

var
 i: integer;
 s: string;
begin
  s:= 'abcd4AbcdABCDdrewabds29abdcabcdabcdwerteds';
  if Length(s) < 5 then Exit;
  for i := Length(s) downto 1 do
   if i >= 4 then
   if s[i-3]+s[i-2]+s[i-1]+s[i] = 'abcd' then Delete(s,i-3,4);
  // Result: s = '4AbcdABCDdrewabds29abdcwerteds'
end;

похоже учёл возможные вылеты и ошибки

З.Ы.Оффтоп:

...Вроде, у меня с примером получилось короче, чем у тебя

Через pos() и я так могу , а вот без функций ВУ чисто перебором намного труднее кому-то аналог StringReplace было собирать :-)

[Aristarh Dark]

А что стандартный StringReplace использовать религия запрещает?

[Alegun]

Совсем оффтоп, прям филиал флудильни в коднашаре образовался :-):

Сообщение от Aristarh Dark

А что стандартный StringReplace использовать религия запрещает?

Не, намного хуже

Сообщение от lmikle

...Тогда StringReplace сам реализуй

вот спор и пошёл на тему простоты

[lmikle]

Да просто пиписьками мериемся на примере StringReplace. ТС это нафих не надо. В какой то момент просто стало интересно до чего дойдем.
По поводу "без Pos". Ну, тогда уж и без Delete и Insert. Это функции одного порядка, изначально реализованы в System. StringReplace добавилась потом. Так что Pos - можно. Собственно, можно просто Pos самому реализовать:

Код:

function MyPos(ASubStr, AStr : String) : Integer;
var
  I, J : Integer;
  F : Boolean;
begin
  Result := 0;
  for I := 1 To Length(AStr)-Length(ASubstr) Do
  begin
    F := true;
    for J := 0 To Length(ASubStr)-1 Do
      F := F And Astr[I+J] = ASubStr[J+1];
    If F Then
      begin
        Result := I;
        Break;
      end;
  end
end;      

Вроде, так.

Ну, собственно, и Length тоже можно самому реализовать.