Случайны выбор дневника Раскрыть/свернуть полный список возможностей


Найдено 1564 сообщений
Cообщения с меткой

с новым годом! - Самое интересное в блогах

Следующие 30  »
Galina_Ivanov_a

Всем праздничного настроения!

Среда, 25 Января 2017 г. 21:29 (ссылка)

Это цитата сообщения lyubava63 Оригинальное сообщение

Всем праздничного настроения!

Счетчик посещений Counter.CO.KZ - бесплатный счетчик на любой вкус!

У ВСЕХ МОИХ ДРУЗЕЙ
ДОЛЖНА БЫТЬ ЁЛОЧКА НА СТРАНИЧКЕ!


Спасибо за ваши комментарии!


Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
Юрий_Скилев

О приеме в МИД России по случаю Нового года по лунному календарю

Вторник, 24 Января 2017 г. 15:52 (ссылка)


В 2017 году празднование Китайского Нового года начнется 28 января и закончится — 11 февраля. Китайцы ведут летоисчисление по лунно-солнечному календарю, поэтому 2017-й по григорианскому календарю — это китайский 4715-й. По схеме Пяти Стихий — предстоящий год будет огненным, а по схеме Животного Зодиака — под властью Петуха.







МИД СООБЩЕНИЕ ДЛЯ СМИ



 



23 января по случаю отмечаемого в ряде стран Азии Нового года по лунному календарю заместитель Министра иностранных дел Российской Федерации И.В.Моргулов устроил прием, на котором присутствовали послы и старшие дипломаты посольств Китайской Народной РеспубликиКорейской Народно-Демократической РеспубликиМонголииРеспублики КореяСоциалистической Республики Вьетнам и Республики Сингапур.



Прием прошел в теплой, непринужденной обстановке.



***



Новый год — самый длинный и самый важный праздник в китайском (лунном) календаре. Фестивали, гулянья, приуроченные к этому празднику, длятся 15 дней. Он приходится на второе новолуние после зимнего солнцестояния, на период между 12 января и 19 февраля. Нередко Новый год по лунному календарю называют «китайским», потому что его празднование распространилось по Азии, а в дальнейшем и по миру, именно из Поднебесной. Более того, в большинстве стран, отмечающих этот праздник, «китайский» Новый год является государственным праздником и радостным событием для представителей всех национальностей и конфессий. Новогодний ужин — главная новогодняя традиция. Причем на столе должно быть как можно больше блюд. Согласно традиции, в праздничную ночь за столом присутствуют духи предков, которые являются полноправными участниками торжества. Приглашаем всех, желающих отметить Китайский Новый Год по всем правилам, на Daily-menu.ru, к настоящему китайскому столу. Все последующие дни принято навещать с поздравлениями родственников и друзей. Также в этот период устраиваются традиционные массовые гулянья — костюмированные пляски и маскарадные уличные шествия. 



Источник: http://www.calend.ru/holidays/0/0/364/

© Calend.ru










  •  



  •  





Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
Лия_плюс

Необычные новогодние ёлки - ёлки с фото и ёлка из смайлов! Мои новые работы.

Воскресенье, 15 Января 2017 г. 20:54 (ссылка)

Друзья, это мои последние празднично-новогодние работы, теперь будем видеться реже, каникулы закончились :)
Ещё раз поздравляю всех с наступившим Новым годом!

Фото-ёлка "С Новым годом, Россия!"Ёлка из смайлов, ностальгическая...С Новым годом!
Чтобы посмотреть в большем размере, надо кликнуть по картинке и увеличить.
На сайте:
Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
В_А_Ш

Последний день

Суббота, 14 Января 2017 г. 12:07 (ссылка)


... теперь сегодня ещё попраздновать, и завтра уже – всё. Игрушки – в коробку, ёлку – на мусорку, подарки  – обратно в магазин. Всё.


Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
Лия_плюс

Встречаем Старый Новый год! Шампанское и его идеальная пара.

Пятница, 13 Января 2017 г. 21:24 (ссылка)

«В Бразилии, где много-много диких обезьян, существует славная традиция проводов старого года. Жители этой страны в канун праздника выбрасывают из своих окон все вещи, которые им не нужны или надоели за прошедший год. Конечно, мы не расточительные бразильцы, а хозяйственные русские. Поэтому предлагаю выбросить из своей души старые обиды, дурные мысли, зависть, неблагодарность, гордыню. И давайте поднимем бокалы за то, чтобы 2017-й Новый год был прожит не хуже, а лучше предыдущего!»

«Однажды, увидев, что Эйнштейн приколачивает над дверью подкову, его ученики спросили:
— Профессор, вы же говорили, что не верите в подкову?
— Да, конечно, но говорят, она приносит удачу даже тем, кто в неё не верит».
Предлагаю поднять бокалы за удачу. Если в Новом году мы вдруг потеряем в неё веру, пусть она всё равно верит в то, что обязательно должна прийти в наш дом!»

К слову об удаче: однажды, когда друзья Юрия Никулина попросили его произнести тост, он сказал: "Я не желаю вам богатства, я не желаю вам счастья, я не желаю вам здоровья, я желаю вам только УДАЧИ ! Ведь все пассажиры "Титаника" были богаты, счастливы и здоровы.
УДАЧИ ВАМ ВСЕМ, ДРУЗЬЯ !





А теперь про шампанское.

Любое шампанское является аперитивом - напитком, возбуждающим аппетит, поэтому правильно подавать его в начале застолья или после перерывов при перемене блюд.
Закуска к шампанскому призвана подчёркивать ароматический букет и вкус самого напитка - чем он богаче, тем проще и нейтральнее должна быть еда.
Чем закусывать?
Читать далее:
Метки:   Комментарии (2)КомментироватьВ цитатник или сообщество
Лия_плюс

2017-й стартовал окончательно! С Новым годом!

Пятница, 13 Января 2017 г. 20:07 (ссылка)



Открытку нарисовала Polina Gortman, анимация Лия плюс.

Открытку нарисовала Анастасия, анимация Лия плюс
Метки:   Комментарии (1)КомментироватьВ цитатник или сообщество
Лия_плюс

Новогодние петушки со стихами и пожеланиями в Старый Новый год!

Пятница, 13 Января 2017 г. 20:06 (ссылка)

Есть сказка мудрая в народе,
В ней петушок есть золотой.

И снова праздник к нам приходит
С предновогодней суетой.

Пусть в Новый год, как в старой сказке,
Добро прибудет в каждый дом,
Метки:   Комментарии (1)КомментироватьВ цитатник или сообщество
Лия_плюс

Супер-потрясающий видео-позитив! "Каникулы в БелКино" и "Новогодняя сказка для белочек". Не пропустите!

Четверг, 12 Января 2017 г. 18:42 (ссылка)




С  НОВЫМ ГОДОМ ВСЕХ, ВСЕХ, ВСЕХ!



Автор фото и видео Валентина Говорушкина.

Более раняя тема "Белочка Нобель" - смотрите ЗДЕСЬ:
Метки:   Комментарии (1)КомментироватьВ цитатник или сообщество
rss_rss_hh_new

VCL, избавляемся от мерцания, раз и навсегда

Пятница, 06 Января 2017 г. 19:05 (ссылка)

image

Delphi и C++Builder разработчики, использующие VCL не по наслышке знают о вездесущей проблеме мерцания контролов.

Мерцание происходит при перерисовке, вследствие того, что сначала отрисовываеться фон компонента, и только потом сам компонент.

И если в случае с наследниками от TWinControl частичным решением проблемы является установка свойства DoubleBuffered в True, что заставляет контрол отрисовываться в буфере(однако DoubleBuffered работает тоже не идеально, к прим.: контрол перестает быть прозрачным), то в случае с TGraphicControl решение с DoubleBuffered просто невозможно, из-за отсутствия у TGraphicControl окна, установка же DoubleBuffered в True у родителя не помогает, из-за того что отрисовка вложенных TGraphicControl-ов происходит уже после прорисовки родителя в буфере.

Обычно остается только одно — смириться с мерцанием, и максимально упростить отрисовку для минимизации эффекта, или использовать по возможности исключительно TWinControl-ы, что не всегда возможно и удобно.



Однажды намучившись с мерцанием, я не выдержал и решил решить эту проблему, раз и навсегда!



Как мне удалось решить проблему?

Заранее извиняюсь за некоторую сумбурность подачи, и недосказанность, описывать подобные вещи довольно сложно, однако поделиться с сообществом хочется.



Был разработан класс TEsCustomControl = class(TWinControl), который осуществляет альтернативную буферизацию(при DoubleBuffered = False, иначе используется родная буферизация VCL).

Класс имеет свойство BufferedChildrens, при активации которого отрисовка вложенных TGraphicControl-ов происходит в буфере, что полностью избавляет от мерцания.



К счастью в VCL нужные методы отрисовки объявлены не как private, что и позволило реализовать полную буферизацию.



Для того чтобы компонент выглядел прозрачным, необходимо отрисовать на нем фон нижележащего компонента, что осуществляется с помощью процедуры DrawParentImage.



procedure DrawParentImage(Control: TControl; DC: HDC; InvalidateParent: Boolean = False);
var
ClientRect: TRect;
P: TPoint;
SaveIndex: Integer;
begin
if Control.Parent = nil then
Exit;
SaveIndex := SaveDC(DC);
GetViewportOrgEx(DC, P);

// if control has non client border then need additional offset viewport
ClientRect := Control.ClientRect;
if (ClientRect.Right <> Control.Width) or (ClientRect.Bottom <> Control.Height) then
begin
ClientRect := CalcClientRect(Control);
SetViewportOrgEx(DC, P.X - Control.Left - ClientRect.Left, P.Y - Control.Top - ClientRect.Top, nil);
end else
SetViewportOrgEx(DC, P.X - Control.Left, P.Y - Control.Top, nil);

IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);

Control.Parent.Perform(WM_ERASEBKGND, DC, 0);
// Control.Parent.Perform(WM_PAINT, DC, 0);
Control.Parent.Perform(WM_PRINTCLIENT, DC, PRF_CLIENT);

RestoreDC(DC, SaveIndex);

if InvalidateParent then
if not (Control.Parent is TCustomControl) and not (Control.Parent is TCustomForm) and
not (csDesigning in Control.ComponentState)and not (Control.Parent is TEsCustomControl) then
begin
Control.Parent.Invalidate;
end;

SetViewportOrgEx(DC, P.X, P.Y, nil);
end;


Буферизация происходит за счет того что компонент в переопределенном методе PaintWindow отрисовываеться не непосредственно на предоставленный хендл, а на временный(или нет в зависимости от свойства IsCachedBuffer) HBITMAP, и уже после полной отрисовки копируется функцией BitBlt.

(Довольно много кода, из-за многих частных случаев)



TEsCustomControl.PaintWindow
procedure TEsCustomControl.PaintWindow(DC: HDC);
var
TempDC: HDC;
UpdateRect: TRect;
//---
BufferDC: HDC;
BufferBitMap: HBITMAP;
Region: HRGN;
SaveViewport: TPoint;
BufferedThis: Boolean;
begin
BufferBitMap := 0;
Region := 0;

if GetClipBox(DC, UpdateRect) = ERROR then
UpdateRect := ClientRect;

BufferedThis := not BufferedChildrens;

if BufferedThis then
begin
//------------------------------------------------------------------------------------------------
// Dublicate code, see PaintHandler
//------------------------------------------------------------------------------------------------
// if control not double buffered then create or assign buffer
if not DoubleBuffered then
begin
BufferDC := CreateCompatibleDC(DC);
// CreateCompatibleDC(DC) return 0 if Drawing takes place to MemDC(buffer):
// return <> 0 => need to double buffer || return = 0 => no need to double buffer
if BufferDC <> 0 then
begin
// Using the cache if possible
if FIsCachedBuffer or FIsFullSizeBuffer then
begin
// Create cache if need
if CacheBitmap = 0 then
begin
BufferBitMap := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
// Assign to cache if need
if FIsCachedBuffer then
CacheBitmap := BufferBitMap;
end
else
BufferBitMap := CacheBitmap;

// Assign region for minimal overdraw
Region := CreateRectRgnIndirect(UpdateRect);//0, 0, UpdateRect.Width, UpdateRect.Height);
SelectClipRgn(BufferDC, Region);
end
else
// Create buffer
BufferBitMap := CreateCompatibleBitmap(DC, RectWidth(UpdateRect), RectHeight(UpdateRect));
// Select buffer bitmap
SelectObject(BufferDC, BufferBitMap);
// [change coord], if need
// Moving update region to the (0,0) point
if not(FIsCachedBuffer or FIsFullSizeBuffer) then
begin
GetViewportOrgEx(BufferDC, SaveViewport);
SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
end;
end
else
BufferDC := DC;
end
else
BufferDC := DC;
//------------------------------------------------------------------------------------------------
end else
BufferDC := DC;

if not(csOpaque in ControlStyle) then
if ParentBackground then
begin
if FIsCachedBackground then
begin
if CacheBackground = 0 then
begin
TempDC := CreateCompatibleDC(DC);
CacheBackground := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
SelectObject(TempDC, CacheBackground);
DrawBackground(TempDC); //DrawParentImage(Self, TempDC, False);
DeleteDC(TempDC);
end;
TempDC := CreateCompatibleDC(BufferDC);
SelectObject(TempDC, CacheBackground);
if not FIsCachedBuffer then
BitBlt(BufferDC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), TempDC,
UpdateRect.Left, UpdateRect.Top, SRCCOPY)
else
BitBlt(BufferDC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), TempDC,
UpdateRect.Left, UpdateRect.Top, SRCCOPY);
DeleteDC(TempDC);
end
else
DrawBackground(BufferDC); //DrawParentImage(Self, BufferDC, False);
end else
if (not DoubleBuffered or (DC <> 0)) then
if not IsStyledClientControl(Self) then
FillRect(BufferDC, ClientRect, Brush.Handle)
else
begin
SetDCBrushColor(BufferDC,
ColorToRGB({$ifdef VER230UP}StyleServices.GetSystemColor(Color){$else}Color{$endif}));
FillRect(BufferDC, ClientRect, GetStockObject(DC_BRUSH));
end;

FCanvas.Lock;
try
Canvas.Handle := BufferDC;
TControlCanvas(Canvas).UpdateTextFlags;

if Assigned(FOnPainting) then
FOnPainting(Self, Canvas, ClientRect);
Paint;
if Assigned(FOnPaint) then
FOnPaint(Self, Canvas, ClientRect);
finally
FCanvas.Handle := 0;
FCanvas.Unlock;
end;

if BufferedThis then
begin
//------------------------------------------------------------------------------------------------
// Dublicate code, see PaintHandler
//------------------------------------------------------------------------------------------------
// draw to window
if not DoubleBuffered then
begin
if not(FIsCachedBuffer or FIsFullSizeBuffer) then
begin
// [restore coord], if need
SetViewportOrgEx(BufferDC, SaveViewport.X, SaveViewport.Y, nil);
BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC, 0, 0, SRCCOPY);
end
else
begin
BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC,
UpdateRect.Left, UpdateRect.Top, SRCCOPY);
end;
end;

if (BufferDC <> DC) then
DeleteObject(BufferDC);
if Region <> 0 then
DeleteObject(Region);
// delete buufer, if need
if not FIsCachedBuffer and (BufferBitMap <> 0) then
DeleteObject(BufferBitMap);
//------------------------------------------------------------------------------------------------
end;
end;


Буферизация вложенных TGraphicControl-ов реализована альтернативным методом PaintHandler, в котором происходит буферизация всех этапов прорисовки компонента, в том числе и отрисовки TGraphicControl-ов.



TEsCustomControl.PaintHandler
procedure TEsCustomControl.PaintHandler(var Message: TWMPaint);
var
PS: TPaintStruct;
BufferDC: HDC;
BufferBitMap: HBITMAP;
UpdateRect: TRect;
SaveViewport: TPoint;
Region: HRGN;
DC: HDC;
IsBeginPaint: Boolean;
begin
BufferBitMap := 0;
Region := 0;
IsBeginPaint := Message.DC = 0;

if IsBeginPaint then
begin
DC := BeginPaint(Handle, PS);
{$IFDEF VER230UP}
if TStyleManager.IsCustomStyleActive and not FIsCachedBuffer then
UpdateRect := ClientRect
// I had to use a crutch to ClientRect, due to the fact that
// VCL.Styles.TCustomStyle.DoDrawParentBackground NOT use relative coordinates,
// ie ignores SetViewportOrgEx!
// This function uses ClientToScreen and ScreenToClient for coordinates calculation!
else
{$endif}
UpdateRect := PS.rcPaint;
end
else
begin
DC := Message.DC;
{$IFDEF VER230UP}
if TStyleManager.IsCustomStyleActive and not FIsCachedBuffer then
UpdateRect := ClientRect
else
{$endif}
if GetClipBox(DC, UpdateRect) = ERROR then
UpdateRect := ClientRect;
end;

//------------------------------------------------------------------------------------------------
// Dublicate code, see PaintWindow
//------------------------------------------------------------------------------------------------
// if control not double buffered then create or assign buffer
if not DoubleBuffered then
begin
BufferDC := CreateCompatibleDC(DC);
// CreateCompatibleDC(DC) return 0 if Drawing takes place to MemDC(buffer):
// return <> 0 => need to double buffer || return = 0 => no need to double buffer
if BufferDC <> 0 then
begin
// Using the cache if possible
if FIsCachedBuffer or FIsFullSizeBuffer then
begin
// Create cache if need
if CacheBitmap = 0 then
begin
BufferBitMap := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
// Assign to cache if need
if FIsCachedBuffer then
CacheBitmap := BufferBitMap;
end
else
BufferBitMap := CacheBitmap;

// Assign region for minimal overdraw
Region := CreateRectRgnIndirect(UpdateRect);//0, 0, UpdateRect.Width, UpdateRect.Height);
SelectClipRgn(BufferDC, Region);
end
else
// Create buffer
BufferBitMap := CreateCompatibleBitmap(DC,
UpdateRect.Right - UpdateRect.Left, UpdateRect.Bottom - UpdateRect.Top);
// Select buffer bitmap
SelectObject(BufferDC, BufferBitMap);
// [change coord], if need
// Moving update region to the (0,0) point
if not(FIsCachedBuffer or FIsFullSizeBuffer) then
begin
GetViewportOrgEx(BufferDC, SaveViewport);
SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
end;
end
else
BufferDC := DC;
end
else
BufferDC := DC;
//------------------------------------------------------------------------------------------------

// DEFAULT HANDLER:
Message.DC := BufferDC;
inherited PaintHandler(Message);

//------------------------------------------------------------------------------------------------
// Dublicate code, see PaintWindow
//------------------------------------------------------------------------------------------------
// draw to window
if not DoubleBuffered then
begin
if not(FIsCachedBuffer or FIsFullSizeBuffer) then
begin
// [restore coord], if need
SetViewportOrgEx(BufferDC, SaveViewport.X, SaveViewport.Y, nil);
BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC, 0, 0, SRCCOPY);
end
else
begin
BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC,
UpdateRect.Left, UpdateRect.Top, SRCCOPY);
end;
end;

if BufferDC <> DC then
DeleteObject(BufferDC);
if Region <> 0 then
DeleteObject(Region);
// delete buufer, if need
if not FIsCachedBuffer and (BufferBitMap <> 0) then
DeleteObject(BufferBitMap);
//------------------------------------------------------------------------------------------------

// end paint, if need
if IsBeginPaint then
EndPaint(Handle, PS);
end;


Класс TEsCustomControl имеет несколько полезных свойств и событий:



  TPaintEvent = procedure(Sender: TObject; Canvas: TCanvas; Rect: TRect) of object;

/// The best replacement for TCustomControl, supports transparency and without flicker
TEsCustomControl = class(TWinControl)
...
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UpdateBackground(Repaint: Boolean); overload;
procedure UpdateBackground; overload;
// ------------------ Properties for published -------------------------------------------------
property DoubleBuffered default False;
{$IFDEF VER210UP}
property ParentDoubleBuffered default False;
{$ENDIF}
// Painting for chidrens classes
property OnPaint: TPaintEvent read FOnPaint write FOnPaint;
property OnPainting: TPaintEvent read FOnPainting write FOnPainting;
// BufferedChildrens
property ParentBufferedChildrens: Boolean read FParentBufferedChildrens write SetParentBufferedChildrens default True;
property BufferedChildrens: Boolean read FBufferedChildrens write SetBufferedChildrens stored IsBufferedChildrensStored;
// External prop
property IsCachedBuffer: Boolean read FIsCachedBuffer write SetIsCachedBuffer default False;
property IsCachedBackground: Boolean read FIsCachedBackground write SetIsCachedBackground default False;
property IsDrawHelper: Boolean read FIsDrawHelper write SetIsDrawHelper default False;
property IsOpaque: Boolean read GetIsOpaque write SetIsOpaque default False;
// property IsTransparentMouse: Boolean read FIsTransparentMouse write FIsTransparentMouse default False;
property IsFullSizeBuffer: Boolean read FIsFullSizeBuffer write FIsFullSizeBuffer default False;
end;


Интересным может оказаться свойство IsDrawHelper рисующее удобную рамку в DesignTime.

image



Для создания своего не мерцающего компонента вам достаточно унаследоваться от TEsCustomControl, как если бы вы делали наследника от TCustomControl, и объявить нужные вам свойства как published.



TEsCustomControl дает полное управление процессом буферизации и отрисовки, и доказал свою надежность во многих проектах и компонентах.



Для примера можно рассмотреть компонент TEsLayout — прозрачный Layout с возможностью буферизации вложенных в него TGraphicControl-ов:

https://github.com/errorcalc/FreeEsVclComponents/blob/master/Source/ES.Layouts.pas



И под спойлером
{******************************************************************************}
{ EsVclComponents v2.0 }
{ ErrorSoft(c) 2009-2016 }
{ }
{ More beautiful things: errorsoft.org }
{ }
{ errorsoft@mail.ru | vk.com/errorsoft | github.com/errorcalc }
{ errorsoft@protonmail.ch | habrahabr.ru/user/error1024 }
{ }
{ Open this on github: github.com/errorcalc/FreeEsVclComponents }
{ }
{ You can order developing vcl/fmx components, please submit requests to mail. }
{ Вы можете заказать разработку VCL/FMX компонента на заказ. }
{******************************************************************************}
unit ES.Layouts;

interface

uses
Winapi.Messages, Vcl.Controls, System.Classes, System.Types, Vcl.Graphics, ES.BaseControls;

type
TEsCustomLayout = class(TEsBaseLayout)
private
FLocked: Boolean;
procedure CMIsToolControl(var Message: TMessage); message CM_ISTOOLCONTROL;
protected
procedure CreateParams(var Params: TCreateParams); override;
property UseDockManager default True;
public
constructor Create(AOwner: TComponent); override;
property Color default clBtnFace;
property DockManager;
property Locked: Boolean read FLocked write FLocked default False;
end;

TEsLayout = class(TEsCustomLayout)
published
property Align;
property Anchors;
property AutoSize;
property BiDiMode;
property BorderWidth;
property BufferedChildrens;// TEsCustomControl
property Color;
property Constraints;
property Ctl3D;
property UseDockManager;
property DockSite;
property DoubleBuffered;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property IsCachedBuffer;// TEsCustomControl
property IsCachedBackground;// TEsCustomControl
property IsDrawHelper;// TEsCustomControl
property IsOpaque;// TEsCustomControl
property IsFullSizeBuffer;// TEsCustomControl
property Locked;
property Padding;
property ParentBiDiMode;
property ParentBackground;
property ParentBufferedChildrens;// TEsCustomControl
property ParentColor;
property ParentCtl3D;
property ParentDoubleBuffered;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Touch;
property Visible;
{$if CompilerVersion > 23}
property StyleElements;
{$ifend}
property OnAlignInsertBefore;
property OnAlignPosition;
property OnCanResize;
property OnClick;
property OnConstrainedResize;
property OnContextPopup;
property OnDockDrop;
property OnDockOver;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGesture;
property OnGetSiteInfo;
property OnMouseActivate;
property OnMouseDown;
property OnMouseEnter;
property OnMouseLeave;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnPaint;// TEsCustomControl
property OnPainting;// TEsCustomControl
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;

implementation

uses
ES.ExGraphics;

procedure TEsCustomLayout.CMIsToolControl(var Message: TMessage);
begin
if not FLocked then Message.Result := 1;
end;

constructor TEsCustomLayout.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
csSetCaption, csParentBackground, csDoubleClicks, csReplicatable, csPannable, csGestures];
Width := 185;
Height := 41;
UseDockManager := True;
end;

procedure TEsCustomLayout.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
// nope now
end;

end.


Исходный же код модуля содержащего TEsCustomControl и его версии-LayoutTEsBaseLayout доступен по ссылке:

https://github.com/errorcalc/FreeEsVclComponents/blob/master/Source/ES.BaseControls.pas



И под спойлером
{******************************************************************************}
{ EsVclComponents/EsVclCore v2.0 }
{ ErrorSoft(c) 2009-2017 }
{ }
{ More beautiful things: errorsoft.org }
{ }
{ errorsoft@mail.ru | vk.com/errorsoft | github.com/errorcalc }
{ errorsoft@protonmail.ch | habrahabr.ru/user/error1024 }
{ }
{ Open this on github: github.com/errorcalc/FreeEsVclComponents }
{ }
{ You can order developing vcl/fmx components, please submit requests to mail. }
{ Вы можете заказать разработку VCL/FMX компонента на заказ. }
{******************************************************************************}

{
This is the base unit, which must remain Delphi 7 support, and it should not
be dependent on any other units!
}

unit ES.BaseControls;

{$IF CompilerVersion >= 18} {$DEFINE VER180UP} {$IFEND}
{$IF CompilerVersion >= 21} {$DEFINE VER210UP} {$IFEND}
{$IF CompilerVersion >= 23} {$DEFINE VER230UP} {$IFEND}
{$IF CompilerVersion >= 24} {$DEFINE VER240UP} {$IFEND}

// see function CalcClientRect
{$define FAST_CALC_CLIENTRECT}

// see TEsBaseLayout.ContentRect
{$define TEST_CONTROL_CONTENT_RECT}

interface

uses
WinApi.Windows, System.Types, System.Classes, Vcl.Controls,
Vcl.Graphics, {$IFDEF VER230UP}Vcl.Themes,{$ENDIF} WinApi.Messages, WinApi.Uxtheme, Vcl.Forms;

const
CM_ESBASE = CM_BASE + $0800;
CM_PARENT_BUFFEREDCHILDRENS_CHANGED = CM_ESBASE + 1;

EsVclCoreVersion = 2.0;

type
THelperOption = (hoPadding, hoBorder, hoClientRect);
THelperOptions = set of THelperOption;

TPaintEvent = procedure(Sender: TObject; Canvas: TCanvas; Rect: TRect) of object;

/// The best replacement for TCustomControl, supports transparency and without flicker
TEsCustomControl = class(TWinControl)
private
// anti flicker and transparent magic
FCanvas: TCanvas;
CacheBitmap: HBITMAP;// Cache for buffer BitMap
CacheBackground: HBITMAP;// Cache for background BitMap
FIsCachedBuffer: Boolean;
FIsCachedBackground: Boolean;
StoredCachedBuffer: Boolean;
StoredCachedBackground: Boolean;
FBufferedChildrens: Boolean;
FParentBufferedChildrens: Boolean;
FIsFullSizeBuffer: Boolean;
// paint events
FOnPaint: TPaintEvent;
FOnPainting: TPaintEvent;
// draw helper
FIsDrawHelper: Boolean;
// transparent mouse
// FIsTransparentMouse: Boolean;
// paint
procedure SetIsCachedBuffer(Value: Boolean);
procedure SetIsCachedBackground(Value: Boolean);
procedure SetIsDrawHelper(const Value: Boolean);
procedure SetIsOpaque(const Value: Boolean);
function GetIsOpaque: Boolean;
procedure SetBufferedChildrens(const Value: Boolean);
procedure SetParentBufferedChildrens(const Value: Boolean);
function GetTransparent: Boolean;
procedure SetTransparent(const Value: Boolean);
function IsBufferedChildrensStored: Boolean;
// handle messages
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure CMParentBufferedChildrensChanged(var Message: TMessage); message CM_PARENT_BUFFEREDCHILDRENS_CHANGED;
procedure DrawBackgroundForOpaqueControls(DC: HDC);
// intercept mouse
// procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
// other
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure WMTextChanges(var Message: TMessage); message WM_SETTEXT;
protected
// paint
property Canvas: TCanvas read FCanvas;
procedure DeleteCache;{$IFDEF VER210UP}inline;{$ENDIF}
procedure Paint; virtual;
procedure BeginCachedBuffer;{$IFDEF VER210UP}inline;{$ENDIF}
procedure EndCachedBuffer;{$IFDEF VER210UP}inline;{$ENDIF}
procedure BeginCachedBackground;{$IFDEF VER210UP}inline;{$ENDIF}
procedure EndCachedBackground;{$IFDEF VER210UP}inline;{$ENDIF}
procedure PaintWindow(DC: HDC); override;
procedure PaintHandler(var Message: TWMPaint);
procedure DrawBackground(DC: HDC); virtual;
// other
procedure UpdateText; dynamic;
//
property ParentBackground default True;
property Transparent: Boolean read GetTransparent write SetTransparent default True;// analog of ParentBackground
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UpdateBackground(Repaint: Boolean); overload;
procedure UpdateBackground; overload;
// ------------------ Properties for published -------------------------------------------------
property DoubleBuffered default False;
{$IFDEF VER210UP}
property ParentDoubleBuffered default False;
{$ENDIF}
// Painting for chidrens classes
property OnPaint: TPaintEvent read FOnPaint write FOnPaint;
property OnPainting: TPaintEvent read FOnPainting write FOnPainting;
// BufferedChildrens
property ParentBufferedChildrens: Boolean read FParentBufferedChildrens write SetParentBufferedChildrens default True;
property BufferedChildrens: Boolean read FBufferedChildrens write SetBufferedChildrens stored IsBufferedChildrensStored;
// External prop
property IsCachedBuffer: Boolean read FIsCachedBuffer write SetIsCachedBuffer default False;
property IsCachedBackground: Boolean read FIsCachedBackground write SetIsCachedBackground default False;
property IsDrawHelper: Boolean read FIsDrawHelper write SetIsDrawHelper default False;
property IsOpaque: Boolean read GetIsOpaque write SetIsOpaque default False;
// property IsTransparentMouse: Boolean read FIsTransparentMouse write FIsTransparentMouse default False;
property IsFullSizeBuffer: Boolean read FIsFullSizeBuffer write FIsFullSizeBuffer default False;
end;

{$IFDEF VER180UP}
TContentMargins = record
type
TMarginSize = 0..MaxInt;
private
Left: TMarginSize;
Top: TMarginSize;
Right: TMarginSize;
Bottom: TMarginSize;
public
function Width: TMarginSize;
function Height: TMarginSize;
procedure Inflate(DX, DY: Integer); overload;
procedure Inflate(DLeft, DTop, DRight, DBottom: Integer); overload;
procedure Reset;
constructor Create(Left, Top, Right, Bottom: TMarginSize); overload;
end;

/// ONLY INTERNAL USE! THIS CLASS CAN BE DELETED! (USE TEsCustomControl OR TEsCustomLayot)
TEsBaseLayout = class(TEsCustomControl)
private
FBorderWidth: TBorderWidth;
procedure SetBorderWidth(const Value: TBorderWidth);
protected
procedure AlignControls(AControl: TControl; var Rect: TRect); override;
procedure AdjustClientRect(var Rect: TRect); override;
procedure Paint; override;
// new
procedure CalcContentMargins(var Margins: TContentMargins); virtual;
public
function ContentRect: TRect; virtual;
function ContentMargins: TContentMargins; inline;
property BorderWidth: TBorderWidth read FBorderWidth write SetBorderWidth default 0;
end;

/// The GraphicControl, supports Padding and IsDrawHelper property
TEsGraphicControl = class(TGraphicControl)
private
FPadding: TPadding;
FIsDrawHelper: Boolean;
function GetPadding: TPadding;
procedure SetPadding(const Value: TPadding);
procedure PaddingChange(Sender: TObject);
procedure SetIsDrawHelper(const Value: Boolean);
protected
procedure Paint; override;
function HasPadding: Boolean;
// new
procedure CalcContentMargins(var Margins: TContentMargins); virtual;
public
destructor Destroy; override;
property Padding: TPadding read GetPadding write SetPadding;
function ContentRect: TRect; virtual;
function ContentMargins: TContentMargins; inline;
property IsDrawHelper: Boolean read FIsDrawHelper write SetIsDrawHelper default False;
end;

procedure DrawControlHelper(Control: TControl; Options: THelperOptions); overload;
procedure DrawControlHelper(Canvas: TCanvas; Rect: TRect; BorderWidth: TBorderWidth;
Padding: TPadding; Options: THelperOptions); overload;
{$ENDIF}

function CalcClientRect(Control: TControl): TRect;

procedure DrawParentImage(Control: TControl; DC: HDC; InvalidateParent: Boolean = False);

implementation

uses
System.SysUtils, System.TypInfo;

type
TOpenCtrl = class(TWinControl)
public
property BorderWidth;
end;

// Old delphi support
{$IFNDEF VER210UP}
function RectWidth(const Rect: TRect): Integer;
begin
Result := Rect.Right - Rect.Left;
end;

function RectHeight(const Rect: TRect): Integer;
begin
Result := Rect.Bottom - Rect.Top;
end;
{$ENDIF}

{$IFDEF VER210UP} {$REGION 'DrawControlHelper'}
procedure DrawControlHelper(Canvas: TCanvas; Rect: TRect; BorderWidth: TBorderWidth;
Padding: TPadding; Options: THelperOptions);
procedure Line(Canvas: TCanvas; x1, y1, x2, y2: Integer);
begin
Canvas.MoveTo(x1, y1);
Canvas.LineTo(x2, y2);
end;
var
SaveBk: TColor;
SavePen, SaveBrush: TPersistent;
begin
SavePen := nil;
SaveBrush := nil;

try
if Canvas.Handle = 0 then
Exit;

// save canvas state
SavePen := TPen.Create;
SavePen.Assign(Canvas.Pen);
SaveBrush := TBrush.Create;
SaveBrush.Assign(Canvas.Brush);

Canvas.Pen.Mode := pmNot;
Canvas.Pen.Style := psDash;
Canvas.Brush.Style := bsClear;

// ClientRect Helper
if THelperOption.hoClientRect in Options then
begin
SaveBk := SetBkColor(Canvas.Handle, RGB(127,255,255));
DrawFocusRect(Canvas.Handle, Rect);
SetBkColor(Canvas.Handle, SaveBk);
end;

// Border Helper
if THelperOption.hoBorder in Options then
begin
if (BorderWidth <> 0) and (BorderWidth * 2 <= RectWidth(Rect)) and (BorderWidth * 2 <= RectHeight(Rect)) then
Canvas.Rectangle(Rect.Left + BorderWidth, Rect.Top + BorderWidth,
Rect.Right - BorderWidth, Rect.Bottom - BorderWidth);
end;

// Padding Helper
if THelperOption.hoPadding in Options then
begin
if (BorderWidth + Padding.Top < RectHeight(Rect) - BorderWidth - Padding.Bottom) and
(BorderWidth + Padding.Left < RectWidth(Rect) - BorderWidth - Padding.Right) then
begin
Canvas.Pen.Style := psDot;

if Padding.Left <> 0 then
Line(Canvas, Rect.Left + Padding.Left + BorderWidth, Rect.Top + Padding.Top + BorderWidth,
Rect.Left + Padding.Left + BorderWidth, Rect.Bottom - Padding.Bottom - BorderWidth - 1);
if Padding.Top <> 0 then
Line(Canvas, Rect.Left + Padding.Left + BorderWidth, Rect.Top + Padding.Top + BorderWidth,
Rect.Right - Padding.Right - BorderWidth - 1, Rect.Top + Padding.Top + BorderWidth);
if Padding.Right <> 0 then
Line(Canvas, Rect.Right - Padding.Right - BorderWidth - 1, Rect.Top + Padding.Top + BorderWidth,
Rect.Right - Padding.Right - BorderWidth - 1, Rect.Bottom - Padding.Bottom - BorderWidth - 1);
if Padding.Bottom <> 0 then
Line(Canvas, Rect.Left + Padding.Left + BorderWidth, Rect.Bottom - Padding.Bottom - BorderWidth - 1,
Rect.Right - Padding.Right - BorderWidth - 1, Rect.Bottom - Padding.Bottom - BorderWidth - 1);
end;
end;

Canvas.Pen.Assign(SavePen);
Canvas.Brush.Assign(SaveBrush);
finally
SavePen.Free;
SaveBrush.Free;
end;
end;

procedure DrawControlHelper(Control: TControl; Options: THelperOptions);
var
Canvas: TCanvas;
Padding: TPadding;
BorderWidth: Integer;
MyCanvas: Boolean;
begin
MyCanvas := False;
Canvas := nil;
Padding := nil;
BorderWidth := 0;

// if win control
if Control is TWinControl then
begin
// get padding
Padding := TWinControl(Control).Padding;
// get canvas
if Control is TEsCustomControl then
Canvas := TEsCustomControl(Control).Canvas
else
begin
MyCanvas := True;
Canvas := TControlCanvas.Create;
TControlCanvas(Canvas).Control := Control;
end;
// get border width
if Control is TEsBaseLayout then
BorderWidth := TEsBaseLayout(Control).BorderWidth
else
BorderWidth := TOpenCtrl(Control).BorderWidth;
end else
if Control is TGraphicControl then
begin
// get canvas
Canvas := TEsGraphicControl(Control).Canvas;
if Control is TEsGraphicControl then
Padding := TEsGraphicControl(Control).Padding;
end;

try
DrawControlHelper(Canvas, Control.ClientRect, BorderWidth, Padding, Options);
finally
if MyCanvas then
Canvas.Free;
end;
end;
{$ENDREGION} {$ENDIF}

function IsStyledClientControl(Control: TControl): Boolean;
begin
Result := False;

{$IFDEF VER230UP}
if Control = nil then
Exit;

if StyleServices.Enabled then
begin
Result := {$ifdef VER240UP}(seClient in Control.StyleElements) and{$endif}
TStyleManager.IsCustomStyleActive;
end;
{$ENDIF}
end;

function CalcClientRect(Control: TControl): TRect;
var
{$ifdef FAST_CALC_CLIENTRECT}
Info: TWindowInfo;
{$endif}
IsFast: Boolean;
begin
{$ifdef FAST_CALC_CLIENTRECT}
IsFast := True;
{$else}
IsFast := False;
{$endif}

Result := Rect(0, 0, Control.Width, Control.Height);

// Only TWinControl's has non client area
if not (Control is TWinControl) then
Exit;

// Fast method not work for controls not having Handle
if not TWinControl(Control).Handle <> 0 then
IsFast := False;

if IsFast then
begin
ZeroMemory(@Info, SizeOf(TWindowInfo));
Info.cbSize := SizeOf(TWindowInfo);
GetWindowInfo(TWinControl(Control).Handle, info);
Result.Left := Info.rcClient.Left - Info.rcWindow.Left;
Result.Top := Info.rcClient.Top - Info.rcWindow.Top;
Result.Right := -Info.rcWindow.Left + Info.rcClient.Right;
Result.Top := -Info.rcWindow.Top + Info.rcClient.Bottom;
end else
begin
Control.Perform(WM_NCCALCSIZE, 0, LParam(@Result));
end;
end;

procedure DrawParentImage(Control: TControl; DC: HDC; InvalidateParent: Boolean = False);
var
ClientRect: TRect;
P: TPoint;
SaveIndex: Integer;
begin
if Control.Parent = nil then
Exit;
SaveIndex := SaveDC(DC);
GetViewportOrgEx(DC, P);

// if control has non client border then need additional offset viewport
ClientRect := Control.ClientRect;
if (ClientRect.Right <> Control.Width) or (ClientRect.Bottom <> Control.Height) then
begin
ClientRect := CalcClientRect(Control);
SetViewportOrgEx(DC, P.X - Control.Left - ClientRect.Left, P.Y - Control.Top - ClientRect.Top, nil);
end else
SetViewportOrgEx(DC, P.X - Control.Left, P.Y - Control.Top, nil);

IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth, Control.Parent.ClientHeight);

Control.Parent.Perform(WM_ERASEBKGND, DC, 0);
// Control.Parent.Perform(WM_PAINT, DC, 0);
Control.Parent.Perform(WM_PRINTCLIENT, DC, PRF_CLIENT);

RestoreDC(DC, SaveIndex);

if InvalidateParent then
if not (Control.Parent is TCustomControl) and not (Control.Parent is TCustomForm) and
not (csDesigning in Control.ComponentState)and not (Control.Parent is TEsCustomControl) then
begin
Control.Parent.Invalidate;
end;

SetViewportOrgEx(DC, P.X, P.Y, nil);
end;

{ TESCustomControl }

procedure BitMapDeleteAndNil(var BitMap: HBITMAP);{$IFDEF VER210UP}inline;{$ENDIF}
begin
if BitMap <> 0 then
begin
DeleteObject(BitMap);
BitMap := 0;
end;
end;

procedure TEsCustomControl.BeginCachedBackground;
begin
if CacheBackground <> 0 then BitMapDeleteAndNil(CacheBackground);
StoredCachedBackground := FIsCachedBackground;
FIsCachedBackground := True;
end;

procedure TEsCustomControl.BeginCachedBuffer;
begin
if CacheBitmap <> 0 then BitMapDeleteAndNil(CacheBitmap);
StoredCachedBuffer := FIsCachedBuffer;
FIsCachedBuffer := True;
end;

procedure TEsCustomControl.CMParentBufferedChildrensChanged(var Message: TMessage);
begin
if FParentBufferedChildrens then
begin
if Parent <> nil then
begin
if Parent is TEsCustomControl then
BufferedChildrens := TEsCustomControl(Parent).BufferedChildrens
else
BufferedChildrens := False;
end;
FParentBufferedChildrens := True;
end;
end;

procedure TEsCustomControl.CMTextChanged(var Message: TMessage);
begin
inherited;
UpdateText;
end;

procedure TEsCustomControl.WMTextChanges(var Message: TMessage);
begin
Inherited;
UpdateText;
end;

constructor TEsCustomControl.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCanvas := TControlCanvas.Create;
TControlCanvas(FCanvas).Control := Self;
ControlStyle := ControlStyle - [csOpaque] + [csParentBackground];
{$IFDEF VER210UP}
ParentDoubleBuffered := False;
{$ENDIF}
FParentBufferedChildrens := True;// !!
CacheBitmap := 0;
CacheBackground := 0;
FIsCachedBuffer := False;
FIsCachedBackground := False;
end;

procedure TEsCustomControl.DeleteCache;
begin
if CacheBitmap <> 0 then BitMapDeleteAndNil(CacheBitmap);
if CacheBackground <> 0 then BitMapDeleteAndNil(CacheBackground);
end;

destructor TEsCustomControl.Destroy;
begin
FCanvas.Free;
DeleteCache;
inherited;
end;

procedure TEsCustomControl.DrawBackground(DC: HDC);
begin
DrawParentImage(Self, DC, False);
end;

procedure TEsCustomControl.DrawBackgroundForOpaqueControls(DC: HDC);
var
i: integer;
Control: TControl;
Prop: Pointer;
begin
for i := 0 to ControlCount - 1 do
begin
Control := Controls[i];
if (Control is TGraphicControl) and (csOpaque in Control.ControlStyle) and Control.Visible and
(not (csDesigning in ComponentState) or not (csNoDesignVisible in ControlStyle)
{$IFDEF VER210UP}or not (csDesignerHide in Control.ControlState){$ENDIF})
then
begin
// Necessary to draw a background if the control has a Property 'Transparent' and hasn't a Property 'Color'
Prop := GetPropInfo(Control.ClassInfo, 'Transparent');
if Prop <> nil then
begin
Prop := GetPropInfo(Control.ClassInfo, 'Color');
if Prop = nil then
FillRect(DC, Rect(Control.Left, Control.Top, Control.Left + Control.Width, Control.Top + Control.Height), Brush.Handle);
end;
end;
// if (Control is TGraphicControl) and (Control is TSpeedButton) and (csOpaque in Control.ControlStyle) and
// Control.Visible and (not (csDesigning in ComponentState) or not (csDesignerHide in Control.ControlState) and
// not (csNoDesignVisible in ControlStyle)) then
// FillRect(DC, Rect(Control.Left, Control.Top, Control.Left + Control.Width, Control.Top + Control.Height), Brush.Handle);
end;
end;

procedure TEsCustomControl.EndCachedBackground;
begin
FIsCachedBackground := StoredCachedBackground;
end;

procedure TEsCustomControl.EndCachedBuffer;
begin
FIsCachedBuffer := StoredCachedBuffer;
end;

function TEsCustomControl.GetIsOpaque: Boolean;
begin
Result := csOpaque in ControlStyle;
end;

function TEsCustomControl.GetTransparent: Boolean;
begin
Result := ParentBackground;
end;

procedure TEsCustomControl.Paint;
var
SaveBk: TColor;
begin
// for Design time
if IsDrawHelper and(csDesigning in ComponentState) then
begin
SaveBk := SetBkColor(Canvas.Handle, RGB(127,255,255));
DrawFocusRect(Canvas.Handle, Self.ClientRect);
SetBkColor(Canvas.Handle, SaveBk);
end;
end;

{ TODO -cCRITICAL : 22.02.2013:
eliminate duplication of code! }
procedure TEsCustomControl.PaintHandler(var Message: TWMPaint);
var
PS: TPaintStruct;
BufferDC: HDC;
BufferBitMap: HBITMAP;
UpdateRect: TRect;
SaveViewport: TPoint;
Region: HRGN;
DC: HDC;
IsBeginPaint: Boolean;
begin
BufferBitMap := 0;
Region := 0;
IsBeginPaint := Message.DC = 0;

if IsBeginPaint then
begin
DC := BeginPaint(Handle, PS);
{$IFDEF VER230UP}
if TStyleManager.IsCustomStyleActive and not FIsCachedBuffer then
UpdateRect := ClientRect
// I had to use a crutch to ClientRect, due to the fact that
// VCL.Styles.TCustomStyle.DoDrawParentBackground NOT use relative coordinates,
// ie ignores SetViewportOrgEx!
// This function uses ClientToScreen and ScreenToClient for coordinates calculation!
else
{$endif}
UpdateRect := PS.rcPaint;
end
else
begin
DC := Message.DC;
{$IFDEF VER230UP}
if TStyleManager.IsCustomStyleActive and not FIsCachedBuffer then
UpdateRect := ClientRect
else
{$endif}
if GetClipBox(DC, UpdateRect) = ERROR then
UpdateRect := ClientRect;
end;

//------------------------------------------------------------------------------------------------
// Dublicate code, see PaintWindow
//------------------------------------------------------------------------------------------------
// if control not double buffered then create or assign buffer
if not DoubleBuffered then
begin
BufferDC := CreateCompatibleDC(DC);
// CreateCompatibleDC(DC) return 0 if Drawing takes place to MemDC(buffer):
// return <> 0 => need to double buffer || return = 0 => no need to double buffer
if BufferDC <> 0 then
begin
// Using the cache if possible
if FIsCachedBuffer or FIsFullSizeBuffer then
begin
// Create cache if need
if CacheBitmap = 0 then
begin
BufferBitMap := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
// Assign to cache if need
if FIsCachedBuffer then
CacheBitmap := BufferBitMap;
end
else
BufferBitMap := CacheBitmap;

// Assign region for minimal overdraw
Region := CreateRectRgnIndirect(UpdateRect);//0, 0, UpdateRect.Width, UpdateRect.Height);
SelectClipRgn(BufferDC, Region);
end
else
// Create buffer
BufferBitMap := CreateCompatibleBitmap(DC,
UpdateRect.Right - UpdateRect.Left, UpdateRect.Bottom - UpdateRect.Top);
// Select buffer bitmap
SelectObject(BufferDC, BufferBitMap);
// [change coord], if need
// Moving update region to the (0,0) point
if not(FIsCachedBuffer or FIsFullSizeBuffer) then
begin
GetViewportOrgEx(BufferDC, SaveViewport);
SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
end;
end
else
BufferDC := DC;
end
else
BufferDC := DC;
//------------------------------------------------------------------------------------------------

// DEFAULT HANDLER:
Message.DC := BufferDC;
inherited PaintHandler(Message);

//------------------------------------------------------------------------------------------------
// Dublicate code, see PaintWindow
//------------------------------------------------------------------------------------------------
// draw to window
if not DoubleBuffered then
begin
if not(FIsCachedBuffer or FIsFullSizeBuffer) then
begin
// [restore coord], if need
SetViewportOrgEx(BufferDC, SaveViewport.X, SaveViewport.Y, nil);
BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC, 0, 0, SRCCOPY);
end
else
begin
BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC,
UpdateRect.Left, UpdateRect.Top, SRCCOPY);
end;
end;

if BufferDC <> DC then
DeleteObject(BufferDC);
if Region <> 0 then
DeleteObject(Region);
// delete buufer, if need
if not FIsCachedBuffer and (BufferBitMap <> 0) then
DeleteObject(BufferBitMap);
//------------------------------------------------------------------------------------------------

// end paint, if need
if IsBeginPaint then
EndPaint(Handle, PS);
end;

{$ifdef VER210UP} {$REGION 'BACKUP'}
(*
// Main magic located here:
procedure TESCustomControl.PaintWindow(DC: HDC);
var
BufferDC, TempDC: HDC;
BufferBitMap: HBITMAP;
UpdateRect: TRect;
SaveViewport: TPoint;
Region: HRGN;
begin
//UpdateRect := Rect(0, 0, Width, Height);
//GetClipBox(DC, UpdateRect);
if GetClipBox(DC, UpdateRect) = ERROR then
UpdateRect := Rect(0, 0, Width, Height);

if not DoubleBuffered then
begin
BufferDC := CreateCompatibleDC(DC);
// for bitmap context
if BufferDC = 0 then
BufferDC := DC
else
begin
if FCachedBuffer then
begin
if CacheBuffer = 0 then
CacheBuffer := CreateCompatibleBitmap(DC, Width, Height);
BufferBitMap := CacheBuffer;
Region := CreateRectRgn(0, 0, UpdateRect.Width, UpdateRect.Height);
SelectClipRgn(BufferDC, Region);
end
else
BufferBitMap := CreateCompatibleBitmap(DC, UpdateRect.Width, UpdateRect.Height);
SelectObject(BufferDC, BufferBitMap);
end;
end
else
BufferDC := DC;

// change coord
if (not DoubleBuffered){ and (not FCachedBuffer)} then
begin
GetViewportOrgEx(BufferDC, SaveViewport);
SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
end;

if not(csOpaque in ControlStyle) then
if ParentBackground then
begin
if FCachedBackground then
begin
if CacheBackground = 0 then
begin
TempDC := CreateCompatibleDC(DC);
CacheBackground := CreateCompatibleBitmap(DC, Width, Height);
SelectObject(TempDC, CacheBackground);
DrawParentImage(Self, TempDC, False);
DeleteDC(TempDC);
end;
TempDC := CreateCompatibleDC(BufferDC);
SelectObject(TempDC, CacheBackground);
BitBlt(BufferDC, 0, 0, UpdateRect.Width, UpdateRect.Height, TempDC, 0, 0, SRCCOPY);
DeleteDC(TempDC);
end
else
DrawParentImage(Self, BufferDC, False);
end else
if (not DoubleBuffered) then
FillRect(BufferDC, Rect(0, 0, Width, Height), Brush.Handle);

FCanvas.Lock;
try
Canvas.Handle := BufferDC;
TControlCanvas(Canvas).UpdateTextFlags;
Paint;
//Canvas.Brush.Color := Random(256*256*256);
//Canvas.FillRect(Updaterect);
finally
FCanvas.Handle := 0;
FCanvas.Unlock;
end;

if IsDrawHelper and(csDesigning in ComponentState) then
begin
SetBkColor(BufferDC, RGB(127,255,255));
DrawFocusRect(BufferDC, self.ClientRect);//self.ClientRect);// for Design
end;

// restore coord
if (not DoubleBuffered){ and (not FCachedBuffer)} then
SetViewportOrgEx(BufferDC, SaveViewport.X, SaveViewport.Y, nil);

if not DoubleBuffered then
begin
if not FCachedBuffer then
BitBlt(DC, UpdateRect.Left, UpdateRect.Top, UpdateRect.Width, UpdateRect.Height, BufferDC, 0, 0, SRCCOPY)
else
begin
//BitBlt(DC, UpdateRect.Left, UpdateRect.Top, UpdateRect.Width, UpdateRect.Height, BufferDC, UpdateRect.Left, UpdateRect.Top, SRCCOPY);
BitBlt(DC, UpdateRect.Left, UpdateRect.Top, UpdateRect.Width, UpdateRect.Height, BufferDC, 0, 0, SRCCOPY);
DeleteObject(Region);
end;
DeleteDC(BufferDC);
end;

if not FCachedBuffer and (BufferBitMap <> 0) then DeleteObject(BufferBitMap);
end;
*)
{$ENDREGION} {$endif}

{ TODO -cMAJOR : 22.02.2013:
See: PaintHandler,
need eliminate duplication of code! }
procedure TEsCustomControl.PaintWindow(DC: HDC);
var
TempDC: HDC;
UpdateRect: TRect;
//---
BufferDC: HDC;
BufferBitMap: HBITMAP;
Region: HRGN;
SaveViewport: TPoint;
BufferedThis: Boolean;
begin
BufferBitMap := 0;
Region := 0;

if GetClipBox(DC, UpdateRect) = ERROR then
UpdateRect := ClientRect;

BufferedThis := not BufferedChildrens;

if BufferedThis then
begin
//------------------------------------------------------------------------------------------------
// Dublicate code, see PaintHandler
//------------------------------------------------------------------------------------------------
// if control not double buffered then create or assign buffer
if not DoubleBuffered then
begin
BufferDC := CreateCompatibleDC(DC);
// CreateCompatibleDC(DC) return 0 if Drawing takes place to MemDC(buffer):
// return <> 0 => need to double buffer || return = 0 => no need to double buffer
if BufferDC <> 0 then
begin
// Using the cache if possible
if FIsCachedBuffer or FIsFullSizeBuffer then
begin
// Create cache if need
if CacheBitmap = 0 then
begin
BufferBitMap := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
// Assign to cache if need
if FIsCachedBuffer then
CacheBitmap := BufferBitMap;
end
else
BufferBitMap := CacheBitmap;

// Assign region for minimal overdraw
Region := CreateRectRgnIndirect(UpdateRect);//0, 0, UpdateRect.Width, UpdateRect.Height);
SelectClipRgn(BufferDC, Region);
end
else
// Create buffer
BufferBitMap := CreateCompatibleBitmap(DC, RectWidth(UpdateRect), RectHeight(UpdateRect));
// Select buffer bitmap
SelectObject(BufferDC, BufferBitMap);
// [change coord], if need
// Moving update region to the (0,0) point
if not(FIsCachedBuffer or FIsFullSizeBuffer) then
begin
GetViewportOrgEx(BufferDC, SaveViewport);
SetViewportOrgEx(BufferDC, -UpdateRect.Left + SaveViewport.X, -UpdateRect.Top + SaveViewport.Y, nil);
end;
end
else
BufferDC := DC;
end
else
BufferDC := DC;
//------------------------------------------------------------------------------------------------
end else
BufferDC := DC;

if not(csOpaque in ControlStyle) then
if ParentBackground then
begin
if FIsCachedBackground then
begin
if CacheBackground = 0 then
begin
TempDC := CreateCompatibleDC(DC);
CacheBackground := CreateCompatibleBitmap(DC, ClientWidth, ClientHeight);
SelectObject(TempDC, CacheBackground);
DrawBackground(TempDC); //DrawParentImage(Self, TempDC, False);
DeleteDC(TempDC);
end;
TempDC := CreateCompatibleDC(BufferDC);
SelectObject(TempDC, CacheBackground);
if not FIsCachedBuffer then
BitBlt(BufferDC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), TempDC,
UpdateRect.Left, UpdateRect.Top, SRCCOPY)
else
BitBlt(BufferDC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), TempDC,
UpdateRect.Left, UpdateRect.Top, SRCCOPY);
DeleteDC(TempDC);
end
else
DrawBackground(BufferDC); //DrawParentImage(Self, BufferDC, False);
end else
if (not DoubleBuffered or (DC <> 0)) then
if not IsStyledClientControl(Self) then
FillRect(BufferDC, ClientRect, Brush.Handle)
else
begin
SetDCBrushColor(BufferDC,
ColorToRGB({$ifdef VER230UP}StyleServices.GetSystemColor(Color){$else}Color{$endif}));
FillRect(BufferDC, ClientRect, GetStockObject(DC_BRUSH));
end;

FCanvas.Lock;
try
Canvas.Handle := BufferDC;
TControlCanvas(Canvas).UpdateTextFlags;

if Assigned(FOnPainting) then
FOnPainting(Self, Canvas, ClientRect);
Paint;
if Assigned(FOnPaint) then
FOnPaint(Self, Canvas, ClientRect);
finally
FCanvas.Handle := 0;
FCanvas.Unlock;
end;

if BufferedThis then
begin
//------------------------------------------------------------------------------------------------
// Dublicate code, see PaintHandler
//------------------------------------------------------------------------------------------------
// draw to window
if not DoubleBuffered then
begin
if not(FIsCachedBuffer or FIsFullSizeBuffer) then
begin
// [restore coord], if need
SetViewportOrgEx(BufferDC, SaveViewport.X, SaveViewport.Y, nil);
BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC, 0, 0, SRCCOPY);
end
else
begin
BitBlt(DC, UpdateRect.Left, UpdateRect.Top, RectWidth(UpdateRect), RectHeight(UpdateRect), BufferDC,
UpdateRect.Left, UpdateRect.Top, SRCCOPY);
end;
end;

if (BufferDC <> DC) then
DeleteObject(BufferDC);
if Region <> 0 then
DeleteObject(Region);
// delete buufer, if need
if not FIsCachedBuffer and (BufferBitMap <> 0) then
DeleteObject(BufferBitMap);
//------------------------------------------------------------------------------------------------
end;
end;

function TEsCustomControl.IsBufferedChildrensStored: Boolean;
begin
Result := not ParentBufferedChildrens;
end;

procedure TEsCustomControl.SetBufferedChildrens(const Value: Boolean);
begin
if Value <> FBufferedChildrens then
begin
FBufferedChildrens := Value;
FParentBufferedChildrens := False;
NotifyControls(CM_PARENT_BUFFEREDCHILDRENS_CHANGED);
end;
end;

procedure TEsCustomControl.SetIsCachedBackground(Value: Boolean);
begin
if Value <> FIsCachedBackground then
begin
FIsCachedBackground := Value;
if not FIsCachedBackground then BitMapDeleteAndNil(CacheBackground);
end;
end;

procedure TEsCustomControl.SetIsCachedBuffer(Value: Boolean);
begin
if Value <> FIsCachedBuffer then
begin
FIsCachedBuffer := Value;
if not FIsCachedBuffer then BitMapDeleteAndNil(CacheBitmap);
end;
end;

procedure TEsCustomControl.SetIsDrawHelper(const Value: Boolean);
begin
FIsDrawHelper := Value;
if csDesigning in ComponentState then Invalidate;
end;

procedure TEsCustomControl.SetIsOpaque(const Value: Boolean);
begin
if Value <> (csOpaque in ControlStyle) then
begin
if Value then
begin
ControlStyle := ControlStyle + [csOpaque];
end else
begin
ControlStyle := ControlStyle - [csOpaque];
end;
Invalidate;
end;
end;

procedure TEsCustomControl.SetParentBufferedChildrens(const Value: Boolean);
begin
//FParentBufferedChildrens := Value;
if Value <> FParentBufferedChildrens then
begin
// if (Parent <> nil) and Value then
// begin
// if Parent is TESCustomControl then
// BufferedChildrens := TESCustomControl(Parent).BufferedChildrens
// else
// BufferedChildrens := False;
// end
// else
// if Value then
// BufferedChildrens := False;
// FParentBufferedChildrens := Value;
FParentBufferedChildrens := Value;
if (Parent <> nil) and not (csReading in ComponentState) then
Perform(CM_PARENT_BUFFEREDCHILDRENS_CHANGED, 0, 0);
end;
end;

procedure TEsCustomControl.SetTransparent(const Value: Boolean);
begin
ParentBackground := Value;
end;

procedure TEsCustomControl.UpdateBackground;
begin
UpdateBackground(True);
end;

procedure TEsCustomControl.UpdateText;
begin
end;

procedure TEsCustomControl.UpdateBackground(Repaint: Boolean);
begin
// Delete cache background
if CacheBackground <> 0 then BitMapDeleteAndNil(CacheBackground);
if Repaint then Invalidate;
end;

procedure TEsCustomControl.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
if DoubleBuffered {and not(csOpaque in ControlStyle)} then
begin
Inherited;
Message.Result := 1;
exit;
end;
if ControlCount <> 0 then
DrawBackgroundForOpaqueControls(Message.DC);
Message.Result := 1;
end;

//procedure TEsCustomControl.WMNCHitTest(var Message: TWMNCHitTest);
//begin
// if (FIsTransparentMouse) and not(csDesigning in ComponentState) then
// Message.Result := HTTRANSPARENT
// else
// inherited;
//end;

procedure TEsCustomControl.WMPaint(var Message: TWMPaint);
begin
ControlState := ControlState + [csCustomPaint];
if BufferedChildrens and (not FDoubleBuffered or (Message.DC <> 0)) then
begin
PaintHandler(Message)// My new PaintHandler
end
else
inherited;// WMPaint(Message);
ControlState := ControlState - [csCustomPaint];
end;

procedure TEsCustomControl.WMSize(var Message: TWMSize);
begin
DeleteCache;
inherited;
end;

procedure TEsCustomControl.WMWindowPosChanged(var Message: TWMWindowPosChanged);
begin
if not (csOpaque in ControlStyle) and ParentBackground{ and not CachedBackground }then
Invalidate;
Inherited;
end;

{$IFDEF VER180UP}
{ TEsBaseLayout }

procedure TEsBaseLayout.AdjustClientRect(var Rect: TRect);
begin
inherited AdjustClientRect(Rect);
if BorderWidth <> 0 then
begin
InflateRect(Rect, -Integer(BorderWidth), -Integer(BorderWidth));
end;
end;

procedure TEsBaseLayout.AlignControls(AControl: TControl; var Rect: TRect);
begin
inherited AlignControls(AControl, Rect);
if (csDesigning in ComponentState) and IsDrawHelper then
Invalidate;
end;

procedure TEsBaseLayout.CalcContentMargins(var Margins: TContentMargins);
begin
Margins.Create(Padding.Left, Padding.Top, Padding.Right, Padding.Bottom);
if BorderWidth <> 0 then
Margins.Inflate(Integer(BorderWidth), Integer(BorderWidth));
end;

function TEsBaseLayout.ContentMargins: TContentMargins;
begin
Result.Reset;
CalcContentMargins(Result);
end;

function TEsBaseLayout.ContentRect: TRect;
var
ContentMargins: TContentMargins;
begin
Result := ClientRect;

ContentMargins.Reset;
CalcContentMargins(ContentMargins);

Inc(Result.Left, ContentMargins.Left);
Inc(Result.Top, ContentMargins.Top);
Dec(Result.Right, ContentMargins.Right);
Dec(Result.Bottom, ContentMargins.Bottom);

{$ifdef TEST_CONTROL_CONTENT_RECT}
if Result.Left > Result.Right then
Result.Right := Result.Left;
if Result.Top > Result.Bottom then
Result.Bottom := Result.Top;
{$endif}
end;

procedure TEsBaseLayout.Paint;
begin
if (csDesigning in ComponentState) and IsDrawHelper then
DrawControlHelper(Self, [hoBorder, hoPadding, hoClientRect]);
end;

procedure TEsBaseLayout.SetBorderWidth(const Value: TBorderWidth);
begin
if Value <> FBorderWidth then
begin
FBorderWidth := Value;
Realign;
Invalidate;
end;
end;

{ TEsGraphicControl }

procedure TEsGraphicControl.CalcContentMargins(var Margins: TContentMargins);
begin
if FPadding <> nil then
Margins.Create(Padding.Left, Padding.Top, Padding.Right, Padding.Bottom)
else
Margins.Reset;
end;

function TEsGraphicControl.ContentMargins: TContentMargins;
begin
Result.Reset;
CalcContentMargins(Result);
end;

function TEsGraphicControl.ContentRect: TRect;
var
ContentMargins: TContentMargins;
begin
Result := ClientRect;

ContentMargins.Reset;
CalcContentMargins(ContentMargins);

Inc(Result.Left, ContentMargins.Left);
Inc(Result.Top, ContentMargins.Top);
Dec(Result.Right, ContentMargins.Right);
Dec(Result.Bottom, ContentMargins.Bottom);

{$ifdef TEST_CONTROL_CONTENT_RECT}
if Result.Left > Result.Right then
Result.Right := Result.Left;
if Result.Top > Result.Bottom then
Result.Bottom := Result.Top;
{$endif}
end;

destructor TEsGraphicControl.Destroy;
begin
FPadding.Free;
inherited;
end;

function TEsGraphicControl.GetPadding: TPadding;
begin
if FPadding = nil then
begin
FPadding := TPadding.Create(nil);
FPadding.OnChange := PaddingChange;
end;
Result := FPadding;
end;

function TEsGraphicControl.HasPadding: Boolean;
begin
Result := FPadding <> nil;
end;

procedure TEsGraphicControl.PaddingChange(Sender: TObject);
begin
AdjustSize;
Invalidate;
if (FPadding.Left = 0) and (FPadding.Top = 0) and (FPadding.Right = 0) and (FPadding.Bottom = 0) then
FreeAndNil(FPadding);
end;

procedure TEsGraphicControl.Paint;
begin
if (csDesigning in ComponentState) and IsDrawHelper then
DrawControlHelper(Self, [hoPadding, hoClientRect]);
end;

procedure TEsGraphicControl.SetIsDrawHelper(const Value: Boolean);
begin
if FIsDrawHelper <> Value then
begin
FIsDrawHelper := Value;
if csDesigning in ComponentState then
Invalidate;
end;
end;

procedure TEsGraphicControl.SetPadding(const Value: TPadding);
begin
Padding.Assign(Value);
end;

{ TContentMargins }

constructor TContentMargins.Create(Left, Top, Right, Bottom: TMarginSize);
begin
Self.Left := Left;
Self.Top := Top;
Self.Right := Right;
Self.Bottom := Bottom;
end;

procedure TContentMargins.Reset;
begin
Left := 0;
Top := 0;
Right := 0;
Bottom := 0;
end;

function TContentMargins.Height: TMarginSize;
begin
Result := Top + Bottom;
end;

procedure TContentMargins.Inflate(DX, DY: Integer);
begin
Inc(Left, DX);
Inc(Right, DX);
Inc(Top, DY);
Inc(Bottom, DY);
end;

procedure TContentMargins.Inflate(DLeft, DTop, DRight, DBottom: Integer);
begin
Inc(Left, DLeft);
Inc(Right, DRight);
Inc(Top, DTop);
Inc(Bottom, DBottom);
end;

function TContentMargins.Width: TMarginSize;
begin
Result := Left + Right;
end;
{$ENDIF}

end.


Но лучше использовать бесплатную библиотеку VCL компонентов EsVclComponents, которая содержит в себе данные модули и еще много интересных компонентов и классов:

https://github.com/errorcalc/FreeEsVclComponents

Посмотрите примеры, особенно "\Samples\BufferedChildrens", где видно "магию" подавления мерцания.

Возможно стоит написать отдельную обзорную статью о данной библиотеке?



Спасибо что дочитали статью до конца!

Надеюсь я помог вам побороть проблему мерцания в ваших приложениях и компонентах.


Original source: habrahabr.ru.

https://habrahabr.ru/post/318876/?utm_source=habrahabr&utm_medium=rss&utm_campaign=best

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
sova007

Новогоднее

Воскресенье, 01 Января 2017 г. 23:31 (ссылка)














Метки:   Комментарии (3)КомментироватьВ цитатник или сообщество
gemchuginkaII

С НОВЫМ ГОДОМ!

Воскресенье, 01 Января 2017 г. 19:09 (ссылка)

Смотреть видео в полной версии
Смотреть это видео







Csfnv-muSjyASW5CXYFCJM6qqvw (500x473, 1000Kb)

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
Натали-Наталка

С Новым годом! С новым счастьем!

Воскресенье, 01 Января 2017 г. 18:54 (ссылка)


































































Подари мне на Новый Год

Бесконечную веру в нас…

В то, что даже в плену забот

Будет литься тепло из глаз…

Веру в то, что для нас с тобой

Не окажется пыткой быт…

В то, что буду твоей судьбой,

А не поводом для обид…





Подари мне на Новый Год

То, чего не купить вовек…

Знаешь, жизнь, как цветочный мёд,

Если любящий человек

Обнимает, когда рассвет

Освещает снежинок слёт…

Просто главный любви секрет –

Отдавать и любить за всё…





Подари мне на Новый Год

Не машину и не кольцо,

А надежду, что боль пройдёт…

Спрячь в ладони моё лицо…

Мне не страшно закрыть глаза

И уснуть на плече твоём…

Я не против, я только «ЗА!»

Счастье – это когда вдвоём…





Подари мне на Новый Год

Самый нежный любимый взгляд.

Без него этот мир – лишь лёд…

Я давно не смотрю назад…

Настоящее – это ты…

Все желанья, мечты не в счёт…

Мне хватает одной мечты –

Быть с тобой каждый Новый Год…





Ирина Самарина-Лабиринт



0a290eb9d7c848363073f2ac7510b981 (489x356, 223Kb)



 










 (130x77, 20Kb)

Метки:   Комментарии (5)КомментироватьВ цитатник или сообщество
ЗАБАВА-ЛЮБАВА

С НОВЫМ ГОДОМ!

Воскресенье, 01 Января 2017 г. 17:03 (ссылка)


16 (488x581, 399Kb)4239794_126958345_4239794_10867246 (116x142, 57Kb)                                                                                                                                                                                                                                                                                                                                                                                               Прошел ещё один не легкий год  



    И следующий придёт вот-вот,


    Желаю в новом я году

    Удачи яркую звезду.

   

    Достатка пожелаю я,

    Осуществится пусть мечта.

    Пусть лучше будет этот год,

    Здоровья счастья принесет!

   

    С Новым годом поздравляю

    И желаю в этот год,

    Каждый день чтоб был счастливым,

    Без печалей и хлопот!


4239794_126958346_4239794_94983334_4059776_0_9469d_5896586_S_jpg (94x150, 30Kb)

Метки:   Комментарии (0)КомментироватьВ цитатник или сообщество
Evany

С НОВЫМ ГОДОМ!

Воскресенье, 01 Января 2017 г. 13:38 (ссылка)


4428840_2017 (571x203, 25Kb)



Дорогие мои, друзья, читатели и гости!



От всего сердца поздравляю вас с Новым 2017 годом!



Пусть всегда вас окружает только атмосфера любви и добра, а удача сопровождает вас во всех делах!



Пусть все загаданное исполнится в этом новом году!



С Новым годом, с новым счастьем,

С новым жизненным витком,

Я желаю, чтобы радость

В Новый год пришла в твой дом.

Чтоб любовь, как теплой шалью,

Укрывала от невзгод,

Все мечты и все желания,

Чтоб исполнил Новый год 



4428840_2_1_ (699x437, 131Kb)



 

Метки:   Комментарии (4)КомментироватьВ цитатник или сообщество

Следующие 30  »

<с новым годом! - Самое интересное в блогах

Страницы: [1] 2 3 ..
.. 10

LiveInternet.Ru Ссылки: на главную|почта|знакомства|одноклассники|фото|открытки|тесты|чат
О проекте: помощь|контакты|разместить рекламу|версия для pda