Тема: Фон MEMO
Показать сообщение отдельно
  #2  
Старый 30.11.2010, 19:48
Аватар для v1s2222
v1s2222 v1s2222 вне форума
Продвинутый
 
Регистрация: 07.09.2010
Сообщения: 726
Репутация: 26711
По умолчанию

Только так:
http://www.sql.ru/Forum/actualfile.aspx?id=3889623
Код:
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    procedure MemoWndProc(var Message: TMessage); 
  public
    { Public declarations }
  end;

var
  Form1	: TForm1;
  Bmp	: TBitmap;
  FMemoInstance : Pointer; 
  FPrevMemoProc : Pointer; 

implementation

{$R *.DFM}

procedure TForm1.MemoWndProc(var Message: TMessage); 
var 
  PS		: TPaintStruct;
  DC		: HDC;
  I, Y		: Integer;
begin 
  with Message do 
    case Msg of 
      WM_PAINT :
      begin
	DC := BeginPaint(Memo1.Handle, PS);
	SetBkMode(DC, TRANSPARENT);
	SelectObject(DC, Memo1.Font.Handle);
	StretchBlt(DC, 0, 0, Memo1.Width, Memo1.Height, Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, SRCCOPY);
	Y := 1;
	for I := 0 to Memo1.Lines.Count - 1 do
	begin
	  TextOut(DC, 1, Y, PChar(Memo1.Lines[i]), Length(Memo1.Lines[i]));
	  inc(Y, abs(Memo1.Font.Height) + 2);
	end;
	DeleteObject(Memo1.Font.Handle);
	EndPaint(Memo1.Handle, PS);
      end;
    else 
      Result := CallWindowProc(FPrevMemoProc, Form1.Memo1.Handle, Msg, wParam, lParam); 
    end; 
end; 

procedure TForm1.FormCreate(Sender: TObject);
begin
  Bmp := TBitmap.Create;
  Bmp.LoadFromResourceName(hInstance, 'ICE');

  FMemoInstance := MakeObjectInstance(MemoWndProc); 
  FPrevMemoProc := Pointer(GetWindowLong(Memo1.Handle, GWL_WNDPROC)); 
  SetWindowLong(Memo1.Handle, GWL_WNDPROC, Longint(FMemoInstance)); 
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Memo1.HandleAllocated then
    SetWindowLong(Memo1.Handle, GWL_WNDPROC, Longint(FPrevMemoProc));
  Bmp.Free;
end;
Или используй другой компонент, хоть тот же TRichView.
__________________
Помогаю за Спасибо
Ответить с цитированием