Текущий архив: 2007.05.20;
Скачать: CL | DM;

Вниз

Перехват события у TMyFrame   Найти похожие ветки 

← →
Ega23 ©   (2007-04-28 14:28) [0]

Есть некий TMyFrame с какой-то начинкой. Надо в рамках этого фрейма уметь перехватывать WM_ERASEBKGND.
Таких фреймов может быть много.

Вопрос: как лучше это сделать? Application-то один...

---

← →
Игорь Шевченко ©   (2007-04-28 15:17) [1]

type
 TfFoo = class(TseBaseFrame)
 ...
   procedure UmSetFooFrameFocus (
     var Message: TMessage); message UM_SETFOOFRAMEFOCUS;
 end;

например так

---

← →
Ega23 ©   (2007-04-28 15:27) [2]

Так-то оно так. А если где-то в недрах WinControl уже есть реакция на этот message? Причём в private-секции?
Новая реализация перекроет существующую или нет?

---

← →
Игорь Шевченко ©   (2007-04-28 15:31) [3]

> Новая реализация перекроет существующую или нет?


перекроет

---

← →
Ega23 ©   (2007-04-28 15:32) [4]

> перекроет


спасибо!

---

← →
Игорь Шевченко ©   (2007-04-28 15:42) [5]

unit MyFrame;

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

type
 TfFoo = class(TFrame)
   Label1: TLabel;
 private
   FBitmap: TBitmap;
   procedure WMEraseBkgnd (var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
 public
   constructor Create (AOwner: TComponent); override;
   destructor Destroy; override;
 end;

implementation

{$R *.dfm}

{ TFrame1 }

function CreateBrushBitmap (Dark, Middle, Light: COLORREF): TBitmap;
begin
 Result := TBitmap.Create;
 with Result do begin
   Width := 8;
   Height := 8;
   with Canvas do begin
     Brush.Color := Middle;
     FillRect(Rect(0, 0, Width, Height));
     Pixels[0,0] := Light;
     Pixels[4,0] := Light;
     Pixels[0,4] := Light;
     Pixels[4,4] := Light;
     Pixels[1,1] := Dark;
     Pixels[5,1] := Dark;
     Pixels[1,5] := Dark;
     Pixels[5,5] := Dark;
    end;
 end;
end;

constructor TfFoo.Create(AOwner: TComponent);
begin
 FBitmap := CreateBrushBitmap (RGB($00,$3C,$5A), RGB($08,$5D,$8B),
   RGB($08,$8D,$CD));
 inherited;
end;

destructor TfFoo.Destroy;
begin
 FBitmap.Free;
 inherited;
end;

procedure TfFoo.WMEraseBkgnd(var Message: TWMEraseBkgnd);
var
 Canvas: TCanvas;
begin
 Canvas := TCanvas.Create;
 try
   Canvas.Handle := Message.DC;
   Canvas.Brush.Bitmap := FBitmap;
   Canvas.FillRect(ClientRect);
   Canvas.Handle := 0;
 finally
   Canvas.Free;
 end;
end;

end.

object fFoo: TfFoo
 Left = 0
 Top = 0
 Width = 298
 Height = 76
 TabOrder = 0
 TabStop = True
 object Label1: TLabel
   Left = 56
   Top = 24
   Width = 189
   Height = 21
   Alignment = taCenter
   AutoSize = False
   Caption = "This is my frame"
   Font.Charset = DEFAULT_CHARSET
   Font.Color = clWindow
   Font.Height = -16
   Font.Name = "Tahoma"
   Font.Style = [fsBold]
   ParentFont = False
   Transparent = True
 end
end

unit main;

interface

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

type
 TForm1 = class(TForm)
   fFoo1: TfFoo;
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

end.

---

Страницы: 1 вся ветка

Текущий архив: 2007.05.20;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.072 c