Tamanho do Executável

Delphi

17/03/2004

Bom Dia! Espero que possam me ajudar.

Criei uma aplicaçãozinha básica, sem acesso a banco.

Mesmo sendo MUITO simples, o executável fica imenso.

Como eu posso saber o que tirar das RUNTIMES PACKAGES para que fique pequeno e rode em qualquer computador Windows, sem precisar ter o Delphi instalado?

Se souberem de algum site que explica também poderá ajudar.

Desde já agradeço.
Abraço a todos!


Damasoneto

Damasoneto

Curtidas 0

Respostas

Nerdex

Nerdex

17/03/2004

Olha só. Uma aplicação somente com o form ja cria 360 Kb, se vc colocar um botão da paleta additional some 60 Kb eu acho... e assim vai...

Primeira dica:
Utilize um Front End do executável UPX que eu desenvolvi para realizar a compressão de um executável: tipo um executável de 100 Kb ficara com 30Kb. Uma diminuição de 70¬...
baixe em: www.process.pop.com.br

Segunda dica:
Vou colar aí em baixo, códigos - APIs para a criação de formulários e objetos feitos no braço. Após estudá-los e testá-los vc verá a diferença...

LIÇÃO 1
*********
program Project1;
{This Program gets System Info to a text file and opens that
file in the default Text edit program. There is no GUI created
and No message loop is used. User interaction is done with
2 Message Boxes}

uses
Windows, ShellApi;
{ShellApi is added to use ShellExecute( )}

{$R *.RES}

var
WinDir: Array[0..4095] of Char;
{WinDir: Array[0..65535] of Char;}
{Getting PChar strings from the Windows OS requires
the recieving var to have memory for that string.
An array of Char does not change it´s memory use like
a PChar or String var. Using a Larger array of Char
will make sure you have enough space for the string.
I use Array[0..4095] alot, 4 Kb will be more than
is needed most of the time, If you need it for a
Multiline Edit then Array[0..65535] will cover the
max size of it´s text buffer}

WindowsDir, SystemDir, CurrentDir, ComName, UserName: String;
Transfer: PChar;
SystemTime1: TSystemTime;
ScreenWidth, ScreenHeight, WinBorder: Integer;
CharSize: Cardinal;
GotMouse, ShowSound: Boolean;
GotVersion: Boolean = False;
WorkRect: TRect;
OSVersionInfo1: TOSVersionInfo;

const
TxtFile = ´C:\Info Folder\System Info.txt´;

function Int2Str(Number : Int64) : String;
var Minus : Boolean;
begin
{SysUtils is not in the Uses Clause so I can not use IntToStr( )
and have to define an Int2Str( ) function here}
Result := ´´;
if Number = 0 then
Result := ´0´;
Minus := Number < 0;
if Minus then
Number := -Number;
while Number > 0 do
begin
Result := Char((Number mod 10) + Integer(´0´)) + Result;
Number := Number div 10;
end;
if Minus then
Result := ´-´ + Result;
end;


procedure MakeTextFile;
var
File1: TextFile;
MemStatus: TMemoryStatus;
begin
AssignFile(File1, TxtFile);
{$I-}
Rewrite(File1);
{$I+}
if IOResult = 0 then
begin
WriteLn(File1,´ the Time is ´+Int2Str(SystemTime1.wHour)+´:´
+Int2Str(SystemTime1.wMinute));
WriteLn(File1,´ This File is ´+TxtFile);
WriteLn(File1,´This Program is ´+ParamStr(0));
WriteLn(File1,´Windows Folder is ´+WindowsDir);
WriteLn(File1,´Windows System Folder is ´+WinDir );
{WinDir, Array of Char can be used as a String}
WriteLn(File1,´Current Folder is ´+CurrentDir);
WriteLn(File1,´Computer Name is ´+ComName);
WriteLn(File1,´User Name is ´+UserName);

{ExpandEnvironmentStrings is used to get DOS environment info}
if ExpandEnvironmentStrings(´¬PATH¬´,WinDir,512) <> 0 then
WriteLn(File1,´Path is - ´+WinDir);
if ExpandEnvironmentStrings(´¬TMP¬´,WinDir,MAX_PATH) <> 0 then
WriteLn(File1,´TMP is - ´+WinDir);

if GotMouse then
WriteLn(File1,´Mouse is Present´)
else WriteLn(File1,´No Mouse is Present´);
if ShowSound then
WriteLn(File1,´Sounds are made Visible´)
else WriteLn(File1,´Sounds are Not made visible´);
WriteLn(File1,´Screen Work Area Rectangle Top is ´+Int2Str(WorkRect.Top)+
´ Left is ´+Int2Str(WorkRect.Left)+´ Bottom is ´+Int2Str(WorkRect.Bottom)
+´ Right is ´+Int2Str(WorkRect.Right));
WriteLn(File1,´Windows Sizing Border multiplier is ´+Int2Str(WinBorder));
WriteLn(File1,´Screen Width is ´+Int2Str(ScreenWidth)+´ Screen Height is ´
+Int2Str(ScreenHeight));

MemStatus.dwLength := SizeOf(MemStatus);
{TMemoryStatus has a Size variable so you have to intialize it}
GlobalMemoryStatus(MemStatus);
{GlobalMemoryStatus gets memory and page file info}
WriteLn(File1,´Tolal System Memory is ´+Int2Str(MemStatus.dwTotalPhys)
+´ bytes - Total Page File is ´+Int2Str(MemStatus.dwTotalPageFile)
+´ Memory Load is ´+Int2Str(MemStatus.dwMemoryLoad)+´¬´);

if GotVersion then
begin
WriteLn(File1,´Windows Major Version is ´
+Int2Str(OSVersionInfo1.dwMajorVersion)
+´ Minor Version is ´+Int2Str(OSVersionInfo1.dwMinorVersion)
+´ CSDversion is´+OSVersionInfo1.szCSDVersion);
if OSVersionInfo1.dwPlatformId = VER_PLATFORM_WIN32_NT then
WriteLn(File1,´This is a windows NT system´);
end;
end;
{$I-}
CloseFile(File1);
{$I+}
if IOResult = 0 then
ShellExecute(0, ´open´, TxtFile, nil, nil, SW_SHOWNORMAL);
{ShellExecute( ) is included here because it is a very useful function.
Here it displays the ´System Info.txt´ so I do not have to make a GUI
with a Multiline Edit control to show it. It can also be set to do the same
with NotePad.exe instead of the default, like this
ShellExecute(0, ´open´, ´Notepad.exe´, TxtFile, nil, SW_SHOWNORMAL);}
end;


begin // / / / / main program begin
GetLocalTime(SystemTime1);
{GetLocalTime will find out the Date and Time}

{when geting a PChar from windows OS, you will have to deal
with getting and setting the amount of memory needed
for the PChar, Array of Char, or String. The following
examples will show different methods of getting strings}

GetWindowsDirectory(WinDir, MAX_PATH);
{WinDir is a Fixed length array of Char, the array can be
larger than the amount of charaters needed, but not smaller.
See the various array lengths in the var clause above.
MAX_PATH is a const used for the Maximum number of charaters
allowed in a path string}

WindowsDir := String(WinDir);

GetSystemDirectory(WinDir,GetSystemDirectory(WinDir,1)+1);
{the result of GetSystemDirectory(WinDir,1) is the length of
the PChar string for the System Directory, add 1 for the
null charater at the end of a PChar string}
SystemDir := String(WinDir);

SetLength(CurrentDir,GetCurrentDirectory(1,nil));
{You can use a pascal String to get the PChar string if you
SeLength( ) to the amount of characters needed and then
typecast the String to PChar}
GetCurrentDirectory(Length(CurrentDir)+1,PChar(CurrentDir));

CharSize := MAX_COMPUTERNAME_LENGTH + 1;
{the computerName has a max length, given in
MAX_COMPUTERNAME_LENGTH, so you can use this to set the memory
needed for the PChar string, it´s OK if it´s more than is needed}
GetMem(Transfer, CharSize);
{allocate memory to the Transfer variable
Always use FreeMem( ) after a GetMem}
GetComputerName(Transfer, CharSize);
ComName := String(Transfer);
FreeMem(Transfer);

GetUserName(nil,CharSize);
{GetUserName(nil,CharSize) gets the length of the
UserName string into the CharSize var}
SetLength(UserName,CharSize);
GetUserName(@UserName[1],CharSize);
{the address of the first Charater of the String
@UserName[1] is used instead of a PChar typecast}


ScreenWidth := GetSystemMetrics(SM_CXSCREEN);
{GetSystemMetrics( ) can get you alot of useful info
see API help for the List of parameters}
ScreenHeight := GetSystemMetrics(SM_CYSCREEN);
GotMouse := Boolean(GetSystemMetrics(SM_MOUSEPRESENT));

SystemParametersInfo(SPI_GETSHOWSOUNDS,0,@ShowSound,0);
{SystemParametersInfo( ) can get and set some System settings}
SystemParametersInfo(SPI_GETWORKAREA,0,@WorkRect,0);
SystemParametersInfo(SPI_GETBORDER,0,@WinBorder,0);

OSVersionInfo1.dwOSVersionInfoSize := SizeOf(OSVersionInfo1);
{many Windows Record structures have a Size variable which
must be filled BEFORE the address of the Record is passed
to Windows}
if GetVersionEx(OSVersionInfo1) then
GotVersion := True;
{GetVersionEx will provide you with Windows version info
for the computer that is running this program
Notice that the variable OSVersionInfo1 does not need a @, like
the @WorkRect and @WinBorder used in the SystemParametersInfo,
there is only one Type of variable allowed in GetVersionEx,
but in SystemParametersInfo the variable can be a TRect, a Boolean
an Integer or other Type so a Pointer Type is used}


{All user input is from Message Boxs, and the Result (ID_YES) will
determine what is done
look in the API help for more MessageBox button and icon options}
if MessageBox(0,PChar(´Today is ´+Int2Str(SystemTime1.wMonth)+´/´
+Int2Str(SystemTime1.wDay)+´/´
+Int2Str(SystemTime1.wYear)+#10
+´Do you want to create the Folder ´Info Folder´ ? ?´
+10+´To place a System Info.txt file with System Information´),
´Make Folder ?´, MB_YESNO or MB_ICONQUESTION or MB_DEFBUTTON2
or MB_SETFOREGROUND) = ID_YES then
begin
if CreateDirectory(´C:\Info Folder´,nil) then
begin
{in the MessageBox function there is the hWnd, handle of owner window,
which is the window handle to return focus to, after the message box.
You would set your Main Window handle here, but there is no Main
Window in this App so I set it to 0 instead.}

if MessageBox(0,´Do you want to create the File ´System Info.txt´ ? ?´,
´Make File ?´, MB_OKCANCEL or MB_ICONQUESTION) = ID_OK then
MakeTextFile;
end else
MessageBox(0,´Could not create a Folder´,
´ ERROR, folder was not created´, MB_OK or MB_ICONERROR)
end;

end.

LIÇÃO 2
**********
program Project1;
{a very basic GUI window creation application that will process
several messages in the WndMessageProc fuction}

uses
Windows, Messages;

{$R *.RES}

var
wClass: TWndClass;
hAppHandle, hMessBut, hExitBut: HWND;
Msg: TMSG;

function Int2Str(Number : Int64) : String;
var Minus : Boolean;
begin
{SysUtils is not in the Uses Clause so I can not use IntToStr( )
and have to define an Int2Str( ) function here}
Result := ´´;
if Number = 0 then
Result := ´0´;
Minus := Number < 0;
if Minus then
Number := -Number;
while Number > 0 do
begin
Result := Char((Number mod 10) + Integer(´0´)) + Result;
Number := Number div 10;
end;
if Minus then
Result := ´-´ + Result;
end;

procedure DoMessage(Param: Integer);
var
Str1: String;
begin
{the LParam of the WndMessageProc is sent here as Param, this number is shown in the
MessageBox along with the WM_COMMAND number and the number for hMessBut}
Str1 := ´A short Message for WM_COMMAND as ´+Int2Str(WM_COMMAND)+#10´ with LParam as ´+
Int2Str(Param)+´ and hMessBut as ´+Int2Str(hMessBut);
MessageBox(hAppHandle,PChar(Str1),
´Button Click´, MB_OK or MB_ICONQUESTION);
end;

function WndMessageProc(hWnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UNIT; stdcall;
begin
{This is the ´Window Proc´ used to communicate with the OS, These messages are how the
Operating System tells this program what has happened, look up the 5 WM_
messages in the Win32 API Help
This function must send a Result back to Windows for its ´message´ back to the OS, which
may change what the OS does for that Msg.
Each of these messages will produce a MessageBox so you can see when the message
gets to this function}
Result := 0;
case Msg of
WM_CREATE: begin
{the CreateWindow( ) fuction sends this WM_CREATE to it´s Class´s lpfnWndProc, after the window is
created, but Before the CreateWindow function returns}
if MessageBox(hAppHandle,´A Message for WM_CREATE´#10´Do You want this Program to Open?´,
´Will OPEN ? ?´, MB_YESNO or MB_ICONQUESTION) = IDNO then
begin
{if the result is -1 then this new window will be Destroyed before it is
shown, since this is the MAIN window of this Program a Result of -1 will
tell the OS to call DestroyWindow(hAppHandle); and end this Program}
Result := -1;
Exit;
{if you want the Result to be -1 then you MUST Exit here so
DefWindowProc( ) will NOT be called and change the Result to a 0}
end;
end;

WM_DESTROY: begin
{WM_DESTROY is sent After the window is hidden but before the window is destroyed}
MessageBox(0,´A Message for WM_DESTROY´#10´the Window has not been Destroyed yet´,
´Window is Hidden´, MB_OK or MB_ICONQUESTION);
PostQuitMessage(0);
{IMPORTANT, to end this Program you need to end your GetMessage Loop.
To do this you will have to send the WM_QUIT message with PostQuitMessage(0)}
end;

WM_CLOSE: if MessageBox(hAppHandle,´A Message for WM_CLOSE´10´Do You want this Program to Close?´,
´Will Close ? ?´, MB_YESNO or MB_ICONQUESTION) = IDNO then
{the WM_CLOSE message is sent to tell your window to CLOSE
and since this is the Main window, to Exit this processes}
begin
{Result := 0;}
{unlike WM_CREATE, the Result of the WM_CLOSE message DOES NOT change what the OS does.
you must Exit in order to keep DefWindowProc( ) from calling DestroyWindow(hAppHandle);}
Exit;
end;

WM_CHAR: MessageBox(hAppHandle, PChar(´A Message for WM_CHAR as ´+Int2Str(WM_CHAR)
+#10´you typed a ´+Chr(wParam)),
´Keyboard Char´, MB_OK or MB_ICONQUESTION);
{the WM_CHAR message is sent for keyboard charater input with the
charater Ord value in the wParam}

WM_COMMAND: if lParam = Integer(hMessBut) then DoMessage(lParam)
else if lParam = Integer(hExitBut) then
PostMessage(hAppHandle, WM_CLOSE, 0, 0);
{when a button is clicked a WM_COMMAND message is sent to it´s parent´s
Message Proc with the lParam set to the button´s Handle}

end;
Result := DefWindowProc(hWnd,Msg,wParam,lParam);
{VERY VERY IMPORTANT - to get normal windows default behavior you must call DefWindowProc for that
message, if you DO NOT want normal windows behavior then DO NOT let DefWindowProc be called.
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 // then MAIN Program Begin / / / / / / / / / / / / / / / / /
wClass.hInstance := hInstance;
with wClass do
begin
{there are more wClass parameters which are not used here to
keep this simple}
style := 0;
hIcon := LoadIcon(hInstance,´MAINICON´);
lpfnWndProc := @WndMessageProc;
hbrBackground:= COLOR_BTNFACE+1;
{COLOR_BTNFACE is not a brush, but sets it to a system brush of that Color}
lpszClassName:= ´First 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);

cbClsExtra := 0;
cbWndExtra := 0;
lpszMenuName := ´´;
end;

RegisterClass(wClass);

{the First Window created in a Program for a Registered Class will be the apps Main Window
or ´Form´ in Delphi terminology, and will be the Main Form for this App.}
hAppHandle := CreateWindow(
wClass.lpszClassName,// pointer to registered class name string
´first Window app´,// 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
Integer(CW_USEDEFAULT),// horizontal position of window
Integer(CW_USEDEFAULT),// vertical position of window
// CW_USEDEFAULT is from earier 16-bit windows programing. I included it
// here only because most begining programming instuctions use it. But I
// don´t see much use for it, you may as well use 0, 0
386,// window width
250,// window height
0,// handle to parent or owner window
// this is the MAIN window, so it does not have a parent
0,// handle to menu or child-window identifier
// if you install a main Menu, it´s handle goes here
hInstance,// handle to application instance
nil // pointer to window-creation data
// window-creation data can be infromation about
// creation options or data storage
);

{below is an Alternate main window Creation, which will give the same window
style as the one above, it includes all the style options of WS_OVERLAPPEDWINDOW
as individual paramerers.
use the one above or this one but not both.}
{hAppHandle := CreateWindow( wClass.lpszClassName, ´first Window app´,
WS_CAPTION or WS_MINIMIZEBOX or WS_MAXIMIZEBOX or WS_SYSMENU or WS_THICKFRAME,
// these window styles will give the same style as WS_OVERLAPPEDWINDOW
// if you leave out the WS_MINIMIZEBOX or the WS_MAXIMIZEBOX then
// those caption buttons will be grayed out (not enabled)
// if you leave out the WS_THICKFRAME then it will NOT be mouse sizable
200, 100, 386, 250,
0,// handle to parent or owner window
0,// handle to menu or child-window identifier
hInstance,// handle to application instance
nil // pointer to window-creation data
);}

if hAppHandle = 0 then
begin
{I do not usually include a ´if hAppHandle = 0 then´
I put it here to show how to test for success or failure
of the CreateWindow}
UnRegisterClass(wClass.lpszClassName, hInstance);
Exit;
end;

{all of the next CreateWindow will have hAppHandle
as the Parent window}

hMessBut := CreateWindow(´Button´,´Show Message´,
WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,
123,128,112,28,hAppHandle,0,hInstance,nil);
{notice that the hApphandle is given as the Parent of this button,
this tells the OS to place it on the Client area of the parent,
try it with 0 (no Parent) instead of hAppHandle}

hExitBut := CreateWindow(´Button´,´Exit´,
WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,
12,42,60,26,hAppHandle,0,hInstance,nil);

{add another button Control here and put a statement in the WM_COMMAND
of the function WndMessageProc, to get it´s click event}

CreateWindow(´Static´, ´Use Keyboard to Type a charater´,
WS_VISIBLE or WS_CHILD, 10, 12, 300, 20, hAppHandle, 0, hInstance, nil);
{this window is a Static control, static means that it DOES NOT get Keyboard or
mouse input, this is used like a TLabel in the VCL, for text display.
NOTICE that the returned Handle for this control is NOT stored in a variable like
hMessBut was, I do not need this Control Handle because I do not change this control
in this program, If I need to move or change the text of this control, I would get
the Handle in a variable like hLabel1 }

{add another Static Control here as a Label for practice}

ShowWindow(hAppHandle, SW_SHOWNORMAL);
{the WS_VISIBLE style was NOT set in the Main window creation
so you need to call ShowWindow( ) to make it visible.
This ´ShowWindow´ with SW_SHOWNORMAL is a Standard way to make your program visible,
if you use this then your progrm can be started by another program as
Maximized or Minimized, otherwize those options will be ignored}

UpdateWindow(hAppHandle);
{the update line above is not needed here because the message loop
has not started yet, but I have added it to show that you need to
update to get changes to a window to be visible after the message loop starts}

while GetMessage(Msg,0,0,0) do
begin
{GetMessage will return True until it gets a WM_OUIT message. So this
Program will keep running untill you Post a Quit Message}
TranslateMessage(Msg); {Translate any WM_KEYDOWN keyboard Msg
to a WM_CHAR message}
DispatchMessage(Msg); {this Sends Msg to the address of the
´Window Procedure´ set in the Resistered
Window´s Class for that window}
end;

{there are 3 calls for CreateWindow( ) for a child window, but
we do not have to use DestroyWindow( ), when the
DefWindowProc(hWnd,Msg,wParam,lParam);
gets the WM_CLOSE message it will call DestroyWindow( ) for that
window (hWnd). The system will also destroy all child windows when
it destroys the parent. There is a complex structure (Record) setup
in the OS for each window, which records it´s height and width, and
it´s Parent and Children, and MANY other things.}

end.

LIÇÃO 3
**********
program Project1;
{this Program will create windows, a Main Form, 5 buttons
and an Edit and Static controls. It will demonstrate how
Windows messages are used to signal events (mouse Clicks and
program termination) and use SendMessage to get and change
window properties}

uses
Windows, Messages;

{$R *.RES}

var
wClass: TWndClass;
hAppHandle, hEdit, hLabel1, hLabel2, hIcon1,
hKillBut, hMakeBut, hChangeBut, hExitBut, hManyBut: THandle;
MainMsg: TMSG;
DirPath: Array[0..MAX_PATH] of Char;
NumMessages, GetMess: Cardinal;
dMess: Byte;

function Int2Str(Number : Int64) : String;
var Minus : Boolean;
begin
{SysUtils is not in the Uses Clause so I can not use IntToStr( )
and have to define an Int2Str( ) function here}
Result := ´´;
if Number = 0 then
Result := ´0´;
Minus := Number < 0;
if Minus then
Number := -Number;
while Number > 0 do
begin
Result := Char((Number mod 10) + Integer(´0´)) + Result;
Number := Number div 10;
end;
if Minus then
Result := ´-´ + Result;
end;

procedure MakeTextFile;
var
File1: TextFile;
begin
GetWindowText(hEdit,DirPath,MAX_PATH);

{Notice that DirPath can be used as a PChar here in GetWindowText
and as a String in MessageBox below}
if CreateDirectory(DirPath,nil) then
begin
if MessageBox(hAppHandle, Pchar(´the folder ´´+ DirPath +
´´ has been created.´#13´Do you want to create the File ´text note.txt´ ? ?´),
´Folder It´, MB_YESNO or MB_ICONQUESTION) = ID_YES then
begin
AssignFile(File1, DirPath+´test note.txt´);
{$I-}
Rewrite(File1);
{$I+}
if IOResult = 0 then
Write(File1,´wow ParamStr 0 is ´+ParamStr(0));
{$I-}
CloseFile(File1);
{$I+}
end;
end else
MessageBox(hAppHandle,´The Folder was NOT Created, it may already exist´,
´ERROR on CreateDirectory´, MB_OK or MB_ICONERROR);
end;

function WndMessageProc(hWnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UNIT; stdcall; forward;
{this is a Foward declaration for the WndMessageProc function called in
the next ManyMessage procedure. Without this, the compiler does not know
about the WndMessageProc yet because it´s defined after ManyMessages and
will not allow it´s call without this foward declaration}

procedure ManyMessage;
var
NewTitle: PChar;
begin
{here 5 different methods are used to do the same thing,
change the Title Barr Caption of this Form. This is to help
you see some of the connections in system methods.
The windows message system allows muti-Tasking by placing
a message for a window into a message queue, so that program
can get that message when it is finished other tasks and has
processor time for that message}

NewTitle := PChar(´New Title ´+Int2Str(dMess));
{dMess is used to change the method used}

case dMess of
0: SetWindowText(hAppHandle, NewTitle);
{The SetWindowText function causes a WM_SETTEXT message to
be sent to the window, you use a PChar variable for the text}

1: SendMessage(hAppHandle,WM_SETTEXT,0,Integer(NewTitle));
{An application sends a WM_SETTEXT message to set the text of a window.
This places the WM_SETTEXT in the message queue and goes through the
GetMessage( ) loop and is dispatched to hAppHandle´s WndMessageProc( ).
Now WndMessageProc( ) uses DefWindowProc( ) to get the system to change
the Caption buffer and redraw the Caption, You use an Integer variable
for the text (which is a memory address for the PChar)}

2: WndMessageProc(hAppHandle,WM_SETTEXT,0,Integer(NewTitle));
{Calling WndMessageProc( ) directly, will bypass the message queue
Nothing goes through GetMessage with this method, system messages queues
are NOT used. This is similar to delphi Form1.Perform(message,wPar,lPar);}

3: DefWindowProc(hAppHandle,WM_SETTEXT,0,Integer(NewTitle));
{since WndMessageProc( ) does NOT do anything to the WM_SETTEXT message,
we can just call DefWindowProc( ) and bypass the Message queue AND WndMessageProc.}

4: CallWindowProc(Pointer(GetWindowLong(hAppHandle, GWL_WNDPROC)),
hAppHandle, WM_SETTEXT,0, Integer(NewTitle));
{We can also get the system to tell us the address of the system Message
function for a window with GetWindowLong( ) having the GWL_WNDPROC parameter
and then use CallWindowProc( ) to call this message function. Try this with
hEdit instead of hAppHandle to see if it works for the Edit control also.}
end; // case

if dMess > 3 then
dMess := 0 else Inc(DMess);

{it is safer to use the SendMessage( ) and the message queue
and have the system allocate processor use,
but you might want to bypass the message queue for speed}

end;

procedure ChangeLabel;
begin
{here we test for hLabel2, AND we cut down on the number of calls to SetWindowText()
by dividing the NumMessages by 4, if you don´t reduce the number of calls to SetWindowText
then there are so many messages that it will overload and crash}
if (hLabel2 <> 0) and (NumMessages Mod 4 =0) then
SetWindowText(hLabel2, PChar(´Number of Messages ´+Int2Str(NumMessages)+
#10´GetMess ´+Int2Str(GetMess)));
{this static Label will show the number of messages that GetMessage and
WndMessageProc have recieved. Do things like drag this form, resize this form,
type into hEdit or double click the form to see the difference in the number of messages.
Many messages go through the message queue and the GetMessage loop, but many do Not. These
messages, which are sent directly to a window procedure, are called nonqueued messages}
end;

procedure DoChange;
begin
{there are SendMessage or Functions to get and set properties of
windows and controls. Here I want to toggle the hMakeBut with the
hChangeBut, I send the WM_GETFONT message and see if it is the
ANSI_VAR_FONT to determine which state the toggle is in, I could
have used a Boolean variable to record it´s state}

if SendMessage(hMakeBut,WM_GETFONT,0,0) = Integer(GetStockObject(ANSI_VAR_FONT)) then
{SendMessage(hMakeBut,WM_GETFONT,0,0) returns the Handle of the font of hMakeBut
you will find out more about fonts and font handles in a later lession}
begin
SendMessage(hMakeBut,WM_SETFONT,GetStockObject(SYSTEM_FONT),0);
SetWindowText(hMakeBut, ´Make Text File´);
{change the Text of the hMakeBut button}
MoveWindow(hMakeBut,23,128,102,28,True);
{change the position and size of hMakeBut button}
ShowWindow(hKillBut,SW_SHOW);
{show the Delete File button}
SetFocus(hExitBut);
{Changes the focus to hExitBut}
end else
begin
SendMessage(hMakeBut,WM_SETFONT,GetStockObject(ANSI_VAR_FONT),0);
SetWindowText(hMakeBut, ´Other Text´);
MoveWindow(hMakeBut,13,128,84,23,True);
ShowWindow(hKillBut,SW_HIDE);
{hide the Delete file button}
end;
end;

function BadWndProc(hWnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UNIT; stdcall;
begin
{this function is here to try and show you what you get and don´t get if
your Window Proc does NOT handle messages}
Result := 5;
end;

function WndMessageProc(hWnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): UNIT; stdcall;
{var
MinMax1: TMinMaxInfo;}
begin
{This is the ´Window Proc´ to get messages, These messages are how the
Operating System tells this program about events}
Result := 0;
if NumMessages < High(NumMessages)-1 then Inc(NumMessages);
{this increases NumMessages each time this function is called for a message}

case Msg of
WM_COMMAND: if lParam = Integer(hExitBut) then PostMessage(hAppHandle,WM_CLOSE,0,0)
{when a button is clicked a WM_COMMAND message is sent with the lParam set to the
button´s Handle}
else if (LParam = Integer(hMakeBut)) and (HIWORD(wParam) = BN_CLICKED) then
MakeTextFile
{you would not normaly need the (HIWORD(wParam) = BN_CLICKED) but it is here to show you
that it is also in the WM_COMMAND message}
else if LParam = Integer(hKillBut) then DeleteFile(PChar(DirPath+´test note.txt´))
else if LParam = Integer(hChangeBut) then DoChange
else if LParam = Integer(hManyBut) then ManyMessage;

WM_DESTROY: PostQuitMessage(0);

WM_LBUTTONDBLCLK: begin
{This Double Ckick message was enabled in the wClass by CS_DBLCLKS
in style parameter}
MoveWindow(hIcon1, LOWORD(lParam), HIWORD(lParam),32,32, True);
{use MoveWindow( ) to reposition and change the size of a window
the LOWORD(lParam) and HIWORD(lParam) have the X and Y Cursor Position}
end;

WM_RBUTTONUP: MessageBox(hAppHandle,PChar(´X position is ´+Int2Str(LOWORD(lParam))+
´ Y position is ´+Int2Str(HIWORD(lParam))),
´WM_RBUTTONUP message´, MB_OK or MB_ICONQUESTION);
{the WM_RBUTTONUP message is for Right mouse button up event, right click
the client area to see this messageBox}

WM_SYSCOMMAND: begin
{the WM_SYSCOMMAND message is sent when a event from the window (system) menu happens
this includes Maximize, Minumize, Restore, Move, Size, Close and others}
if (wParam and $FFF0) = SC_MAXIMIZE then
MessageBox(hAppHandle,PChar(´Mouse X position is ´+Int2Str(LOWORD(lParam))+
´ Mouse Y position is ´+Int2Str(HIWORD(lParam))+
#10´This is the SC_MAXIMIZE wParam´),
´WM_SYSCOMMAND message´, MB_OK or MB_ICONQUESTION)
else
if (wParam and $FFF0) = SC_MINIMIZE then Exit else
{if you Exit and do not call DefWindowProc, this window will not be minumized}
if (wParam and $FFF0) = SC_RESTORE then MessageBox(hAppHandle,PChar(´Mouse X position is ´+
Int2Str(LOWORD(lParam))+´ Mouse Y position is ´+Int2Str(HIWORD(lParam))+
#10´This is the SC_RESTORE wParam´),
´WM_SYSCOMMAND message´, MB_OK or MB_ICONQUESTION);
end;

WM_WINDOWPOSCHANGING: begin
{the WM_WINDOWPOSCHANGING message is sent Before a windows position changes}
if PWINDOWPOS(lParam).cx > 450 then PWINDOWPOS(lParam).cx := 450;
if PWINDOWPOS(lParam).cy > 300 then PWINDOWPOS(lParam).cy := 300;
{typecast the lParam to a PWindowPos and then change the cx and cy to change the
width and height of this Form}
end;
WM_GETMINMAXINFO: begin
{WM_GETMINMAXINFO is sent Before a window changes it´s dimentions}
//PMinMaxInfo(lParam).ptMaxTrackSize.x := 450;
//PMinMaxInfo(lParam).ptMaxTrackSize.y := 300;
PMinMaxInfo(lParam).ptMinTrackSize.x := 370;
PMinMaxInfo(lParam).ptMinTrackSize.y := 240;
//PMinMaxInfo(lParam).ptMaxSize.x := 640;
//PMinMaxInfo(lParam).ptMaxSize.y := 480;
end;
end; // case

ChangeLabel;
{the ChangeLabel procedure changes Label2}

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 let DefWindowProc be called.
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 / / / / / / / / / / / / / / / / / / / / / /
NumMessages := 0;
GetMess := 0;
hLabel2 := 0;
dMess := 0;

wClass.hInstance := hInstance;

with wClass do
begin
{all of the wClass parameters are used here and
set to 0 if not used}
style := CS_DBLCLKS;
hIcon := LoadIcon(hInstance,´MAINICON´);
lpfnWndProc := @WndMessageProc;
//lpfnWndProc := @BadWndProc;
{you can use BadWndProc to see what happens if the Proc does nothing}

//lpfnWndProc := @DefWindowProc;
{you can use DefWindowProc, but the app will not terminate when the
main Form is destroyed because PostQuitMessage( ) is not called and
the GetMessage loop keeps on going}

hbrBackground:= COLOR_BTNFACE+1;
{COLOR_BTNFACE is not a brush, but sets it to a system brush of that Color}
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_UPARROW);
{I use a non standard Cursor just to show you what happens to the
cursor for this form, notice that the cursor goes back to the
default (arrow) over buttons but not over static controls}

lpszMenuName := ´´;
cbClsExtra := 0;
cbWndExtra := 0;
end;

RegisterClass(wClass);
{more than one Class can be Registered, the lpfnWndProc address
will be used to send all of the messages for windows of this class
when they are dispatched in GetMessage}

{this is the First Window created here, and will be the
Main Form for this App.}
hAppHandle := CreateWindow(
wClass.lpszClassName,// PChar for registered class name
´second Window app´,// PChar for window name (title bar Caption here)
WS_OVERLAPPEDWINDOW{ or WS_VISIBLE},// window style
{WS_OVERLAPPEDWINDOW is the default standard main window with a
Title bar and system menu and sizing border, there is No WS_CHILD here}
100, // horizontal position of window
50, // vertical position of window
386, // window width
250, // window height
0, // handle to parent or owner window
{this is the MAIN window, so it does not have a parent}
0, // handle to menu or child-window identifier
{if you install a main Menu, it´s handle goes here}
hInstance,// handle to application instance
nil // pointer to window-creation data
);

{all of the next CreateWindow will have hAppHandle as the Parent
window}

{this Static control is used as a Label, and it´s style includes WS_CHILD, so
it´s position is on the Client Rect of it´s Parent, hAppHandle,
not Screen corodinates. It´s Height is 42, enought for 2 lines of
System Font text, the text will be auto wrapped to 2 lines}
CreateWindow(´Static´,
´Enter the path with \ at the end, below for the Folder you want Created´,
WS_VISIBLE or WS_CHILD or SS_LEFT,40,10,340,42,hAppHandle,0,hInstance,nil);
{notice that there is no variable like ´hExitBut´ to get this window´s handle,
because it is not not sent messages or changed and no messages are used from it,
and it will be destroyed as a child of hAppHandle on the WM_DESTROY message.
But there is a Handle reference in the Windows OS outside of the memory space
for this App. So if this App exists without a call to Destroy the hAppHandle
window, the Handle for this window will remain in the Windows OS, even though
this thread has ended and this App´s memory is released}

hExitBut := CreateWindow(´Button´,´Exit´,
WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,
285,186,64,28,hAppHandle,0,hInstance,nil);
{This window is a button that will have Text on it, a button event like
left or right click will cause the OS to send a WM_COMMAND message to the
WndMessageProc( ) function, with the lParam as hExit to identify which
button was clicked. In the HIWORD(wParam) will be BN_CLICKED, but this is
for versions before Win3.1 and is not used much}

hEdit := CreateWindowEx(WS_EX_CLIENTEDGE,´Edit´,´C:\Folder path\´,
WS_VISIBLE or WS_CHILD or ES_LEFT or ES_AUTOHSCROLL,
13,54,310,20,hAppHandle,0,hInstance,nil);
{an Edit control can have many styles for different uses. A Control window
will use the System Font by default, to have it use a different font use
SendMessage( ) with WM_SETFONT}

SendMessage(hEdit,WM_SETFONT,GetStockObject(ANSI_VAR_FONT),0);
{to use window OS standard Objects (fonts, brushs, pens) call
GetStockObject with the fnObject as the one you want}

hLabel1 := CreateWindow(´Static´,
´Click the ´Make Text File´ button to create a Folder above and a ´test note.txt´ file in it´,
WS_VISIBLE or WS_CHILD or SS_CENTER,6,88,370,32,hAppHandle,0,hInstance,nil);
SendMessage(hLabel1,WM_SETFONT,GetStockObject(ANSI_VAR_FONT),0);
{unlike the first Static Label, we get a Handle, hLabel1. This is needed to change it´s Font
to Font1 with SendMessage( )}

hLabel2 := CreateWindow(´Static´, ´Number of Messages´,
WS_VISIBLE or WS_CHILD,270,128,98,46,hAppHandle,0,hInstance,nil);
SendMessage(hLabel2,WM_SETFONT,GetStockObject(ANSI_VAR_FONT),0);

hMakeBut := CreateWindow(´Button´,´Make Text File´,
WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,
23,128,102,28,hAppHandle,0,hInstance,nil);

hKillBut := CreateWindow(´Button´,´Delete Text File´,
WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,
143,128,120,28,hAppHandle,0,hInstance,nil);

hChangeBut := CreateWindow(´Button´,´Change MakeBut´,
WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,
10,172,126,26,hAppHandle,0,hInstance,nil);
SendMessage(hChangeBut,WM_SETFONT,GetStockObject(ANSI_FIXED_FONT),0);

hManyBut := CreateWindow(´Button´,´Many Messages´,
WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON or BS_TEXT,
152,172,116,26,hAppHandle,0,hInstance,nil);
SendMessage(hManyBut,WM_SETFONT,GetStockObject(ANSI_FIXED_FONT),0);

hIcon1 := CreateWindow(´Static´, ´MAINICON´, WS_VISIBLE or WS_CHILD or SS_ICON,
1,1,1,1,hAppHandle,0,hInstance,nil);
{a Static control can also display an Icon or Bitmap with the SS_ICON or
SS_BITMAP style, you do not have to LoadIcon from resource, just put the
resource name in the window name parameter. Notice that the width and
height are 1, the OS will auto size the Static control to the size of
the Icon or Bitmap}

ShowWindow(hAppHandle, SW_SHOWDEFAULT);

{GetMessage will return True until it gets a WM_OUIT message}
while GetMessage(MainMsg,0,0,0) do
begin
if GetMess < High(GetMess)-1 then Inc(GetMess);
{this increases the GetMess Count each time a message goes through here}

TranslateMessage(MainMsg); {Translate any WM_KEYDOWN keyboard Msg
to a WM_CHAR message}

{the ´if not´ below tests for a hEdit window message of WM_CHAR, and a wParam of ?
this does NOT send that message to hEdit, try to type a ? into the edit box}
if not ((MainMsg.hWnd = hEdit) and (MainMsg.message = WM_CHAR) and (MainMsg.wParam = Ord(´?´))) then
DispatchMessage(MainMsg); {this Sends Msg to the address of the
´Window Procedure´ set in the Resistered
Window´s Class for that window, hWnd}
end;

end.


GOSTEI 0
Louzada

Louzada

17/03/2004

Você pode usar o ASPACK que faz isto que você quer. Baixe um versão de em [url]http://www.aspack.com[/url]


GOSTEI 0
POSTAR