unit Small;
interface
function CreateButton(ACaption : String; AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function CreateLabel(AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function CreateEdit(AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function CreateMaskedEdit(AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function CreateListBox(AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function CreateComboBox(AHandle : Integer; Left, Top, Right, Bottom : Integer):Integer;
function MakeFont(AFont : String):Integer;
function FastForm(AClassName, ACaption : String; Left, Top, Right, Bottom : Integer):Integer;
function LaunchOpenDialog(AHandle : Integer; var AFileName : String; AInitialDir, AFilter : String):Boolean;
function LaunchSaveDialog(AHandle : Integer; var AFileName : String; AInitialDir, AFilter : String):Boolean;
procedure ListBoxAdd(AHandle : Integer; AString : String);
procedure ListBoxDelete(AHandle, Index : Integer);
procedure ComboBoxAdd(AHandle : Integer; AString : String);
procedure SetFont(AHandle, AFont : Integer);
procedure SetInstance(AInstance : Integer);
implementation
uses
Windows, Messages, CommDlg;
var
TheInstance : Integer;
procedure SetInstance;
begin
TheInstance := AInstance;
end;{ SetInstance }
function CreateButton;
begin
Result := CreateWindow('Button', PChar(ACaption), WS_VISIBLE or WS_CHILD or BS_PUSHLIKE or BS_TEXT,
Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;{ CreateButton }
function CreateLabel;
begin
Result := Createwindow('Static','', WS_VISIBLE or WS_CHILD or SS_LEFT,
Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;{ CreateLabel }
function CreateEdit;
begin
Result := CreateWindowEx(WS_EX_CLIENTEDGE, 'Edit', '', WS_CHILD or WS_VISIBLE or
WS_BORDER, Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;{ CreateEdit }
function MakeFont;
begin
Result := CreateFont(-11, 0, 0, 0, 400, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY,
DEFAULT_PITCH or FF_DONTCARE, PChar(AFont));
end;{ CreateFont }
procedure SetFont;
begin
SendMessage(AHandle, WM_SETFONT, AFont, 0);
end;{ SetFont }
function FastForm;
var
WinClass: TWndClassA;
begin
{ ** Create Main Window ** }
Result := CreateWindowEx(WS_EX_WINDOWEDGE,PChar(AClassName),PChar(ACaption),
WS_VISIBLE or WS_SIZEBOX or WS_CAPTION or WS_SYSMENU
or WS_MAXIMIZEBOX or WS_MINIMIZEBOX,
Left, Top, Right, Bottom, 0, 0, TheInstance, nil);
end;{ FastForm }
function CreateMaskedEdit;
begin
Result := CreateWindowEx(WS_EX_CLIENTEDGE,'Edit', '', WS_CHILD or WS_VISIBLE or
WS_BORDER or ES_PASSWORD, Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;{ CreateMaskedEdit }
function CreateListBox;
begin
Result := CreateWindowEx(WS_EX_CLIENTEDGE,'LISTBOX', '', WS_CHILD or WS_VISIBLE or
LBS_DISABLENOSCROLL or LBS_NOINTEGRALHEIGHT or LBS_NOTIFY,
Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;
procedure ListBoxAdd;
begin
SendMessage(AHandle, LB_ADDSTRING , 0, Integer(PChar(AString)));
end;{ ListBoxAdd }
procedure ListBoxDelete;
begin
SendMessage(AHandle, LB_DELETESTRING , Index, 0);
end;{ ListBoxDelete }
function CreateComboBox;
begin
Result := CreateWindowEx(WS_EX_CLIENTEDGE,'COMBOBOX', '', WS_CHILD or WS_VISIBLE or
CBS_NOINTEGRALHEIGHT ,
Left, Top, Right, Bottom, AHandle, 0, TheInstance, nil);
end;{ CreateComboBox }
procedure ComboBoxAdd;
begin
SendMessage(AHandle, CB_ADDSTRING , 0, Integer(PChar(AString)));
end;{ ComboBoxAdd }
procedure LaunchOpenDialog;
var
OpenFileName : TOpenFilename;
begin
SetLength(AFileName,MAX_PATH);
FillChar(OpenFileName, SizeOf(OpenFileName), 0);
with OpenFileName do
begin
lStructSize := SizeOf(TOpenFilename);
hWndOwner := AHandle;
hInstance := TheInstance;
lpstrFilter := PChar(AFilter);
nMaxFile := MAX_PATH;
lpstrFile := PChar(AFileName);
lpstrInitialDir := PChar(AInitialDir);
lpstrTitle := PChar('Open');
Flags := OFN_HIDEREADONLY;
end;
Result := GetOpenFileName(OpenFilename);
end;{ LaunchOpenDialog }
procedure LaunchSaveDialog;
var
OpenFileName : TOpenFilename;
begin
SetLength(AFileName,MAX_PATH);
FillChar(OpenFileName, SizeOf(OpenFileName), 0);
with OpenFileName do
begin
lStructSize := SizeOf(TOpenFilename);
hWndOwner := AHandle;
hInstance := TheInstance;
lpstrFilter := PChar(AFilter);
nMaxFile := MAX_PATH;
lpstrFile := PChar(AFileName);
lpstrInitialDir := PChar(AInitialDir);
lpstrTitle := PChar('Save');
Flags := OFN_HIDEREADONLY;
end;
Result := GetSaveFileName(OpenFilename);
end;{ LaunchSaveDialog }
end.
*************Demo*****************
program SmallDemo;
uses
Windows,
Messages,
SysUtils,
Small in 'Small.pas';
var
WinClass: TWndClassA;
Inst, Handle, Button1, Button2, Button3, Label1,
Edit1, Edit2, Label2, ListBox1, ComboBox1 : Integer;
Msg: TMsg;
hFont: Integer;
{ Checks if typed password is 'Amigreen' and shows Message }
procedure CheckPassword;
var
Textlength: Integer;
Text: PChar;
begin
TextLength := GetWindowTextLength(Edit1);
if TextLength = 6 then
begin
GetMem(Text, TextLength + 1);
GetWindowText(Edit1, Text, TextLength + 1);
if Text = 'gunmen' then
begin
MessageBoxA(Handle, 'Password is correct.', 'Password check', MB_OK);
FreeMem(Text, TextLength + 1);
Exit;
end;
end;
MessageBoxA(Handle, 'Password is incorrect.', 'Password check', MB_OK);
end;
procedure DialogOpen;
var
FileName, Filter : String;
begin
FileName := 'A file name';
Filter := 'All(*.*)' + #0 + '*.*' + #0;
if LaunchOpenDialog(Handle,FileName,'c:\windows\desktop',Filter) then
MessageBoxA(Handle, PChar(FileName), 'file', MB_OK);
end;
procedure DialogSave;
var
FileName, Filter, InitDir : String;
begin
FileName := 'A file name';
Filter := 'All(*.*)' + #0 + '*.*' + #0;
InitDir := 'c:\windows\desktop';
if LaunchSaveDialog(Handle,FileName,InitDir,Filter) then
MessageBoxA(Handle, PChar(FileName), 'file', MB_OK);
end;
procedure ListBoxClick;
var
N : Integer;
begin
MessageBoxA(Handle, 'ListBox Message', 'we got your message', MB_OK);
N := SendMessage(ListBox1,LB_GETCOUNT, 0, 0);
if N = 1 then
ListBoxAdd(ListBox1,'new item')
else
ListBoxDelete(ListBox1,N-1);
end;
procedure ComboBoxClick;
var
N : Integer;
begin
N := SendMessage(ComboBox1,CB_GETCOUNT, 0, 0);
MessageBoxA(Handle, PChar(Format('ComboBox Message%SItems : %d', [#10,N])), 'we got your message', MB_OK);
end;
{ Custom WindowProc function }
function WindowProc(hWnd, uMsg, wParam, lParam: Integer): Integer; stdcall;
begin
{ for all the usuall messages }
Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
{ Checks for messages }
case uMsg of
WM_COMMAND : if lParam = Button1 then CheckPassword else
if lParam = Button2 then DialogOpen else
if lParam = Button3 then DialogSave {else
if lParam = ListBox1 then ListBoxClick else
if lParam = ComboBox1 then ComboBoxClick};
WM_DESTROY : Halt;
end;
end;
begin
{ ** Register Custom WndClass ** }
SetInstance(hInstance);
Inst := hInstance;
FillChar(WinClass, SizeOf(WinClass), 0);
with WinClass do
begin
style := CS_CLASSDC or CS_PARENTDC;
lpfnWndProc := @WindowProc;
hInstance := Inst;
hbrBackground := color_btnface + 1;
lpszClassname := 'SMALL_TESTWINDOW';
hCursor := LoadCursor(0, IDC_ARROW);
end; { with }
RegisterClass(WinClass);
{ ** Create Main Window ** }
Handle := FastForm('SMALL_TESTWINDOW','Small unit TestWindow 1.00',363, 100, 305, 400);
{ ** Create a button ** }
Button1 := CreateButton('OK', handle, 216, 8, 75, 49 );
Button2 := CreateButton('Open Dialog', handle, 215, 230, 80, 50);
Button3 := CreateButton('Save Dialog', handle, 215, 290, 80, 50);
{ ** Create a label (static) ** }
Label1 := CreateLabel(handle, 8, 12, 76, 13);
Label2 := CreateLabel(handle,8, 34, 76, 13);
{ ** Create an edit field ** }
Edit1 := CreateMaskedEdit(handle, 88, 8, 121, 21);
Edit2 := CreateEdit(handle, 88, 32, 121, 21);
{ ** Create an List Box ** }
ListBox1 := CreateListBox(handle, 8, 60, 281, 160);
ComboBox1 := CreateComboBox(handle, 8, 230,200,140);
{ ** Create Font Handle ** }
hFont := MakeFont('MS Sans Serif');
{ Change fonts }
if hFont <> 0 then
begin
SetFont(Button1 , hFont);
SetFont(Button2 , hFont);
SetFont(Button3 , hFont);
SetFont(Label1 , hFont);
SetFont(Edit1, hFont);
SetFont(Label2, hFont);
SetFont(Edit2, hFont);
SetFont(ListBox1, hFont);
SetFont(ComboBox1, hFont);
end;
{ Change label (static) text }
SetWindowText(Label1, 'Enter password:');
SetWindowText(Label2, 'My Label');
{ Add a string to the ListBox }
ListBoxAdd(ListBox1, 'First Item');
ListBoxAdd(ListBox1, 'Second Item');
ListBoxAdd(ListBox1, 'a few items');
ListBoxAdd(ListBox1, 'last Item');
{ Add a string to the ListBox }
ComboBoxAdd(ComboBox1, 'First Item');
ComboBoxAdd(ComboBox1, 'Second Item');
ComboBoxAdd(ComboBox1, 'a few items');
ComboBoxAdd(ComboBox1, 'Item');
ComboBoxAdd(ComboBox1, 'Item');
ComboBoxAdd(ComboBox1, 'last Item');
{ Set the focus to the edit control }
SetFocus(Edit1);
UpdateWindow(Handle);
{ ** Message Loop ** }
while(GetMessage(Msg, Handle, 0, 0)) do
begin
TranslateMessage(msg);
DispatchMessage(msg);
end; { while }
end.