Mega Code Archive
Text Box
<![CDATA[
Title: Text Box
Question: How to create sizeble text box (something like Microsoft Office text box)
Answer:
unit Unit1;
interface
uses
Windows, Messages, Classes, Forms, Dialogs, StdCtrls, Controls;
type
TForm1 = class(TForm)
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
end;
var
Form1: TForm1;
lst : cardinal;
lst_font : cardinal;
lst_def_proc : pointer;
function lst_proc (handle : cardinal; msg : cardinal; wparam : cardinal; lparam : cardinal) : integer; stdcall;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
// Create a control (text box). You may add es_left, es_center or es_right to the style parameter to set text alignment.
// es_multiline is added to style to allow entering multiple lines.
lst := CreateWindowEx(
ws_ex_clientedge,
'edit', 'initial text here',
ws_visible or ws_child or es_multiline or es_wantreturn,
10, 10, 200, 100,
memo1.handle, 0, hinstance, nil
);
// To be able to move a control, we will have to catch and process messages that lst will receive. To do this, we have
// to specify a function that messages will go through. It is done by SetWindowLong() function with gwl_wndproc as
// nIndex parameter. Return value will be pointer of previous (default) procedure - we have to store this value because
// we will have to call this procedure.
lst_def_proc := pointer(SetWindowLong(lst, gwl_wndproc, integer(@lst_proc)));
// Next function sets focus. Delete it, if you don't want to force focusing of created control.
windows.SetFocus(lst);
// There are several ways of making font for control. You may use CreateFont() function (look at MSDN for parameters,
// http://msdn.microsoft.com/), you may use TFont variable (var f : TFont; ... f := TFont.Create;) and then specify
// f.handle as a wParam parameter in SendMessage() function. You may also use some of existing fonts, for example,
// font used in Memo1 (in such case specify Memo1.Font.Handle as a wParam parameter in SendMessage() function).
// In this example I use CreateFont to make a font for control, so I needed a variable that holds a handle of font.
lst_font := CreateFont(-12, 0, 0, 0, 0, 0, 0, 0, default_charset, 0, 0, default_quality, default_pitch, 'Courier New');
SendMessage(lst, wm_setfont, lst_font, 0);
end;
function lst_proc (handle : cardinal; msg : cardinal; wparam : cardinal; lparam : cardinal) : integer; stdcall;
begin
// Now we will try to change a border when control will receive/lose focus.
case msg of
wm_setfocus : begin // control receives a focus
SetWindowLong(handle, gwl_style, GetWindowLong(handle, gwl_style) or ws_sizebox);
SetWindowPos(handle, 0, 0, 0, 0, 0, swp_nozorder or swp_nomove or swp_nosize or swp_framechanged);
end;
wm_killfocus : begin // control loses a focus
SetWindowLong(handle, gwl_style, GetWindowLong(handle, gwl_style) and not ws_sizebox);
SetWindowPos(handle, 0, 0, 0, 0, 0, swp_nozorder or swp_nomove or swp_nosize or swp_framechanged);
end;
end;
// Usually you have to call CallWindowProc() to ensure proper working of control. In such case lst_proc must return a
// value that is returned by CallWindowProc() function. However, sometimes you may want to block some messages, for
// example - focusing of a button. In such case calling CallWindowProc() is not necessary, if msg is wm_setfocus. Read
// MSDN to get more information about all of this.
if (msg = wm_nchittest) and (GetFocus = handle) then begin
result := htcaption;
end else begin
result := CallWindowProc(lst_def_proc, handle, msg, wparam, lparam);
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Free memory from font, created with CreateFont() function. If you use TFont variable for creating font, this should
// be f.Destroy (if f is a variable of type TFont) instead of DeleteObject(lst_font).
DeleteObject(lst_font);
// Free memory from a control (text box).
DestroyWindow(lst);
end;
end.
]]>