Serge_Bliznykov:

procedure TForm1.Button1Click(Sender: TObject);
var i, j : integer;
begin
   i := Memo1.Lines.Count-1;
   while i>=0 do begin
     //присваиваем переменной j номер найденной строки (ищем строчку с индексом i
     j := Memo1.Lines.IndexOf(Memo1.Lines);
     // пока строчка нашлась и эта строчка не является текущей (т.к. сама себя она найдётся всегда) и пока строчки не кончились
     //удаляем строчку и ищем следующую, пока условия выполняются
     while (j>=0) and (j<i) and (i>=0) do begin //пока индексов и количества строк больше нуля
       Dec(i);
       Memo1.Lines.Delete(j); //удаляем индекс
       if i>=0 then
         j := Memo1.Lines.IndexOf(Memo1.Lines);
     end;
     Dec(i);
   end;
end;

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

raxp:

…так сказать в продолжение изысканий

…для тех кто увлекается или кто интересуется или не имеет возможности приобрести настоящую станцию-трансивер, но горит желанием узнать в чем тусня – есть два сервиса (наиболее стабильных) покрутить виртуальную ручку настройки и послушать эфир:
1- http://www.globaltuners.com/receiver/list.php?free=1 (требуется регистрация)
2- http://websdr.ewi.utwente.nl:8901 (вещание в MPEG потоке)

Для облегчения процесса и чтоб не лазить по сайтам с регистрацией, склепал онлайн-приемник потоков с радиолюбительских серверов (к примеру, SDR приемник Vivenna2 в Австрии часто ловит станцию с перевернутым речевым-спектром, кто сталкивался – знает) >>> см. вложения

p.s.: можно конечно сграбить адреса и винампом слухати, но это не наш метод вот адреса:
Vienna 2 – DX Node / Austria / Icom IC-756=http://212.108.34.182:8888/audio/low
Vienna 1 – CNode / Austria / Icom PCR-1500=http://212.108.34.182:8000/audio/low
Vidablick / Sweden / Icom AH-7000=http://62.119.128.101:8900/audio/low
Odenwald / Germany / Icom PCR-1000=http://94.249.216.106:3333/audio/low
Bratislava / Slovakia / Icom PCR-1000 25-1300MHz=http://62.168.109.2:5505/audio/low
Breda / Netherlands / Icom PCR-1000=http://82.170.170.203:3333/audio/low

p.s.: также есть возможность выйти в эфир на реальной станции (цифровой трансивер) посредством VoIP через Интернет (уже существуют готовые приложения) – VoIP радиолюбительский интернет-репитер >>> см. вложения

Вложения:
онлайн-приемник вещательных станций + радиолюбительских серверов.zip
VoIP радиолюбительский интернет-репитер.zip
описание_VoIP радиолюбительский интернет-репитер.pdf

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

Alexei91:

Исходник прилагаю.
Т.к. пример достаточно простой,нужно указывать откуда копировать файла + имя коп. файла и куда копировать + имя коп. файла- так что нужные функции дальше сами добавите.
Почитайте книжку А.Чиртик … “Delphi Трюки&Эффекты”.
Красивое копирование файла.zip

unit Unit1;

interface

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls, ComCtrls;

type
   TForm1 = class(TForm)
     Label1: TLabel;
     pbCopyProgress: TProgressBar;
     cmbCopy: TButton;
     txtFrom: TEdit;
     txtTo: TEdit;
     Label2: TLabel;
     procedure cmbCopyClick(Sender: TObject);
     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
   private
     { Private declarations }
   public
     { Public declarations }
   end;

var
   Form1: TForm1;

implementation
var
   progress: TProgressBar;
   bCancelCopy: BOOL;

{$R *.dfm}

//Функция обратного вызова для отображения хода копирования
function CopyProgressFunc( TotalFileSize: Int64;
      TotalBytesTransferred: Int64;
     StreamSize: Int64;
     StreamBytesTransferred: Int64;
     dwStreamNumber: DWORD;
     dwCallbackReason: DWORD;
     hSourceFile: THandle;
     hDestinationFile: THandle;
     lpData: Pointer ): DWORD; stdcall;
begin
   progress.Position := 100 * TotalBytesTransferred div TotalFileSize;
   Application.ProcessMessages; //Чтобы не “зависал” интерфейс приложения
   CopyProgressFunc := PROGRESS_CONTINUE;
end;

procedure TForm1.cmbCopyClick(Sender: TObject);
begin
   if cmbCopy.Caption = ‘Копировать’ then
   begin
     //Запускаем копирование
     progress := pbCopyProgress; //Настроен от 0 до 100%
     bCancelCopy := FALSE;
     cmbCopy.Caption := ‘Отмена’;
     if CopyFileEx(PAnsiChar(txtFrom.Text), PAnsiChar(txtTo.Text),
       Addr(CopyProgressFunc), nil, Addr(bCancelCopy),
       COPY_FILE_FAIL_IF_EXISTS) = FALSE
     then
       MessageBox(Handle, ‘Не удается скопировать файл’, ‘Копирование’,
       MB_ICONEXCLAMATION);
   end
   else
   begin
     //Останавливаем процесс копирования
     bCancelCopy := TRUE;
     cmbCopy.Caption := ‘Копировать’;
   end;
end;

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
   //Останавливаем процесс копирования
   bCancelCopy := TRUE;
end;

end.

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

function GetLocalIPs: TStringList;
type
   TaPInAddr = Array[0..10] of PInAddr;
   PaPInAddr = ^TaPInAddr;
var
   phe: PHostEnt;
   pptr: PaPInAddr;
   Buffer: Array[0..63] of Char;
   I: Integer;
   GInitData: TWSAData;
   IPs: TStringList;
begin
   IPs := TStringList.Create;
   WSAStartup($101, GInitData);
   GetHostName(Buffer, SizeOf(Buffer));
   phe := GetHostByName(buffer);
   if phe = nil then IPs.Add(’No IP found’)
   else
   begin
     pPtr := PaPInAddr(phe^.h_addr_list);
     I := 0;
     while pPtr^ nil do
     begin
       IPs.Add(inet_ntoa(pptr^^));
       Inc(I);
     end;
   end;
   WSACleanup;
   Result := IPs;
end;

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

  // — Настройки
   define(’WIDTH’,200); // Ширина иконки
   define(’HEIGHT’,200); // Высота иконки
   define(’R’,255);define(’G’,255);define(’B’,255); // RGB для фонового цвета под иконкой

   // — Поехали
   $imageInfo = getimagesize( $file );
   switch( $imageInfo[2] ){
      case 1: $image = imagecreatefromgif( $file ); break;
     case 2: $image = imagecreatefromjpeg( $file ); break;
     case 3: $image = imagecreatefrompng( $file ); break;
     default: exit();
   }

   //— Создание иконки фотки
   $result = imagecreatetruecolor(WIDTH,HEIGHT);
   $bg = imagecolorallocate( $result, R, G, B );
   imagefilledrectangle( $result, 0, 0, WIDTH-1, HEIGHT-1, $bg );

   //— Вычисляем соотношение сторон для иконки
   $ratio1 = $imageInfo[0]/WIDTH;
   $ratio2 = $imageInfo[1]/HEIGHT;
   $ratio = $ratio1<$ratio2?$ratio1:$ratio2; // выбираем наименьшее соотношение

   // if ( $ratio<1 ) $ratio=1; // Оставить иконки меньших размеров WIDTH и HEIGHT не трогать
   $width = $imageInfo[0]/$ratio;
   $height = $imageInfo[1]/$ratio;
   imagecopyresampled( $result, $image, 0, 0, ($imageInfo[0]-WIDTH*$ratio)/2, ($imageInfo[1]-HEIGHT*$ratio)/2, WIDTH, HEIGHT, $ratio*WIDTH, $ratio*HEIGHT);

   //— Отправляем (возвращаем) иконку
   header(’Content-type: image/jpeg’);
   imagejpeg($result);

Алгоритм используется для подготовки эскизов (иконок) изображений.
Причем данная версия для того хороша, когда все фотки каких-попало форматов. И все аккуратненько подгоняются под размер WIDTHхHEIGHT. То, что не влазит, обрезается.

Если обрезание (обрезание исходной картинки имеется ввиду) не нужно, т.е. чтобы эскиз со своими “какими-попало” пропорциями просто вписался в прямоугольник WIDTHхHEIGHT.

Достаточно заменить одну строчку:

…..
imagecopyresampled( $result, $image, 0, 0, ($imageInfo[0]-WIDTH*$ratio)/2, ($imageInfo[1]-HEIGHT*$ratio)/2, WIDTH, HEIGHT, $ratio*WIDTH, $ratio*HEIGHT);
…..
// вот на эту:
imagecopyresampled( $result, $image, (WIDTH-$width)/2, (HEIGHT-$height)/2, 0, 0, $width, $height, $imageInfo[0], $imageInfo[1]);

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

Необходимо проверить, доступна-ли фотография по заданному пользователю адресу.

Andkorol:
Можно попробовать использовать функцию get_headers()
Примерно так:
$file = ‘http://www.domain.com/somefile.jpg’;
$file_headers = @get_headers($file);
if($file_headers[0] == ‘HTTP/1.1 404 Not Found’) {
   $exists = false;
}
else {
   $exists = true;
}

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

Через COM, или LPT? А может USB?

В теме обсуждается, какой порт выбрать для управления шаговым двигателем. Присоединится к обсуждению.

От ведущего.

Здравствуйте, друзья!! С опозданием выходит семидесятый выпуск рассылки клуба программистов. За прошлую неделю у нас новостей поменьше чем обычно. Связанно это с тем, что сейчас лето, самый разгар курортного периода, и многие великие умы тоже хотят отдохнуть и набраться сил.

(читать всё…)

Вложения

BDB.zip (667.0 Кб,

Перейти к теме на форуме.

Друзья, я вот от нечего делать начал писать свою CMS. Написана она на php, и еще очень сырая. Готово лишь процентов 50. Но тем не менее, пользоваться этой цмс-кой уже можно, хотя и не совсем удобно. А местами даже и страшно. CMS писал с нуля, сам (естественно, что яваскрипт фрейморки написаны не мной и еще некоторые шаблоны html),пишу этот проект уже с мая месяца. Основной уклон сайта который вы увидете на видео – музыка и общение. Сайт построен на оконной системе. Иными словами, внешним видом главная страница сайта напоминает рабочий стол windows. Все теже окна и
ярлычки которые можно таскать… На этой ЦМС уже мона постить новости,материалы(файлы),регистриро ваться,авторизироваться,писать комментарии, и вообщем еще некоторый минимально-необходимый функционал. Так-же в ЦМС встроен небольшой поисковичок. Да и еще…по скольку это всего лишь тестовая версия, то не обращайте особо внимания на картинки и ярлыки…их все равно заменю)))

Видео

P.S:Рекомендую смотреть видео в полноэкранном режиме и в высоком качестве, дабы все нормально видеть. Хотя вообщем и так все понятно.
Вообщем не судите строго…это первый мой крупный проект с претензиями на CMS. Думаю, что в скором времени доделаю её..

Тема на форуме.

raxp:
…книжка замечательного автора Дугласа Вильямса …будет полезна не только фанатам роботостроения, но и программистам в других областях. Вы спросите почему?

Краткие выдержки из содержания:

• работа с микроконтроллерами и ИК передатчиками
• изготовление аппаратной части (электр.начинка робота, . инфракрасный дальномер, движки), печатной платы и т.д. и т.п.
• как задействовать ИК канал связи / + код
• ПО под PalmOS
• ПО под WinCE
• видеосвязь (работа с VFW) / + код
• отправка данных с помощью FTP / + код
• беспроводное управление и линия передачи данных до робота (wi-fi) / + код
• детектор движения / + код

…сопровождается исходным кодом.

ПРОграммируемый робот управляемый с КПК.zip

по теме роботостроения надыбал дюже интересный видеоролик

Тема на форуме.

function vk_login(Login, Pass : string; IdHTTP : TIdHTTP): Boolean;
var
  sl : TStringList;
  text : string;
begin
  sl := TStringList.Create;
  sl.Add('email=' + Login + '&pass=' + Pass + '&expire=&vk=');
  text := IdHTTP.Post('http://login.vk.com/?act=login',sl);
  if Pos('Aoia',text)<>0 then begin
    MessageBox(Application.Handle,'Iaaa?iua aaiiua: Eiaei , Ia?ieu','Ioeaea',0);
    Result := False;
  end else begin
    text := Copy(text,Pos('name=' + #39 + 's' + #39,text)+16,PosEx(#39,text,Pos('name=' + #39 + 's' + #39,text)+17)-Pos('name=' + #39 + 's' + #39,text)-16);
    IdHTTP.Request.CustomHeaders.Add('Cookie:remixchk=5; remixsid=' + text);
    Result := True;
  end;
  sl.Free;
end;

vk_login(Edit1.Text,Edit2.Text,IdHTTP1);

function VK_ParsEmail(s:string; IdHTTP1:TIdHTTP): TStringList;
var
  i : Integer;
  mess_full, mess_text,
  mess_id, mess_new,
  mess_aut, mess_aut_id,
  mess_date, mess_title : string;
  sl : TStringList;
begin
  Result := TStringList.Create;
  i := 1;
  s := Copy(s,PosEx('</tr>',s,Pos('<div id="messages_wrap">',s))+6,PosEx('</table>',s,Pos('<div id="messages_wrap">',s))-PosEx('</tr>',s,Pos('<div id="messages_wrap">',s))-6);
  while PosEx('<tr ',s,i)<>0 do
  begin
    mess_full := Copy(s,PosEx('<tr ',s,i),PosEx('</tr>',s,PosEx('<tr ',s,i))-PosEx('<tr ',s,i));

    // Iieo?aiea id niiauaiey
    mess_id := Copy(mess_full,Pos('id="',mess_full)+8,PosEx('"',mess_full,Pos('id="',mess_full)+9)-Pos('id="',mess_full)-8);

    // iiaia ee yoi niiauaiea
    if Pos('class='+#39+'newRow'+#39,mess_full)<>0 then mess_new := '1' else mess_new := '0';

    if mess_new = '1' then
    begin
      // Io eiai niiauaiea
      mess_aut := Copy(mess_full,PosEx('">',mess_full,Pos('<div>',mess_full)+19)+2,PosEx('</a>',mess_full,PosEx('">',mess_full,Pos('<div>',mess_full)+19)+3)-PosEx('">',mess_full,Pos('<div>',mess_full)+19)-2);

      // EA iieuciaaoaey, eioi?ue i?eneae niiauaiea
      mess_aut_id := Copy(mess_full,Pos('href="',mess_full)+7,PosEx('">',mess_full,Pos('href="',mess_full)+8)-Pos('href="',mess_full)-7);

      // Aaoa, eiaaa i?eoei niiauaiea
      mess_date := Copy(mess_full,Pos('class="date">',mess_full)+13,PosEx('</div',mess_full,Pos('class="date">',mess_full)+14)-Pos('class="date">',mess_full)-13);

      //Oaia niiauaiey
      mess_title := Copy(mess_full,PosEx('<span>',mess_full,Pos('new messageSubject',mess_full))+6,PosEx('</span>',mess_full,Pos('new messageSubject',mess_full))-PosEx('<span>',mess_full,Pos('new messageSubject',mess_full))-6);

      // Oaeno niiauaiey
      mess_text := IdHTTP1.Get('http://vkontakte.ru/mail.php?act=show&id='+ mess_id);
      mess_text := Copy(mess_text,PosEx(';">',mess_text,Pos('class="messageText"',mess_text))+3,PosEx('</div>',mess_text,Pos('class="messageText"',mess_text))-PosEx(';">',mess_text,Pos('class="messageText"',mess_text))-3);
    end;

    Result.Add(mess_aut+' '+mess_aut_id+' '+mess_date+' '+mess_text);
    i := PosEx('<tr ',s,i)+2;
    Sleep(300);
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Memo1.Lines := VK_ParsEmail(IdHTTP1.Get('http://vkontakte.ru/mail.php'),IdHTTP1);
end;

Следите за темой на форуме. Форумчанин Dionix настроен серьезно.