Последние записи

made in programmersforum 6

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

13th
Сен

idHTTP и кодировка

добрый вечер. в переменную типа стринг качается через идхттп гет запросом страница. страница в ютф8, после всего этого пытаюсь распарсить через pos (нужно найти фразу <liкакойтотекстнарусском<strong>) . соответственно, руские буквы кракозябрами, и пос их не ищет. пытался декодировать utf8toansi и наоборот – ничего не помогает. кракозябры меняются только

Код:


function UTF8ToStrSmart(Value: String): String;

      function UTF8ToStr(Value: String): String;
      var
        buffer: Pointer;
        BufLen: LongWord;
      begin
        BufLen := Length(Value) + 4;
        GetMem(buffer, BufLen);
        FillChar(buffer^, BufLen, 0);
        MultiByteToWideChar(CP_UTF8, 0, @Value[1], BufLen - 4, buffer, BufLen);
        Result := WideCharToString(buffer);
        FreeMem(buffer, BufLen);
      end;

var
  Digit: String;
  i: integer;
  HByte: Byte;
  Len: Byte;
begin
  Result := '';
  Len := 0;
  if Value = '' then Exit;
  for i := 1 to Length(Value) do
  begin
    if Len > 0 then
    begin
      Digit := Digit + Value;
      Dec(Len);
      if Len = 0 then
        Result := Result + UTF8ToStr(Digit);
    end else
    begin
      HByte := Ord(Value);
      if HByte in [$00..$7f] then       //Standart ASCII chars
        Result := Result + Value
      else begin
        //Get length of UTF-8 char
        if HByte and $FC = $FC then
          Len := 6
        else if HByte and $F8 = $F8 then
          Len := 5
        else if HByte and $F0 = $F0 then
          Len := 4
        else if HByte and $E0 = $E0 then
          Len := 3
        else if HByte and $C0 = $C0 then
          Len := 2
        else begin
          Result := Result + Value;
          Continue;
        end;
        Dec(Len);
        Digit := Value;
      end;
    end;
  end;
end;

Есть ещё 2 совета.
1. Брось инди и переходи на ICS.
2. Обнови инди до максимально последней версии.

Код:

function HttpGetUrl(url: string; idHttp: TidHttp): string;


var
M: TStringStream;
begin
M := TStringStream.Create('');
//  try


try
IdHTTP.Get(url, m);
if IdHTTP.ResponseCode = 502 then
begin
result := 'ошибка|'+url;
freeandnil(m);
exit;
end;
except
on e: exception do
begin
//          MessageBox(application.ActiveFormHandle, PAnsiChar('Произошла ошибка при получении текста страницы: '+#13+ url + #13+e.Message), 'Ошибка', IDOK);
result := 'ошибка|'+url;
freeandnil(m);
end;
end;

result := m.DataString;


//  finally
freeandnil(m);
//  end;
end;

итого полный код будет:
Код:

//получаем тест страницы со ссылками на объявления slText := UTF8ToStrSmart(HttpGetUrl(URL, idHttp1));

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

Добавлено в Пост-обзор. Дата Сентябрь 13th, 2010

12th
Сен

Перевод PByte в TBytes

Код:


var
  p: PByte;
  p1: TBytes;
  i: byte;
begin
  GetMem(p, 5);

  for i := 0 to 4 do
  begin
    p^ := i;
    Inc(p, 1);
  end;

  Dec(p, 5);

  SetLength(p1, 5);

  Move(p^, p1[0], 5);
  FreeMem(p);
end;

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

Добавлено в Пост-обзор. Дата Сентябрь 12th, 2010

12th

Анимированный Gif в компоненте Image

Есть модуль от Андерса Меландера, бесплатный. Подключаете его в секцию uses и пишете код:

Код:


procedure Tform1.FormCreate(Sender : Tobject);
var
gif : TGifImage;
begin
gif:=TGIfImage.Create;
try
Image1.Picture.LoadFromFile('1.gif);
finally
gif.Free;
end;
end;

А вот собственно сам модуль

Вложения

GIFImage.rar (53.6 Кб)

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

Добавлено в Пост-обзор. Дата Сентябрь 12th, 2010

9th
Сен

Рассылка. Выпуск 75.

Posted by Chas under Рассылка

redaktor От ведущего.

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

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

Добавлено в Рассылка. Дата Сентябрь 9th, 2010

9th

Всплывающее окно и фокус

В программе есть всплывающее окно, как сделать чтобы когда оно будет всплывать, оно было поверх остальных окон, но при этом не брало на себя фокус ввода?

код:

procedure TForm1.Button1Click(Sender: TObject);
var
   Form2: TForm;
begin
   Form2 := TForm.Create(Form1);
   Form2.FormStyle := fsStayOnTop;
   …
   Form2.Show;
   Form1.Show;
end;

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

Добавлено в Пост-обзор. Дата Сентябрь 9th, 2010

8th
Сен

Как в указанной папке и её подпапках найти все файлы определённого типа?

код:

procedure DirSearch(Dir: string; Mask : string; SL: TStrings);
var
SearchRec: TSearchRec;
begin
Dir := IncludeTrailingBackslash(Dir);

   if FindFirst(Dir + ‘*.*’, faAnyFile, SearchRec) = 0 then
     repeat
       Application.ProcessMessages;

       if (SearchRec.Attr and faDirectory) 0 then begin
         if (SearchRec.name ‘.’) and (SearchRec.name ‘..’) then
                 DirSearch(Dir + SearchRec.name, Mask, sl)
       end
       else
         if MatchesMask(ExtractFileName(SearchRec.Name), Mask) then
           Sl.Add(Dir + SearchRec.Name);
     until FindNext(SearchRec) 0;
   FindClose(SearchRec);
end;

// ИСПОЛЬЗОВАТЬ ТАК:
procedure TForm1.Button1Click(Sender: TObject);
begin
DirSearch(’C:\TEMP’, ‘*.AVI’, Memo1.Lines);
end;

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

Добавлено в Пост-обзор. Дата Сентябрь 8th, 2010

6th
Сен

Работа с com портом

Есть прибор, который подключаеться через com порт к компьютеру. Протокол обмена известен. Как отправить ему 16 ричное значение и как прочитать такое значение от него?

код:

function readcom: string;
var RX_Count : cardinal;
TempArray: array[1..255] of Byte;
Count : Integer;
begin
result:= ”;
ReadFile(Com, TempArray, 255, RX_Count, nil);
for Count:= 1 to RX_Count do result:= result + Chr(TempArray[Count])
end;

procedure sendcom(s: string);
var TempArray: array[1..255] of Byte;
Count : Integer;
TX_Count : cardinal;
begin
for Count:= 1 to Length(S) do TempArray[Count]:= Ord(S[Count]);
WriteFile(Com, TempArray,Length(S),TX_Count,nil)
end;

// или если компонентом пользуешся
type tb = array[1..255] of Char; //Определяем символьный массив
      pb = ^tb;
procedure Tmf.comReceiveData(Sender: TObject; Buffer: Pointer;
   BufferLength: Word);
var PX : pb;
     i : integer;
     str: string;
begin
PX:= buffer; str:=”;
for i:= 1 to BufferLength do
   str:=str+PX^;
packet(str)
end;

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

Добавлено в Пост-обзор. Дата Сентябрь 6th, 2010

6th

Как можно реализовать анимацию иконки на активной форме?

Alexei91:
ImageList на форму – в нём возможные значки иконок 16х16.
Таймер на форму, задаём нужный интервал.
На OnTimer

код:

ImageList.GetIcon(iconindex, Application.Icon);
iconindex := iconindex + 1;
if iconindex > then
iconindex := 0;

где IconIndex Ваша глобальная переменная типа Integer.
На OnCreate

код:

iconindex := 0;
ImageList.GetIcon(iconindex, Application.Icon);

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

Добавлено в Пост-обзор. Дата Сентябрь 6th, 2010

6th

Как в C# можно узнать координаты определенной точки битмапа?

код:

bmp=new Bitmap(openFileDialog1.FileName);
int x, y;
for (x = 0; x < bmp.Width; x++)//Перебор пикселей
for (y = 0; y < bmp.Height; y++)
bmp.GetPixel(x, y);//функция возвращает цвет пикселя с координатами x,y

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

Добавлено в Пост-обзор. Дата Сентябрь 6th, 2010

6th

Процесс создания sfx 7zip в картинках?

способ 1: выбираем файлы и папки для архивации. нажимаем “Добавить архив” (”+” зелёный). появится окно. в нём в “Опции” выбираем “Создать SFX-архив” и нажимаем “OK”.

рисунок 1

способ 2: если хочется немного изменить вид проги…
берём “Res Hacker”, открываем файл 7z.sfx в папке с архиватором “7-zip”. изменяем всё, что нужно, запаковываем “UPX” и заменяем оригинальный файл 7z.sfx в папке с архиватором. далее по способу 1.

способ 3: создать архив 7z. взять sfx из папки с архиватором. можно ещё поизвращаться из способа 2. потом к готовому sfx приписываем 7z архив.
код:

copy /b sfx.exe+archive.7z

можно даже сделать этот sfx с XP стилем.
для этого в Res Hacker открываем sfx файл. жмём “Действия\Добавить новый ресурс”. нажимаем кнопку “Файл с новым ресурсом…”, выбираем файл в архиве. дальше заполняем по картинке.

рисунок 2