кастомная полупрозрачная форма

I

ilyaign86

Новичок
Здаравствуйте! Помогите объединить две функции. Сделал установщик с прозрачной формой и без рамки и сделал, чтобы можно было за саму форму перемещать, но при перемещении появляется розовая подложка. Полупрозрачность взял из скрипта инсталлеров CODEX. Как сделать, чтобы можно было бы перетягивать форму и при этом она бы становилась прозрачной без появлеения розовой "маски"?
 

Вложения

Получается что SetLayeredWindowAttributes сначала в InitializeWizard применяю с флагом 1, чтобы цвет FF00FF сделать прозрачным, а потом в другом месте с флагом 2 без этого цвета и получается конфликт, эта функция целиком к окну применяется, а не к уже кастомной форме.
 
Crachlow написал(а):
Ну во 1 ты собрал все в одну кучу

был написан под 5.5.1, в лучшем случае под 6.3.3 от @Leserg с изменениями. да и в общем
Код: 
WizardStyle=modern light hidebevels includetitlebar
ExtraDiskSpaceRequired={#NeedSize}
от куда это?
Нажмите для раскрытия...
версия инно 6.7, для компиляции скрипта кроме инно ничего не надо. Там от Кодексовского только идея реализации (потому что их установщики нравятся) и эта часть с прозрачность при перетаскивании, DLL винды на любом инно работают. От Inno Enhanced абсолютно ничего не используется, только стандартный встроенный функционал. Просто для формы кастомной формы и прозрачностью при перемещении используется одна и та же функция из винды отсюда и конфликт. Вопрос в том реально ли сделать и то, и другое, если нет, то вообще откажусь от этого.
 
Последнее редактирование:
ilyaign86 написал(а):
Здаравствуйте! Помогите объединить две функции. Сделал установщик с прозрачной формой и без рамки и сделал, чтобы можно было за саму форму перемещать, но при перемещении появляется розовая подложка. Полупрозрачность взял из скрипта инсталлеров CODEX. Как сделать, чтобы можно было бы перетягивать форму и при этом она бы становилась прозрачной без появлеения розовой "маски"?
Нажмите для раскрытия...
попробуй идею от сюда взять. может получиться при таскании прозрачность
Two Worlds II + ISDone Shegorat

Two Worlds II + ISDone

Скрипт Two Worlds II + ISDone
 
ilyaign86, SetLayeredWindowAttributes поддерживает возможность использования сразу двух флагов dwFlags, (Например так: LWA_ALPHA or LWA_COLORKEY). Ну и crKey не забываем. Внизу прикрепил часть кода которые можно заменить и попробовать. У меня работает, только процесс хука нужно освобождать прежде разрушения окна. Честно, код нужно бы оптимизировать, мне лень.
Код: 
(**   ПРОЗРАЧНОСТЬ   **)
procedure MyOnTimer(h, msg, idevent, dwTime: LongWord);
  begin
   if Transparency > 100 then begin
    KillTimer(WizardForm.Handle, TimerID);
   end;
   Transparency := Transparency + 5;
   SetLayeredWindowAttributes(WizardForm.Handle, $FF00FF, 255 - Transparency, 1 or 2)
  end;

 function MyProc(h:HWND; Msg, wParam, lParam: LongInt): LongInt;
  var
   ExStyle: LongInt;
  begin
   if Msg = 534 then begin
    ExStyle := GetWindowLong(WizardForm.Handle, GWL_EXSTYLE);
    if not SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, DraggingEnabled, 0) then begin
     Exit;
    end;
    SetWindowLong(WizardForm.Handle, GWL_EXSTYLE, GetWindowLong(WizardForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
    if (Transparency = 0) and (DraggingEnabled <> 0) then begin
     TimerID := SetTimer(WizardForm.Handle, 1, 10, WrapTimerProc(@MyOnTimer, 4));
    end;
   end;
   if Msg = 533 then begin
    Transparency := 0;
    SetWindowLong(WizardForm.Handle, GWL_EXSTYLE, GetWindowLong(WizardForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
    SetLayeredWindowAttributes(WizardForm.Handle, $FF00FF, 255, 1 or 2);
   end;
   Result := CallWindowProc(oldWFproc, h, Msg, wParam, lParam);
  end;
(**   КОНЕЦ   **)
 
Nemko написал(а):
ilyaign86, SetLayeredWindowAttributes поддерживает возможность использования сразу двух флагов dwFlags, (Например так: LWA_ALPHA or LWA_COLORKEY). Ну и crKey не забываем. Внизу прикрепил часть кода которые можно заменить и попробовать. У меня работает, только процесс хука нужно освобождать прежде разрушения окна. Честно, код нужно бы оптимизировать, мне лень.
Код: 
(**   ПРОЗРАЧНОСТЬ   **)
procedure MyOnTimer(h, msg, idevent, dwTime: LongWord);
  begin
   if Transparency > 100 then begin
    KillTimer(WizardForm.Handle, TimerID);
   end;
   Transparency := Transparency + 5;
   SetLayeredWindowAttributes(WizardForm.Handle, $FF00FF, 255 - Transparency, 1 or 2)
  end;

 function MyProc(h:HWND; Msg, wParam, lParam: LongInt): LongInt;
  var
   ExStyle: LongInt;
  begin
   if Msg = 534 then begin
    ExStyle := GetWindowLong(WizardForm.Handle, GWL_EXSTYLE);
    if not SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, DraggingEnabled, 0) then begin
     Exit;
    end;
    SetWindowLong(WizardForm.Handle, GWL_EXSTYLE, GetWindowLong(WizardForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
    if (Transparency = 0) and (DraggingEnabled <> 0) then begin
     TimerID := SetTimer(WizardForm.Handle, 1, 10, WrapTimerProc(@MyOnTimer, 4));
    end;
   end;
   if Msg = 533 then begin
    Transparency := 0;
    SetWindowLong(WizardForm.Handle, GWL_EXSTYLE, GetWindowLong(WizardForm.Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
    SetLayeredWindowAttributes(WizardForm.Handle, $FF00FF, 255, 1 or 2);
   end;
   Result := CallWindowProc(oldWFproc, h, Msg, wParam, lParam);
  end;
(**   КОНЕЦ   **)
Нажмите для раскрытия...
Спасибо, милчеловек за подсказку. Все работает, и кастомная форма, и ее полупрозрачность, и розовая подложка не появляется.
 
(** ПРОЗРАЧНОСТЬ ОКНА ПРИ ПЕРЕТАСКИВАНИИ **)
procedure MyOnTimer(h, msg, idevent, dwTime: LongWord);
begin
if Transparency > 100 then begin
KillTimer(WizardForm.Handle, TimerID);
end;
Transparency := Transparency + 5;
SetLayeredWindowAttributes(WizardForm.Handle, $FF00FF, 255 - Transparency, 1 or 2)
end;

function MyProc(h:HWND; Msg, wParam, lParam: LongInt): LongInt;
var
ExStyle: LongInt;
begin
if (Msg = 534) then begin
ExStyle := GetWindowLong(WizardForm.Handle, GWL_EXSTYLE);
if not SystemParametersInfo(SPI_GETDRAGFULLWINDOWS, 0, DraggingEnabled, 0) then begin
Exit;
end;
SetWindowLong(WizardForm.Handle, GWL_EXSTYLE, ExStyle or WS_EX_LAYERED);
if (Transparency = 0) and (DraggingEnabled <> 0) then begin
TimerID := SetTimer(WizardForm.Handle, 1, 10, WrapTimerProc(@MyOnTimer, 4));
end;
end;
if (Msg = 533) then begin
Transparency := 0;
SetWindowLong(WizardForm.Handle, GWL_EXSTYLE, ExStyle or WS_EX_LAYERED);
SetLayeredWindowAttributes(WizardForm.Handle, $FF00FF, 255, 1 or 2);
end;
Result := CallWindowProc(OldProc1, h, Msg, wParam, lParam);
end;
(** КОНЕЦ **)

(** ПЕРЕТАСКИВАНИЕ ОКНА ИНСТАЛЛЯТОРА **)
function AppOnMsg(h: HWND; msg: Longint; wParam, lParam: Longint): Longint;
begin
if (msg = WM_MOUSEMOVE) and (GetKeyState(VK_LBUTTON) > 0) then
begin
ReleaseCapture;
SendMessage(WizardForm.Handle, WM_SYSCOMMAND, SC_DRAGMOVE, 0);
end;
Result:= CallWindowProc(OldProc2, h, msg, wParam, lParam);
end;
(** КОНЕЦ **)
 
Последнее редактирование:
Войдите или зарегистрируйтесь для ответа.
Назад
Сверху