 Home |
7. Button and Edit controls |
Home |
|
This Example creates Button, Static and Edit controls in a program file called ButEdit.dpr. There are several styles of the button, static and edit controls created in here to demonstrate some of the options available for getting controls that have different looks or uses. There is a single line and a multi-line Edit, there are push, checkbox, radio, bitmap, ownerdraw, and groupbox buttons. There are text and Icon static controls used here. . . . . A very important and useful method called Sub-Classing will be used. In order to get a standard window's control to do what you want it to do, you have to get and process it's messages. Sub-Classing is the way to get those messages and change what the control does or how it looks. |
|
Many Options You have seen how to Create button, edit and static controls before in previous lessions. In the code here more creation and message options are presented for these types of controls. You will need to look at the API Help for CreateWindow( ) and CreateWindowEx( ) to read the explanations for the Style flags avaiable for each control (or the general flag bits like WS_EX_CLIENTEDGE). You can look at the code in the Button Edit program to see how to use use some of these flags to get some of the control features availible from the API. But you will need to try your own creation Flag combinations and experiment with control variations to see what is possible and what effects a flag has, and if it conflicks with another flag. The program code below also shows you how to change the features (style) of some of the controls, Most often the SetWindowLong( ) using GWL_STYLE will change the Style of a control or window (but sometimes it does not, depending on the control and the style bit), see the procedure ChangeStyle; in the program code. Some control options (styles) are changed with special control messages, like BM_SETSTYLE for buttons. Static Controls - Static controls do not normaly get user input, they get no messages for mouse or keyboard events. If you do not move, or change a static control, then you should just draw the Text, Icon or Bitmap on your Main Form's hDC with the forms WM_PAINT message and not use a static control. For each control you create, there are operating system resources allocated and used, like a handle and the window's specifications, so not using a control saves on these system resources. Even if you need the text or image to move (with a form's resize), or change the text or image displayed, you could still draw it in the WM_PAINT and use variables for the position (X and Y), and the Text (a PChar) or Image (a hBitmap or hIcon). But sometimes you might need to use a static control, so some are here to see how they work. Button Controls - Button controls can have many styles and looks, push buttons, check box buttons, radio buttons, combo check box and push buttons, and group box buttons. Look at the style bits for CreateWindow( ) for the buttons in the ButtonEdit code. Look at the creation style bits for hReadOnlyCB, you can combine the style bits BS_AUTOCHECKBOX with BS_PUSHLIKE to get a push button that toggles between Up and Down for a Checked and unchecked effect for a push button. You can also combine the BS_AUTORADIOBUTTON with BS_PUSHLIKE to get a Radio Button effect with a push button, look at hGrpMove1RB. There is also a "Owner Draw" button, where the button is not painted by windows OS, and you have to supply the code to paint this button. See - "hOwnerDraw := CreateWindow('Button','', WS_VISIBLE or WS_CHILD or BS_OWNERDRAW," - - - - and the WM_DRAWITEM message in MessageProc( ). Edit Controls - Edit controls can be single-line or multi-line and have auto scroll options, and text alignment options. Look at the style options for CreateWindow( ) for the EDIT class in the API Help then look at the CreateWindow( ) for hEdit2. It has the ES_MULTILINE style bit, but to get it to have the normal TMemo scrolling you will need to add the ES_AUTOVSCROLL. The WS_VSCROLL or WS_HSCROLL put scroll bars on the multi-line Edit. To use a Muti-line edit you may need to get info about the text selection, number of lines, claret position, and others, you can use SendMessage( ) with a EM_ message. See the "procedure SelectMouse(X,Y: Integer);" in the Button Edit program code below. I want to select a line of text in the muti-line edit that has been clicked on, So I need to know when this edit has been clicked. One way to do this is by processing this edit's mouse messages, you can get these messages by "SubClassing" this control, into your own Window Proc and processing the WM_LBUTTONUP message.
SubClassing Controls, get more messages Only a few of a control's messages are made available in it's parents Window Proc, look at the else if (lParam = hEdit1) then if (HIWORD(wParam) = EN_MAXTEXT)in the WM_COMMAND message of MessageProc( ). This EN_MAXTEXT and a few other notification messages are sent to the parents window. To get all of a controls messages, you will have to have a Window Proc for that control in your code. Subclassing is a way to allow a program to get and process messages (button click, paint, charater) sent to a particular control before they are sent to the system's Window Proc for that type of control. Since a window's "Window Proc" is established by it's Class parameters, changing the Window Proc is called "SubClassing". By subclassing a control, a program can bypass, change, or monitor the behavior of the control. For example, a program could subclass an edit control to stop the edit from accepting certain characters. Controls are subclassed by calling SetWindowLong( ) to replace the address of the function of the window's system Window Proc, with the address of your own Window Proc function for that control, in your code. Then, that new function receives any messages sent to the control. The new message function (Window Proc) can just pass the message to the system Window Proc, process the message and pass it, modify the message and pass it, or process the message and not pass it to the system Window Proc. SubClass setup - You First have to tell the OS about where to send messages for that control with SetWindowLong( ) using the GWL_WNDPROC parameter. This call to SetWindowLong( ) returns the address of the controls's current Window Proc function (usually the original system Window Proc, but a control may be subclassed more than once), which you must use in your program's subclassed Window Proc to get normal control behavior. The following call to SetWindowLong( ) will change hControl Window Proc to the function ControlProc( ) in your program. var
PSystemProc: Pointer;
PSystemProc := Pointer(SetWindowLong(hControl, GWL_WNDPROC,
Integer(@ControlProc)));
the function address @ControlProc has to be TypeCast as an Integer, and the SetWindowLong( ) has to be TypeCast as a Pointer. You must have a ControlProc function like this
function ControlProc(hWnd, Msg, wParam, lParam: Integer): Integer; stdcall;
begin
Result := 0;
case Msg of
WM_CHAR: if wParam = Ord('?') then Exit;
end;
Result := CallWindowProc(PSystemProc,hWnd,Msg,wParam,lParam);
end;
This function has the same parameters and use as the Window Proc's you have seen in earier lessons and the MessageProc( ) in this ButEdit program, but notice that the Result is NOT from DefWindowProc( ). We need to call the original funtion who's address is stored in the pointer PSystemProc usingCallWindowProc(PSystemProc,hWnd,Msg,wParam,lParam); The CallWindowProc( ) will pass the four message parameters to the function specified by it's first parameter. This control's Window Proc will get many of the same messages as the MessageProc, WM_CREATE, WM_PAINT, WM_LBUTTONDOWN and WM_CHAR, , it will also get special messages for that control type like EM_LINEINDEX. It is recommeded to restore the Window Proc when you destroy your Main Window, like this (also see the "procedure ShutDown;" in ButEdit code). SetWindowLong(hControl, GWL_WNDPROC, Integer(PSystemProc));In the ButtonEdit program 2 controls are subclassed, hGroup1 and hEdit2. Look at the Group1Proc( ) and Edit2Proc( ) in the ButtonEdit program code below. The hGroup1 group box is the parent of some button controls, so the button click messages for these buttons are sent to hGroup1, and NOT to hForm1. Also there is a WM_PAINT message, and you will usually need to handle control painting differently than a Form window. Here we call the CallWindowProc( ) first to paint the title and borders of the group box. If you call BeginPaint the PaintStructure rect will be empty after the CallWindowProc( ), and nothing will be painted, so we will use GetDC( ) to get the group box hDC. I get a system check bitmap with LoadBitmap( ) and then create a compatible hDC. The check bitmap is drawn in the title of the group box. A Note - - - Painting in text display controls (edits, listboxes, ect) can be tricky, and may require special methods. hEdit2 will monitor the WM_CHAR messages in it's Edit2Proc( ), and change some of the charaters and block "?" charaters. What if you wanted to have keyboard navigation of your app by pressing the Tab key to shift focus to the next control. You could subclass all the controls you wanted to have as tab stops, and when a WM_CHAR message was a tab key #9, then change focus to next control. That would be alot of subclassing, and there's an easier way. . . See the Tab key change Focus with IsDialogMessage( ) below for some info about this. But first let's look at SetWidowLong( ) some more.
More Uses for SetWindowLong( ) and GetWindowLong( ) You saw how to subClass using the SetWindowLong( ) function above, but there are several other window (control) properties you can change with this function. First I'll talk about the "User Data" interger that every window and control has. The system keeps 4 bytes of User Data for every window, which you can use to store info for that window-control. If you look under the code of creating the hExitBut, you will see SetWindowLong(hExitBut, GWL_USERDATA, 1); which is used to set the value of this user data. And in the procedure ChangeStyle1; this User Data is retrived with LongData := GetWindowLong(hExitBut, GWL_USERDATA); You can think of this user data like the "Tag" property in the Delphi VCL. You can put a Pointer value in this user data to reference a PChar string or a TRect or other, non integer info. Something that is simalar to the user data is the window class "Extra" data (memory). If you look at the wClass field setup you will see wClass.cbWndExtra := 8; Which tells the system to setup 8 bytes of "Extra" window info (memory). If you look at the code below the hForm1 creation you will see SetWindowLong(hForm1, 0, 100); SetWindowLong(hForm1, 4, -1);Which places values in this "Extra" window data. This Extra data is not very useful unless you need to store info with certain window classes that you create. But I wanted to show you that it is availible if you need it. Control ID numbers Controls can have and use ID numbers, you can set ID's in the HMENU parameter of CreateWindow( ) function, or with SetWindowLong(hExitBut, GWL_ID, 55); and get them with IDnum := GetWindowLong(hExitBut, GWL_ID); Control ID's can be useful in some messages (see the WM_DRAWITEM message) and functions, I have not tried to show you much about ID's, thinking that beginners should use Handles for control reference at first.
Changing the creation style with SetWindowLong( ) - To Change the creation style of windows and controls you can try SetWindowLong( ) with the GWL_STYLE. If you look at the code in the procedure ChangeStyle1; and procedure ChangeStyle2; in the program below, you will see the SetWindowLong( ) used with the GWL_STYLE flag. This is used to change the creation style bits for a window, hForm1, an Edit, and several buttons. The hForm1 style is changed from a mouse sizable form to one that is not (WS_SIZEBOX). The hExitBut is changed from a Text button to a Bitmap button in ChangeStyle1, it is changed to an Owner Drawn button in ChangeStyle2. You will probally need to RePaint the control after a style change with InvalidateRect(hExitBut, nil, True); The hEdit1 also has a style change, in StyleChange2 the ES_UPPERCASE is added to it's style, so it will now only add UpperCase letters, but this does not change any text already in the Edit. If you look at ChangeStyle1 I try to change the hEdit1 style to ES_RIGHT (right align text), but this does not work, the Text align remains to the left. Some styles for some controls do not change with a SetWindowLong. If you tried to change the Read Only of hEdit2 with the GWL_STYLE flag, that will not work either, but there is an edit message EM_SETREADONLY that will change the read only property, see the procedure DoReadOnly;. A Note - - - Some controls styles can not be changed with the SetWindowLong( ) or a special control message. In order to change that style, you will need to record all of that control's information (text, section, scroll position) and Destroy the control and then Create the control again, with the style bit you want. For instance, if you need to change the Sort property of a ListBox, you will have to destroy and recreate it. There is no telling if a style change will work with SetWindowLong( ) until you try it and see.
Tab key change Focus with IsDialogMessage( ) In window's dialog boxs, tab key control navigation is automaticly enabled. Tab key presses will move focus to the next control, buttons are pressed with an Enter key press, and focus is moved in a group with an Arrow key press. If you put the IsDialogMessage( ) function in your program's GetMessage( ) loop, it will process the Tab, Enter, Space, Arrow, Home, End and other keys to change focus and click controls that have the WS_TABSTOP style in their CreateWindow( ) function. (see the Win32 API Help for index "IsDialogMessage") So you will not have to subclass all the controls that you want to be a tab stop. But sometimes you need to have the Tab key go to the control and not to IsDialogMessage (with a multi line edit control), you could test the hWnd in GetMessage and not send that message to IsDialogMessage. But IsDialogMessage( ) asks the control the message is for if it wants the message, with a WM_GETDLGCODE message. You can subclass the control and have the Result of the WM_GETDLGCODE indicate what you want IsDialogMessage to do with the message.
Look at the code in ButtonEdit's Edit2Proc( ) below. In the WM_GETDLGCODE message, DLGC_WANTALLKEYS is the Result sent back to the OS, this causes IsDialogMessage to send all of the keyboard input to the Edit2Proc and not capture the tab, enter or arrow keys.
Owner Drawn Buttons In the code of ButEdit we create an "Owner Drawn" Button control with the handle hOwnerDraw and a style bit of BS_OWNERDRAW. We will paint the button with yellow color and put the system check bitmap on it. Since buttons get user input, you will need alot more code to paint it than the owner drawn static control that we did in the last lesson. Keep in mind that the system does not do any default painting for this button, so can draw whatever your creativity can think of, on this button. You may want to look at the Win32 API Help for index "WM_DRAWITEM", and then the index "DRAWITEMSTRUCT". The TDrawItemStruct is defined as - PDrawItemStruct = ^TDrawItemStruct;
tagDRAWITEMSTRUCT = packed record
CtlType: UINT;
CtlID: UINT;
itemID: UINT;
itemAction: UINT;
itemState: UINT;
hwndItem: HWND;
hDC: HDC;
rcItem: TRect;
itemData: DWORD;
end;
TDrawItemStruct = tagDRAWITEMSTRUCT;
DRAWITEMSTRUCT = tagDRAWITEMSTRUCT;Member defintions -CtlType - will have the Type of control being drawn, in this case a "ODT_BUTTON", but there are some for ListBoxs, Menus, Static. You can test this if more than one type of control is Owner Drawn. Let's look at the code for the WM_DRAWITEM message in the MessageProc of the code for ButEdit. Again we have declared a pDrawItem: PDrawItemStruct; variable and set it with pDrawItem := Pointer(LParam); Unlike the owner drawn static, we have to paint this button according to the "State" it is in. There are several different button "States" that are sent in the pDrawItem's itemState member. To see if this button should be painted as enabled, we use this itemState test - if pDrawItem.itemState = ODS_DISABLED then beginand paint the button grey if true, otherwise we paint it yellow. For buttons, we have to paint it to look like it is normal (not pushed, Up) and like it is pushed or "Down". To detect if the button should be painted as pushed or up we use - if (pDrawItem.itemState and ODS_SELECTED) <> 0 thenand draw a sunken Edge if true, and draw a raised Edge if false. The ODS_SELECTED name does not reflect the use here, for a button that is Pushed, but this ODS_SELECTED flag is used for other types of controls when they are in a selected state (listBox, MenuItem). To see if the button should be painted as focused, we use - if pDrawItem.itemState = ODS_FOCUS thenand if true, use DrawFocusRect( ) to draw a "Focus Rectangle" on the button. You can look at the code below for more examples of testing for the State of the button. When you use an Owner Drawn control and have to do all of the "Work" for painting that control, you may begin to appreciate the "Coding Advantage" of an Operating System that does most of the system control "Code Work" for you, like painting and mouse driver input translation. If you are interested in more creative control display options, you will need to experiment with the Owner Drawn controls to get a sense of what you can do when drawing whatever you want on it.
FindFirstFile Function In the program Code there is the ListFiles procedure, which is called to use the API FindFirstFile( ) function and get the names of all the files in a Folder. The FindFirstFile function is very useful for using the OS to do Disk searchs for Folders or Files. In the ListFiles procedure, I first test to see if the folder exists, if it does, then I add the "WildCard" characters "*.*" to the folder name. It is nessary to add the wildcard characters to get any file or folder that is in that Folder. You will see that I set the "Error Mode" for the system to SEM_FailCriticalErrors, if you do not do this then on NT systems if a drive is not avaiable, an Error message Box will be displayed asking to insert a disk, or other Error procedure. Afer the call for FindFirstFile( ) the Error Mode is restored. The FindFirstFile function is called with a TWin32FindData parameter, defined in windows.pas as - type
PWin32FindDataA = ^TWin32FindDataA;
PWin32FindDataW = ^TWin32FindDataW;
PWin32FindData = PWin32FindDataA;
_WIN32_FIND_DATAA = record
dwFileAttributes: Cardinal;
ftCreationTime: TFileTime;
ftLastAccessTime: TFileTime;
ftLastWriteTime: TFileTime;
nFileSizeHigh: Cardinal;
nFileSizeLow: Cardinal;
dwReserved0: Cardinal;
dwReserved1: Cardianl;
cFileName: array[0..MAX_PATH - 1] of Char;
cAlternateFileName: array[0..13] of Char;
end;
_WIN32_FIND_DATA = _WIN32_FIND_DATAA;
TWin32FindDataA = _WIN32_FIND_DATAA;
TWin32FindData = TWin32FindDataA;If the FindFirstFile function is successful and finds a file or folder, it will fill this TWin32FindData record with all the information about that file. The first member of this record is the dwFileAttributes and will have the "Attributes" of the file or folder in bit mask positions of this Cardinal value. The values for this dwFileAttributes can be a combination of these Flag Values -
Some of these file Attributes may not indicate the actual file status, such as FILE_ATTRIBUTE_ARCHIVE and FILE_ATTRIBUTE_SYSTEM. These Attributes may be set, but not be the file's current status. The FILE_ATTRIBUTE_DIRECTORY and the FILE_ATTRIBUTE_HIDDEN will represent the acual status of that Item. |
In this program I try to show you how to use some of the many options availible for static, button and edit controls. Start out by looking at the button creation code like
hIncludeCB := CreateWindow('Button','Include Folders',
WS_VISIBLE or WS_CHILD or BS_AUTOCHECKBOX or BS_TEXT or WS_TABSTOP,
334,104,110,21,hForm1,0,hInstance,nil);This will create a windows Check Box, which is a "Button", even though you may not think of a check box as a button. A style bit of BS_GROUPBOX will create a "Button" that's a Group Box, which doesn't much look or act like a button. Look at the other button creation Style bits and when you see a style bit that you are not familar with like BS_AUTORADIOBUTTON or WS_GROUP, you can look it up in the API Help for CreateWindow, to see what it says about it. There are several suggestions to remove and add style bits like WS_CLIPSIBLINGS to see what effect it will have on the control, you will need to experiment with different options and styles to see what happens to the control or it's behavior. Sometimes the changes are what you expect and often they are not, only by using the different option, will you know what they
do, and weather they will cooperate or conflict with other options or controls.This program demonstrates how to sub-class an Edit control and a Group Box control. Examine the code used for SetWindowLong( ) to sub-class them and the Message functions for them, the function Group1Proc( ) and the function Edit2Proc( ). You will see that many of the same messages are sent to a control as are sent to the main Form, like WM_COMMAND, WM_LBUTTONUP, WM_CHAR, and WM_PAINT. Sub-Classing is a VERY IMPORTANT method to get non-standard behavior or information, that you need, from any control. Sub-classing allows to to have control of what it does, by using or changing the messages. There's alot of code presented here, you may want to create your own project and then add just one or two Button or Edit controls, and use the code examples below to experiment with creation styles, subclassing, changing styles at run time, or painting text instead of using a Static control. Or whatever you want to try and learn about how to do that. see comments in code for more info |
program ButEdit;
{this program will show Button and Edit control creation options
and messaging operations, with some window Style changes}
uses
Windows, Messages, SmallUtils;
{$R *.RES}
var
wClass: TWndClass;
hForm1, hLabel1, hLabel2, hLabel3, hLabel4, hExitBut, hImageBut, hOwnerDraw,
hEdit1, hEdit2, hIncludeCB, hJustTexRB, hJustExeRB, hAllRB, hListFilesBut,
hReadOnlyCB, hGroup1, hWhiteBackRB, hYellowBackRB, hRedBackRB,
hGrpMove1RB, hGrpMove2RB, hGrpMove3RB, hParentCB,
Font1, Font2, Font3, Pen1, hIcon2, hIcon3, hIconBut: Integer;
Brush1, Brush2, Brush3: HBRUSH;
mainMsg: TMSG;
Rect1: TRect;
FontLog1: TLogFont;
TempDC: HDC;
Size1: TSize;
PEdit2Proc, PGroup1Proc: Pointer;
const
ID_ExitBut = 55;
{ID number used by the Exit Button}
procedure ShutDown;
begin
DeleteObject(Font1);
DeleteObject(Font2);
DeleteObject(Font3);
DeleteObject(Brush1);
DeleteObject(Brush2);
DeleteObject(Brush3);
DeleteObject(Pen1);
{Return the SubClass to original}
SetWindowLong(hEdit2, GWL_WNDPROC, Integer(PEdit2Proc));
SetWindowLong(hGroup1, GWL_WNDPROC, Longint(PGroup1Proc));
PostQuitMessage(0);
end;
procedure ListFiles;
var
FindHandle: HWND;
ErrorMode: Word;
FindData: TWin32FindData;
FolderName, FolderStr, FileStr: String;
FileN: PChar;
begin
FolderName := GetWindowStr(hEdit1);
if FolderName[Length(FolderName)] <> '\' then
FolderName := FolderName+'\';
if not DirectoryExists(FolderName) then
begin
MessageBox(hForm1,
PChar('The folder - '+FolderName+' does NOT exist, Files can not be listed'),
'No Folder', MB_OK or MB_ICONERROR);
Exit;
end;
FolderName := FolderName+'*.*';
{you must add the WildCard character * to the FolderName
in order to get Any File in that folder}
FolderStr := '';
FileStr := '';
ErrorMode := SetErrorMode(SEM_FailCriticalErrors);
{Set the Error Mode to avoid the Drive not avaible Errors of the NT systems}
FindHandle := FindFirstFile(@Foldername[1], FindData);
{FindFirstFile will only find ONE file, if you look for more than a single file
you will need to call FindNextFile to continue the search in the same folder}
SetErrorMode(ErrorMode);
FileN := '';
if FindHandle <> INVALID_HANDLE_VALUE then
begin
{You will need to test the file's Data in the FindData
to see if it is the file you are looking for}
if FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
FileN := FindData.cFileName;
if (FileN <> '.') then
FolderStr := String(FileN)+#13#10;
while FindNextFile(FindHandle, FindData) do
begin
FileN := FindData.cFileName;
if (FileN <> '.') and (FileN <> '..') then
begin
if FindData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY then
FolderStr := FolderStr+String(FileN)+#13#10
else
if SendMessage(hAllRB, BM_GETCHECK,0,0) = BST_CHECKED then
FileStr := FileStr+String(FileN)+#13#10
else
if SendMessage(hJustTexRB, BM_GETCHECK,0,0) = BST_CHECKED then
begin
if LowerCase(GetFileExt(String(FileN))) = '.txt' then
FileStr := FileStr+String(FileN)+#13#10;
end else
if SendMessage(hJustExeRB, BM_GETCHECK,0,0) = BST_CHECKED then
begin
if LowerCase(GetFileExt(String(FileN))) = '.exe' then
FileStr := FileStr+String(FileN)+#13#10;
end;
end;
end;
{ALWAYS close the Find Handle}
FindClose(FindHandle);
end else MessageBox(hForm1,
'Invalid find handle',
'No Find First', MB_OK or MB_ICONERROR);
FolderStr := FolderStr+'--------------------------------------------'+#13#10;
if SendMessage(hIncludeCB,BM_GETCHECK,0,0) = BST_CHECKED then
SetWindowText(hEdit2,PChar(FolderStr+FileStr))
else SetWindowText(hEdit2,PChar(FileStr));
FileStr := '';
FolderStr := '';
end;
procedure ChangeStyle1;
var
Style, LongData, DC: Integer;
EBRect: TRect;
begin
EnableWindow(hOwnerDraw,not IsWindowEnabled(hOwnerDraw));
{in a Owner Draw control disable will not be shown unless you
change the painting for disabled control}
{this is to show you that you can change some window and control styles
by calling SetWindowLong with the GWL_STYLE, , , but some styles
can not be changed by calls to change them}
LongData := GetWindowLong(hExitBut, GWL_USERDATA);
{I test the Exit Button's window User Data to change if the button's style
has the WS_VISIBLE bit. The User Data can be used to store any 4 byte value
like an integer, cardinal or pointer}
if Boolean(LongData) then
begin
SetWindowLong(hExitBut,GWL_STYLE,{WS_VISIBLE or} WS_CHILD or BS_PUSHBUTTON or BS_BITMAP);
{I leave out the WS_VISIBLE and BS_TEXT, and add the BS_BITMAP styles to the Exit Button}
GetWindowRect(hExitBut, EBRect);
ScreenToClient(hForm1, EBRect.TopLeft);
ScreenToClient(hForm1, EBRect.BottomRight);
{unlike the ShowWindow function, if you set the style to not visible, the parent window
is NOT redrawn to show this change, so you will need to Invalidate that Rect}
InvalidateRect(hForm1, @EBRect, True);
SetWindowLong(hExitBut, GWL_USERDATA, 0);
{I need to set the User data to zero for Not visible}
end else
begin
SetWindowLong(hExitBut,GWL_STYLE, WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_BITMAP);
SendMessage(hExitBut,BM_SETIMAGE, IMAGE_BITMAP, LoadBitmap(0,MAKEINTRESOURCE(OBM_DNARROW)));
{I get a System bitmap with the LoadBitmap using the MAKEINTRESOURCE and the OBM_DNARROW}
InvalidateRect(hExitBut,nil, True);
SetWindowLong(hExitBut, GWL_USERDATA, 1);
end;
Style := GetWindowLong(hEdit1,GWL_STYLE);
{you can get the style of a control with GetWindowLong and GWL_STYLE
but you have to test the style for style elements (numbers, bits)}
if Style or ES_RIGHT = Style then
SetWindowLong(hEdit1,GWL_STYLE, (Style and Not ES_RIGHT) or ES_LEFT)
else
SetWindowLong(hEdit1,GWL_STYLE, (Style and Not ES_LEFT) or ES_RIGHT);
UpdateWindow(hEdit1);
{using SetWindowLong with GWL_STYLE and ES_RIGHT, does NOT change hEdit1's
style for text placement to ES_RIGHT, some changes of style work and some
do NOT. You can Not change the Read Only style of an edit with GWL_STYLE,
see the code in procedure DoReadOnly below. You will need to try a style
change to see if it works on that window or control}
Style := GetWindowLong(hReadOnlyCB,GWL_STYLE);
if (Style or BS_PUSHLIKE) = Style then
SendMessage(hReadOnlyCB,BM_SETSTYLE,Style and (not BS_PUSHLIKE),1)
else
SendMessage(hReadOnlyCB,BM_SETSTYLE, Style or BS_PUSHLIKE,1);
{SendMessage with BM_SETSTYLE and BS_PUSHLIKE does not change the PushLike property
of hReadOnlyCB}
LongData := GetWindowLong(hForm1,0);
{Since the windows Class for hForm1 was resistered with 8 bytes of Extra window memory
wClass.cbWndExtra := 8; we can get the first Long (4 byte) with
GetWindowLong(hForm1,0);}
DC := GetDC(hForm1);
TextOut(DC, 320,10, PChar(Int2Str(LongData)), Length(Int2Str(LongData)));
ReleaseDC(hForm1, DC);
Inc(LongData);
{Increase the LongData to count the number of times this procedure is called}
SetWindowLong(hForm1,0,LongData);
end;
procedure ChangeStyle2;
var
Style, LongData: Integer;
begin
Style := GetWindowLong(hImageBut,GWL_STYLE);
if (Style or BS_BITMAP) = Style then
begin
{change the style to and from a bitmap button}
SetWindowLong(hImageBut,GWL_STYLE,WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON
or BS_TEXT or BS_BOTTOM or WS_TABSTOP);
InvalidateRect(hImageBut,nil, True);
end else
begin
SetWindowLong(hImageBut,GWL_STYLE,WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or WS_GROUP
or BS_BITMAP or WS_TABSTOP);
InvalidateRect(hImageBut,nil, True);
end;
//WS_OVERLAPPEDWINDOW original style for hForm1
Style := GetWindowLong(hForm1,GWL_STYLE);
if (Style or WS_SIZEBOX) = Style then
begin
SetWindowLong(hForm1,GWL_STYLE,WS_VISIBLE or WS_SYSMENU or WS_CAPTION or WS_MINIMIZEBOX);
RedrawWindow(hForm1,nil,0, RDW_INVALIDATE or RDW_FRAME or RDW_NOCHILDREN);
{use RedrawWindow to invalidate NON-Client areas of a window}
end else
begin
SetWindowLong(hForm1,GWL_STYLE,WS_VISIBLE or WS_SYSMENU or WS_CAPTION or
WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SIZEBOX);
RedrawWindow(hForm1,nil,0, RDW_INVALIDATE or RDW_FRAME or RDW_NOCHILDREN);
end;
LongData := GetWindowLong(hForm1,4);
{the second Long value in the extra class window memory is retrived with
GetWindowLong(hForm1,4); using 4 as the offset to the second 4 byte value}
Style := GetDC(hForm1);
{I use the Style variable for an HDC}
TextOut(Style, 380,10, PChar(Int2Str(LongData)+' '), Length(Int2Str(LongData)+' '));
ReleaseDC(hForm1, Style);
Inc(LongData);
SetWindowLong(hForm1,4,LongData);
Style := GetWindowLong(hExitBut,GWL_STYLE);
{in the next code I change the Exit Button's style to Owner Draw, and it will
now use the WM_OWNERDRAW message to paint the button}
if (Style or BS_OWNERDRAW) = Style then
SetWindowLong(hExitBut,GWL_STYLE, WS_VISIBLE or WS_CHILD or
BS_PUSHBUTTON or BS_TEXT or BS_BOTTOM or WS_TABSTOP)
else
SetWindowLong(hExitBut,GWL_STYLE, WS_VISIBLE or WS_CHILD or BS_OWNERDRAW or WS_TABSTOP);
InvalidateRect(hExitBut,nil, True);
Style := GetWindowLong(hEdit1,GWL_STYLE);
if Style or ES_UPPERCASE = Style then
SetWindowLong(hEdit1,GWL_STYLE, Style and Not ES_UPPERCASE)
else
SetWindowLong(hEdit1,GWL_STYLE, Style or ES_UPPERCASE);
{the style of hEdit1 is changed to Upper Case, and does NOT change the text already in
the edit, only new text added, , you will need to type into hEdit1 to see this effect}
end;
procedure SelectMouse(X,Y: Integer);
var
LineCount, LineCharIndex, CharFromPos, CharLength: Integer;
begin
{this procedure uses Edit control messages to get the line
clicked in hEdit2 and then select that line}
CharFromPos := SendMessage(hEdit2, EM_CHARFROMPOS,0,MAKELPARAM(X, Y));
LineCharIndex := SendMessage(hEdit2, EM_LINEINDEX,HIWORD(CharFromPos),0);
SetWindowText(hLabel2,PChar('Char is '+Int2Str(LoWord(CharFromPos))+
' Line is '+Int2Str(HIWORD(CharFromPos))));
{here are some additional edit messages}
{EM_LINEFROMCHAR
EM_GETFIRSTVISIBLELINE
EM_LINEINDEX
EM_GETSELTEXT
EM_GETLINE}
CharLength := SendMessage(hEdit2, EM_LINELENGTH,LOWORD(CharFromPos),0);
if IsWindowEnabled(hListFilesBut) then
{I only want on click select if it is Read Only so I test the List Files
button to see if it is enabled, you could also get the Style of hEdit2
with Styles := GetWindowLong(hEdit2, GWL_STYLE), see Edit2Proc below}
begin
SendMessage(hEdit2,EM_SETSEL,-1,0);
if (X < 319) and (Y< 126) then
{X < 319 is to make sure the mouse BUTTONUP was inside the listbox
you might check Y also}
begin
LineCount := SendMessage(hEdit2, EM_GETLINECOUNT,0,0);
if LineCount < 1 then Exit;
if LineCount = 1 then SendMessage(hEdit2,EM_SETSEL,0,-1)
else SendMessage(hEdit2, EM_SETSEL, LineCharIndex,
LineCharIndex+ CharLength);
end;
end;
end;
function Group1Proc(hWnd, Msg, WParam, LParam: Integer): Integer; stdcall;
var
GrpBoxDC, BmpDC: HDC;
hCheckBmp: THandle;
procedure SetBack(Brush: HBRUSH);
begin
SetClassLong(hForm1,GCL_HBRBACKGROUND,Brush);
invalidateRect(hForm1,nil,True);
end;
begin
{this is a SubClass Window Proc for hGroup1, the messages for this window
are sent here instead of to the system Window Proc for group box buttons}
{since button click messages are sent to the buttons parent,
we need to have hGroup1 SubClassed and process the radio
buttons click messages to change hForm1 background color}
case Msg of
WM_PAINT: begin
Result := CallWindowProc(PGroup1Proc,hWnd,Msg,wParam,lParam);
{if you want to paint in a control call the CallWindowProc first to have
system do default painting of the control, using BeginPaint is useless because there is no
rcPaint rect after CallWindowProc, so we have to get the DC for the control}
GrpBoxDC := GetDC(hGroup1);
hCheckBmp := LoadBitmap(0,MAKEINTRESOURCE(OBM_CHECK));
{OBM_CHECK gets the system check bitmap}
BmpDC := CreateCompatibleDC(GrpBoxDC);
{get a DC that is the like (Compatible with) the GrpBoxDC}
SelectObject(BmpDC,hCheckBmp);
BitBlt(GrpBoxDC, 110, 0, 16, 16, BmpDC, 0, 0, SRCAND);
DeleteDC(BmpDC);
{always delete a hDC that you create}
DeleteObject(hCheckBmp);
ReleaseDC(hGroup1,GrpBoxDC);
Exit;
{you need to exit since CallWindowProc has already been called}
end;
WM_COMMAND: if LParam = hWhiteBackRB then
begin
SetBack(wClass.hbrBackground);
{although the Class Background brush is changed with
SetClassLong(hForm1,GCL_HBRBACKGROUND,Brush) your wClass
record is not changed so it is still the white brush}
end else
if LParam = hYellowBackRB then
begin
SetBack(Brush2);
end else
if LParam = hRedBackRB then
begin
SetBack(Brush3)
end else
if LParam = hParentCB then
begin
SetParent(hParentCB,hForm1);
MoveWindow(hParentCB,170,294,100,21,True);
{this LParam = hParentCB message will only be
sent here if hGroup1 is the parent of hParentCB}
end;
end;
Result:=CallWindowProc(PGroup1Proc,hWnd,Msg,wParam,lParam);
end;
function Edit2Proc(hWnd, Msg, WParam, LParam: Integer): Integer; stdcall;
var
Styles: Integer;
begin
{this is the SubClass Window Proc for hEdit2
we need this to get click and WM_CHAR messages for this edit}
case Msg of
WM_GETDLGCODE: begin
{WM_GETDLGCODE is sent to SubClassed Proc to get a result
that will tell the OS which Keys to use or not for the Dialog
keys, a multiline edit will be less easy to get Tab Stop
functioning, because it may need Tab key input}
Result := DLGC_WANTALLKEYS;
{DLGC_WANTALLKEYS tells the OS to send all keys to this Edit Box
Multi-Line Edits should get all keys}
Exit;
end;
{mouse position is given in the HI and LO Word positions of lParam}
WM_LBUTTONUP: SelectMouse(LOWORD(lParam),HIWORD(lParam));
{on a left mouse up this Edit will select the line that was clicked}
WM_RBUTTONUP: begin
{on a right mouse up the edit will display a default edit
popup menu if ES_ReadOnly is NOT in Styles}
Styles := GetWindowLong(hEdit2, GWL_STYLE);
Result := 0;
if (Styles or ES_ReadOnly) = Styles then
Exit;
{CallWindowProc gets a right click popup menu}
end;
WM_CHAR: if wParam = Ord('m') then wParam := Ord('M')
{you can change what charater goes in the edit by changing
the wParam, try typing a m into this edit}
else if wParam = Integer('?') then
{you can block characters by exiting or sending 0
as wParam, try typing a ? into hEdit2}
begin
Styles := GetWindowLong(hEdit2, GWL_STYLE);
if (Styles or ES_ReadOnly) <> Styles then
begin
MessageBox(hForm1,' ? Question mark chararter not allowed',
'No ? char', MB_OK or MB_ICONQUESTION);
Result := 0;
SetFocus(hEdit2);
{the MessageBox returns focus to hForm1 so we
SetFocus back to hEdit2}
Exit;
{Exit and no character is set into this edit}
end;
end else
if (wParam = 9) and (GetKeyState(VK_SHIFT) < 0) then
SetFocus(hIncludeCB);
{since the WM_GETDLGCODE result is DLGC_WANTALLKEYS the IsDialogMessage
will send all character keys (including Tab) to this edit, to Tab out
of this edit hold down the Shift key and hit Tab to send focus to hIncludeCB}
end;
Result := CallWindowProc(PEdit2Proc,hWnd,Msg,wParam,lParam);
end;
procedure DoReadOnly;
var
Styles: Integer;
begin
{this changes hEdit2 Read Only property}
Styles := GetWindowLong(hEdit2, GWL_STYLE);
if (Styles or ES_ReadOnly) = Styles then
begin
SendMessage(hEdit2, EM_SETREADONLY, 0, 0);
{some controls have special messages to change their properties
If you try to use
SetWindowLong(hEdit2, GWL_STYLE, WS_VISIBLE or WS_CHILD or ES_LEFT or
ES_AUTOVSCROLL or WS_VSCROLL or WS_HSCROLL or ES_MULTILINE or WS_TABSTOP);
it will have no effect on hEdit2 and will not remove the Read only}
EnableWindow(hListFilesBut, False);
{I disable the List Files button}
end else
begin
SendMessage(hEdit2, EM_SETREADONLY, 1, 0);
EnableWindow(hListFilesBut, True);
end;
UpdateWindow(hEdit2);
end;
procedure MoveGroup;
begin
{the owner draw button moves the group box,
I uncheck and check the radio buttons}
MoveWindow(hGroup1, 40,274,320,90,True);
SendMessage(hGrpMove1RB, BM_SETCHECK, BST_UNCHECKED,0);
SendMessage(hGrpMove3RB, BM_SETCHECK, BST_UNCHECKED,0);
SendMessage(hGrpMove2RB, BM_SETCHECK, BST_CHECKED,0);
end;
function MessageProc(hWnd, Msg, WParam, LParam: Integer): Integer; stdcall;
var
DC: HDC;
PaintS: TPaintStruct;
pDrawItem: PDrawItemStruct;
hCheckBmp, OldFont: THandle;
begin
case Msg of
WM_CREATE: begin
PostMessage(hWnd, WM_KEYDOWN, VK_TAB,0);
PostMessage(hWnd, WM_KEYUP, VK_TAB,0);
{this will set the Focus to the Exit Button, just like a Tab key press}
end;
WM_PAINT: begin
DC := BeginPaint(hWnd, PaintS);
{use WM_PAINT to draw on your Form, the BeginPaint tells
you the WM_PAINT DC}
SelectObject(DC,Brush1);
SelectObject(DC,Pen1);
Ellipse(DC,60-((Size1.cy) div 2),6, 60+((Size1.cy+2) div 2), Size1.cy+6);
Ellipse(DC,60+Size1.cx+(Size1.cx div 10)-((Size1.cy+4) div 2), 6, 60+Size1.cx+
(Size1.cx div 10)+ ((Size1.cy) div 2), Size1.cy+6);
{these 2 Ellipse draw hLable1 ends based on the Font3 dimentions in Size1}
SetBkMode(PaintS.hDC, TRANSPARENT);
SelectObject(DC,GetStockObject(ANSI_VAR_FONT));
TextOut(PaintS.hDC,370,220,'These are Style Change Buttons', 30);
TextOut(PaintS.hDC,370,340,'Resize this Form with your mouse', 32);
EndPaint(hWnd,PaintS);
Result := 0;
Exit;
end;
WM_DRAWITEM: begin
{the WM_DRAWITEM Msg is sent for OwnerDraw Controls, buttons, comboBox, listBox, listView
menu, static and Tab. For buttons everything has to be painted by your code, a WM_DRAWITEM
message is sent whenever these buttons need to be painted. The DrawItemStruct has the info
to tell you how to draw it}
pDrawItem := Pointer(LParam);
{typecast the LParam to a Pointer for pDrawItem}
{the hOwnerDraw and the hExitBut are the 2 buttons that can be owner drawn.
There are 2 ways to tell which button is being painted, by the button's handle
in the pDrawItem.hwndItem and by the button's control ID number in the WParam}
if (Integer(pDrawItem.hwndItem) = hOwnerDraw) or
(Integer(pDrawItem.hwndItem) = hExitBut) then
begin
OldFont := SelectObject(pDrawItem.hDC,Font2);
{to put a Bitmap on this button, you need to have a bitmap Handle and
a Device Context (hDC) for that bitmap}
hCheckBmp := LoadBitmap(0,MAKEINTRESOURCE(OBM_CHECK));
{OBM_CHECK gets the system check bitmap}
DC := CreateCompatibleDC(pDrawItem.hDC);
{get a DC that is the like (Compatible with) the button DC}
SelectObject(DC,hCheckBmp);
{once the hCheckBmp is selected into DC, DC becomes the hDC for that bitmap}
if pDrawItem.itemState = ODS_DISABLED then
begin
{test the itemState to see if disabled
this is painting for a Disabled button a Grey color}
SetBkColor(pDrawItem.hDC, $BBBBBB);
FillRect(pDrawItem.hDC, pDrawItem.rcItem, GetStockObject(LTGRAY_BRUSH));
SetBkMode(pDrawItem.hDC,TRANSPARENT);
SetTextColor(pDrawItem.hDC,$DDDDDD);
{I set the hExitBut control ID to ID_ExitBut with SetWindowLong}
if WParam = ID_ExitBut then
TextOut(pDrawItem.hDC,12,8,'E X I T',7)
else
TextOut(pDrawItem.hDC,8,8,'Move it',7);
SetTextColor(pDrawItem.hDC,$666666);
if WParam = ID_ExitBut then
TextOut(pDrawItem.hDC,10,6,'E X I T',7)
else
begin
TextOut(pDrawItem.hDC,6,6,'Move it',7);
BitBlt(pDrawItem.hDC, 56, 8, 16, 16, DC, 0, 0, SRCCOPY);
end;
end else
begin
{this is painting for a normal button
an Yellow or Red color}
if WParam = ID_ExitBut then
begin
SetBkColor(pDrawItem.hDC, $0000FF);
FillRect(pDrawItem.hDC, pDrawItem.rcItem, Brush3);
TextOut(pDrawItem.hDC,10,6,'E X I T',7);
end else
begin
SetBkColor(pDrawItem.hDC, $00FFFF);
FillRect(pDrawItem.hDC, pDrawItem.rcItem, Brush2);
TextOut(pDrawItem.hDC,6,6,'Move it',7);
BitBlt(pDrawItem.hDC, 56, 8, 16, 16, DC, 0, 0, SRCCOPY);
end;
end;
DeleteDC(DC);
{always delete a hDC that you create}
DeleteObject(hCheckBmp);
{always deleteObject any bitmap you make}
{test the ODS_SELECTED to see if the button is down}
if (pDrawItem.itemState and ODS_SELECTED) <> 0 then
DrawEdge(pDrawItem.hDC, pDrawItem.rcItem, EDGE_SUNKEN, BF_RECT)
else
DrawEdge(pDrawItem.hDC, pDrawItem.rcItem, EDGE_RAISED, BF_RECT);
{draw a sunken edge if the button is down, raised edge if not}
{test itemState for ODS_FOCUS}
if pDrawItem.itemState = ODS_FOCUS then
begin
InflateRect(pDrawItem.rcItem,-4,-4);
DrawFocusRect(pDrawItem.hDC, pDrawItem.rcItem);
{make the rcRect smaller and draw a focus Rect}
end;
SelectObject(pDrawItem.hDC, OldFont);
{restore the font to hDC}
Result := 1;
Exit;
{Exit do Not call DefWindowProc}
end;
end;
{when a button is clicked a WM_COMMAND message is sent with the lParam set to the
button's Handle, also the LOWORD(WParam) has a control ID}
WM_COMMAND: if LOWORD(WParam) = ID_ExitBut then PostMessage(hForm1,WM_CLOSE,0,0)
else if LParam = hImageBut then ChangeStyle1
else if LParam = hIconBut then ChangeStyle2
else if LParam = hOwnerDraw then MoveGroup
else if (LParam = hListFilesBut) and (HIWORD(wParam) = BN_CLICKED) then ListFiles
{I have put the test for BN_CLICKED only to show that this is
in the message, but you can leave it out as long as you do
NOT put the BS_NOTIFY in the button's CreateWindow() styles}
else if LParam = hReadOnlyCB then DoReadOnly
else if LParam = hParentCB then
begin
SetParent(hParentCB,hGroup1);
{this LParam = hParentCB message will only be
sent here if hForm1 is the parent of hParentCB,
see Group1Proc for this message there}
MoveWindow(hParentCB,140,20,100,21,True);
{Child window corordinates are in the client area
of the parent window, so we have to move hParentCB}
end
else if LParam = hGrpMove1RB then MoveWindow(hGroup1, 10, 274,320,90,True)
else if LParam = hGrpMove2RB then
begin
MoveWindow(hGroup1, 40,274,320,90,True);
{InvalidateRect(hParentCB,nil,True);}
end
else if LParam = hGrpMove3RB then
begin
MoveWindow(hGroup1, 70,244,320,90,True);
{InvalidateRect(hParentCB,nil,True);
{InvalidateRect(hGroup1,nil,True);}
end
else if lParam = hEdit1 then
if (HIWORD(wParam) = EN_MAXTEXT) then
{the EN_MAXTEXT notification is sent when the text exceeds the Edits capacity}
MessageBox(hForm1,PChar('You tried to put more text in this Edit than it will hold '
+#13+SysErrorMessage(GetLastError)), 'Too much Text',MB_OK or MB_ICONERROR) else
if (HIWORD(wParam) = EN_KILLFOCUS) then
SetWindowText(hForm1, 'Edit1 has lost Focus');
WM_DESTROY: ShutDown;
WM_CTLCOLORSTATIC: if LParam = hLabel1 then
{WM_CTLCOLORSTATIC is the pre Static Paint message to get
colors to paint hLabel1}
begin
SetTextColor(wParam,$FFFFFF);
SetBkColor(wParam,$FF0000);
{SetBkColor is only for the text drawing}
Result := Brush1;
{Result is the Brush Handle used to paint any
background not covered by text}
Exit;
{IMPORTENT
You MUST Exit so the DefWindowProc is NOT called
try it without Exit and the Static will NOT change colors}
end else
if LParam = hIcon2 then
begin
Result := wClass.hbrBackground;
Exit;
end;
WM_CTLCOLOREDIT: if lParam = hEdit1 then
{pre Paint message for Edits - WM_CTLCOLOREDIT}
begin
{this can set the colos used for hEdit1}
SetTextColor(wParam,$0000FF);
SetBkColor(wParam,GetSysColor(COLOR_BTNHIGHLIGHT));
{I have used different colors for SetBkColor and Result
to show you what it will look like, but they are usually the same}
Result := GetSysColorBrush(COLOR_WINDOW);
{Result is the brush used to paint NON-Text areas}
Exit;
{you must Exit so DefWindowProc will not
be called}
end;
WM_SIZE: begin
{when you resize hForm1 a WM_SIZE message is sent,
so I move the controls on the edge}
MoveWindow(hExitBut, LOWORD(lParam)-74,HIWORD(lParam)-38,64,28,True);
{I change positions of controls to match the resized form}
MoveWindow(hIcon2, LOWORD(lParam)-70,2,32,32,True);
MoveWindow(hIcon3, LOWORD(lParam)-37,2,32,32,True);
MoveWindow(hEdit1, 6,58,LOWORD(lParam)-126,21,True);
MoveWindow(hListFilesBut, LOWORD(lParam)-116,58,110,21,True);
end;
end; // case
Result := DefWindowProc(hWnd,Msg,wParam,lParam);
{VERY VERY IMPORTANT - to get normal windows behavior you must call DefWindowProc for that
message, if you DO NOT want normal windows behavior then DO NOT call DefWindowProc.
I have put it at the end of this function, so if you don't want DefWindowProc then you just
add and "Exit;" in that message response above}
end;
begin // main program begin / / / / / / / / / / / / / / / / / / / / / /
{since Brushes, Pens and Fonts are Window's System Objects
I usually create them first. You must Delete these Objects
before your Program ends, see ShutDown procedure above}
Brush1 := CreateSolidBrush($FF0000);
Pen1 := CreatePen(PS_SOLID, 1, $FF0000);
Brush2 := CreateSolidBrush($00FFFF);
Brush3 := CreateSolidBrush($0000FF);
with FontLog1 do
begin
lfHeight := -12;
lfWidth := 0;
lfWeight := 0;
lfEscapement := 0;
lfOrientation := 0;
lfItalic := 0;
lfUnderline := 0;
lfStrikeOut := 0;
lfCharSet := ANSI_CHARSET;
lfOutPrecision := OUT_DEFAULT_PRECIS;
lfClipPrecision := CLIP_DEFAULT_PRECIS;
lfQuality := DEFAULT_QUALITY;
lfPitchAndFamily := VARIABLE_PITCH or FF_SWISS;
lfFaceName := 'MS Sans Serif';
end;
Font1 := CreateFontIndirect(FontLog1);
with FontLog1 do
begin
lfHeight := -14;
lfWeight := FW_BOLD;
lfOutPrecision := OUT_TT_PRECIS;
lfPitchAndFamily := VARIABLE_PITCH or FF_ROMAN;
lfFaceName := 'Times New Roman';
end;
Font2 := CreateFontIndirect(FontLog1);
with FontLog1 do
begin
lfHeight := -20;
lfPitchAndFamily := VARIABLE_PITCH or FF_SWISS;
lfFaceName := 'y22ak2v';
{there will be no Font named y22ak2v, this is to show you what happens
if the font you name is NOT on the computer, hLabel1's
size depends on this font, look at
GetTextExtentPoint32(TempDC, 'Button and Edit Demo', 20, Size1);
below and the WM_PAINT in the MessageProc }
end;
Font3 := CreateFontIndirect(FontLog1);
wClass.hInstance := hInstance;
wClass.cbWndExtra := 8;
{the cbWndExtra parameter is used to set extra bytes of memory
to use in the systems window information record}
with wClass do
begin
style := CS_PARENTDC;
{CS_PARENTDC is used so that the child can draw on the parent
and it does not give the child the parent's device context
or device context settings. enhances a program's performance}
hIcon := LoadIcon(hInstance,'MAINICON');
lpfnWndProc := @MessageProc;
hbrBackground := GetStockObject(WHITE_BRUSH);
{GetStockObject is good to get system Brushs, Pens, and fonts
you do NOT need to call DeleteObject for Stock Objects}
lpszClassName := 'Second Class';
{you may use any class name, but you may want to make it descriptive
if you register more than one class}
hCursor := LoadCursor(0,IDC_ARROW);
end;
RegisterClass(wClass);
SetRect(Rect1,0,0,546,400);
if not AdjustWindowRect(Rect1,WS_OVERLAPPEDWINDOW,False) then
SetRect(Rect1,0,0,552,427);
{AdjustWindowRect() will change Rect1 to the size needed for a
Window's Client Area of the size it first gets in Rect1 including
the CaptionBar and Borders, this is an important function, since Title bar Height
and Border width can be changed by the computer's user}
{the WS_EX_CONTROLPARENT allows user to use Tab key for control change}
hForm1 := CreateWindowEx(WS_EX_CONTROLPARENT,
wClass.lpszClassName, // pointer to registered class name
' Button & Edit test', // pointer to window name (title bar Caption here)
WS_OVERLAPPEDWINDOW, // window style
{WS_OVERLAPPEDWINDOW is the default standard main window with a
Title bar and system menu and sizing border}
(GetSystemMetrics(SM_CXSCREEN) div 2)-276, // horizontal position of window
(GetSystemMetrics(SM_CYSCREEN) div 2)-222, // vertical position of window
Rect1.Right-Rect1.Left, // window width
Rect1.Bottom-Rect1.Top, // window height
0, // handle to parent or owner window
{this is the MAIN window, so it will be the parent}
0, // handle to menu or child-window identifier
hInstance, // handle to application instance
nil // pointer to window-creation data
);
if hForm1 = 0 then
begin
{I do not usually include a "if Handle = 0 then"
I put it here to show how to test for success or failure
of CreateWindow()}
UnRegisterClass(wClass.lpszClassName, hInstance);
Exit;
end;
{since I set the wClass.cbWndExtra := 8; there are 8 bytes of
memory for user data for each window of this class. You use the
SetWindowLong to put data into this extra memory}
SetWindowLong(hForm1, 0, 100);
{the second parameter sets the BYTE position, not the integer
(4 byte) position}
SetWindowLong(hForm1, 4, -1);
TempDC := GetDC(hForm1);
SelectObject(TempDC,Font3);
{Select the font that goes in hLabel1}
GetTextExtentPoint32(TempDC, 'Button and Edit Demo', 20, Size1);
{GetTextExtentPoint32 gets the size of text for that DC
Size1 is used to get the correct size for hLabel1, you could
create hLabel1 first and then get the text extent and resize hLabel1,
but this uses less code}
ReleaseDC(hForm1,TempDC);
{remember to call ReleaseDC whenever you call GetDC}
hLabel1 := CreateWindow('Static', 'Button and Edit Demo',
WS_VISIBLE or WS_CHILD or SS_CENTER, 60, 5, Size1.cx+(Size1.cx div 10),
Size1.cy+2, hForm1, 0, hInstance,nil);
{hLabel1 is assigned a Font name that will not be found, Font3, but even if you
use a font that will be found you should calculate the hLabel1 size based on the
Size1 from GetTextExtentPoint32() so it will be the correct size for that font, and
it will be the correct size if that font name is not found}
SendMessage(hLabel1,WM_SETFONT,Font3,0);
CreateWindow('Static', 'MAINICON',
WS_VISIBLE or WS_CHILD or SS_ICON,
6,2,1,2,hForm1,0,hInstance,nil);
hIcon2 := CreateWindow('Static', nil,
WS_VISIBLE or WS_CHILD or SS_ICON or WS_CLIPSIBLINGS,
507,2,3,120,hForm1,0,hInstance,nil);
{I put WS_CLIPSIBLINGS in these 2 Icons to prevent them from drawing on each other,
remove the WS_CLIPSIBLINGS and resize the form making it wider or narrow and see
what the Icons do}
SendMessage(hIcon2, STM_SETIMAGE, IMAGE_ICON,LoadIcon(0,IDI_QUESTION));
{to put a NON-Resource Icon in a Static Icon you SendMessage, STM_SETIMAGE}
hIcon3 := CreateWindow('Static', '',
WS_VISIBLE or WS_CHILD or SS_ICON or WS_CLIPSIBLINGS,
475,2,7,11,hForm1,0,hInstance,nil);
SendMessage(hIcon3,STM_SETIMAGE,IMAGE_ICON,LoadIcon(0,IDI_QUESTION));
hLabel2 := CreateWindow('Static', 'Enter the Folder you want to list the File Names for below',
WS_VISIBLE or WS_CHILD or SS_LEFT,10,40,290,16,hForm1,0,hInstance,nil);
SendMessage(hLabel2,WM_SETFONT,Font1,0);
{if possible leave some extra room on controls, width and heigth, in case
the font mapper picks a different font than the one you named}
hExitBut := CreateWindow('Button','Exit',
WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT or BS_BOTTOM or WS_TABSTOP,
285, 108, 64, 28, hForm1, 0, hInstance,nil);
SendMessage(hExitBut, WM_SETFONT, GetStockObject(SYSTEM_FIXED_FONT),0);
{because the IsDialogMessage( ) is in the GetMessage loop below, you can put
WS_TABSTOP in a control's style to have that control be a Tab Stop.
Tab Stop Order is set by the creation order of the Tab Stop controls
Since this is the first control with a WS_TABSTOP it is FIRST in the
Tab Stop Order, hEdit1 will be next}
SetWindowLong(hExitBut, GWL_USERDATA, 1);
{Every window has 4 bytes (integer) of "User Data", which you can set and read
with SetWindowLong and GetWindowLong, you might think of this user data integer
like the "Tag" property of controls in the VCL. Here I will use the Exit buttons
user data as a boolean to signify if the button is visible, see the ChangeStyle
procedure above}
SetWindowLong(hExitBut, GWL_ID, ID_ExitBut);
{control ID numbers are sometimes used in system messages,
like the WM_DRAWITEM message, ID can also be used in the WM_COMMAND. .
Normaly you would just put this ID number in the hMenu parameter of the
CreateWindow function, I do this here to show methods for the SetWindowLong}
hEdit1 := CreateWindowEx(WS_EX_CLIENTEDGE,'Edit','C:\Stuff',
WS_VISIBLE or WS_CHILD or ES_LEFT {or ES_AUTOHSCROLL} or WS_TABSTOP,
6,58,420,21,hForm1,0,hInstance,nil);
{add the ES_AUTOHSCROLL style and see what difference it makes also try
ES_LOWERCASE , replace ES_LEFT with ES_CENTER,}
SendMessage(hEdit1,WM_SETFONT,Font1,0);
hListFilesBut := CreateWindow('Button','<--- List Folder Files',
WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_LEFT or BS_TEXT or WS_TABSTOP,
420,58,110,21,hForm1,0,hInstance,nil);
SendMessage(hListFilesBut,WM_SETFONT,Font1,0);
hEdit2 := CreateWindowEx(WS_EX_CLIENTEDGE,'Edit','Click on a line in this memo to Select it.',
WS_VISIBLE or WS_CHILD or ES_LEFT or ES_AUTOVSCROLL or WS_VSCROLL or WS_HSCROLL or
ES_READONLY or ES_MULTILINE or WS_TABSTOP,
6,86,320,128,hForm1,0,hInstance,nil);
{hEdit2 is a Multi-Line edit, which will have more than one line to deal with
and more style optons like ES_AUTOVSCROLL}
SendMessage(hEdit2,WM_SETFONT,Font1,0);
SendMessage(hEdit2, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MAKELONG(4, 3));
{EM_SETMARGINS will adjust the margins of an Edit control}
hLabel4 := CreateWindow('Static', 'Set List Folder Options below',
WS_VISIBLE or WS_CHILD or SS_LEFT,334,84,160,16,hForm1,0,hInstance,nil);
SendMessage(hLabel4,WM_SETFONT,Font1,0);
hIncludeCB := CreateWindow('Button','Include Folders',
WS_VISIBLE or WS_CHILD or BS_AUTOCHECKBOX or BS_TEXT or WS_TABSTOP,
334,104,110,21,hForm1,0,hInstance,nil);
{this button has the BS_AUTOCHECKBOX style and will be a Check box that will
automaticaly check and UNcheck this Check Box on clicks, If you use BS_CHECKBOX
you will have to check and UNcheck this one with code}
SendMessage(hIncludeCB,WM_SETFONT,Font1,0);
hJustTexRB := CreateWindow('Button','only .txt files',
WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or BS_TEXT or WS_GROUP,
334,134,110,21,hForm1,0,hInstance,nil);
{this button uses the BS_AUTORADIOBUTTON style, so it automaticly
shows a check. You need to add a WS_GROUP, to group a number of Radio
Buttons together. All controls BEFORE the next control with
WS_GROUP style will be grouped together
ALSO grouping effects the Tab Stop}
SendMessage(hJustTexRB,WM_SETFONT,Font1,0);
hJustExeRB := CreateWindow('Button','only .exe files',
WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or BS_TEXT,
334,155,110,21,hForm1,0,hInstance,nil);
{grouping is Important for Auto Radio Buttons}
SendMessage(hJustExeRB,WM_SETFONT,Font1,0);
hAllRB := CreateWindow('Button','All files',
WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or BS_TEXT,
334,176,110,21,hForm1,0,hInstance,nil);
SendMessage(hAllRB,WM_SETFONT,Font1,0);
{after creation ALL radio buttion are UNchecked, so you
have to send the BM_SETCHECK message to check a button}
SendMessage(hAllRB, BM_SETCHECK, 1, 0);
hReadOnlyCB := CreateWindow('Button','Edit2 Read Only',
WS_VISIBLE or WS_CHILD or BS_AUTOCHECKBOX or BS_PUSHLIKE or BS_TEXT or WS_GROUP or WS_TABSTOP,
14,240,108,28,hForm1,0,hInstance,nil);
{this button has Both BS_AUTOCHECKBOX and BS_PUSHLIKE styles, so it looks like a
Push button and toggles between a button up state (unChecked) and a button down state
(Checked)}
SendMessage(hReadOnlyCB,WM_SETFONT,Font1,0);
hParentCB := CreateWindow('Button','Group1 Parent',
WS_VISIBLE or WS_CHILD or BS_AUTOCHECKBOX or BS_TEXT,
170,294,100,21,hForm1,0,hInstance,nil);
SendMessage(hParentCB, WM_SETFONT, Font1,0);
{this Parent Check Box is here to show that controls can be placed in a Group
Box without the Group Box as the Parent, so the Group Box can just be used as
a visual indication of a group, also this shows some of the Z-order and overlaped
child windows and default painting and movement of a parent. The hGroup1 CreateWindow
has the WS_CLIPSIBLINGS style added. Remove ClipSibings and see how painting is
changed on moving Group1. Look at the MessageProc for the "LParam = hGrpMove2RB"
and look at the "InvalidateRect(hParentCB,nil,True)" You can move this
"hParentCB := CreateWindow( )" to after the "hGroup1 := CreateWindow( )" and
see the difference in Z-Order and painting}
hGroup1 := CreateWindow('Button','a Moving Group Box ',
WS_VISIBLE or WS_CHILD or BS_GROUPBOX or WS_CLIPSIBLINGS,
10,274,320,90,hForm1,0,hInstance,nil);
{a button with a BS_GROUPBOX style looks like a Group Box and will
group controls together that have it as their parent,
the WS_CLIPSIBLINGS prevents it from drawing Over other controls
when it is moved, try it without that to see what happens}
SendMessage(hGroup1,WM_SETFONT,Font1,0);
hWhiteBackRB := CreateWindow('Button','White Background',
WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or BS_TEXT,
7,20,118,20,hGroup1,0,hInstance,nil);
{Notice that hGroup is set as the Parent of hWhiteBackRB and
the following radio buttons, so they will be grouped together}
SendMessage(hWhiteBackRB,WM_SETFONT,Font1,0);
SendMessage(hWhiteBackRB, BM_SETCHECK, 1, 0);
hYellowBackRB := CreateWindow('Button','Yellow Background',
WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or BS_TEXT,
7,40,118,20,hGroup1,0,hInstance,nil);
SendMessage(hYellowBackRB,WM_SETFONT,Font1,0);
hRedBackRB := CreateWindow('Button','Red Background',
WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or BS_TEXT,
7,60,118,20,hGroup1,0,hInstance,nil);
SendMessage(hRedBackRB,WM_SETFONT,Font1,0);
{the next 3 buttons have the BS_AUTORADIOBUTTON and BS_PUSHLIKE styles,
so they will look like a push button, but be grouped together like
radio buttons, so when you click one button it goes to Down and the
button that was Down goes to Up (UnChecked state)}
hGrpMove1RB := CreateWindow('Button','Group1 x=10',
WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or BS_TEXT or BS_PUSHLIKE or WS_GROUP,
10,372,90,22,hForm1,0,hInstance,nil);
SendMessage(hGrpMove1RB,WM_SETFONT,Font1,0);
SendMessage(hGrpMove1RB, BM_SETCHECK, 1, 0);
hGrpMove2RB := CreateWindow('Button','Group1 x=40',
WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or BS_TEXT or BS_PUSHLIKE,
120,372,90,22,hForm1,0,hInstance,nil);
SendMessage(hGrpMove2RB,WM_SETFONT,Font1,0);
hGrpMove3RB := CreateWindow('Button','Group1 x=70',
WS_VISIBLE or WS_CHILD or BS_AUTORADIOBUTTON or BS_TEXT or BS_PUSHLIKE,
238,372,90,22,hForm1,0,hInstance,nil);
SendMessage(hGrpMove3RB,WM_SETFONT,Font1,0);
hImageBut := CreateWindow('Button','IB',
WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON {or BS_TEXT} or WS_GROUP or {BS_ICON} BS_BITMAP,
410,246,26,26,hForm1,0,hInstance,nil);
{If you include the BS_BITMAP style, then the BS_TEXT will be ignored,
and you can not put any text on this button by having it in the lpWindowName
parameter, you could also use BS_ICON for an Icon instead of a bitmap}
SendMessage(hImageBut,BM_SETIMAGE,IMAGE_BITMAP,LoadBitmap(0,MAKEINTRESOURCE(OBM_REDUCE)));
{to get a bitmap on a bitmap button you need to send the BM_SETIMAGE message.
Here I use LoadBitmap(0,MAKEINTRESOURCE(OBM_REDUCE)), if the hInstance of LoadBitmap
is 0 then the system resources are used. The MAKEINTRESOURCE( ) function will
locate a resource by it's ID number, OBM_REDUCE is the system bitmap used for
caption miminize buttons}
hIconBut := CreateWindow('Button','IcB',
WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_ICON,
460,240,36,36,hForm1, 0,hInstance,nil);
SendMessage(hIconBut,BM_SETIMAGE,IMAGE_ICON,wClass.hIcon);
{an Icon Button uses the same methods for the Icon as a Bitmap
button does for it's bitmap}
hOwnerDraw := CreateWindow('Button','ODB',
WS_VISIBLE or WS_CHILD or BS_OWNERDRAW,
410,300,100,28,hForm1,0,hInstance,nil);
{this OwnerDraw button has no default painting except to fill it's rect with the
button face color. So you will have to add all the painting and Text drawing to the
WM_DRAWITEM message in it's parents MessageProc( ) , see above. This is the type
of button Delphi creates for VCL TBitBtn }
hLabel3 := CreateWindow('Static',
'Click the "Edit2 Read Only" button to change Edit2',
WS_VISIBLE or WS_CHILD or SS_LEFT,10,219,290,15,hForm1,0,hInstance,nil);
SendMessage(hLabel3,WM_SETFONT,Font1,0);
{ SubClassing a control
when you need to process the messages of a control you have to
SubClass it. To SubClass you SetWindowLong with GWL_WNDPROC and send the address @
of the Window Proc function that you want to recieve the messages - -
PEdit2Pro gets the address of the system Window Proc for that hEdit2
see Edit2Proc function above}
PEdit2Proc := Pointer(SetWindowLong(hEdit2, GWL_WNDPROC, Integer(@Edit2Proc)));
PGroup1Proc := Pointer(SetWindowLong(hGroup1, GWL_WNDPROC, Integer(@Group1Proc)));
{SetFocus(hExitBut);}
ShowWindow(hForm1, SW_SHOWNORMAL);
{the WS_VISIBLE style was NOT set in the Main window creation, if you use
SW_SHOWNORMAL, then your program can be launched in Maximied or Minimized}
while GetMessage(mainMsg,0,0,0) do
begin
{IsDialogMessage( ) will use Tab, Enter, arrow, Home, End keys and others
that are use to navigate the controls of a Window with the keyboard
You need to add the WS_TABSTOP to contol creation to have it be a Tab Stop.
ALSO see the Edit2Proc( ) and the GETDLGCODE message}
if not IsDialogMessage(hForm1, mainMsg) then
begin
TranslateMessage(mainMsg);
DispatchMessage(mainMsg);
end;
end;
end.
|
| You will need to be able to change your windows at run time, and for some programs, you will need to be able to do large scale changes (appearence and functions) for a main window or control. Here you have learned something about creating and changing windows and controls (Buttons and Edits). I would encourage you to experiment with the creation options for different controls to see the variety of styles availible for that control. You will also need to try and change the main window and it's controls, and discover some of the options and methods availible for different controls. You will also need to SubClass several controls and experiment with their message handling, to see what is possible for you to change in their behavior. . . There are many options and different methods used in the API for changing window and control behavior, so you will need to use some of these to see how they work. |
Next
In the Delphi VCL there is no standard Dialog Window Creation from templates. Templete Dialogs are a different approach to creating Pop-Up Windows, to give the user information and to get a responce (input) for this new information, a Dialog. In the next lession we'll learn about creating Dialogs and using them.
Lesson 8. Using Dialogs
H O M E
