Прозрачные компоненты

[TSnake]

Как сделать, чтобы фон у TMemo а был прозрачным?

 

[zubr]

В Net такая фича есть. В Delphi же можно только всю форму сделать прозрачной или полупрозрачной (для NT-систем).
А так ручками самому отрисовывать фон компонента.

 

[TSnake]

А поконкретнее можно? Просто очень нужно сделать, чтобы под мемо был виден битмап, а так весь вид проги портит.

 

[zubr]

Вот тебе способ для NT-систем, не совсем красивый, но работающий. Смотри во вложенном файле. Обрати внимание в инспекторе объектов для Form2 свойства AlphaBlend и AlphaBlendValue. Поэкспериментируй со свойством AlphaBlendValue.
З.Ы. Проект собран в Delphi7

 

[TSnake]

Такой вариант я уже видел, но как-то это совсем не элегантно <_< . я люблю чтобы всё было изящно, красиво, а этот способ, к сожалению, не является таковым .
Совершенно случайно натктнулся в инете на прозрачную панель(TPanel), там "прозрачность" реализована так: копируется область битмапа под панелью и копируется в свой фон. Хотел подсосать идею и сделать прозрачный TEdit таким же образом, но он не имеет канвы.
буду думать чё-нить ещё

 

[zubr]

Совершенно случайно натктнулся в инете на прозрачную панель(TPanel), там "прозрачность" реализована так: копируется область битмапа под панелью и копируется в свой фон. Хотел подсосать идею и сделать прозрачный TEdit таким же образом, но он не имеет канвы.

Посмотри в исходниках TEdit, где там происходит прорисовка фона - туда и пытайся влезть. Или создай свой компонент типа TEdit на базе TCustomPanel. Можно еще попробовать фон отрисовывать своей кистью - когда то делал, надо порыться в архиве, найду - выложу.

 

[zubr]

Вот как раскрасить фон компонента одноцветной кистью:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Edit1: TEdit;
private
{ Private declarations }
procedure WMCTLCOLOREDIT(var msg:TMessage); message WM_CTLCOLOREDIT;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.WMCTLCOLOREDIT(var msg:TMessage);
var
hdc, hbs:cardinal;
begin
If msg.LParam<>Edit1.Handle then
exit;
hdc:=msg.wParam;
hbs:=CreateSolidBrush(clYellow);
SetBkColor(hdc, clYellow);
SetTextColor(hdc, clRed);
msg.Result:=hbs;
end;

end.

Попробуй вместо CreateSolidBrush создавать кисть на основе битмапа, используя функцию CreatePatternBrush или CreateDIBPatternBrush.

 

[TSnake]

c Edit'ом получилось.
А вот с Memo такая штука не проходит

да и с Edit'ом всё не так хорошо: если Edit лежит на панели, то фон не перерисовывается.

 

[zubr]

Вот тебе вариант с перехватом процедуры окна у панели. Здесь на Panel1 расположены Memo1 и Edit1:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Panel1: TPanel;
Edit1: TEdit;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;



var
Form1: TForm1;

implementation

{$R *.dfm}

var
wProc:Pointer;

function NewWndProc(Handle:hWnd; msg, wParam, lParam:Longint):Longint; stdcall;
var
hdc, hbs:cardinal;
begin
Result:=CallWindowProc(wProc, Handle, msg, wParam, lParam);
If msg=WM_CTLCOLOREDIT then
begin
If (lParam=Form1.Edit1.Handle) or (lParam=Form1.Memo1.Handle) then
begin
hdc:=wParam;
hbs:=CreateSolidBrush(clYellow);
SetBkColor(hdc, clYellow);
SetTextColor(hdc, clRed);
Result:=hbs;
end;
end;
If msg=WM_PAINT then
begin
hdc:=GetDC(Form1.Memo1.Handle);
hbs:=CreateSolidBrush(clYellow);
FillRect(hdc, Rect(0, 0, Form1.Memo1.Width, Form1.Memo1.Height), hbs);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
wProc:=Pointer(SetWindowLong(Panel1.Handle, gwl_WndProc, Integer(@NewWndProc)));
end;

end.

З.Ы. Очистку мусора я не делал, показан принцип.

 

[TSnake]

а как быть с Мемо? в нём-то битмап не рисуется

 

[zubr]

Так а что CreatePatternBrush или CreateDIBPatternBrushPt не катят? Посмотри реализацию этих функций в MSDN, там по моему примеры их использования есть. В конце концов можно в WM_PAINT Memo (подменять процедуру окна Memo), рисовать фон, а затем выводить текст (OutText):

If msg=WM_PAINT then
begin
hdc:=GetDC(Form1.Memo1.Handle);
BitBlt(....
OutText(....
end;