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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 31.08.2008, 09:08   #1
Roof
Форумчанин
 
Аватар для Roof
 
Регистрация: 01.02.2007
Сообщений: 785
По умолчанию исправить компонент под делфи 2007

недавно стал изучать создание новых компонентов. Наткнулся в инете на код прозрачного Memo. Так вот какие дела - под делфи7 работает замечательно. А вот под Делфи 2007 никак не хочет быть прозрачным! Как его подправить под 2007 версию ? Подскажите
Код:
unit TransMemo;

interface

uses
  SysUtils, Classes, Controls, StdCtrls, Windows, Messages, Forms;

type
  TCrackWinControl = class(TWinControl);

  TTransparentMemo = class(TMemo)
  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('TransMemo', [TTransparentMemo]);
end;

{ TTransparentMemo }

constructor TTransparentMemo.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FAlignText := taLeftJustify;
 FTransparent := False;
 FPainting := False;
end;

destructor TTransparentMemo.Destroy;
begin
 inherited Destroy;
end;

procedure TTransparentMemo.SetAlignText(Value: TAlignment);
begin
 if FAlignText <> Value then
   begin
    FAlignText := Value;
    RecreateWnd;
    Invalidate;
   end;
end;

procedure TTransparentMemo.SetTransparent(Value: Boolean);
begin
 if FTransparent <> Value then
   begin
    FTransparent := Value;
    Invalidate;
   end;
end;

procedure TTransparentMemo.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 := ClientOrigin;
       Windows.ScreenToClient(Parent.Handle, p);
       p.x := -p.x;
       p.y := -p.y;
       MoveWindowOrg(DC, p.x, p.y);
       SendMessage(Parent.Handle, $0014, DC, 0);
       TCrackWinControl(Parent).PaintControls(DC, nil);
       RestoreDC(DC, i);
      end;
   end else inherited;
end;

procedure TTransparentMemo.WMPaint(var Message: TWMPaint);
begin
 inherited;
 if FTransparent then
 if not FPainting then
 RepaintWindow;
end;

procedure TTransparentMemo.WMNCPaint(var Message: TMessage);
begin
 inherited;
end;

procedure TTransparentMemo.CNCtlColorEdit(var Message: TWMCtlColorEdit);
begin
 inherited;
 if FTransparent then
 SetBkMode(Message.ChildDC, 1);
end;

procedure TTransparentMemo.CNCtlColorStatic(var Message: TWMCtlColorStatic);
begin
 inherited;
 if FTransparent then
 SetBkMode(Message.ChildDC, 1);
end;

procedure TTransparentMemo.CMParentColorChanged(var Message: TMessage);
begin
 inherited;
 if FTransparent then
 Invalidate;
end;

procedure TTransparentMemo.WMSize(var Message: TWMSize);
begin
 inherited;
 Invalidate;
end;

procedure TTransparentMemo.WMMove(var Message: TWMMove);
begin
 inherited;
 Invalidate;
end;
Изо всей благодати
В руках крепко сжатых
Я донесу только капли
Roof вне форума Ответить с цитированием
Старый 31.08.2008, 09:09   #2
Roof
Форумчанин
 
Аватар для Roof
 
Регистрация: 01.02.2007
Сообщений: 785
По умолчанию

Продолжение кода:
Код:
procedure TTransparentMemo.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 TTransparentMemo.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 TTransparentMemo.Change;
begin
 RepaintWindow;
 inherited Change;
end;

procedure TTransparentMemo.SetParent(AParent: TWinControl);
begin
 inherited SetParent(AParent);
end;

end.
Изо всей благодати
В руках крепко сжатых
Я донесу только капли
Roof вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как установить компонент на Delphi 2007 Kostia Компоненты Delphi 7 06.04.2010 16:11
как в CodeGear Delphi 2007 установить компонент TIcqClient andrey4623 Компоненты Delphi 3 17.04.2009 18:06
Иконка приложения в Делфи 2007 Roof Общие вопросы Delphi 2 22.08.2008 23:15
Как исправить компонент TCoolTrayIcon для корректного выведения юникодных символов? SkAndrew Компоненты Delphi 14 20.08.2008 12:55
Delphi 2007 for Win32 + Delphi 2007 for PHP Noor Софт 0 20.04.2007 08:36