duci.ro FORUM at forumco.com
duci.ro FORUM at forumco.com
Home | Profile | Register | Active Topics | Active Polls | Members | Private Messages | Search | FAQ
Username:
Password:
Save Password
Forgot your Password?




 All Forums
 ProgrammingPool environment
 Functiile WinAPI32
 Interfata WinApi32-FREE PASCAL
 Forum Locked
 Send Topic to a Friend
 Printer Friendly
Author Previous Topic Topic Next Topic  

n/a
deleted


5 Posts

Posted - 08/13/2005 :  07:29:45  Show Profile  Email Poster Send n/a a Private Message
{$APPTYPE GUI}
{$MODE DELPHI}
program INTERFATA_INTRARE_IESIRE_3;
uses
strings , windows ;

type
SirCaractere = array [0.. 260 ] of char ;

const
AppName = 'Interfata';

var
NumeFisier : SirCaractere ;
Window : HWND ;
Menu : HMENU ;

{********************************************************************}

function SelectieFisier(var FName : SirCaractere ; Decizie : boolean ): boolean ;
const
Filtru : PCHAR = 'Fisiere text (*.txt)'#0'*.txt'#0+
'Toate fisierele (*.*)'#0'*.*'#0#0 ;
Extensie : PCHAR = 'txt';
var
NumeStructura : OPENFILENAME ;
Begin
FillChar ( NumeStructura, sizeof (NumeStructura),0 );
FName[ 0 ] := #0 ;
with NumeStructura do
begin
LStructSize := sizeof (NumeStructura);
HWndOwner := Window;
LpStrFilter := Filtru;
LpStrFile := @FName;
lpstrTitle :='Deschide fisier';
NMaxFile := MAX_PATH ;
Flags := OFN_EXPLORER or OFN_HIDEREADONLY ;
if Decizie then
begin
Flags := Flags or OFN_FILEMUSTEXIST ;
end ;
LpStrDefExt := Extensie;
end ;

if Decizie then
SelectieFisier := GetOpenFileName (@NumeStructura)
else
SelectieFisier := GetSaveFileName (@NumeStructura);
End ;

{********************************************************************}

function WindowProc(Window: HWnd; AMessage, WParam,
LParam: longint ): longint ; stdcall ; export ;
var
dc : HDC ;
ps : PAINTSTRUCT ;
r,rc : RECT ;
hwndEdit,hwndEdit1,hwndEdit2,hButon : HWND ;
pEnd , szNume : SirCaractere ;
xxyy : real ;
i : integer ;
iCodMesaj : longint ;

begin
WindowProc := 0 ;

case AMessage of

WM_PAINT :
begin
dc:=BeginPaint (Window,@ps);
GetClientRect ( Window,@r);
MoveToEx (dc,150,150,1);
LineTo (dc,200,200);
DrawText (dc,'< Linie si "Hello world" grafic ',-1,@ r,
DT_SINGLELINE or DT_CENTER or DT_VCENTER );
EndPaint (Window,ps);
exit ;
end ;

WM_CREATE :
begin
hwndEdit := CreateWindowEx (
WS_EX_CLIENTEDGE OR WS_OVERLAPPEDWINDOW ,
'ListBox',{'Edit',}
'Eticheta' ,
WS_CHILD or WS_VISIBLE or WS_SYSMENU
or WS_VSCROLL or WS_HSCROLL or
{ ES_LEFT OR ES_MULTILINE OR ES_AUTOVSCROLL , }
LBS_HASSTRINGS ,
110 , 5 , 380 , 130 ,
Window , 10 , system.MainInstance ,
nil
);
StrPCopy (@pEnd[0],'text exceptional');
for i:=1 to 10 do
SendMessage ( hwndEdit , LB_ADDSTRING {WM_SETTEXT }
, 0 ,longint (@pEnd) ) ;

hwndEdit1 := CreateWindowEx (
WS_EX_DLGMODALFRAME or
WS_EX_CLIENTEDGE ,
'Edit',
'Campul 1',
WS_CHILD or WS_VISIBLE or ES_LEFT or ES_AUTOHSCROLL ,
10 , 5 , 80 , 26 ,
Window , 11 , system.MainInstance , NULL
);
hwndEdit2 :=
CreateWindowEx (
{WS_EX_DLGMODALFRAME OR }
WS_EX_CLIENTEDGE ,
'Edit',
'Campul 2',
WS_CHILD or WS_VISIBLE or ES_LEFT or ES_AUTOHSCROLL ,
10 , 45 , 80 , 26 ,
Window , 12 , system.MainInstance , nil
);
hButon := CreateWindow (
'Button',
'Calculeaza',
WS_CHILD or WS_VISIBLE or BS_PUSHBUTTON ,
10 ,85 , 80 , 26 ,
Window , 21 , system.MainInstance , nil
);
exit ;
end ;

WM_COMMAND :
begin
iCodMesaj := LOWORD ( wParam );
if iCodMesaj=101 then
begin
SelectieFisier( NumeFisier , TRUE );
SendDlgItemMessage (Window,10,LB_ADDSTRING,0,longint (@NumeFisier) );
i:=SendDlgItemMessage (Window, 10 , LB_GETCOUNT , 0 , 0 );
SendDlgItemMessage (Window, 10 , LB_SETCURSEL , i - 1 , 0 );
end ;
if ( iCodMesaj = 21 ) then //butonul apasat
begin
{GetDlgItemText ( Window, 11 , szNume , 100 ) ;}
{StrPCopy ( @pEnd [ 0 ], 'transfer de text'); }
{SendMessage ( 12 , WM_SETTEXT , 1 , longint (@pEnd) );}{ nu merge }
GetDlgItemText ( Window , 12 , pEnd , 100 ) ;{ merge}
MessageBox ( HWND_DESKTOP , pEnd ,'citit pEnd',MB_OK );
{Afiseaza rezultatul}
SendDlgItemMessage (Window,11,WM_SETTEXT,0,longint (@pEnd) );
for i:=1 to 10 do
SendDlgItemMessage (Window,10,LB_ADDSTRING,0,longint (@pEnd) );
{Du cursorul la sfarsitul afisajului}
i:=SendDlgItemMessage (Window, 10 , LB_GETCOUNT , 0 , 0 );
SendDlgItemMessage (Window, 10 , LB_SETCURSEL , i - 1 , 0 );
end ; {21 : iCodMesaj}
exit ;
end ;

WM_DESTROY :
begin
PostQuitMessage ( 0 );
Exit ;
end ;
end ;

WindowProc := DefWindowProc (Window, AMessage, WParam, LParam);
end ;

{ Inregistrarea clasei la Windows }
function WinRegister : boolean ;
var
WindowClass: WNDCLASS ;
begin
WindowClass.Style := CS_HREDRAW or CS_VREDRAW ;
WindowClass.lpfnWndProc := WndProc (@WindowProc);
WindowClass.cbClsExtra := 0 ;
WindowClass.cbWndExtra := 0 ;
WindowClass.hInstance := system.MainInstance;
WindowClass.hIcon := LoadIcon (0 , IDI_APPLICATION );
WindowClass.hCursor := LoadCursor (0 , IDC_ARROW );
WindowClass.hbrBackground := GetStockObject ( LTGRAY_BRUSH );{BLACK_BRUSH ) ; WHITE_BRUSH );}
WindowClass.lpszMenuName := nil ;
WindowClass.lpszClassName := AppName;

Result := RegisterClass (WindowClass) <> 0 ;
end ;

{ Crearea clasei }
function WinCreate: HWND ;
var
Window: HWND ;
begin
Window := CreateWindow (AppName, 'Interfata Intrare-Iesire (Pascal WinAPI32)',
WS_OVERLAPPEDWINDOW ,
CW_USEDEFAULT ,CW_USEDEFAULT ,
544,380,//CW_USEDEFAULT ,CW_USEDEFAULT ,
0 , 0 , system.MainInstance , nil );

if Window <> 0 then begin
Menu:=CreateMenu ;
AppendMenu ( Menu,MF_STRING ,101 ,'&Fisier...' );
SetMenu ( Window,Menu );
ShowWindow ( Window, CmdShow );
UpdateWindow ( Window );
end ;

Result := Window;
end ;

var
AMessage: MSG ;


BEGIN
if not WinRegister then begin
MessageBox (0 , 'Register failed', nil , MB_OK );
Exit ;
end ;
Window := WinCreate ;
if longint (Window) = 0 then begin
MessageBox (0 , 'WinCreate failed', nil , MB_OK );
Exit ;
end ;

while GetMessage (@AMessage, 0 , 0 , 0 ) do begin
TranslateMessage (AMessage);
DispatchMessage (AMessage);
end ;
Halt (AMessage.wParam);
END.

Guest
  Previous Topic Topic Next Topic  
 Forum Locked
 Send Topic to a Friend
 Printer Friendly
Jump To:
duci.ro FORUM at forumco.com © 2000-05 ForumCo.com Go To Top Of Page
Generated in 0.17 seconds. Hello from Duci !!! Snitz Forums 2000
RSS Feed 1 RSS Feed 2
Powered by ForumCo 2000-2008
TOS - AUP - URA - Privacy Policy
ForumCo Free Blogs and Galleries
Signup for a free forum or Go Banner Free