I often think that if a component can display it according to the appearance you want, what is a piece of Cool, this article is going to be a beautiful appearance, but what is good? Button?
Master breakthrough
>
About the definition of yourself
Button,
as well as
Checkbox
Practice
Button
From
CustomPanel
inherit
,
Overload
Paint
Method to paint appearance
.
If you are interested in
,
Can look for it
,
Not doing here
Button
In
,
Do one
Memo
How?
.
? It is a good idea.
Let's first have a name called TCOOLMEMO. The above articles have already talked a lot of components, and only a few key points here. Not much more.
First, the MEMO is inherited from a CustomMemo, which is a look: a flat, the border is a line that can be set, the corresponding color variable is fedgecolor, and there is another box, there is another box, and another box. When the mouse enters MEMO, this box will display when the mouse is left, and the color is disappeared, and the color can also be set, the corresponding variable is FenterColor.
So how to judge the mouse into and leaving, here MEMO will take two Delphi internal messages:
// The following two get the internal message of Delphi, when the mouse enters and leaves
Procedure CmmouseEnter (Var Message: TMESSAGE); Message Cm_MouseEnter;
Procedure CmmouseLeave (Var Message: TMESSAGE); Message Cm_MouseLeave;
In fact, the parent class has intercepted these two messages and made corresponding processing, so the message processing function in TCOOLMEMO is
INHERITED; make your own processing. Here is a variable here.
Mousein: boolean; / / Identify if the mouse enters the component
Next, TCOOLMEMO will also take two messages:
Procedure WmPaint (Var Message: TMESSAGE); Message WM_Paint;
Procedure WmncCalcsize (VAR Message: twmncccalcsize; message wm_nccalcsize;
The first is very familiar, when you need to call back, trigger the message,
The second is that when the form needs to calculate the location and size, the message contains the size of the window client area, and we use this purpose mainly to narrow the customer zone three pixels to draw components. Area.
Procedure TcoolMemo.wmnccalcSize (var message: twmnccalcsize);
Begin
inherited;
INFLATERECT (Message.calcSize_Params ^ .RGRC [0], -3, -3);
END;
The above message processing function, cm_mouseenter and cm_mouselave; will cause TCOOLMEMO's appearance, WM_PAINT saves its appearance to not be wiped. So use a function of a picture component, namely:
Drawborder;
The GDI function of several APIs is used inside. I have a detailed explanation in the code, plus yourself, it should be understandable.
In addition, compared to MEMO, it expands such a function: set the margin and the position of the cursor. These two corresponding sex are margin, position. They are all public, and they cannot be seen in the object viewer.
Let's take a part
Margin setting
Property Margin: Byte Read FMargin Write setMargin Default 0; two of where two messages are sent in the setmargin function:
/ / This message acquires the size of the input area
SendMessage (Handle, EM_GETRECT, 0, longint);
/ / This message sets the size of the input area
SendMessage (Handle, EM_SETRECT, 0, Longint (@Rect));
The position of the cursor:
Property Position: tposition read getposition;
TPOSTION is a structure, with two values and column values:
TPosition = Record // Specify the row and columns of the cursor
Row: longint;
Col: longint;
END;
GetPosition; There is also a problem in Chinese. The code has a detailed description. If there is Chinese in the text, the correct row and columns can be obtained.
Finally, two events have been added
Property Onenter;
Property onExit;
They are all evolved from the parent class, in fact, CM_MOUSEENTER and CM_MouseLeave; the message is caused. When you want to make a triple button, these two events have a role.
Ok, the focus is above, the following is the source code, which also have a detailed description:
Unit coolmemo;
Interface
Uses
Windows, Messages, Classes, Forms, Controls, Graphics, Stdctrls
Type
// White with setting edge
TPosition = Record // Specify the row and columns of the cursor
Row: longint;
Col: longint;
END;
TCOOLMEMO = Class (TCUSTOMMEMO)
Private
FMargin: Byte; // Marged size
FedgeColor: Tcolor; // Border Color
FENTERCOLOR: TCOLOR; // Box color on the edge of the border
Mousein: boolean; / / Identify if the mouse is entered
Function getPosition: tposition; // Cursor row and column
Procedure setmargin (value: byte);
Procedure setEdgeColor (Value: tcolor);
Procedure STENTERCOLOR (Value: tcolor);
// The following two get the internal message of Delphi, when the mouse enters and leaves
Procedure CmmouseEnter (Var Message: TMESSAGE); Message Cm_MouseEnter;
Procedure CmmouseLeave (Var Message: TMESSAGE); Message Cm_MouseLeave;
// When the appearance of a window must be drawn, the application sends this message to the window.
Procedure WmPaint (Var Message: TMESSAGE); Message WM_Paint;
// The form is triggered when the location needs to calculate the position and size.
// We use this purpose mainly to narrow three pixels in order to draw components.
Procedure WmncCalcsize (VAR Message: twmncccalcsize; message wm_nccalcsize;
protected
/ / The border of the drawing is a more beautiful.
Procedure drawborder;
public
Constructor Create (Aowner: Tcomponent); OVERRIDE;
Property Position: tposition read getPosition; Property margin: byte Read FMargin Write setMargin Default 0;
Published
Property EdgeColor: Tcolor Read Fedgecolor Write SetEdgeColor Default $ FF0000;
Property Entercolor: Tcolor Read Fentercolor Write setEntercolor Default $ 0000FF;
// Explicitly the attribute of the parent class
Property Align;
Property alignment;
Property Dragcursor;
Property Dragmode;
Property enabled;
Property Color;
Property font;
Property Lines;
Property Maxlength;
Property Oemconvert;
Property Parentfont;
Property Parentshowhint;
Property Popupmenu;
Property Readonly;
Property Showhint;
Property scrollbars;
Property Taborder;
Property Tabstop;
Property visible;
Property Wantreturns;
Property Wanttabs;
Property WordWrap;
Property onchange;
Property Onclick;
Property OnDBLClick;
Property OnDragDrop;
Property OnDragover;
Property Oneenddrag;
// Increase these two events, process the mouse to enter and leave
Property Onenter;
Property onExit;
Property onkeyDown;
Property OnkeyPress;
Property onkeyup;
Property OnMouseDown;
Property OnMouseMove;
Property OnMouseup;
Property onstartdrag;
END;
PROCEDURE register;
IMPLEMentation
PROCEDURE register;
Begin
RegisterComponents ('Samples', [TCOOLMEMO]);
END;
Constructor TCOOLMEMO.CREATE (Aowner: Tcomponent);
Begin
Inherited Create (Aowner);
ControlStyle: = ControlStyle - [csframed];
Parentfont: = true;
Fedgecolor: = $ ff0000;
FENTERCOLOR: = $ 0000FF;
// Set the appearance, the plane is boundless
CTL3D: = FALSE;
FMargin: = 0;
Borderstyle: = bsnone;
HEIGHT: = 150;
Width: = 200;
END;
Procedure tcoolmemo.setmargin (value: byte);
VAR
RECT: TRECT;
Begin
/ / This message gets the size of the client area
SendMessage (Handle, EM_GETRECT, 0, longint);
/ / The following is a re-determination size
Rect.top: = Value;
Rect.Left: = value;
Rect.right: = Width -Value; Rect.Bottom: = Height -Value;
/ / This message sets the size of the client area
SendMessage (Handle, EM_SETRECT, 0, Longint (@Rect));
FMargin: = Value;
END;
Function TCOOLMEMO.GETPSITION: TPOSITION;
VAR
Row,
COL
: longint;
CBLines: longint;
Str: wideString;
Begin
// This message acquires the line of the cursor,
Row: = sendMessage (Handle, EM_LINEFROMCHAR, SELSTART, 0);
/ / The message acquires the position started at the row of the cursor, and the position starts from the first row of 0,
/ / Add 1 for each character,
Cblines: = sendMessage (Handle, EM_LINDEX, ROW, 0);
/ / Get the row of the cursor
COL
= SELSTART-CBLINES;
/ / In order to solve Chinese problems, you need to use a wide character pattern to obtain the cursor.
// The string before the cursor is located in the row, which can solve the problem of the number of Chinese columns.
Str: = COPY (LINES [ROW], 1, COL);
Col: = Length (STR) 1;
Result.row: = ROW 1;
Result.col: = COL;
END;
Procedure TcoolMemo.setedgeColor (Value: tcolor);
Begin
IF fedgecolor <> value kil
Begin
Fedgecolor: = Value;
Drawborder;
END;
END;
Procedure TcoolMemo.setentercolor (Value: tcolor);
Begin
IF fentercolor <> Value Then
Begin
FENTERCOLOR: = Value;
Drawborder;
END;
END;
Procedure TcoolMemo.cmmouseEnter (Var Message: tMessage);
Begin
inherited;
Mousein: = true;
Drawborder;
END;
Procedure TcoolMemo.cmmouseLeave (Var message: tMessage);
Begin
inherited;
Mousein: = false;
Drawborder;
END;
Procedure TcoolMemo.wmpaint (Var message: tMessage);
Begin
inherited;
Drawborder;
END;
Procedure TcoolMemo.wmnccalcSize (var message: twmnccalcsize);
Begin
inherited;
INFLATERECT (Message.calcSize_Params ^ .RGRC [0], -3, -3);
END;
Procedure TcoolMemo.drawborder;
VAR
DC: HDC; // Device Description Table
R: TRECT; / / Customer area
Enterbrush, Outerbrush, Borderbrush: Hbrush; // Brush handle, API
Begin
DC: = getWindowDC (Handle); / / A device description table for this component
Try
GetWindowRect (Handle, R); / / A customer area size of this component
OffsetRect (r, -r.left, -r.top); // Left offset
// Create a brush, two, separate code borders, border, white brush Borderbrush: = Createsolidbrush (Colortorgb (FedgeColor);
Enterbrush: = CreateSolidbrush (Colortorgb (FENTERCOLOR));
Outerbrush: = Createsolidbrush (Colortorgb (CLWHITE));
// Not (Csdesigning In ComponentState guarantees unchanged during design)
IF (csdesigning in componentstate) and
(Mousein = true) Then // If the mouse enters
Begin
// Draw a rectangular box with Borderbrush brush
Framerect (DC, R, Borderbrush);
// narrow the R to a pixel
INFLATERECT (R, -1, -1);
/ / Draw a rectangular box and use Outerbrush brush
FrameRECT (DC, R, Outerbrush);
INFLATERECT (R, -1, -1);
FrameRECT (DC, R, Enterbrush);
end
Else // If the mouse does not enter
Begin
Framerect (DC, R, Borderbrush);
INFLATERECT (R, -1, -1);
FrameRECT (DC, R, Outerbrush);
INFLATERECT (R, -1, -1);
FrameRECT (DC, R, Outerbrush);
END;
Finally
ReleaseDC (Handle, DC); // Release Device Description Table
END;
DeleteObject (borderbrush); // Release brush
DeleteObject (Enterbrush);
DeleteObject (OuterBrush);
END;
End.
Get it to install it, it is much better than Memo1, and the function is also strong. is it.
At that, three components have been made, it is not very complicated, as long as it is clear. It seems that this component can be ended here, but it has not yet. We seem to have not done non-visual components. So I think the last one is to do a non-visual component. Want to know what, look down.
