 Home |
13. MakeApp Unit A Form and Control Unit, with Font and Menu creation |
Home |
In this lesson I will have code for a Unit called MakeApp, this is a Unit that I have used many times when doing API programs. This is a "One Size Fits All" or universal type of unit, meant to be used in many different programs as a container for re-usable code that will do the main form window creation, with a main-menu. I do not have this as a "Delphi TObject" type of creation code, but try and use some functions in this to simplify some often-used common tasks, like control and font creation. This is an expansion and improvement of the ApiFormU.pas unit you saw in the last lesson, the MakeForm( ) function in that unit is the same as the one in this MakeApp unit. This also includes the SetWinClass( ), RunMsgLoop( ), MakeFont( ), and MakeButton( ) functions from the ApiFormU, of the last lesson. . Some new functions are included, one for making the Main-Menu sub-menus called MakeSubMenu( ) and one for List Boxes called MakeListBox( ), and one for Combo Boxes MakeComboBox( ), and one to create a container window, like the ever popular TPanel called MakePanel( ). |
|
MakeApp.pas Unit These are the five functions from the APIFormsU.pas Unit, in this MakeApp unit -
This MakeApp.pas unit has the MakeButton function, and adds two other control creation functions, List Box creation is added as the "MakeListBox( )" function and Combo Box Creation has been added with the "MakeComboBox( )" function. I use alot of menus, so I added the Sub-Menu Creation function for the "Main Menu" of the main Form, with the "MakeSubMenu( )" function. I also added code to make a "Container" window, modeled after the popular Delphi TPanel window. You should notice that I do NOT attempt to make these controls have all of the creation or usage options that delphi does in it's VCL, I do not even try and write any control modification functions or any message handling code. Since I know the API code methods for options, messages, or control changes, I just use the API function code in my programs. I only wanted some reusable code for things that I do many times, like MakeForm or MakeFont, and keep the code as simple as I could. . . Also, the more functions and code you add to make a "One Size Fits All" control functions, it will increase the byte size of your compiled program. If you look at the MakeComboBox( ) function, you will see that I have included code to correctly resize a Simple style Combo-Box, if you never use a Simple Combo-Boxes, then this is wasted (unused) code and just adds to the size of the program without being used. So you might try to consider the trade off between having "fast and easy" code writing, and having "small and efficient" code methods.
I present this MakeApp unit code as a possible Help for you, but you should create your own units with your own constant values, creation and modification function code for the types of windows, controls and methods, that YOU frequently use, , , adding the default properties that are most common in your programs. Also add any code that you see and use over and over again. Code for the MakeApp.pas Unit - |
unit MakeApp;
{this MakeApiForm unit, is an example for a One Size Fits All unit, that
can be used in many other programs, that need an API Main Form creation,
a GetMessage Loop procedure, a Menu and a simple MakeFont function.
there are 4 control creation functions}
interface
uses // I have NO Units from any Program in the Uses clause
Windows;
const
Zero = 0; // used so much, I made it a const
DEF = -1; // This is my DEFAULT value for Make functions
type
{the TPanelFunc if the function that will be called by the PanelMessFunc when
that panel's Windows message proc is called, you can use the three message
parameters to provide the methods (like WM_PAINT or button clicks) for that panel}
PPanelFunc = ^TPanelFunc;
TPanelFunc = function(iMsg, wParam, lParam: Integer): Integer;
{there are six styles of Panel creation, with a raised Edge, a Border, and a
"Tab Stop child control message handling" a psNone has none of these styles.
a psEdge has only the raised Edge, a psTabEdge has both the Edge and the Tab
Stop, the psBorder has the WS_BORDER style, psTabBorder adds the Tab Stop.
psTab has only the child control Tab Stop with WS_EX_CONTROLPARENT}
TPanelStyle = (psEdge, psTabEdge, psBorder, psTabBorder, psTab, psNone);
{For Font Creation, there are four font settings in the TFontLook for the way
a font will look on screen, flBold is for a Bold font, and the other three
will give the font the look of their name}
TFontLook = (flBold, flItalic, flUnderLine, flStrikeOut);
TFontLooks = Set of TFontLook; // Used in th MakeFont( ) function
var
hMainMenu: Integer = Zero;
VarFont: Integer = Zero;
ShowCmdd: Integer = SW_SHOWDEFAULT;
{if you need to alter the show command in ShowWindow( ), you can change
this ShowCmdd before calling the RunMsgLoop procedure}
function SetWinClass(const ClassName: String; pMessFunc: Pointer;
wcStyle: Integer = CS_PARENTDC or CS_BYTEALIGNCLIENT): Word;
{the SetWinClass function will get the ClassName and Message Function
address, so it can register a new Window System Class for the Form here.
This function MUST be called BEFORE the MakeForm function}
function MakeForm(Left, Top, Width, Height: Integer; const Caption: String;
WinStyle: Integer = DEF): Integer;
{the MakeForm function will create the main window (form) using
the class in wClassEx, this wClassEx is filled and registered in
the SetWinClass procedure}
procedure RunMsgLoop(Show: Boolean = True);
{the RunMsgLoop procedure will start the GetMessage loop
to keep this program running}
function MakeFont(Height, Width: Integer; const FontName: String;
Look: TFontLooks = []; Roman: Boolean = False): Integer;
{the MakeFont function will simplify Font creation, however you will
loose the ability for many font create options}
function MakeButton(Left, Top, Width, Height: Integer; pCaption: PChar;
hParent, ID_Number: Cardinal; hFont: Integer = DEF): Integer;
{the MakeButton function will simplify Button creation, there are NO
style parameters and there is a hFont parameter, to set the font
for the button. This only makes a Push Button with a Tab Stop}
function MakeListBox(Left, Top, Width, Height, Parent: Integer;
const ListItems: String; WinStyle: Integer = DEF): Integer;
{the MakeListBox function will create a ListBox control and place the Items
in the ListItems string in the list box}
function MakeComboBox(Left, Top, Width, Height, Parent: Integer;
const ListItems: String; WinStyle: Integer = DEF): Integer;
{the MakeComboBox function will create a ComboBox control and place the Items
in the #0 delimited ListItems string in the list box}
function MakePanel(Left, Top, Width, Height, hParent: Integer; WndFunc: TPanelFunc;
ID_Number: Cardinal; Style: TPanelStyle = psTabEdge): Integer;
{the MakePanel function will create a container window like the Delphi TPanel,
it can have one of six panel styles, with a raised Edge, a Border or Tab Stop}
function MakeSubMenu(const ItemList: String; ID1, ID2: Cardinal;
hMenu: Integer = Zero): Integer;
{the MakeSubMenu function is used to create a Main Menu for the MakeForm,
with sub menus and menu Items}
function id4menu(a, b: Byte; c: Byte = Zero; d: Byte = Zero): Cardinal;
{the id4menu function is used to set a Cardinal value to have 4 separate
byte values for the two ID numbers in the MakeSubMenu function}
implementation
uses
Messages, CommCtrl, SmallUtils;
type
TPanelRec = record
Handle: Integer;
WndFunc: TPanelFunc;
end;
const
One = 1;
Two = 2;
n8 = 8;
n13 = 13;
E_WinClas1: PChar =
'ERROR - in SetWinClass - Class Name or pMessProc parameter Incorrect';
E_WinClas2: PChar = 'ERROR - in SetWinClass - RegisterClassEx = FAILED';
E_MakeForm1: PChar = 'ERROR - in MakeForm - wClassEx is NOT registered';
E_MakeForm2: PChar = 'ERROR - in MakeForm - CreateWindow = FAILED';
E_MakeBut: PChar = 'ERROR - in MakeEZButton - CreateWindow = FAILED';
E_MakeMenu: PChar = 'ERROR - in MakeSubMenu - ItemList string is Incorrect';
E_TitleWinClas: PChar = 'SetWinClass function ERROR';
E_TitleMF: PChar = 'MakeForm function ERROR';
E_TitleButton: PChar = 'MakeButton function ERROR';
E_TitleMenu: PChar = 'MakeSubMenu function ERROR';
E_TitlePanel: PChar = 'MakePanel function ERROR';
var
wClassEx, PanelClass: TWndClassEx;
Atom1: Word = Zero;
FirstForm: Integer = Zero;
LBnum: Integer = Zero;
CBnum: Integer = Zero;
aryPanel: Array of TPanelRec;
procedure ErrorMsgBox(pText, pTitle: PChar);
begin
MessageBox(Zero, PChar(pText+#10+SysErrorMessage(GetLastError)),
pTitle, MB_ICONERROR);
end;
function MakeFont(Height, Width: Integer; const FontName: String;
Look: TFontLooks = []; Roman: Boolean = False): Integer;
var
FontLog1: TLogFont;
begin
{this function simplifies Font Creation, you can
create a font with as few as 3 parameters}
ZeroMemory(@FontLog1, SizeOf(FontLog1));
with FontLog1 do
begin
lfHeight := Height;
lfWidth := Width;
if flBold in Look then
lfWeight := FW_BOLD;
if flItalic in Look then
lfItalic := One;
if flUnderline in Look then
lfUnderline := One;
if flStrikeOut in Look then
lfStrikeOut := One;
lfCharSet := DEFAULT_CHARSET;
lfOutPrecision := OUT_TT_PRECIS;
if Roman then
lfPitchAndFamily := VARIABLE_PITCH or FF_ROMAN
else
lfPitchAndFamily := VARIABLE_PITCH or FF_SWISS;
StrLCopy(@lfFaceName[Zero], PChar(FontName), 31);
end;
Result := CreateFontIndirect(FontLog1);
end;
function MakeButton(Left, Top, Width, Height: Integer; pCaption: PChar;
hParent, ID_Number: Cardinal; hFont: Integer = DEF): Integer;
begin
{this function simplifies button creation by including a Font
parameter, which is used to set the button's font}
case hFont of
DEF: hFont := VarFont;
-2: hFont := GetStockObject(ANSI_FIXED_FONT);
{ -1 and -2 will get Var and Fixed Stock fonts}
end;
Result := CreateWindow('Button', pCaption, WS_VISIBLE or WS_CHILD or WS_CLIPSIBLINGS
or BS_PUSHBUTTON or BS_TEXT or WS_TABSTOP, Left, Top,
Width, Height, hParent, ID_Number, hInstance, nil);
{there is NO way to adjust the style, so this only makes a BS_PUSHBUTTON}
if Result = Zero then
begin
ErrorMsgBox(E_MakeBut, E_TitleButton);
Exit;
end;
if hFont <> Zero then
SendMessage(Result, WM_SETFONT, hFont, Zero);
end;
function MakeListBox(Left, Top, Width, Height, Parent: Integer;
const ListItems: String; WinStyle: Integer = DEF): Integer;
var
Lim: Integer;
pGet: PChar;
begin
if WinStyle < Zero then
WinStyle := WS_VISIBLE or WS_CHILD or LBS_NOTIFY
or WS_VSCROLL or WS_CLIPSIBLINGS or WS_TABSTOP;
Result := CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX',PChar('LB '+Int2Str(LBnum)),
Cardinal(WinStyle),Left,Top,Width,Height,Parent,Zero,hInstance,nil);
if Result = Zero then Exit;
Inc(LBnum);
SendMessage(Result,WM_SETFONT,VarFont,Zero);
if (ListItems = '') or (ListItems[One] <> #255) or (Length(ListItems) < Two) then
Exit;
pGet := @ListItems[Two];
Lim := Zero;
while (Lim < 256) do
begin
Inc(Lim);
SendMessage(Result, LB_ADDSTRING, Zero, Integer(pGet));
pGet := StrEnd(pGet);
Inc(pGet);
if pGet^ = #0 then Break;
end;
end;
function MakeComboBox(Left, Top, Width, Height, Parent: Integer;
const ListItems: String; WinStyle: Integer = DEF): Integer;
var {WinStyle defaults to Def, -1 }
Lim: Integer;
pGet: PChar;
{the 4 variables below are used to get the correct Simple Combo Size}
hChild: Integer;
pnt: TPoint;
eRect, LBRect: TRect;
begin
{a -1 (DEF) in the WinStyle will get the Default style Flags}
if WinStyle < Zero then
WinStyle := WS_VISIBLE or WS_CHILD or CBS_DROPDOWN or
WS_CLIPSIBLINGS or WS_TABSTOP or WS_VSCROLL;
Result := CreateWindow('COMBOBOX',PChar('cb'+Int2Str(CBnum)),
Cardinal(WinStyle),Left,Top,Width,Height,Parent,Zero,hInstance,nil);
{the ID of the Combo Box is set to the ID_Combo0+ ComboNumber}
if Result = Zero then Exit;
Inc(CBnum);
SendMessage(Result,WM_SETFONT,VarFont, Zero);
{if you create a Simple Combo Box, that is NOT in a Dialog window,
it WILL NOT size and paint correctly, The following code will
correctly "Size" a simple combo box.}
if (WinStyle and CBS_SIMPLE) <> Zero then
begin
pnt.x := n8;
pnt.y := 6;
hChild := ChildWindowFromPoint(Result, pnt);
if hChild <> Zero then
begin
GetWindowRect(hChild, eRect);
pnt.x := n8;
pnt.y := (eRect.Bottom - eRect.Top)+6;
hChild := ChildWindowFromPoint(Result, pnt);
if hChild <> Zero then
begin
if GetWindowRect(hChild, LBRect) then
MoveWindow(Result, Left, Top, Width,(LBRect.bottom - eRect.Top) +3, False);
end;
end;
end;
{I have a method to use One string (ListItems), as a #0 delimited string to
add all of the Items to this combo box at once. Just to show you, I have
placed the #255 charater, at the begining of the string and test for it.
I set a PChar variable pGet to the memory address of the second charcter
in the ListItems string}
if (ListItems <> '') and (ListItems[One] = #255) then
begin
pGet := @ListItems[Two];
Lim := Zero; {LIM is just a "Safety" test in-case you forget to put an extra
#0 at the end of your ListItems string}
while Lim < 256 do
begin
Inc(Lim);
SendMessage(Result,CB_ADDSTRING, Zero, Integer(pGet));
{the CB_ADDSTRING message will only read the ListItems string until the next #0}
pGet := StrEnd(pGet);
{reset the pGet pointer to the next charater after the #0 ,
with StrEnd and Inc(pGet)}
Inc(pGet);
if pGet^ = #0 then Break;
{you will need to have a #0 at the end of your ListItems string,
so this while loop will end}
end;
SendMessage(Result, CB_SETCURSEL, Zero, Zero);
end;
end;
function PanelMessFunc(hWnd, Msg, wParam, lParam: Integer): Integer; stdcall;
var
i: Integer;
begin
Result := -2;
for i := Zero to High(aryPanel) do
if (aryPanel[i].Handle = hWnd) and (@aryPanel[i].WndFunc <> nil) then
Result := aryPanel[i].WndFunc(Msg, wParam, LParam);
if Result = -2 then
Result := DefWindowProc(hWnd,Msg,wParam,lParam);
end;
function MakePanel(Left, Top, Width, Height, hParent: Integer; WndFunc: TPanelFunc;
ID_Number: Cardinal; Style: TPanelStyle = psTabEdge): Integer;
var
ExStyle, wStyle: Cardinal;
begin
{this function creates a window control container like the delphi VCL TPanel.
In order to get the messages for buttons and other controls on this container
you will need a TPanelFunc and place that function in the WndFunc parameter}
if Length(aryPanel) = Zero then
if RegisterClassEx(PanelClass) = Zero then
begin
Result := Zero;
ErrorMsgBox('ERROR - in Makepanel - Failure Register Panel Class', E_TitlePanel);
Exit;
end;
wStyle := WS_CHILD or WS_CLIPSIBLINGS or WS_CLIPCHILDREN or WS_VISIBLE;
ExStyle := Zero;
case Style of
psEdge: ExStyle := WS_EX_DLGMODALFRAME;
psTabEdge: ExStyle := WS_EX_CONTROLPARENT or WS_EX_DLGMODALFRAME;
psBorder: wStyle := wStyle or WS_BORDER;
psTabBorder: begin
ExStyle := WS_EX_CONTROLPARENT;
wStyle := wStyle or WS_BORDER;
end;
psTab: ExStyle := WS_EX_CONTROLPARENT;
end;
Result := CreateWindowEx(ExStyle,PanelClass.lpszClassName,
PChar('panel '+Int2Str(Length(aryPanel))), wStyle, Left,
Top, Width, Height, hParent, ID_Number, hInstance, nil);
if Result = Zero then
begin
ErrorMsgBox('ERROR - in MakePanel - Panel Window not Created', E_TitlePanel);
Exit;
end;
SetLength(aryPanel, Length(aryPanel)+One);
aryPanel[High(aryPanel)].Handle := Result;
aryPanel[High(aryPanel)].WndFunc := WndFunc;
end;
function id4menu(a, b: Byte; c: Byte = Zero; d: Byte = Zero): Cardinal;
begin
{this function will join 4 bytes into a DWord for a MakeSubMenu ID container}
Result := a or (b shl n8) or (c shl 16) or (d shl 24);
end;
function MakeSubMenu(const ItemList: String; ID1, ID2: Cardinal;
hMenu: Integer = Zero): Integer;
var
Lim, Flags, Enab, mID: Integer;
pGet, pSub: PChar;
begin
{this MakeSubMenu function is a way to make Menu creation have less lines
of code. But to keep it simple, it has Limited functionality. . .
You can not add more than 8 String type menu Items, And only ONE item
can have a sub-Menu. After the submenu is created, and you need more Items,
then you can use the menu Handle and API functions like AppendMenu or
InsertMenu to have more than 8 string items or more items with sub-menus}
Result := Zero;
if (ItemList = '') or (Length(ItemList) < 4) or
(not ((ItemList[One] = #250) or (ItemList[One] = #251))) then
begin
SetLastError(n13);
MessageBox(Zero, E_MakeMenu, E_TitleMenu, MB_ICONERROR);
Exit;
end;
pSub := nil;
{if ItemList[1] is #250 , then This sub-menu is added to the Main Menu
if ItemList[1] is #251 , then a separate, sub-menu is created
and NOT added to the main menu}
Enab := MF_STRING or MF_POPUP;
if ItemList[One] = #250 then
begin
pSub := @ItemList[Two];
if pSub^ = #202 then
begin
Enab := Enab or MF_GRAYED;
Inc(pSub);
end;
pGet := StrEnd(pSub);
Inc(pGet);
end else
pGet := @ItemList[Two];
if pGet^ = #0 then
begin
SetLastError(n13);
ErrorMsgBox('ERROR - in MakeSubMenu - No Menu Item Text Charaters', E_TitleMenu);
Exit;
end;
Result := CreateMenu;
if Result = Zero then
begin
ErrorMsgBox('ERROR - in MakeSubMenu - CreateMenu = FAILED', E_TitleMenu);
Exit;
end;
Lim := Zero;
while (Lim < 9) do
begin
if Lim = n8 then
begin
SetLastError(n13);
ErrorMsgBox('ERROR - in MakeSubMenu - More Than 8 Menu Items', E_TitleMenu);
Break;
end;
Flags := MF_STRING;
{test for the menu Item options}
case pGet^ of
#200: begin
Flags := MF_SEPARATOR;
Inc(pGet);
end;
#201: begin
Flags := Flags or MF_CHECKED;
Inc(pGet);
end;
#202: begin
Flags := Flags or MF_GRAYED;
Inc(pGet);
end;
#203: begin
Flags := Flags or MF_POPUP;
Inc(pGet);
end;
end;
mID := Zero;
if Flags = MF_STRING or MF_POPUP then
begin
if hMenu = Zero then
mID := DEF else
mID := hMenu;
end else
if Flags = MF_SEPARATOR then mID := $200
else
case Lim of
Zero: mID := ID1 and $FF;
One: mID := (ID1 and $FF00) shr n8;
Two: mID := (ID1 and $FF0000) shr 16;
3: mID := ID1 shr 24;
4: mID := ID2 and $FF;
5: mID := (ID2 and $FF00) shr n8;
6: mID := (ID2 and $FF0000) shr 16;
7: mID := ID2 shr 24;
{separate the bytes out of the ID numbers}
end;
if mID <> DEF then
begin
if not AppendMenu(Result, Flags, mID, pGet) then
begin
ErrorMsgBox('ERROR - in MakeSubMenu - AppendMenu = FAILED', E_TitleMenu);
DestroyMenu(Result);
Result := Zero;
Exit;
end;
end else
begin
SetLastError(n13);
ErrorMsgBox('ERROR - in MakeSubMenu - SubMenu handle is Zero', E_TitleMenu);
end;
pGet := StrEnd(pGet);
Inc(pGet);
if pGet^ = #0 then Break;
if not ((Flags = MF_SEPARATOR) or (Flags = MF_STRING or MF_POPUP)) then
Inc(Lim);
end;
if pSub <> nil then
begin
if hMainMenu = Zero then
hMainMenu := CreateMenu;
AppendMenu(hMainMenu, Enab, Result, pSub);
end;
end;
function SetWinClass(const ClassName: String; pMessFunc: Pointer;
wcStyle: Integer = CS_PARENTDC or CS_BYTEALIGNCLIENT): Word;
begin
{this function will set the wClassEx record and regsiter a new Class.
You MUST call this function BEFORE you can call the MakeForm function}
Result := Zero;
{test the parameters}
if (Length(ClassName) < Two) or (pMessFunc = nil) then
begin
SetLastError(n13); // The data is invalid.
ErrorMsgBox(E_WinClas1, E_TitleWinClas);
{the ErrorMsgBox procedure takes the string constants
and shows an Error Message Box}
Exit;
end;
{I have 3 wcStyle preSets, , a CS_PARENTDC or CS_BYTEALIGNCLIENT if No
parameter is set and a -1 and -2 alternates}
if wcStyle = DEF then
wcStyle := CS_PARENTDC
else
if wcStyle = -2 then
wcStyle := CS_PARENTDC or CS_HREDRAW or CS_VREDRAW or CS_BYTEALIGNCLIENT
else
if wcStyle < -2 then
wcStyle := Zero;
{the wClassEx was Filled with Zeros in the initialization}
with wClassEx do
begin
cbSize := SizeOf(wClassEx);
Style := wcStyle;
hInstance := SysInit.hInstance;
hIcon := LoadIcon(hInstance,'MAINICON');
lpfnWndProc := pMessFunc;
hbrBackground := COLOR_BTNFACE+One;
GetMem(lpszClassName, Length(ClassName)+One);
StrCopy(lpszClassName, PChar(ClassName));
hCursor := LoadCursor(Zero, IDC_ARROW);
end;
Atom1 := RegisterClassEx(wClassEx); // Zero in Atom1 means Failure
if Atom1 = Zero then
begin
ErrorMsgBox(E_WinClas2, E_TitleWinClas);
Exit;
end;
Result := Atom1;
end;
function MakeForm(Left, Top, Width, Height: Integer; const Caption: String;
{hMenu: Integer;} WinStyle: Integer = DEF): Integer;
var
Rect1: TRect;
begin
Result := Zero;
{this function will check the Atom1 to see if the wClassEx was
registered and then Create the main Form Window with the parameters}
if Atom1 = Zero then
begin
SetLastError(n13); // The data is invalid.
ErrorMsgBox(E_MakeForm1, E_TitleMF);
Exit;
end;
{I use -1 as the Default Value in this WinStyle parameter}
if WinStyle < Zero then
WinStyle := WS_CAPTION or WS_MINIMIZEBOX or WS_SYSMENU or WS_CLIPCHILDREN;
if Width < Zero then
begin
Width := -Width;
SetRect(Rect1, Zero, Zero,Width,Height);
end else
begin
SetRect(Rect1, Zero, Zero,Width,Height);
if not AdjustWindowRect(Rect1, WinStyle,False) then
SetRect(Rect1, Zero, Zero, Width+6, Height+26);
end;
{if Top is -1 (Default) then the form is centered in the screen vertical}
if Top < Zero then
Top :=(GetSystemMetrics(SM_CYSCREEN) shr One)-((Rect1.Bottom-Rect1.Top) shr One);
{if Left is -1 (Default) then the form is centered in the screen horizontal}
if Left < Zero then
Left :=(GetSystemMetrics(SM_CXSCREEN) shr One)-((Rect1.Right-Rect1.Left) shr One);
Result := CreateWindow(wClassEx.lpszClassName, PChar(Caption), WinStyle,
Left, Top, Rect1.Right-Rect1.Left,
Rect1.Bottom-Rect1.Top, Zero, hMainMenu, hInstance, nil);
if FirstForm = Zero then
FirstForm := Result;
if Result = Zero then
ErrorMsgBox(E_MakeForm2, E_TitleMF);
end;
procedure RunMsgLoop(Show: Boolean = True);
var
MainMsg: TMSG;
begin
if FirstForm = Zero then
begin
SetLastError(n13);
ErrorMsgBox('ERROR - in RunMsgLoop - FirstForm is Zero',
'ERROR, No Form has been created');
Exit;
end;
{this RunMsgLoop procedure will run the GetMessage Loop to keep
this program running, I have included a Show parameter, if False the
Main Window will not be visible}
if Show then
ShowWindow(FirstForm, ShowCmdd);
while GetMessage(MainMsg,Zero,Zero,Zero) do
begin
if not IsDialogMessage(FirstForm, MainMsg) then
begin
TranslateMessage(MainMsg);
DispatchMessage(MainMsg);
end;
end;
end;
procedure DoInit;
begin
{I will fill the wClassEx and PanelClass with Zeros}
ZeroMemory(@wClassEx, SizeOf(wClassEx));
ZeroMemory(@PanelClass, SizeOf(PanelClass));
VarFont := GetStockObject(ANSI_VAR_FONT);
with PanelClass do
begin
cbSize := SizeOf(PanelClass);
Style := CS_BYTEALIGNWINDOW;
hInstance := SysInit.hInstance;
lpfnWndProc := @PanelMessFunc;
hbrBackground := COLOR_BTNFACE+One;
lpszClassName := 'hPanel Class';
hCursor := LoadCursor(Zero, IDC_ARROW);
end;
InitCommonControls;
// I will get the ComControl library in this process
end;
initialization
DoInit
finalization
if wClassEx.lpszClassName <> nil then
FreeMem(wClassEx.lpszClassName);
end. |
Many of the functions in this unit are the same as in the ApiFormU.pas unit of the last lesson. Including, SetWinClass( ), MakeForm( ), RunMsgLoop( ), MakeFont( ), and MakeButton( ), Please look at the last lesson for explanations of these functions, that were introduced there. You have seen the methods I use for the MakeComboBox( ) and MakeListBox( ) functions in the ComboBoxU.pas file of the last lesson, so you can look at the explanation for MakeComboBox( ) in ComboBoxU.pas, in the last lesson, at InUnits, ComboBoxU. . . With both of these functions, I use a single string parameter called "ListItems" as a Zero delimted string, to load all of the "Items" into that control's list boxes. An example of code for a list box creation -
hListBox1 := MakeListBox(7, 7, 136, 104, hForm1, #255'First Item'+
#0'Next Item'#0'Item 3'#0'Item4'#0'Item 5'#0+
'Item 6'#0'Item 7'#0'Last Item'#0);I do not include any Owner draw code for these controls, to keep down the code used, but if you use owner drawn listboxes or comboboxes alot, you might take some of the owner-draw code form ComboBoxU.pas and put it in this MakeApp unit, or make a separate unit for those owner-drawn controls. There are two New functions in this, including MakePanel( ) and MakeSubMenu( ).
MakePanel fuction function MakePanel( Left, Top, Width, Height, // standard position parameters hParent: Integer; // handle of Parent Window WndFunc: TPanelFunc; // a TPanelFunc function used for messages ID_Number: Cardinal; // standard control ID number Style: TPanelStyle = psTabEdge): // Style is set to a TPanelStyle Integer; // result is the system window Handle for panelthe MakePanel( ) function is much like the other "Make" functions and has the standard "Left, Top, Width, Height, hParent, and ID_Number" parameters. It also has the "Style" parameter (TPanelStyle), which can be set to one of six panel Styles, to have the panel have an Edge, Border or Tab Stop processing for child windows, See these styles listed below - TPanelStyle = (psEdge, psTabEdge, psBorder, psTabBorder, psTab, psNone);
Because this is a "Container" control, it is nessary to get the event and change messages of child controls (like buttons). So there is a parameter called "WndFunc" of Type "TPanelFunc", you will need a function of type - function(iMsg, wParam, lParam: Integer): Integer; to handle the messages of this Panel. When the system calls the Window Proc with a message for a panel, then the TPanelFunc (in the WndFunc parameter) is called, passing the message, wParam and lParam. You may notice that this function is like the standard Window Proc, except that I do not have a hWnd, since this function is suppose to be used for only ONE panel window that you should know it's handle. So From the MakePanel function, you use the Panel's handle as the hWnd handle if you need it. If you need the hWnd paramter included in the TPanelFunc for your coding style, then you can add it to the TPanelFunc in this MakeApp unit. . . const
ID_PanelBut = 100;
var
hPanel1: Integer;
function PanelFunc(iMsg,wParam,lParam:Integer):Integer;
begin
{the Result of this will be passed back to the windows system,
UNLESS it is -2, then the DefWindowProc is called and it's Result
goes back to the system. So if you want DefWindowProc, use -2,
otherwise DefWindowProc will NOT be called}
Result := -2;
case iMsg of
WM_COMMAND: if LOWORD(wParam) = ID_PanelBut then
MessageBox(hForm1, 'Panel Button Click',
'Click Button', MB_ICONINFORMATION);
end;
end;
// - - - Panel and button creation below
hPanel1 := MakePanel(30,50, 138, 93, hForm1, PanelFunc, 0, True);
MakeButton(25,16,76, 22, 'Panel Button', hPanel1, ID_PanelBut);IMPORTANT - If you have the panel Style with the TabStop (psTab, psTabEdge, psTabBorder) and that panel is a CHILD of another CHILD window, you must make sure that the panel's parent also has the WS_EX_CONTROLPARENT ExStyle. If it's parent window does not also have the WS_EX_CONTROLPARENT ExStyle, then your program can Freeze Up. I do not have a function for a Panel's destruction and removal, since I did not need this sort of thing, however if you find that you need this, you can add that code. You can see some code examples for these Panel methods in the next page at
function MakeSubMenu( ) function MakeSubMenu(const ItemList: String; ID1, ID2: Cardinal;
hMenu: Integer = Zero): Integer;
This function will create a system sub menu and it's Result will be the handle for that new Sub-Menu. You may want to look at the code in the MakeApp unit above for the MakeSubMenu function. You will see that the ItemList string is searched for the special menu Item Characters (#250, #251, #200, #201, #202, #203). There is no function or setting in this MakeApp.pas to place a "Main Menu" on the main Form. If you call this MakeSubMenu( ) function with the #250 in the ItemList string, and it succesfully makes a Sub Menu, the Main Menu is automaticly created and added to the main Form window. If you look at this function's parameters, the first is the ItemList, string, like the MakeComboBox( ) function, this is a Zero delimited string, with a sub-string for each added menu item. The ID1 and ID2 cardinal parameters are the "menu Item ID" containers, each 4 byte Cardinal value will contain 4 Byte values, each byte having an ID number for a single menu Item ID. (so the maximum menu-Items with ID is eight, the separator does not use an ID, so there can be more than 8 Items). The hMenu Integer parameter is the menu handle for an added Sub-Menu, and set to Zero if there are no added sub-menus.In these parameters, you will NOT see any for menu Item creation options, I use a method of including a single charater in the ItemList string to indicate a Menu Item Creation option or type of menu Item. This is my own method to have menu Item options without function parameters for those options. I use a method of string "Charater Switch" because this is a #0 delimited string, so I can add a special "Switch" charater after a #0 to turn ON an Item option. This is unlike any methods used by the Delphi VCL, and you may not understand it or like it, if so, you can skip over this method or just delete the MakeSubMenu( ) function code. The very First charater in the ItemList string must be a #250 or a #251 charater or the function will fail. The #250 will tell the function to make a main-menu sub-menu, and automaticly add it to the Main-menu. The #251 will tell the function to make a sub-menu and NOT add it to the main-menu. You always need to have either a #250 or #251 charater as the first charcter in this parameter string. Use the #250 if you want the sub-menu to be automatically added to the Main-Menu. If you use the #251 charater, the submenu will be created, but NOT added to the Main menu, so you will need to get the result as a menu Handle and add this sub-menu to another menu yourself. The sub-menu Handle returned by the MakeSubMenu( ) function is a System menu Handle, which can be used in any of the API menu functions needing a menu Handle. There are four special "Switch" charaters for item options or types, they are the #200, #201, #202, #203 charaters. You will need to place these "Switch" chatacters after the #0 and before capton "text" of that menu Item. The menu Item option these "Switch" charaters will turn ON is listed below - • #200 will make a "Separator" menu-item, and with this type NO ID number (byte) will be used. • #201 will make the menu-item Checked, with a menu check mark. • #202 will make the menu-item Greyed, Disabled. • #203 will have that menu-item add a Sub-Menu for this menu, and you must have a sub-menu handle in the hMenu parameter to add to this menu. And with this type NO ID number (byte) will be used. You can only have ONE #203, sub-menu in a ItemList string. The 2 ID parameters, ID1 and ID2, are Cardinal valuse that can hold 4 ID numbers each as single bytes of the cardinal value, so you can NOT have more than 8 menu items with ID in a ItemList string. I did not want to have Eight parameteres for 8 Byte values in this function, so I use two Cardinal parameters, (4 bytes in each). Since the IDs are Byte values, then your IDs are limited to 0 to 255, which is less than the menu Items can have, but more than enough for my personal menu Item ID use in this function. I have included a function to build one Cardinal value from 4 byte values, called id4menu( ) and looks like this - function id4menu(a, b: Byte; c: Byte = Zero; d: Byte = Zero): Cardinal;If you have just one menu item for the cardinal value, you can just place that byte value in the Cardinal parameter. If you need more than one ID value in the Cardinal ID then you can use the id4menu( ) function. Making the ItemList string var
LS: String;
LS := #250'&File'#0'Top Item'#0'Menu Item2'#0'menu item 3'#0;
MakeSubMenu(LS, id4menu(0,1,2), 0, 0);
or
MakeSubMenu(#250'&File'#0'Top Item'#0'Menu Item2'#0'menu item 3'#0,
id4menu(0,1,2), 0, 0);This will make a three Item Sub-Menu for the Main-Menu, the Main-Menu name will be "File".If you need a menu "Sepatator" you add the #200 before the menu Item, although the separator does not have any text, you must include at least ONE text charater, so there is not a double #0#0 . (all menu additions require at least ONE charater for the text, if you do not want any Text to show then use a single space character) LS := #250'&File'#0'Top Item'#0'Menu Item2'#0#200'.'#0'menu item 3'#0; If you want a sub-menu Item to be checked, then place a #201 before it's text string, this will check the first menu item - LS := #250'&File'#0#201'Top Item'#0'Menu Item2'#0'menu item 3'#0; If you want a sub-menu Item to be Disabled, then place a #202 before it's text string, this will disable and grey the first menu item - If you need a sub-menu item in this sub-menu, then you would use the #203 before the text characters. But with an added sub-menu, you will need to have created a sub-menu and place it's Handle in the hMenu parameter of the MakeSubMenu( ) function. LS := #251'Top Item'#0'Menu Item2'#0'menu item 3'#0;
{the first charater of the LS is a #251, which means that
this Sub-menu will NOT be added to the main-menu}
hSubMenu := MakeSubMenu(LS, id4menu(16,17,18), 0, 0);
// you must get the sub-menu handle, I use hSubMenu
LS := #250'&File'#0'Top Item'#0#203'Sub Menu Item2'#0'menu item 3'#0;
MakeSubMenu(LS, id4menu(0,1), 0, hSubMenu);
{if you have the #203 in the LS, then you MUST have a menu
handle in the hMenu parameter, Also notice that the id4menu only
has two ID numbers, a Sub-Menu does NOT use an ID}You can see some example code for using the MakeSubMenu function on the next MakeApp lesson at MakeApp Unit Example Code
This should give you some ideas on how to get some of the code that you use many times into a reuseable unit. You should create your own "One Size Fits All" code container units and then try to structure those units with code that is reusable to save you time and effort for tasks that you offen need.
More lessons about MakeApp and GraphCtrls 13A. MakeApp Unit Example Code 13b. Graphic Control Creation 13C. Using GrafCtrls Program |
Next
The following lesson shows you how to create the system Open and Save Dialog Boxes.
14. Open and Save Dialogs
H O M E
