Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Компоненты Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 28.05.2016, 20:18   #1
casus
Пользователь
 
Аватар для casus
 
Регистрация: 12.03.2013
Сообщений: 28
По умолчанию полупрозрачность компонента

Всем добра. Ковыряю чужой компонент class(TCustomGrid), немогу догнать как сделать его полупрозрачным. Хочу сквозь его наблюдать картинку на форме.

сделал следущее:

Код:
procedure THexEditor.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
end;

procedure THexEditor.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
Message.Result := 1;
end;
не работает, хотя в интернетах пишут что именно так..
чего я еще не добавил? где глянуть пример переделки компонента?
Вложения
Тип файла: zip HexEditor.zip (26.6 Кб, 11 просмотров)
Давлю тараканов

Последний раз редактировалось casus; 28.05.2016 в 22:00.
casus вне форума Ответить с цитированием
Старый 31.05.2016, 02:17   #2
casus
Пользователь
 
Аватар для casus
 
Регистрация: 12.03.2013
Сообщений: 28
По умолчанию

Пробовал сделать форму прозрачной под определенный цвет, создать форму с рисунком фона за активной формой. Но есть беда. Непонятно по каким причинам, при работе с компонентом я получаю фокус дочерней формы. Пробовал обработать событие WMMoving для синхронного перемещения дочерней формы. Но получаю плавающий фон который отстает от родительской формы от 1 до 10 пикс. Поэтому вопрос актуальный. Что надо сделать с компонентом чтобы он стал полупрозрачным?
Пробовал делать наследника класса, по аналогии с прозрачным Memo. Не просвечивает..
Код:
unit TransHexEditor;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls;
 
type
  TCtrl = class(TWinControl);
 
  // Transparent HexEditor
  TTransHexEditor = class(THexEditor)
  private
    FAlignText: TAlignment;
    FTransparent: Boolean;
    FPainting: Boolean;
    procedure SetAlignText(Value: TAlignment);
    procedure SetTransparent(Value: Boolean);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
    procedure CNCtlColorEdit(var Message: TWMCtlColorEdit); message CN_CTLCOLOREDIT;
    procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;
    procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMMove(var Message: TWMMove); message WM_MOVE;
  protected
    procedure RepaintWindow;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Change; override;
    procedure SetParent(AParent: TWinControl); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property AlignText: TAlignment read FAlignText write SetAlignText default taLeftJustify;
    property Transparent: Boolean read FTransparent write SetTransparent default false;
  end;
 
procedure Register;
 
implementation
 
const
 BorderRec: array[TBorderStyle] of Integer = (1, -1);
 
procedure Register;
begin
  RegisterComponents('NotStandart', [TTransHexEditor]);
end;
 
function GetScreenClient(Control: TControl): TPoint;
var
 p: TPoint;
begin
 p := Control.ClientOrigin;
 ScreenToClient(Control.Parent.Handle, p);
 Result := p;
end;
 
// Transparent HexEditor
constructor TTransHexEditor.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FAlignText := taLeftJustify;
 FTransparent := true;
 FPainting := false;
end;
 
destructor TTransHexEditor.Destroy;
begin
 inherited Destroy;
end;
 
procedure TTransHexEditor.SetAlignText(Value: TAlignment);
begin
 if FAlignText <> Value then
 begin
  FAlignText := Value;
  RecreateWnd;
  Invalidate;
 end;
end;
 
procedure TTransHexEditor.SetTransparent(Value: Boolean);
begin
 if FTransparent <> Value then
 begin
  FTransparent := Value;
  Invalidate;
 end;
end;
 
procedure TTransHexEditor.WMEraseBkGnd(var Message: TWMEraseBkGnd);
var
 DC: hDC;
 i: integer;
 p: TPoint;
begin
 if FTransparent then
 begin
  if Assigned(Parent) then
  begin
   DC := Message.DC;
   i := SaveDC(DC);
   p := GetScreenClient(self);
   p.x := -p.x;
   p.y := -p.y;
   MoveWindowOrg(DC, p.x, p.y);
   SendMessage(Parent.Handle, $0014, DC, 0);
   TCtrl(Parent).PaintControls(DC, nil);
   RestoreDC(DC, i);
  end;
 end else inherited;
end;
 
procedure TTransHexEditor.WMPaint(var Message: TWMPaint);
begin
 inherited;
 if FTransparent then
 if not FPainting then
 RepaintWindow;
end;
 
procedure TTransHexEditor.WMNCPaint(var Message: TMessage);
begin
 inherited;
end;
 
procedure TTransHexEditor.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
 inherited;
 if FTransparent then
 SetBkMode(Message.ChildDC, 1);
end;
 
procedure TTransHexEditor.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
 inherited;
 if FTransparent then
 SetBkMode(Message.ChildDC, 1);
end;
 
procedure TTransHexEditor.CMParentColorChanged(var Message: TMessage);
begin
 inherited;
 if FTransparent then
 Invalidate;
end;
 
procedure TTransHexEditor.WMSize(var Message: TWMSize);
begin
 inherited;
 Invalidate;
end;
 
procedure TTransHexEditor.WMMove(var Message: TWMMove);
begin
 inherited;
 Invalidate;
end;
 
procedure TTransHexEditor.RepaintWindow;
var
 DC: hDC;
 TmpBitmap, Bitmap: hBitmap;
begin
 if FTransparent then
 begin
  FPainting := true;
  HideCaret(Handle);
  DC := CreateCompatibleDC(GetDC(Handle));
  TmpBitmap := CreateCompatibleBitmap(GetDC(Handle), Succ(ClientWidth), Succ(ClientHeight));
  Bitmap := SelectObject(DC, TmpBitmap);
  PaintTo(DC, 0, 0);
  BitBlt(GetDC(Handle), BorderRec[BorderStyle], BorderRec[BorderStyle], ClientWidth, ClientHeight, DC, 1, 1, SRCCOPY);
  SelectObject(DC, Bitmap);
  DeleteDC(DC);
  ReleaseDC(Handle, GetDC(Handle));
  DeleteObject(TmpBitmap);
  ShowCaret(Handle);
  FPainting := false;
 end;
end;
 
procedure TTransHexEditor.CreateParams(var Params: TCreateParams);
const
 Alignments: array [TAlignment] of DWord = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
 inherited CreateParams(Params);
 Params.Style := Params.Style or ES_MULTILINE or Alignments[FAlignText];
end;
 
procedure TTransHexEditor.Change;
begin
 RepaintWindow;
 inherited Change;
end;
 
procedure TTransHexEditor.SetParent(AParent: TWinControl);
begin
 inherited SetParent(AParent);
end;
 
end.
Давлю тараканов

Последний раз редактировалось casus; 31.05.2016 в 03:24.
casus вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Canvas и Полупрозрачность NEoMASTERR Общие вопросы Delphi 4 20.03.2015 11:59
полупрозрачность текста в ИЕ Алек Помощь студентам 1 01.02.2012 15:48
to Kotoff / полупрозрачность в Delphi BOBAH13 Свободное общение 27 06.04.2011 12:33
Прозрачность и полупрозрачность Алкаш Мультимедиа в Delphi 4 25.11.2008 01:04
Полупрозрачность - как? t3ns0r Общие вопросы Delphi 13 10.08.2007 10:04