понедельник, 28 декабря 2015 г.

Рулим новогодней елoчкой

В пpедвеpии наcтупающего Новoгo Гoда было решено прокачать левел домашней ёлочки на несколько пунктов:


Контроль реализован на базе предыдущего прожекта и сервиса Zello | забрать себе. Также был разработан виджет елочки на рабочий стол с визуализацией зажигания гирлянд и синхронной подачей команд на Wi-Fi розетку на базе моей же библиотеки 'KANKUN_KK_SP3.dll'. Полный код виджета:
var
  osdf: Tosdf;
  OrgP,OrgXY: TPoint;
  p: boolean;
  t: tstringlist;
  i: integer = 0;
  id: integer;
 

    status: function: pansichar; stdcall; // статус соединения
    onoff: procedure(ip,                  // IP адрес розетки KANKUN KK-SP3
                     login,               // Login, default = root
                     pass:                // Password, default = admin
                     pansichar;
                     activate: uint       // Включить розетку/выключить
                     ); stdcall;
    reinit: procedure(activate:           // активировать/деактивировать поток
                      uint); stdcall;
    LibHandle: THandle;


implementation
{$R *.DFM}

function LinkProc(ProcName: string):Pointer;
begin
 result:= GetProcAddress(LibHandle,PChar(ProcName))
end;

procedure Tosdf.ghotkey(var msg:TMessage);
begin
 if (msg.LParamHi = vk_f3) then begin
   p:= not p;
   if p then begin
     osdf.show;
     SetForegroundWindow(Handle);
   end else osdf.hide
 end;
end;


function Tosdf.BitmapToRegion(Bitmap: TBitmap; TransColor: TColor): HRGN;
var X, Y, XStart: smallint;
    temp:integer;
begin
 Result := 0;
 with Bitmap do
 for Y := 0 to Height - 1 do
  begin
   X := 0;
   while X < Width do
    begin
     while (X < Width) and (Canvas.Pixels[X, Y] = TransColor) do
      Inc(X);
      if X >= Width then Break;
      XStart := X;
      while (X < Width) and (Canvas.Pixels[X, Y] <> TransColor) do
       Inc(X);
      if Result = 0 then
       Result := CreateRectRgn(XStart, Y, X, Y + 1)
      else temp:=CreateRectRgn(XStart, Y, X, Y + 1);
      CombineRgn(Result, Result,temp, RGN_OR);
      DeleteObject(Temp);
    end
  end
end;

procedure Tosdf.rgn(cb: Tcolor);
var Rgn: integer;
begin
 Rgn:= BitmapToRegion(img.Picture.Bitmap, cb);
 SetWindowRgn(Handle, Rgn, True);
 DeleteObject(Rgn)
end;

procedure Tosdf.setimg(t: string);
begin
 //
 img.Picture.Bitmap.LoadFromFile(t);
 width := img.Picture.Bitmap.Width;
 height:= img.Picture.Bitmap.Height;
 rgn(clwhite);

end;

procedure Tosdf.Timer1Timer(Sender: TObject);
begin
 if p then
       SetWindowPos(Handle, // handle to window
                  HWND_TOPMOST, // placement-order handle {*}
                  Left, // horizontal position
                  Top, // vertical position
                  Width,
                  Height,
                  // window-positioning options
                  SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE);
end;

procedure Tosdf.FormCreate(Sender: TObject);
begin
 SetWindowLong(Application.Handle,GWL_EXSTYLE,GetWindowLong(Application.Handle, GWL_EXSTYLE) or
  not WS_EX_APPWINDOW);
 BorderStyle := bsNone;
 FormStyle := fsStayOnTop;

 // ищем все-
 t:= tstringlist.Create;
 recurs(extractfilepath(paramstr(0)),'.bmp;',t, false);
 //
 setimg(t[i]);


 LibHandle:= LoadLibrary('KANKUN_KK_SP3.dll');
 if LibHandle<>0 then begin
  onoff := LinkProc('onoff');
  reinit:= LinkProc('reinit');
  status:= LinkProc('status');
 end;

 // активируем поток
 reinit(1);
end;


procedure Tosdf.FormDestroy(Sender: TObject);
begin
 t.Free;

 if LibHandle<>0 then begin
  // деактивируем поток
  reinit(0);
  freelibrary(LibHandle);
 end;

end;

procedure Tosdf.Exit1Click(Sender: TObject);
begin
 close
end;

procedure Tosdf.imgMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var _p : TPoint;
begin
 if (Shift = [ssLeft]) then
  begin
   _p:= ClientToScreen(Point(X, Y));
   SetBounds(OrgP.X + (_p.X - OrgXY.X),OrgP.Y + (_p.Y - OrgXY.Y), Width, Height);
  end
end;

procedure Tosdf.imgDblClick(Sender: TObject);
begin
 inc(i); if i>t.Count-1 then i:= 0;
 setimg(t[i]);

 if i=1 then onoff('192.168.1.102','', '', 1);
 if i=0 then onoff('192.168.1.102','', '', 0)
end;

procedure Tosdf.imgMouseDown(Sender:TObject;Button:TMouseButton;
 Shift:TShiftState;X,Y:Integer);
begin
 OrgP := Point(Left, Top);
 OrgXY:= ClientToScreen(Point(X, Y))
end;

Вуа-ля:



Видео работы



скачать виджет ёлочки.

Комментариев нет:

Отправить комментарий

В комментариях уважайте собеседника, внимательно читайте посты и не додумывайте. Просьбы и предложения из разряда: «можно ваш Skype/Viber/телефон», «напишите мне в vk/FB», а также другие им подобные — игнорируются. Выход новых версий ПО, внешняя ссылка, переставшая работать с течением времени и т.п. не является основанием для претензий. Желающие спокойно подискутировать и высказаться — Welcome. Желающие спонсировать блог — Donate. Нарушение этих простых правил ведет к бану и удалению комментариев без предупреждения.