• Главная
  • Исходники Delphi
  • Справочники Delphi
  • Книги Delphi
  • Основы Delphi
  • библиотека Delphi исходников
  • Форум
  • Блоги

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

  • Прозрачность тайлсета в TPNGImage
  • Как сделать VBA макрос в excel
  • Поиск по столбцу 1-ого не нулевого значения (формулой в Microsoft Office Excel)
  • Простановка единиц в ячейки под объектами (Microsoft Office Excel)
  • Расчет затраченного времени между определенным рабочим временем (формулой в Microsoft Office Excel)
  • Мигающий экран на Assembler
  • VBA-макрос по копированию 10 строчек в выбранном диапазоне в Microsoft Office Excel
  • Копирование только нужного диапазона в Microsoft Office Excel
  • Перенос диапазона стоки в Microsoft Office Excel на другой лист по условию
  • Мелодия в Pascal.ABC.Net с помощью System.Console.Beep — задержка воспроизведения звука

made in programmersforum 6

programmersforum6

  • .NET
  • ASP.NET
  • assembler
  • Basic
  • c/c++
  • CMS
  • Delphi
  • HTML
  • iPhone
  • Java
  • JavaScript
  • Linux
  • Pascal
  • Perl
  • Photoshop
  • php
  • Python
  • Ruby
  • SEO
  • sql
  • VBA
  • Win Api
  • Windows
  • XML и XSLT
  • Администрирование ОС
  • Апгрейды
  • Архив
  • Безопасность
  • Блоги
  • Веб-аналитика
  • Железо
  • Журнал
  • Заметки
  • Имейдж
  • Интервью
  • Исходники
  • Новости
  • Общалка
  • Операционные системы
  • Пост-обзор
  • Профлитература
  • Рассылка
  • Реклама
  • си шарп
  • Советы
  • Софт
  • Статьи
  • Топик-обзор
  • Файлы








27th
Мар

Корректное перетаскивание прозрачной формы

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

невероятно, но я смог сам разобраться! вылаживаю код может кому нибуть поможет…

Код:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
     procedure FormDblClick(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
   end;

var
  Form1: TForm1;
  last_pos: TPoint;
   hbmp: HBITMAP; // Прозрачная картинка
  backdc: HDC; // Контекст для прозрачной картинки

implementation

{$R *.dfm}

uses GDIPAPI, GDIPOBJ; // Юзаем GDI+ !!!

procedure TForm1.FormCreate(Sender: TObject);
var
  img: TGPBitmap;
   screendc: HDC;
   pt1, pt2 : TPoint;
   sz : TSize;
   bf : TBlendFunction;
begin
  // Убираем рамку окна. Иначе ничего не выйдет.
   Self.BorderStyle := bsNone;
   // Делаем окно многослойным
   if SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or
WS_EX_LAYERED) = 0 then ShowMessage(SysErrorMessage(GetLastError));
   // Загружаем 32-битный PNG с альфа каналом и получаем его HBITMAP
   img := TGPBitmap.Create(’s.png’,True);
   with img do begin
     GetHBITMAP(0,hbmp);
     Width := GetWidth;
     Height := GetHeight;
     Free;
   end;
   // Получаем контекст экрана
   screendc := GetDC(0);
   // Создаем контекст, совместимый с экраном
   backdc := CreateCompatibleDC(screendc);
   // Загружаем в него картинку
   SelectObject(backdc, hbmp);
   // Вызываем UpdateLayeredWindow
   pt1 := Point(Left, Top);
   pt2 := Point(0,0);
   sz.cx := Width;
   sz.cy := Height;
   with bf do begin
     BlendOp := AC_SRC_OVER;
     BlendFlags := 0;
     SourceConstantAlpha := $FF; // Можно ставить общую прозрачность
     AlphaFormat := AC_SRC_ALPHA;
  end;
  UpdateLayeredWindow(Handle, screendc, @pt1, @sz, backdc, @pt2,0, @bf,ULW_ALPHA);
   // Освобождаем контекст экрана
   ReleaseDC(0,screendc);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   // Освобождаем ресурсы
  DeleteObject(hbmp);
   DeleteDC(backdc);
end;

  // Дальше 2 обработчика нужны, чтобы двигать мышкой форму без заголовка
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
cur_pos: TPoint;
begin
  if ssLeft in Shift then
   begin
     GetCursorPos(cur_pos);
     Left := cur_pos.X – last_pos.X;
     Top := cur_pos.Y – last_pos.Y;
  end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
   last_pos.X := X;
   last_pos.Y := Y;
end;

  // Закрываем прогу по двойному клику в окошке
procedure TForm1.FormDblClick(Sender: TObject);
begin
   Close;
end;

end.

Перейти к теме на форуме

Похожие статьи

  • Запретить выход курсора за API форму
  • Изменение положения компонента при разворачивании формы
  • Упорядоченное расположение компонентов на форме
  • Запрет выхода курсора за форму
  • Загрузка 2 формы как главной в delphi
  • Как получить классы всех дочерних окон формы?
  • Всплывающее окно и фокус
  • Какой процедурой узнать что форму взяли и начали двигать?
  • Массив чекбоксов, как в PHP узнать, какой из чекбоксов выбран?
  • Как передать значение из <select> в action формы
Теги: Delphi | форма








© Copyright "Клуб программистов" – материалы по Delphi и С++. Создание и продвижние сайта - Веб-сателлит.