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

made in programmersforum 3

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

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

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

Modern.rar

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

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

5th
Сен

Липкие обьекты

Как можно сделать эффект липких объектов?

Stilet:
Обработчик перемещения так чтоб картинки клеились к друг другу сбоку:

код:

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
   Y: Integer);
var cx2,cx,pt2:TPoint;i:integer; r1,r2:double;
begin
   if (pt.X>0)and(pt.Y>0) then begin
     pt2:=TImage(Sender).ClientToScreen(Point(x,y));
     TImage(Sender).Left:=TImage(Sender).Left+(pt2.X-pt.X);
     TImage(Sender).Top:=TImage(Sender).Top+(pt2.y-pt.y);
     pt:=pt2;
     cx.X:=TImage(Sender).Left+TImage(Sender).Width div 2;
     cx.y:=TImage(Sender).Top+TImage(Sender).Height div 2;
      r1:=sqrt(sqr(TImage(Sender).Width)+sqrt(TImage(Sender).Height));
     for i := 0 to ControlCount – 1 do begin
      if (Controls is TImage)and(Controlssender) then begin
        with TImage(Controls) do begin
         cx2.X:=Left+Width div 2;
         cx2.y:=Top+Height div 2;
         r2:=sqrt(sqr(Width)+sqrt(Height));
         if sqrt(sqr(cx.X-cx2.X)+sqr(cx.y-cx2.y))<((r2+r1)/2+20) then begin
         //******************************************
            if (cx.X>cx2.X) then begin
             TImage(Sender).Left:=Left+Width;
             TImage(Sender).Top:=top;
            end;
            if (cx.X<cx2.X) then begin
             TImage(Sender).Left:=Left-Width;
             TImage(Sender).Top:=top;
            end;
         //******************************************
         end;
       end;
      end;
     end;
   end;
end;

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

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

5th

Вывод содержимого папки

Пример выводит содержащиеся в папке файлы и папки.

Serge_Bliznykov:

код:

program Project2;
{$APPTYPE CONSOLE}
uses SysUtils;

var
   Dir : String;
   SearchRec: TSearchRec;
begin
   WriteLn;
   Write(’What’’s directory need dir ? ‘);
   Readln(Dir);

Dir := IncludeTrailingBackslash(Dir);

   if FindFirst(Dir + ‘*.*’, faAnyFile, SearchRec) = 0 then
     repeat
       if (SearchRec.Attr and faDirectory) 0 then begin
         if (SearchRec.name ‘.’) and (SearchRec.name ‘..’) then
            WriteLn(Dir + SearchRec.name,’ ‘)
       end
       else
          WriteLn(Dir + SearchRec.name,’ ‘,SearchRec.Size);
     until FindNext(SearchRec) 0;
   FindClose(SearchRec);
end.