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

made in programmersforum 3

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

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

24th
Авг

Как в WebBrowser выбрать из списка и нажать на кнопку?

Posted by Chas under Пост-обзор

zlodey:

Нажатие на кнопку:
код:

procedure PSpisokClick;
var HtmlDocument : IHtmlDocument2;
   i : integer;
   HtmlCollection : IHtmlElementCollection;
   HtmlElement : IHtmlElement;
   spisok : string;
begin
   HtmlDocument := BrowserMain.Document as IHtmlDocument2;
   HtmlCollection := HtmlDocument.All;
   for i := 0 to HtmlCollection.length – 1 do
   begin
     if stop = 1 then Exit;
     HtmlElement := HtmlCollection.Item(i, 1) as IHtmlElement;
     spisok := HtmlElement.InnerText;
     Trim(spisok);
     if spisok = ‘список’ then
     begin
       HtmlElement.click;
       Exit;
     end;
   end;
end;

выбор из открывающегося списка:
код:

procedure SetFieldValue(theForm: IHTMLFormElement;
const fieldName, newValue: string; const instance: integer);
var
   field: IHTMLElement;
   inputField: IHTMLInputElement;
   selectField: IHTMLSelectElement;
   textField: IHTMLTextAreaElement;
begin
   field := theForm.Item(fieldName,instance) as IHTMLElement;
   if Assigned(field) then
   begin
     if field.tagName = ‘INPUT’ then
     begin
       inputField := field as IHTMLInputElement;
       if (inputField.type_ ‘radio’) and (inputField.type_ ‘checkbox’)
       then inputField.value := newValue
       else inputField.checked := (newValue = ‘checked’);
     end
     else if field.tagName = ‘SELECT’ then
     begin
       selectField := field as IHTMLSelectElement;
       selectField.value := newValue;
     end
     else if field.tagName = ‘TEXTAREA’ then
     begin
       textField := field as IHTMLTextAreaElement;
       textField.value := newValue;
     end;
   end;
end;

вызов процедуры:
код:

theForm := GetFormByNumber(BrowserMain.Documen t as IHTMLDocument2,0);
SetFieldValue(theForm,’type’,переменная);

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

Добавлено в Пост-обзор. Дата Август 24th, 2010

23rd
Авг

Как узнать количество строк в memo?

У новичков может возникнуть такой вопрос.
код:

a := Memo1.Lines.Count;// кол-во строк Memo1

Нумерация строк начинается с нуля.

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

Добавлено в Пост-обзор. Дата Август 23rd, 2010

23rd

Определить нажата правая клавиша мыши?

Событие OnMouseDown у формы, проверяя таким макаром:

код:

if Button=mbRight then Form2.ShowModal;

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

Добавлено в Пост-обзор. Дата Август 23rd, 2010

23rd

Как развернуть flash-приложение во весь экран?

Kotofff:
Компонент которым показываешь (проигрываешь) флеш-ролик в программе выравнивай на всю форму, а с самой формой можно так :

код:

procedure TForm1.FormCreate(Sender: TObject);
var
   HTaskbar: HWND;
   OldVal: LongInt;
begin
   try
     HTaskBar := FindWindow(’Shell_TrayWnd’, nil);
     SystemParametersInfo(97, Word(True), @OldVal, 0);
     EnableWindow(HTaskBar, False);
     ShowWindow(HTaskbar, SW_HIDE);
   finally
     with Form1 do
     begin
       BorderStyle := bsNone;
       FormStyle := fsStayOnTop;
       Left := 0;
       Top := 0;
       Height := Screen.Height;
       Width := Screen.Width;
     end;
   end
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
   HTaskbar: HWND;
   OldVal: LongInt;
begin
   HTaskBar := FindWindow(’Shell_TrayWnd’, nil);
   SystemParametersInfo(97, Word(False), @OldVal, 0);
   EnableWindow(HTaskBar, True);
   ShowWindow(HTaskbar, SW_SHOW);
end;

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

Добавлено в Пост-обзор. Дата Август 23rd, 2010

21st
Авг

Полупрозрачность в Delphi

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

Перво наперво, качаем gdiplus.dll (если есть желание) с MS Official Site

Потом смотрим мои (DIB) и не мои (GdiPlus) модули в аттаче.

И так… Подготовим плацдарм для нашего окошка

код:

implementation

const
WndClassName = ‘Trulyalya’;

var
   WndClass: TWndClass = (
     style: CS_DBLCLKS;
     cbClsExtra: 0;
     cbWndExtra: 0;
     hbrBackground: 0;
     lpszMenuName: NIL;
     lpszClassName: WndClassName;
   );

…

initialization
   WndClass.lpfnWndProc := @DefWindowProc; // I hope…
   WndClass.hInstance := HInstance;
   WndClass.hIcon := LoadIcon(HInstance, ‘MAINICON’);
   WndClass.hCursor := LoadCursor(0, IDC_ARROW);
   Windows.RegisterClass(WndClass);

finalization
Windows.UnregisterClass(WndClassName, HInstance);

И так у нас есть зарегиный класс, вот ведь счастье ну мы не собираемся на этом останавливаться и пойдем до конца! Теперь давайте создадим окошко

Код:
hWnd := CreateWindowEx(WS_EX_TOOLWINDOW or WS_EX_LAYERED,
WndClass.lpszClassName, NIL, WS_POPUP or WS_VISIBLE, 0, 0, 0, 0, 0, 0, HInstance, NIL);

Думаю то что здесь, понять не составит труда. Теперь стоит понять, что у нас есть окошко со стилем WS_EX_LAYERED и это дает нам по сути установить и отобразить любое 32х битное изображение разумеется в формате ARGB никакие PNG и т.п. на прямую не ставятся. Как же это сделать?

Код:

var
   Context: GpGraphics;
   Tmp: TDIB;
   Image: TDIB;
   Rect: TRect;
begin
   // Rect := GetWindowRect(); / GetClientRect(); не помню как точно, сами разберетесь

Tmp := TDIB.Create(Rect.right – Rect.left, Rect.bottom – Rect.top); // создаем битмап по размеру окна
Image := TDIB.Create(’my_image.png’); // загрузим какое то изображение

   GdipCreateFromHDC(Tmp.DC, Context); // создадим контекст GDI+ c Tmp
   GdipSetSmoothingMode(Context, SmoothingModeAntiAlias); // antialias включим
   GdipSetCompositingMode(Context, CompositingModeSourceCopy); // рисование с перекрытием
   GdipSetInterpolationMode(Context, InterpolationModeHighQualityBicubic); // качественно масштабировать изображения

   GdipDrawImageRectRect(Context, Image.Bitmap,
      0, 0, Tmp.Width, Tmp.Height, // покрываем все окно
      0, 0, Image.Width, Image.Height, // берем все изображение
      UnitPixel, NIL, NIL, NIL);

GdipDeleteGraphics(Context);
Image.Free();

И так, мы узнали размер окна, создали битпам для окна, загрузили картинку, связали GDI+ с Tmp и нарисовали с помощью GDI+ нашу картинку, потом все освободили. Теперь у нас есть Tmp на с отрисованной картинкой. Осталось дело за малым, отобразить на окне.

Код:

var
   BlendFunc: TBlendFunction;
   ZPoint: TPoint;
   LeftTop: TPoint;
   Size: TSize;
   Rect: TRect;
begin
   with BlendFunc do
   begin
      BlendOp := AC_SRC_OVER;
      BlendFlags := 0;
      AlphaFormat := AC_SRC_ALPHA;
      SourceConstantAlpha := 255; // не желательно менять это, да станет прозрачней, но тормаза начнутся, лучше перерисовать сам битмап в более прозрачный.
   end;

// Rect := GetWindowRect(); / GetClientRect(); не помню как точно, сами разберетесь

   ZPoint := Point(0, 0);
   LeftTop := Point(Rect.left, Rect.top);
   Size.cx := Rect.right – Rect.left;
   Size.cy := Rect.bottom – Rect.top;

UpdateLayeredWindow(hWnd, 0, @LeftTop, @Size, Tmp.DC, @ZPoint, 0, @BlendFunc, ULW_ALPHA);

Разумеется, не забудьте сделать это Tmp.Free();

Опять такие, это мануалчик, проверять не могу сейчас, да и думаю тут суть ясна, садитесь и пробуйте.
DIB.rar

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

Обсудить на форуме — Полупрозрачность в Delphi

Добавлено в Статьи, Топик-обзор. Дата Август 21st, 2010

20th
Авг

Маленькие помощники программиста

All Ежедневно мы сталкиваемся с рутинной работой, которая отнимает львиную долю нашего времени. В этой статье я попробую «приучить» читателя к созданию маленьких помощников, оптимизирующих работу или сокращающих время рутинных операций…

Маленькие помощники программиста

Алексей Шишкин

by Alex Cones www.programmersforum.ru

http://www.programmersforum.ru/member.php?u=40711

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

Но, не смотря на такую жестокую реальность, программисты главным образом живут в мире виртуальном. Поэтому ничто не мешает им улучшать свою жизнь, создавая «роботов»-помощников. «Но какие-же помощники могут быть у программиста?» – скажете Вы. Я постараюсь ответить на Ваш вопрос, опираясь на собственный опыт.

История появления…

Итак, первая вещь, которая была создана мной для облегчения собственной жизни – это «Заполнялкин» (см. рисунок 1):

Рис. 1. Утилита «Заполнялкин»

Эта программа предназначалась для того, чтобы оптимизировать написание больших блоков кода, отличающихся только ссылками. Так, например, введя шаблон:

Label@@.Caption := IntToStr(@@);

Можно было получить практически неограниченное количество следующих строк:

Label1 := IntToStr(1);

Label2 := IntToStr(2);

Label3 := IntToStr(3);

Label4 := IntToStr(4);

Label5 := IntToStr(5);

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

Второй программой стал Resource Builder (см. рисунок 2):

Рис. 2. Утилита Resource Builder

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

Итак, вопрос удобства создания программ уже не стоял, я приступил к улучшению окружающей меня обстановки: я создал G.A.P. Создать эту программу меня вдохновили действия Educated Fool – он создал excel-ский макрос, который упаковывал проект в архив, создавал к нему превью и отправлял на FTP сервер. По аналогии моя программа делает снимок экрана (или части его ? по выбору пользователя), дает возможность создать превью к снимку, отметить на нем что-то и отправить на сервис хранения картинок, оставив ссылку на картинку в буфере обмена (см. рисунок 3):

Рис. 3. Утилита G.A.P

* Комментарий автора

На этом месте я хочу предупредить читателя о том, что данная статья задумывалась вовсе не как реклама этих программ, а как пособие начинающему «импруверу» (от англ. improve – улучшать). Не бойтесь экспериментировать, и запомните одну вещь – ЛЮБАЯ работа может быть оптимизирована. Даже если кажется, что это не так.

Однажды мне потребовалось залить на файлообменный сервис достаточно большой файл. С моей полу-диалапной скоростью эта задача имеет решение только посредством FTP доступа. К счастью сервис предоставляет такую услугу. Радости моей не было предела и на первую же ночь я поставил на загрузку злополучный файл. Проснувшись утром и просмотев логии, я ужаснулся – сервер отключает меня каждые 15 минут бездействия. Даже если в этот момент загружается файл. Выход был лишь один – отправлять команду просмотра каталогов каждые 10 минут (благо для этого была выделена отдельная кнопка). Но не кликать-же по ней каждые десять минут, пока файл не загрузится? Хотя-я… Собственно, почему нет? За 15 минут был создан Click Shot (программа, которая будет кликать за меня в нужную точку экрана через заданный промежуток времени)

Рис. 4. Утилита Click Shot

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

Вчера один из моих товарищей вставил в мой ноутбук свою флешку. Несмотря на то, что на ней были только документы, Windows спросила разрешения запускать с неё программы. Снизойдя до отказа, я включил отображения скрытых и системных файлов и обнаружил autorun и exe-шник. Открыв авторан, я понял, почему антивирус продолжал молчать

[AutoRun

;lsbvrkskjvbliurbsv

;srvlbsrvksrjksr

open = klbhk.exe

;kjbsjvbkvksjvn

Одна закрывающаяся скобка… И план вторжения армий провалился… Но что-то я отвлекся. Удаление файлов прокатывать не захотело по причине аттрибута «системный» у обоих файлов. Форматировать флешку мне не позволили, и я накатал программу, изменяющую аттрибуты каталогов и файлов по выбору пользователя. Так появился на свет A.ch (см. рисунок 5):

Рис. 5. Утилита A.ch

Заключение

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

Ссылки

. Заполнялкин. Версия 1.0 http://www.programmersforum.ru/showpost.php?p=367784&postcount=26

. Resource Builder http://www.programmersforum.ru/showthread.php?t=69505

. GAP http://www.programmersforum.ru/showthread.php?t=69505

. Click Shot http://www.programmersforum.ru/showthread.php?t=92768

. A.ch – Attribute Changer http://www.programmersforum.ru/showthread.php?t=104574

Статья из пятого выпуска журнала ПРОграммист.
Скачать этот номер можно по ссылке.
Ознакомиться со всеми номерами журнала.

Обсудить на форуме — Маленькие помощники программиста

Добавлено в Журнал, Статьи. Дата Август 20th, 2010

12th
Авг

Авторасширение Memo


var
  Form1: TForm1;
    i:Integer;
implementation

{$R *.dfm}

procedure TForm1.memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);

begin
  if memo1.Lines.Count>i then
  begin
    memo1.Height:=memo1.Height+15;
    memo1.Top:=memo1.Top-15;
    i:=i+1;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  i:=1;
  memo1.DoubleBuffered:=True;
end;

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

Добавлено в Пост-обзор. Дата Август 12th, 2010

12th

Как в Memo найти и удалить повторяющиеся строки?

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;

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

Добавлено в Пост-обзор. Дата Август 12th, 2010

9th
Авг

Как сделать копирование как в TotaleComander?

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.

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

Добавлено в Исходники, Пост-обзор. Дата Август 9th, 2010

8th
Авг

Определние локального и внутреннего IP

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;