var i: integer = 0;

procedure TForm1.Image1Click(Sender: TObject);

begin

 TIMER1.Enabled:= TRUE

end;
procedure TForm1.Timer1Timer(Sender: TObject);

begin

 gen1.ResetAM;

 gen1.Prepare;

 gen1.Frequency:= 500;
 INC(I); if i> length(slovo) then begin

   timer1.Enabled:= false;

   i:= 0

 end;
 if slovo= '.' then begin gen1.Duration:=100;  gen1.Play end;

 if slovo= '-' then begin gen1.Duration:= timer1.Interval; gen1.Play end

end;

	mz_res.zip (236.5 Кб)
	Виртуальные приборы. Синтезатор азбуки Морзе (Минск).pdf (264.8 Кб)

тема на форуме

Добрый день, дорогие читатели. Читайте в сегодняшнем номере рассылки обзор интересных тем за неделю на форуме программистов.

Как в коснольном приложении открыть диалог сохранения?
Диалог сохранения или открытия тоже?
Тема на форуме

Поддержка drag and drop для Tlistview?
пишу маленькую программу с использованием Tlistview не подскажете как обработать сообщение WM_DROPFILES только для Tlistview ,а не для всей формы или как сделать поддержку drag and drop для Tlistview?
Тема на форуме

Создание структуры бд для рерайтера
Гораздо лучше использовать файл базы со своей структурой. У меня структура такая:
Тема на форуме

Получить набираемое слово в memo
Тема на форуме

Записать StringGrid1 в двумерный массив
Тема на форуме

Вычислить контрольную сумму строки
Вычислить контрольную сумму строки «58 00 A0 90 CB B7 A6 02 04 4D BC A2 80 60 8C 9A 00 D0 33 5F 5B 54 AF 6A D3″, являющуюся инверсией XORа всех байт.
Тема на форуме

Программный подсчёт комбинаций и вероятностей в покере, создание покер бота
На форуме уже ни одна тема была по созданию бота для покер рума, также в разделе win api на форуме – Работа с покер-румом. И даже выкладывались наработки, например, покера с костями. Все актуальные и более релевантные темы можно посмотреть через google – site:programmersforum.ru покер. Всё это и многое другое, например – игровые автоматы, делается для многих и многих онлайн казино на просторах интернета.
Тема на форуме

Завтра отменят службу в армии. А вы еще служите или служили. вам обидно будет?
Очередная армейская тема всплыла на форуме, потому я решил создать опрос. В развитых странах уже давно отменили службу в армии. Вот другого президента переизберем и может новый президент или следующий за ним отменит службу в армии. Или может Путин решить стать Линкольном и отменит завтра службу в армии. Вам будет обидно?
Тема на форуме

Искажать видео записываемое с веб камеры
Искажения типа «выпуклая линза». Как это сделать – ума не приложу. Для записи видео используется TVideoGrabber, если что. Как вообще происходит процесс искажения? Что для этого стоит использовать? Есть какие нибудь идеи?
Тема на форуме

Как лучше авторизовать пользователя
Всем привет. Хотелось бы поговорить об авторизации пользователя.
Как известно в хорошей системе пользователи разделены на системных (редакторов, админов, суперадминов) и обычных пользователей.

Собственно вопрос такой :
Что лучше авторизация посредством .htaccess и .htpswd ? Или же стандратно посредством формы и полей логин пароль?
Напомню, что разговор о веб приложение на рнр

И опять же, если выбрать первый вариант, то как поймать данные об авторизованном пользователе для системы рнр скриптов.
Тема на форуме

Присвоить текст в edit в определенный день
меня не интересует как присвоить свойству caption текст из edit. мне надо, что бы это присваивание было только в указанный день, именно в тот день, который я указал в Edit2.
Тема на форуме

Как добавить таблицу из StringGrid в excel?
Тема на форуме

Читать этот номер в клубе.

3D Hunter
по теме: используй класс TOpenDialog/TSaveDialog.

program Project1;

{$APPTYPE CONSOLE}
uses

  SysUtils, dialogs;
var

  od:TOpenDialog;

begin

  try

    try

      od:=TOpenDialog.Create(nil);

      if od.Execute(0) then ShowMessage(od.FileName);

    finally

      FreeAndNil(od);

    end;

  except

    on E: Exception do

      Writeln(E.ClassName, ': ', E.Message);

  end;

end.

С TSaveDialog работать аналогично.

тема на форуме

вот пример
grafgrial

procedure TForm1.DropFiles(var msg: TMessage);

var

  i, count  : integer;

  dropFileName : array [0..511] of Char;

  MAXFILENAME: integer;

begin

  MAXFILENAME := 511;

  count := DragQueryFile(msg.WParam, $FFFFFFFF, dropFileName, MAXFILENAME);

  for i := 0 to count - 1 do

  begin

    DragQueryFile(msg.WParam, i, dropFileName, MAXFILENAME);

    Memo1.Lines.Add(dropFileName);

  end;

  DragFinish(msg.WParam);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

DragAcceptFiles(ListView1.Handle, True);

end;

тема на форуме

%

немного|чуточку|чуток|чуть-чуть|малость|слегка

поправить|отредактировать|изменить

Если рерайтер (я создаю именно рерайтер, а не простой синонимайзер) найдет в тексте слово «чуток», то он его заменит на «немного», «чуточку», «чуть-чуть», «малость» или «слегка». И не надо для каждого слова писать отдельную строчку, а тем более группу.

Главная сложность – создать интерпретатор для такой структуры файлов. Ведь рерайтер – это не просто замена одиночных слов на их синонимы. Вот, например, я создал и обработку конструкций «который»:

$noun:subject , котор@ -- Эт@ $noun:derivative

* $noun:object , котор@ $verb -- * $noun , $participle:derivative-verb

Не буду объяснять, что значат эти строчки, могу только сказать, что здесь происходит замена конструкции «который» на причастный оборот. Например, предложение: «Человек, который любит подумать», заменится на: «Человек, любящий подумать».

Но вы уж тут сами разбирайтесь с такими сложными обработками. Я приведу код только синонимизации (потому что код рерайтера я никому не отдам… ).

После вырезки некоторых строчек кода, управляющих обработкой формул типа «который», получилось вот это:

//Анализ формулы -- это вы можете спокойно убрать, так же как и знак "%" из базы синонимов

function TFormMain.FormulaAnalyse(Formula: string): TVarStr;

var i: integer;

begin

 SetLength(Result, 0);

 SetLength(Result, 1);

 for i := 1 to Length(Formula) do

 begin

  if Formula = ' ' then

  begin

   SetLength(Result, Length(Result) + 1);

   Continue;

  end;
  Result[Length(Result)-1] := Result[Length(Result)-1] + Formula;

 end;

end;
//Это просто проверка символа на причастность к алфавиту   т.е. буква ли это

function TFormMain.InAlphabet(Symbol: char; upper: boolean): boolean;

var i: integer;

begin

 Result := false;

 for i := 0 to 32 do

  if upper then

  begin

   if AnsiUpperCase(Alphabet) = Symbol then

   begin

    Result := true; Exit;

   end;

  end else

  begin

   if Alphabet = Symbol then //На всякий случай: Alphabet - это массив из литер

   begin

    Result := true; Exit;

   end;

  end;

end;
//Сама процедура генерации синонимизированного текста

procedure TFormMain.SentencesGenerate;

var

 i, j, o, y, u: integer;

 AnalyseFile: TStrings;

 Formula: string;

 FormComp: TVarStr;

 SentComp: TVarStr;

 Synonims: TVarStr;

 s: string;

 c: char;

 n: integer;

 check_f: boolean;

label l;

begin

 AnalyseFile := TStringList.Create;

 try

  AnalyseFile.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'Data\Syn_Words.txt');

  Formula := AnalyseFile[0];
  FormComp := FormulaAnalyse(Formula);
  for i := 0 to Length(Sentences) - 1 do

  begin

   SentComp := SentenceAnalyse(Sentences);
   for j := 0 to Length(FormComp) - 1 do

   begin

    if FormComp[j] = '%' then

    begin

     for o := 0 to Length(SentComp) - 1 do

     begin

      s := '';
      for y := 1 to AnalyseFile.Count - 1 do

      begin

       Synonims := SynonimsAnalyse(AnalyseFile[y]);

       for u := 0 to Length(Synonims) - 1 do

       begin

        if Synonims = SentComp[o] then

        begin

         l: n := Random(Length(Synonims));
         if Synonims[n] = SentComp[o] then goto l

         else s := Synonims[n];

         Break;

        end;

       end;

      end;
      if s <> '' then memGen.Text := memGen.Text + ' ' + s

      else begin

       if Length(SentComp[o]) = 1 then

       begin

        c := SentComp[o][1];

        if (not InAlphabet(c, False)) and (not InAlphabet(c, true)) then

         memGen.Text := memGen.Text + SentComp[o]

        else memGen.Text := memGen.Text + ' ' + SentComp[o];

       end

       else memGen.Text := memGen.Text + ' ' + SentComp[o];

      end;

     end;

    end;

   end;

  end;
  memGen.Text := Trim(memGen.Text);

 finally

  AnalyseFile.Free;

  SetLength(FormComp, 0);

  SetLength(SentComp, 0);

  SetLength(Synonims, 0);

 end;

end;
//Анализ предложения; идет разбивка на слова и пунктуационные знаки

function TFormMain.SentenceAnalyse(Sentence: string): TVarStr;

var i: integer;

begin

 SetLength(Result, 0);

 SetLength(Result, 1);
 for i := 1 to Length(Sentence) do

 begin

  if Sentence = ' ' then

  begin

   SetLength(Result, Length(Result) + 1);

   Continue;

  end;
  if (not InAlphabet(Sentence, false)) and (not InAlphabet(Sentence, true)) then

  begin

   SetLength(Result, Length(Result) + 1);

   Result[Length(Result)-1] := Sentence;

   SetLength(Result, Length(Result) + 1);

   Continue;

  end;
  Result[Length(Result)-1] := Result[Length(Result)-1] + Sentence;

 end;

end;
//Анализ базы синонимов; идет разбивка на слова-синонимы

function TFormMain.SynonimsAnalyse(Synonims: string): TVarStr;

var i: integer;

begin

 SetLength(Result, 0);

 SetLength(Result, 1);

 for i := 1 to Length(Synonims) do

 begin

  if Synonims = '|' then

  begin

   SetLength(Result, Length(Result) + 1);

   Continue;

  end;
  Result[Length(Result)-1] := Result[Length(Result)-1] + Synonims;

 end;

end;
//Анализ текста; идет разбивка на предложения

procedure TFormMain.TextAnalysis;

var

 i: integer;

 NewSentence: boolean;

begin

 memText.Text := Trim(memText.Text);
 NewSentence := true;

 SetLength(Sentences, 0);

 for i := 1 to Length(memText.Text) do

 begin

  if NewSentence then SetLength(Sentences, Length(Sentences) + 1);

  Sentences[Length(Sentences)-1] := Sentences[Length(Sentences)-1] + memText.Text;

  if (memText.Text = '.') and ((i = Length(memText.Text)) or (InAlphabet(memText.Text, true))) then

   NewSentence := true

  else NewSentence := false;

 end;

end;
//При нажатии на кнопку генерации синонимизированного текста.

procedure TFormMain.bt_GenerateClick(Sender: TObject);

begin

 memGen.Clear;
 TextAnalysis;

 SentencesGenerate;

end;

Код меняйте под свои нужды. Но вопросов по его работе задавать не стоит. Отвечать не буду. Во всем можете разобраться сами.

Прикреплю вам испытательный полигон для опытов.

P.S. Генерация происходит при нажатии второй «безкартиночной» кнопки на toolbar’е

Syn.rar (219.2 Кб)

тема на форуме

procedure TForm1.Memo1Change(Sender: TObject);

begin

  if Tag > 0 then

  begin

    Memo1.SelStart := Tag;

    Memo1.SelLength := Abs(Length(Memo1.Text) - Tag);

    Label2.Caption := Memo1.SelText;

    Memo1.SelStart := Length(Memo1.Text);

  end;

end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);

begin

  if Key = #32 then Tag := Memo1.SelStart;

end;

imlist.rar (169.5 Кб)

тема на форуме

for i:=0 to StringGrid1.RowCount - 1 do

   for j:=0 to StringGrid1.ColCount - 1 do

      A := StrToFloat( StringGrid1.Cells[ j, i ];

тема на форуме

Serge_Bliznykov
примерно так:

 ks := Stroka[1];

  for i:=2 to Length(Stroka) do

    ks := ks xor Stroka;

  ks := Not ks; {инверсия результата}

тема на форуме

В начале работы с колодой карт в покере, вероятно, сначала стоит рассмотреть все комбинации в покере dixonich предлагает массив cards[52] .

dixonich:

собственно есть массив
cards[52] = {21,31,41,…,144}
последняя цифра – масть. это колода.
нужно осуществить проверку комбинаций. какие есть варианты, кроме 1000 ифов? ))

veniside предлагает решение:

veniside:

Вот, меня хватило только до Straight, но идея, думаю, понятна.

struct card {

int v; // 2=2, 3=3, ... 11=J, 12=Q, 13=K, 14=A

int suit; // 1=clubs, 2=spades, 3=hearts, 4=diamonds

};

struct deck {

int count; // number of cards

card set[52]; // cards

};
void sort(deck &d, bool byV)	// bubble sort (by Value or by Suit)

{

bool sorted = false;

while (!sorted) {

//

int i = 0;

sorted = true;

while (i < d.count - 1) { 			// 			bool gt = byV ? d.set.v > d.set.v : d.set.suit > d.set.suit;

if (gt) {

//

sorted = false;

card tmp = d.set;

d.set = d.set;

d.set = tmp;

}

i++;

}

}

}
int longrun(deck &d, int &second)

{

sort(d, true); // sort by value

//

second = 0;

int first = 1, current = 1;

//

int v = d.set[0].v;

int i = 0;

while (i++ < d.count - 1) { 		// 		if (v == d.set.v) current++; 		else { 			// 			if (current > first)

first = current;

if ((current < first) && (current > second))

second = current;

//

current = 1;

v = d.set.v;

}

}

if (current > first)

first = current;

if ((current < first) && (current > second))

second = current;

//

return first;

}
bool Straight(deck &d, bool Flush)

{

sort(d, true); // sort by value

//

// check if values are increasing & all suits are same

int v = d.set[0].v;

int s = d.set[0].suit;

int i = 0;

while (i++ < d.count - 1) {

//

if ( (d.set.v != d.set.v + 1) || (Flush & (d.set.suit != s)) )

return false;

}

//

return true;

}
bool RoyalFlush(deck &d)

{

if (Straight(d, true))

return (10 == d.set[0].v);

else

return false;

}
bool FourOfAKind(deck &d)

{

int s;

return (4 == longrun(d, s));

}
bool FullHouse(deck &d)

{

int f, s;

f = longrun(d, s);

return ((3 == f) && (2 == s));

}
bool Flush(deck &d)

{

sort(d, false);	// sort by suit

int s = d.set[0].suit;

int i = 0;

while (i++ < d.count - 1) {

//

if ( d.set.suit != s )

return false;

}

return true;

}

Использовать примерно так:

deck hand;

hand.count = 5;

hand.set[0].v = 10;

hand.set[0].suit = 1;

hand.set[1].v = 10;

hand.set[1].suit = 2;

hand.set[2].v = 9;

hand.set[2].suit = 1;

hand.set[3].v = 9;

hand.set[3].suit = 3;

hand.set[4].v = 9;

hand.set[4].suit = 2;

//

bool rf = RoyalFlush(hand);		// Royal Flush

bool sf = Straight(hand, true);	// Straight Flush

bool foak = FourOfAKind(hand);	// Four Of A Kind

bool fh = FullHouse(hand);		// FullHouse

bool f = Flush(hand);			// Flush

bool s = Straight(hand, false);	// Straight

Подробнее в теме на форуме – Проверка комбинаций в покере.

Вадим Мошев
Считаю, что служба в армии (если отбросить имеющиеся на данный момент времени неприятности, например, неуставные отношения) всё же нужна. Почему? Это физическое развитие, закалка и подготовка к возможным «форс-мажорам». На мой взгляд, очень странно, что развитые страны отказались от службы в армии. Как же в этом случае тогда противостоять возможным неприятностям, которые без спецподготовки не преодолеть? Я понимаю, что есть спецслужбы (НАПРИМЕР, ОМОН или спецназ), но, ИМХО, никому плохо не будет, если человек, не имеющий отношения к выше оговоренным структурам, будет владеть навыками, позволяющими обезопасить себя и/или окружающих.

В данный момент я не могу говорить о пользе службы для русской молодёжи (хотя положительные моменты были отмечены выше). Возможно, если бы в армии не было неуставных отношений, которые есть в настоящее время, то в большинстве случаев служба бы пошла только на пользу, ИМХО.

Лично моё же мнение о службе такое.
Всё же служба – это не только отметка в военном билете, но также ещё и несколько «открытых дверей» на некоторые места работы (например, в пожарную охрану или в милицию не возьмут даже компьютерным работником, если вы не годны/не служили).
Помимо выше озвученного, это ещё и высокая репутация в глазах других людей (моё мнение!), в частности перед девушками/женщинами. Имхо, у служивших будет больше успеха в общении с девушками/женщинами.

С другой стороны, если говорить о «защите родины», то защищать такую страну, где такое отношение к людям и такая жизнь, совсем не хочется.
Хотя возможно, русских людей именно на то и программируют, чтобы ослабить страну и манипулировать нами было ещё легче. Так что здесь виновата не Россия, а государственно-политический аппарат. Страну, в которой всё хорошо, и защищать приятно.

тема на форуме