Оригинал Поиск Дополнительно Вход
ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net
Конференция "KOL" » Lupa [Delphi, Windows]
[21 - 30 из 30]<< < 1 2 > >>
  
  • Sheleh (28.03.15 18:44) [20]
    Если в конце перед Run(LupeForm) добавить
       hReg1:= CreateEllipticRgn(0, 0, Diametre, Diametre);
     LupeForm.HasBorder := False;
     SetWindowRgn(LupeForm.GetWindowHandle , hReg1, TRUE);
    То окно становиться круглым, и ничего не тормозит.
  • Sheleh (29.03.15 18:27) [21]
    program Lupe;

    uses Windows, KOL, messages;

    var LupeForm: PControl;
       Diametre: Integer;
       StartPos: TPoint;
       Moving: Boolean;
       DC:hDC;
       BgScrBt: PBitmap;
       hReg1: HRgn;

    procedure ScreenCopy();
    var W,H: integer;
    begin
     W:= GetSystemMetrics(SM_CXSCREEN);
     H:= GetSystemMetrics(SM_CYSCREEN);
     BgScrBt := NewBitmap( W, H );
     BitBlt(BgScrBt.canvas.Handle, 0,0, W, H, GetDC(0), 0, 0, SRCCOPY);
    end;

    function LupeWndProc(Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
    var pt: TPoint;
    begin
     Result:=False;
      case Msg.message of
       WM_CREATE:
         begin
           ScreenCopy;
           DC:=GetDC(LupeForm.Handle);
         end;
       WM_LBUTTONDOWN:
         begin
           GetCursorPos(pt);
           Moving:=True;
           Sender.Caption:='Moving';
           StartPos.X:=pt.x-Sender.Left;
           StartPos.Y:=pt.Y-Sender.Top;
           SetCapture(Sender.Handle);
         end;
       WM_LBUTTONUP:
         begin
           Moving:=False;
           Sender.Caption:='Lupe';
           ReleaseCapture();
         end;
       WM_MOUSEMOVE:
         if Moving then
          begin
           GetCursorPos(pt);
           SetWindowPos(Sender.Handle,0, pt.X-StartPos.X, pt.Y-StartPos.Y, 0, 0, SWP_NOSIZE {or SWP_NOREDRAW});
          end;
       WM_ERASEBKGND:
        begin
          StretchBlt(DC, 0, 0, Sender.Width, Sender.Height, BgScrBt.Canvas.Handle, Sender.Left, Sender.Top, Sender.Width div 2, Sender.Width div 2, SRCCOPY);
          Result:=True;
        end;
       WM_PAINT:
         begin
           Result:=True;
         end;
      end;
    end;

    begin
     Diametre:=300;
     LupeForm:=NewForm(Applet, 'Lupe').Size(Diametre, Diametre);
     LupeForm.AttachProc(@LupeWndProc);
     hReg1:= CreateEllipticRgn(0, 0, Diametre, Diametre);
     LupeForm.HasBorder := False;  // Скрываем бордюр
     SetWindowRgn(LupeForm.GetWindowHandle , hReg1, TRUE);
     Run(LupeForm);
    end.
  • Sheleh (29.03.15 18:29) [22]
    Браузер глючит, не обновлял страницу. Удалить бы 2 поста перед предыдущим
  • Thaddy © (30.03.15 11:16) [23]
    Neat, but it doesn't support multimonitors.
    try this instead ;)

    procedure ScreenCopy();
    var W,H: integer;
    begin
     W:= GetSystemMetrics(SM_CXVIRTUALSCREEN);
     H:= GetSystemMetrics(SM_CYVIRTUALSCREEN);
     BgScrBt := NewBitmap( W, H );
     BitBlt(BgScrBt.canvas.Handle, 0,0, W, H, GetDC(0), 0, 0, SRCCOPY);
    end;

  • Thaddy © (30.03.15 17:48) [24]
    You may also want to do something like this:


       WM_ERASEBKGND:
        begin
          If (sender.left < 0) or (sender.Top < 0) then
             FillRect(DC,MakeRect(0,0,Sender.Width+sender.left, Sender.Height+Sender.Top), GetStockObject(BLACK_BRUSH));
          StretchBlt(DC, 0, 0, Sender.Width, Sender.Height, BgScrBt.Canvas.Handle, Sender.Left, Sender.Top, Sender.Width div 2, Sender.Width div 2, SRCCOPY);
          Result:=True;



    I will look into a neat way to solve minimizing/maximizing applications and have proper restore. (combinergn stuff)
  • Sheleh (30.03.15 18:38) [25]
    На счет черных границ, получается двойной вывод, и проглядываются тормоза. На самом деле это не обязательно, ведь я не посчитал offset и увеличиваемый фрагмент у меня берется от угла формы, а надо высчитать, что бы он был по центру лупы.
  • Sheleh (10.04.15 18:42) [26]
    А вот так можно реализовать прозрачность софтварно, без использования средств операционной системы.
    program Lupe;

    uses Windows, KOL, messages;

    type
     TBig = array[0..0] of Integer;

    var LupeForm: PControl;
       Diametre: Integer;
       StartPos: TPoint;
       Moving: Boolean;
       DC, BmpDC:hDC;
       BgScrBt, BgBmp: PBitmap;
       hReg1: HRgn;
       BgBmpPointer: Pointer;

    function GetDIBPointer(BitMap: PBitmap):Pointer;
    var
     BInfo: TBitmapInfo;
    begin
     BInfo.bmiHeader.biSize := sizeof(BitmapInfo);
     BInfo.bmiHeader.biWidth := BitMap.Width;
     BInfo.bmiHeader.biHeight := -BitMap.Height;
     BInfo.bmiHeader.biPlanes := 1;
     BInfo.bmiHeader.biBitCount := 32;
     BInfo.bmiHeader.biCompression := BI_RGB;
     BitMap.Handle:=CreateDIBSection(BitMap.Handle, BInfo, DIB_RGB_COLORS, Result, 0, 0);
    end;

    procedure ScreenCopy();
    var W,H: integer;
    begin
     W:= GetSystemMetrics(SM_CXSCREEN);
     H:= GetSystemMetrics(SM_CYSCREEN);
     BgScrBt := NewBitmap( W, H );
     BitBlt(BgScrBt.canvas.Handle, 0,0, W, H, GetDC(0), 0, 0, SRCCOPY);
     BgBmp:= NewBitmap(Diametre, Diametre);
     BgBmpPointer := GetDIBPointer(BgBmp);
    end;

    function LupeWndProc(Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
    var pt: TPoint;
       R: TRect;
       x,y: integer;
    begin
     Result:=False;
      case Msg.message of
       WM_CREATE:
         begin
           ScreenCopy;
           DC:=GetDC(LupeForm.Handle);
         end;
       WM_LBUTTONDOWN:
         begin
           GetCursorPos(pt);
           Moving:=True;
           Sender.Caption:='Moving';
           StartPos.X:=pt.x-Sender.Left;
           StartPos.Y:=pt.Y-Sender.Top;
           SetCapture(Sender.Handle);
         end;
       WM_LBUTTONUP:
         begin
           Moving:=False;
           Sender.Caption:='Lupe';
           ReleaseCapture();
         end;
       WM_MOUSEMOVE:
         if Moving then
          begin
           GetCursorPos(pt);
           SetWindowPos(Sender.Handle,0, pt.X-StartPos.X, pt.Y-StartPos.Y, 0, 0, SWP_NOSIZE {or SWP_NOREDRAW});
          end;
      WM_ERASEBKGND:
       begin
         //StretchBlt(BgBmp.Canvas.Handle, 0, 0, Diametre, Diametre, BgScrBt.Canvas.Handle, Sender.Left, Sender.Top, Diametre div 2, Diametre div 2, SRCCOPY);
         BitBlt(BgBmp.Canvas.Handle, 0,0, Sender.Width, Sender.Height, BgScrBt.Canvas.Handle, Sender.Left, Sender.Top, SRCCOPY);
         for y:=0 to Diametre -1 do
          for x:=0 to Diametre -1 do
           begin
             TBig(BgBmpPointer^)[x + y * Diametre] := RGB(GetRValue(TBig(BgBmpPointer^)[x + y * Diametre]) div 2,GetGValue(TBig(BgBmpPointer^)[x + y * Diametre]) div 2,GetBValue(TBig(BgBmpPointer^)[x + y * Diametre]) div 2);
           end;
         BitBlt(DC, 0,0, Sender.Width, Sender.Height, BgBmp.Canvas.Handle, 0, 0, SRCCOPY);
         Result:=True;
        end;
       WM_PAINT:
         begin
           Result:=True;
         end;
      end;
    end;

    begin
     Diametre:=300;
     LupeForm:=NewForm(Applet, 'Lupe').Size(Diametre, Diametre);
     LupeForm.AttachProc(@LupeWndProc);
     hReg1:= CreateEllipticRgn(0, 0, Diametre, Diametre);
     LupeForm.HasBorder := False;  // Скрываем бордюр
     SetWindowRgn(LupeForm.GetWindowHandle , hReg1, TRUE);

     Run(LupeForm);
    end.
  • Sheleh (11.04.15 05:55) [27]
    Размытие
    program Lupe;

    uses Windows, KOL, messages;

    type
     TBig = array[0..0] of Integer;

    var LupeForm: PControl;
       Diametre: Integer;
       StartPos: TPoint;
       Moving: Boolean;
       DC, BmpDC:hDC;
       BgScrBt, BgBmp: PBitmap;
       hReg1: HRgn;
       BgBmpPointer: Pointer;

    function GetDIBPointer(BitMap: PBitmap):Pointer;
    var
     BInfo: TBitmapInfo;
    begin
     BInfo.bmiHeader.biSize := sizeof(BitmapInfo);
     BInfo.bmiHeader.biWidth := BitMap.Width;
     BInfo.bmiHeader.biHeight := -BitMap.Height;
     BInfo.bmiHeader.biPlanes := 1;
     BInfo.bmiHeader.biBitCount := 32;
     BInfo.bmiHeader.biCompression := BI_RGB;
     BitMap.Handle:=CreateDIBSection(BitMap.Handle, BInfo, DIB_RGB_COLORS, Result, 0, 0);
    end;

    procedure ScreenCopy();
    var W,H: integer;
    begin
     W:= GetSystemMetrics(SM_CXSCREEN);
     H:= GetSystemMetrics(SM_CYSCREEN);
     BgScrBt := NewBitmap( W, H );
     BitBlt(BgScrBt.canvas.Handle, 0,0, W, H, GetDC(0), 0, 0, SRCCOPY);
     BgBmp:= NewBitmap(Diametre, Diametre);
     BgBmpPointer := GetDIBPointer(BgBmp);
    end;

    function LupeWndProc(Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
    var pt: TPoint;

       x,y,R,G,B: integer;
    begin
     Result:=False;
      case Msg.message of
       WM_CREATE:
         begin
           ScreenCopy;
           DC:=GetDC(LupeForm.Handle);
         end;
       WM_LBUTTONDOWN:
         begin
           GetCursorPos(pt);
           Moving:=True;
           Sender.Caption:='Moving';
           StartPos.X:=pt.x-Sender.Left;
           StartPos.Y:=pt.Y-Sender.Top;
           SetCapture(Sender.Handle);
         end;
       WM_LBUTTONUP:
         begin
           Moving:=False;
           Sender.Caption:='Lupe';
           ReleaseCapture();
         end;
       WM_MOUSEMOVE:
         if Moving then
          begin
           GetCursorPos(pt);
           SetWindowPos(Sender.Handle,0, pt.X-StartPos.X, pt.Y-StartPos.Y, 0, 0, SWP_NOSIZE {or SWP_NOREDRAW});
          end;
      WM_ERASEBKGND:
       begin
         //StretchBlt(BgBmp.Canvas.Handle, 0, 0, Diametre, Diametre, BgScrBt.Canvas.Handle, Sender.Left, Sender.Top, Diametre div 2, Diametre div 2, SRCCOPY);
         BitBlt(BgBmp.Canvas.Handle, 0,0, Sender.Width, Sender.Height, BgScrBt.Canvas.Handle, Sender.Left, Sender.Top, SRCCOPY);
         for y:=0 to Diametre -2 do
          for x:=0 to Diametre -2 do
           begin
             R:=(GetRValue(TBig(BgBmpPointer^)[x + y * Diametre]) + GetRValue(TBig(BgBmpPointer^)[x+1 + (y+1) * Diametre]) + GetRValue(TBig(BgBmpPointer^)[x+ (y+1) * Diametre]) + GetRValue(TBig(BgBmpPointer^)[x+1 +y * Diametre])) div 4;
             G:=(GetGValue(TBig(BgBmpPointer^)[x + y * Diametre]) + GetGValue(TBig(BgBmpPointer^)[x+1 + (y+1) * Diametre]) + GetGValue(TBig(BgBmpPointer^)[x+ (y+1) * Diametre]) + GetGValue(TBig(BgBmpPointer^)[x+1 +y * Diametre])) div 4;
             B:=(GetBValue(TBig(BgBmpPointer^)[x + y * Diametre]) + GetBValue(TBig(BgBmpPointer^)[x+1 + (y+1) * Diametre]) + GetBValue(TBig(BgBmpPointer^)[x+ (y+1) * Diametre]) + GetBValue(TBig(BgBmpPointer^)[x+1 +y * Diametre])) div 4;
             if R>254 then R:=254;
             if G>254 then G:=254;
             if B>254 then B:=254;
             if R<0 then R:=0;
             if G<0 then B:=0;
             if B<0 then B:=0;
             TBig(BgBmpPointer^)[x + y * Diametre] := RGB(R,G,B);
           end;
         BitBlt(DC, 0,0, Sender.Width, Sender.Height, BgBmp.Canvas.Handle, 0, 0, SRCCOPY);
         Result:=True;
        end;
       WM_PAINT:
         begin
           Result:=True;
         end;
      end;
    end;

    begin
     Diametre:=300;
     LupeForm:=NewForm(Applet, 'Lupe').Size(Diametre, Diametre);
     LupeForm.AttachProc(@LupeWndProc);
     hReg1:= CreateEllipticRgn(0, 0, Diametre, Diametre);
     LupeForm.HasBorder := False;  // Скрываем бордюр
     SetWindowRgn(LupeForm.GetWindowHandle , hReg1, TRUE);

     Run(LupeForm);
    end.
  • Sheleh (11.04.15 06:01) [28]
    Глубокое размытие
    program Lupe;

    uses Windows, KOL, messages;

    type
     TBig = array[0..0] of Integer;

    var LupeForm: PControl;
       Diametre: Integer;
       StartPos: TPoint;
       Moving: Boolean;
       DC, BmpDC:hDC;
       BgScrBt, BgBmp: PBitmap;
       hReg1: HRgn;
       BgBmpPointer: Pointer;

    function GetDIBPointer(BitMap: PBitmap):Pointer;
    var
     BInfo: TBitmapInfo;
    begin
     BInfo.bmiHeader.biSize := sizeof(BitmapInfo);
     BInfo.bmiHeader.biWidth := BitMap.Width;
     BInfo.bmiHeader.biHeight := -BitMap.Height;
     BInfo.bmiHeader.biPlanes := 1;
     BInfo.bmiHeader.biBitCount := 32;
     BInfo.bmiHeader.biCompression := BI_RGB;
     BitMap.Handle:=CreateDIBSection(BitMap.Handle, BInfo, DIB_RGB_COLORS, Result, 0, 0);
    end;

    procedure ScreenCopy();
    var W,H: integer;
    begin
     W:= GetSystemMetrics(SM_CXSCREEN);
     H:= GetSystemMetrics(SM_CYSCREEN);
     BgScrBt := NewBitmap( W, H );
     BitBlt(BgScrBt.canvas.Handle, 0,0, W, H, GetDC(0), 0, 0, SRCCOPY);
     BgBmp:= NewBitmap(Diametre, Diametre);
     BgBmpPointer := GetDIBPointer(BgBmp);
    end;

    function LupeWndProc(Sender: PControl; var Msg: TMsg; var Rslt: Integer ): Boolean;
    var pt: TPoint;

       i, x,y,R,G,B: integer;
    begin
     Result:=False;
      case Msg.message of
       WM_CREATE:
         begin
           ScreenCopy;
           DC:=GetDC(LupeForm.Handle);
         end;
       WM_LBUTTONDOWN:
         begin
           GetCursorPos(pt);
           Moving:=True;
           Sender.Caption:='Moving';
           StartPos.X:=pt.x-Sender.Left;
           StartPos.Y:=pt.Y-Sender.Top;
           SetCapture(Sender.Handle);
         end;
       WM_LBUTTONUP:
         begin
           Moving:=False;
           Sender.Caption:='Lupe';
           ReleaseCapture();
         end;
       WM_MOUSEMOVE:
         if Moving then
          begin
           GetCursorPos(pt);
           SetWindowPos(Sender.Handle,0, pt.X-StartPos.X, pt.Y-StartPos.Y, 0, 0, SWP_NOSIZE {or SWP_NOREDRAW});
          end;
      WM_ERASEBKGND:
       begin
         //StretchBlt(BgBmp.Canvas.Handle, 0, 0, Diametre, Diametre, BgScrBt.Canvas.Handle, Sender.Left, Sender.Top, Diametre div 2, Diametre div 2, SRCCOPY);
         BitBlt(BgBmp.Canvas.Handle, 0,0, Sender.Width, Sender.Height, BgScrBt.Canvas.Handle, Sender.Left, Sender.Top, SRCCOPY);
         for i:=1 to 5 do //Глубина размытия. Повторяем усреднение соседних пикселей несколько раз. Чем больше тем глубже. Но тормознее
          for y:=0 to Diametre -2 do
           for x:=0 to Diametre -2 do
            begin
              R:=(GetRValue(TBig(BgBmpPointer^)[x + y * Diametre]) + GetRValue(TBig(BgBmpPointer^)[x+1 + (y+1) * Diametre]) + GetRValue(TBig(BgBmpPointer^)[x+ (y+1) * Diametre]) + GetRValue(TBig(BgBmpPointer^)[x+1 +y * Diametre])) div 4;
              G:=(GetGValue(TBig(BgBmpPointer^)[x + y * Diametre]) + GetGValue(TBig(BgBmpPointer^)[x+1 + (y+1) * Diametre]) + GetGValue(TBig(BgBmpPointer^)[x+ (y+1) * Diametre]) + GetGValue(TBig(BgBmpPointer^)[x+1 +y * Diametre])) div 4;
              B:=(GetBValue(TBig(BgBmpPointer^)[x + y * Diametre]) + GetBValue(TBig(BgBmpPointer^)[x+1 + (y+1) * Diametre]) + GetBValue(TBig(BgBmpPointer^)[x+ (y+1) * Diametre]) + GetBValue(TBig(BgBmpPointer^)[x+1 +y * Diametre])) div 4;
              if R>254 then R:=254;
              if G>254 then G:=254;
              if B>254 then B:=254;
              if R<0 then R:=0;
              if G<0 then B:=0;
              if B<0 then B:=0;
              TBig(BgBmpPointer^)[x + y * Diametre] := RGB(R,G,B);
            end;

         BitBlt(DC, 0,0, Sender.Width, Sender.Height, BgBmp.Canvas.Handle, 0, 0, SRCCOPY);
         Result:=True;
        end;
       WM_PAINT:
         begin
           Result:=True;
         end;
      end;
    end;

    begin
     Diametre:=300;
     LupeForm:=NewForm(Applet, 'Lupe').Size(Diametre, Diametre);
     LupeForm.AttachProc(@LupeWndProc);
     hReg1:= CreateEllipticRgn(0, 0, Diametre, Diametre);
     LupeForm.HasBorder := False;  // Скрываем бордюр
     SetWindowRgn(LupeForm.GetWindowHandle , hReg1, TRUE);

     Run(LupeForm);
    end.
  • имя (25.11.15 02:14) [29]
    Удалено модератором
[21 - 30 из 30]<< < 1 2 > >>
 
Конференция "KOL" » Lupa [Delphi, Windows]
ДомойОсновная Компоненты FreePascal Начинающим KOL Игры Corba Media Журнал WinAPI Сети Прочее Базы .Net
Есть новые Нет новых   [134427   +34][b:0][p:0.001]