Вопрос Как сделать прозрачными DirEdit и GroupEdit?

Tjeyn · 9 Фев 2015

Как сделать прозрачными DirEdit и GroupEdit, но только так что бы текст них можно было выделять?

sergey3695 · 9 Фев 2015

Ну.. это геморно. С вашей базой знаний это хардкор. Хотя может есть кроме вырезания еще способ? я б глянул, можно хоть намек.

Shegorat · 10 Фев 2015

sergey3695 написал(а):
Ну.. это геморно. С вашей базой знаний это хардкор. Хотя может есть кроме вырезания еще способ? я б глянул, можно хоть намек.

Обработка сообщения WM_CTLCOLOREDIT. Правда примера под рукой нет.

sergey3695 · 10 Фев 2015

Shegorat написал(а):
Обработка сообщения WM_CTLCOLOREDIT

Огромное спасибо :drinks:

Супер работает.

Код:

[setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirName={pf}\MyApp

[files]
Source: 1.bmp; Flags: dontcopy;

[code]
type
  HBRUSH = LongWord;
  hDC = Longword;

const
  WM_CTLCOLOREDIT  = $0133;
  WM_CTLCOLORSTATIC  = $0138;
  CN_BASE  = $BC00;
  CN_CTLCOLOREDIT  = CN_BASE + WM_CTLCOLOREDIT;
  CN_CTLCOLORSTATIC  = CN_BASE + WM_CTLCOLORSTATIC;

function SetWindowLong(Wnd: HWnd; Index: Integer; NewLong: Longint): Longint; external 'SetWindowLongW@user32.dll stdcall';
function SetBkMode(DC: hDC; BkMode: Integer): Longint; external 'SetBkMode@gdi32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: Longint; hWnd: HWND; Msg: UINT; wParam, lParam: Longint): Longint; external 'CallWindowProcW@user32.dll stdcall';
function CreatePatternBrush(b: HBitmap): HBrush; external 'CreatePatternBrush@gdi32.dll stdcall';

var
  OldProc: Longint;
  FBrush: HBRUSH;
  FBitmap: TBitmap;

function MyProc(h: HWND; Msg, wParam, lParam: longint): Longint;
begin
  case Msg of
  CN_CTLCOLOREDIT,CN_CTLCOLORSTATIC: begin
  if FBrush <> 0 then
  begin
  CallWindowProc(OldProc, h, Msg, wParam, lParam);
  SetBkMode(wParam,1);
  Result:= FBrush;
  end;
  end
  else
  Result:= CallWindowProc(OldProc, h, Msg, wParam, lParam);
  end;
end;

Procedure InitializeWizard();
Begin
  ExtractTemporaryFile('1.bmp');
 
  FBitmap := TBitmap.Create;
  FBitmap.LoadFromFile(ExpandConstant('{tmp}\1.bmp'));
  FBrush:= 0;
  FBrush:= CreatePatternBrush(FBitmap.Handle);
//  WizardForm.DirEdit.Enabled:= False;
  OldProc:= SetWindowLong(WizardForm.DirEdit.Handle, -4, CallbackAddr('MyProc'));
end;

procedure DeinitializeSetup();
begin
  SetWindowlong(WizardForm.DirEdit.Handle, -4, OldProc);
end;

Shift85 · 10 Фев 2015

sergey3695 написал(а):
Огромное спасибо
Супер работает.

sergey3695, Можно пример с картинкой на всю форму?

Tjeyn · 10 Фев 2015

Shift85, можно просто координаты картинки подогнать

Shift85 · 10 Фев 2015

Tjeyn написал(а):
Shift85, можно просто координаты картинки подогнать

Tjeyn, Как например?

sergey3695 · 10 Фев 2015

Shift85, Tjeyn, ща будет. я кушал. Скрипт тогда лучше делать без ScaleX,Y.

Shift85 · 10 Фев 2015

sergey3695, Замечен небольшой баг если присмотреться при нажатии на эдит картинка на этите смещается вниз.

Если применить на эдите:

Код:

BorderStyle:= bsNone;

баг пропадает.

sergey3695 · 10 Фев 2015

Shift85, это не баг. так просто лучше. сотри применения стиля WS_EX_COMPOSITED и будет без смещения.

Shift85 · 10 Фев 2015

sergey3695 написал(а):
Shift85, это не баг. так просто лучше. сотри применения стиля WS_EX_COMPOSITED и будет без смещения.

sergey3695, Понятно. :ok:

А возможно такое на GroupEdit реализовать.

sergey3695 · 10 Фев 2015

Shift85, можно CopyPaste

Код:

#define A = (Defined UNICODE) ? "W" : "A"

#define GameName "Star Wars Empire at War Gold Pack"
#define GroupName "Krinkels Team"
#define AppExeName "Game.exe"
#define AppExeWorkingDir "{app}\"

[setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirName={pf}\MyApp

[files]
Source: 1.bmp; Flags: dontcopy;

[Icons]
Name: {group}\ {#GameName}; Filename: {#AppExeWorkingDir}{#AppExeName}; Workingdir: {#AppExeWorkingDir};
Name: {group}\ {#GameName}; Filename: {uninstallexe}; WorkingDir: {app};

[code]
type
  HBRUSH = LongWord;
  hDC = Longword;
const
  WM_CTLCOLOREDIT     = $0133;
  WM_CTLCOLORSTATIC   = $0138;
  CN_BASE             = $BC00;
  CN_CTLCOLOREDIT     = CN_BASE + WM_CTLCOLOREDIT;
  CN_CTLCOLORSTATIC   = CN_BASE + WM_CTLCOLORSTATIC;
//
  GWL_EXSTYLE = (-20);
  WS_EX_COMPOSITED = $02000000;

function GetWindowLong(hWnd: HWND; nIndex: Integer): Longint; external 'GetWindowLong{#A}@user32.dll stdcall';
//
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function SetBkMode(DC: hDC; BkMode: Integer): Longint; external 'SetBkMode@gdi32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: Longint; hWnd: HWND; Msg: UINT; wParam, lParam: Longint): Longint; external 'CallWindowProc{#A}@user32.dll stdcall';
function CreatePatternBrush(b: HBitmap): HBrush; external 'CreatePatternBrush@gdi32.dll stdcall';
function MapWindowPoints(hWndFrom, hWndTo: HWND; var lpPoints: TPoint; cPoints: UINT): Integer; external 'MapWindowPoints@user32.dll stdcall';
function SetBrushOrgEx(hdc: Longint; nXOrg, nYOrg: Integer; var lppt: TPoint): BOOL; external 'SetBrushOrgEx@gdi32.dll stdcall';
function GetAncestor(hwnd: HWND; gaFlags: UINT): HWND; external 'GetAncestor@user32.dll stdcall';

var
  OldProc1,OldProc2: Longint;
  FBrush: HBRUSH;
  pt: TPoint;

function MyProc1(h: HWND; Msg, wParam, lParam: longint): Longint;
begin
  case Msg of
    CN_CTLCOLOREDIT,CN_CTLCOLORSTATIC: begin
    if FBrush <> 0 then
    begin
        CallWindowProc(OldProc1, h, Msg, wParam, lParam);
        MapWindowPoints(h, GetAncestor(h, 2), pt, 1);
        SetBrushOrgEx(wParam, -pt.x, -pt.y, pt);
        SetBkMode(wParam,1);
        Result:= FBrush;
    end;
    end
    else
      Result:= CallWindowProc(OldProc1, h, Msg, wParam, lParam);
  end;
end;

function MyProc2(h: HWND; Msg, wParam, lParam: longint): Longint;
begin
  case Msg of
    CN_CTLCOLOREDIT,CN_CTLCOLORSTATIC: begin
    if FBrush <> 0 then
    begin
        CallWindowProc(OldProc2, h, Msg, wParam, lParam);
        MapWindowPoints(h, GetAncestor(h, 2), pt, 1);
        SetBrushOrgEx(wParam, -pt.x, -pt.y, pt);
        SetBkMode(wParam,1);
        Result:= FBrush;
    end;
    end
    else
      Result:= CallWindowProc(OldProc2, h, Msg, wParam, lParam);
  end;
end;

var
  Image: TBitmapImage;

Procedure InitializeWizard();
Begin
  ExtractTemporaryFile('1.bmp');
//
  WizardForm.InnerNotebook.Hide;
  WizardForm.OuterNotebook.Hide;
//
  WizardForm.ClientWidth:= 554;
  WizardForm.ClientHeight:= 312;
  WizardForm.Position:= poScreenCenter;
//
  Image := TBitmapImage.Create(WizardForm);
  Image.Width := 554;
  Image.Height := 312;
  Image.Bitmap.LoadFromFile(ExpandConstant('{tmp}\1.bmp'));
  Image.Stretch := True;
  Image.Parent := WizardForm;
//
  FBrush:= 0;
  FBrush:= CreatePatternBrush(Image.Bitmap.Handle);
//
with WizardForm.DirEdit do
begin
  SetBounds(56, 130, 354, 23);
  Font.Color:= clWhite;
//  Enabled:= False;
  Parent:= WizardForm;
//
  SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_COMPOSITED);
//
  OldProc1:= SetWindowLong(Handle, -4, CallbackAddr('MyProc1'));
end;
with WizardForm.GroupEdit do
begin
  SetBounds(56, 160, 354, 23);
  Font.Color:= clWhite;
//  Enabled:= False;
  Parent:= WizardForm;
//
  SetWindowLong(Handle, GWL_EXSTYLE, GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_COMPOSITED);
//
  OldProc2:= SetWindowLong(Handle, -4, CallbackAddr('MyProc2'));
end;
end;

procedure DeinitializeSetup();
begin
  SetWindowlong(WizardForm.DirEdit.Handle, -4, OldProc1);
  SetWindowlong(WizardForm.GroupEdit.Handle, -4, OldProc2);
end;

Shift85 · 10 Фев 2015

sergey3695, С ботвой дружит или нет.
Если картинку через ботву прилепить. :pardon:

sergey3695 · 11 Фев 2015

Shift85, проверь. bmp - botva :unknown:

зачем тут botva. Ну ладно. Думаю не стоит разводить флудню уже.

HandyMan · 11 Фев 2015

Shift85 написал(а):
А возможно такое на GroupEdit реализовать.

Код:

#define A = (Defined UNICODE) ? "W" : "A"

[setup]
AppName=MyApp
AppVerName=MyApp
DefaultDirName={pf}\MyApp
DefaultGroupName=MyApp

[files]
Source: 1.bmp; Flags: dontcopy;

[code]
type
  HBRUSH = LongWord;
  hDC = Longword;

const
  WM_CTLCOLOREDIT     = $0133;
  WM_CTLCOLORSTATIC   = $0138;
  CN_BASE             = $BC00;
  CN_CTLCOLOREDIT     = CN_BASE + WM_CTLCOLOREDIT;
  CN_CTLCOLORSTATIC   = CN_BASE + WM_CTLCOLORSTATIC;
//
  GWL_USERDATA = (-21);
  GWL_WNDPROC = (-4);

function GetWindowLong(hWnd: HWND; nIndex: Integer): Longint; external 'GetWindowLong{#A}@user32.dll stdcall';
//
function SetWindowLong(hWnd: HWND; nIndex: Integer; dwNewLong: Longint): Longint; external 'SetWindowLong{#A}@user32.dll stdcall';
function SetBkMode(DC: hDC; BkMode: Integer): Longint; external 'SetBkMode@gdi32.dll stdcall';
function CallWindowProc(lpPrevWndFunc: Longint; hWnd: HWND; Msg: UINT; wParam, lParam: Longint): Longint; external 'CallWindowProc{#A}@user32.dll stdcall';
function CreatePatternBrush(b: HBitmap): HBrush; external 'CreatePatternBrush@gdi32.dll stdcall';
function MapWindowPoints(hWndFrom, hWndTo: HWND; var lpPoints: TPoint; cPoints: UINT): Integer; external 'MapWindowPoints@user32.dll stdcall';
function SetBrushOrgEx(hdc: Longint; nXOrg, nYOrg: Integer; var lppt: TPoint): BOOL; external 'SetBrushOrgEx@gdi32.dll stdcall';
function GetAncestor(hwnd: HWND; gaFlags: UINT): HWND; external 'GetAncestor@user32.dll stdcall';
function DeleteObject(hObject: THandle): BOOL; external 'DeleteObject@gdi32.dll stdcall';

var
  OldProc: Longint;
  FBrush: HBRUSH;
  pt: TPoint;

function MyProc(h: HWND; Msg, wParam, lParam: longint): Longint;
begin
  case Msg of
    CN_CTLCOLOREDIT,CN_CTLCOLORSTATIC:
    begin
      if FBrush <> 0 then begin
         MapWindowPoints(h, GetAncestor(h, 2), pt, 1);
         SetBrushOrgEx(wParam, -pt.x, -pt.y, pt);
         SetBkMode(wParam,1);
         Result:= FBrush;
      end;
    end else
      Result:= CallWindowProc(GetWindowLong(h, GWL_USERDATA), h, Msg, wParam, lParam);
  end;
end;

procedure SubclassControlProc(const Control: TWinControl);
var
    i: Integer;
begin
    for i := 0 to Control.ControlCount-1 do if Control.Controls[i] is TWinControl then
    begin
        // subclass notebook page
        if Control.Controls[i] is TEdit then with TEdit(Control.Controls[i]) do
            if GetWindowLong(Handle, GWL_USERDATA) = 0 then
                SetWindowLong(Handle, GWL_USERDATA, SetWindowLong(Handle, GWL_WNDPROC, CallbackAddr('MyProc')));

        if TWinControl(Control.Controls[i]).ControlCount > 0 then
            SubclassControlProc(TWinControl(Control.Controls[i]));
    end;
end;

var
  Image: TBitmapImage;

Procedure InitializeWizard();
Begin
  ExtractTemporaryFile('1.bmp');
//
  WizardForm.InnerNotebook.Hide;
  WizardForm.OuterNotebook.Hide;
//
  WizardForm.ClientWidth:= 554;
  WizardForm.ClientHeight:= 312;
  WizardForm.Position:= poScreenCenter;
//
  Image := TBitmapImage.Create(WizardForm);
  Image.Width := 554;
  Image.Height := 312;
  Image.Bitmap.LoadFromFile(ExpandConstant('{tmp}\1.bmp'));
  Image.Stretch := True;
  Image.Parent := WizardForm;
//
  FBrush:= 0;
  FBrush:= CreatePatternBrush(Image.Bitmap.Handle);
//
  with WizardForm.DirEdit do
  begin
    SetBounds(56, 130, 354, 23);
    Font.Color:= clWhite;
//  Enabled:= False;
    Parent:= WizardForm;
  end;

  with WizardForm.GroupEdit do
  begin
    SetBounds(56, 160, 354, 23);
    Font.Color:= clWhite;
//  Enabled:= False;
    Parent:= WizardForm;
  end;

  SubclassControlProc(WizardForm);
end;

procedure UnSubclassControlProc(const Control: TWinControl);
var
    i: Integer;
begin
    for i := 0 to Control.ControlCount-1 do if Control.Controls[i] is TWinControl then
    begin
        // unsubclass notebook page
        if (Control.Controls[i] is TEdit) then with TEdit(Control.Controls[i]) do
            if GetWindowLong(Handle, GWL_USERDATA) > 0 then
                SetWindowLong(Handle, GWL_WNDPROC, GetWindowLong(Handle, GWL_USERDATA));

        if TWinControl(Control.Controls[i]).ControlCount > 0 then
            UnSubclassControlProc(TWinControl(Control.Controls[i]));
    end;
end;

procedure DeinitializeSetup();
begin
  UnSubclassControlProc(WizardForm);
  if FBrush <> 0 then DeleteObject(FBrush);
end;

Shift85 · 15 Фев 2015

sergey3695, с ботвой абсолютно не дружит.
Придется все через bmp клепать как по старинке... :flagoftruce:

sergey3695 · 15 Фев 2015

Shift85, ну почему же, но меня смущает там кое-что. Надо тестировать. У меня-то все работает. Это на страх и риск. (DoubleBuffered на юникоде только, там не стоит условие, сотри если анси). Может кто посмотрит из знающих, правильно ли там.

Shift85 · 15 Фев 2015

sergey3695,

sergey3695 · 15 Фев 2015

Shift85, эмм..

только Unicode.

Shift85 · 15 Фев 2015

sergey3695 написал(а):
эмм.. только Unicode.

sergey3695, Для анси забабахай.

Вопрос Как сделать прозрачными DirEdit и GroupEdit?

Новичок

Ветеран

Lord of Madness

Ветеран

Старожил

Новичок

Старожил

Ветеран

Вложения

Старожил

Ветеран

Старожил

Ветеран

Старожил

Ветеран

Новичок

Старожил

Ветеран

Вложения

Старожил

Вложения

Ветеран

Старожил