El Martes, 9 de Noviembre de 2004 08:08, [EMAIL PROTECTED] escribiste:
> I am new to Windows programming so please bear with me if it is some
> trivial mistake.
In my humble opinion, the mistake is using plain Windows API :-)
Unless you have a very good reason, it's better to use a higher level library.
To control every aspect of a Winapi GUI program is too much work. I think
that you would find Lazarus libraries, GTK+ bindings and maybe KOL much
easier.
Anyway, I'll try to answer your question.
> I have created a window with :
> hWindow := CreateWindow (AppName,'First Prog',ws_OverlappedWindow or
> WS_VScroll,
> cw_UseDefault,cw_UseDefault,cw_UseDefault,
> cw_UseDefault,0,0,system.MainInstance,Nil);
>
> Now after I write some text on the window with TextOut function that goes
> beyond the window size the window do not scroll.
>
> Please educate me - what is wrong?
It's wrong to think that Windows will take care of scroll. It won't. You need
to:
* Find out how much text fits in a line.
* Draw the text for every physical line.
* Count the resulting lines and the current position so you can answer when
Windows *ask* you how to draw the scroll bar.
By the way, you say that you write the text using TextOut. You should be doing
that inside the code that answers to the WM_PAINT message. Otherwise, the
text will be erased as soon as the window is resized or obscured by another
window.
The following code implements a simple text brower. It doesn't compile because
it depends in a missing file that should provide LoadFile (load a text file
in memory) and GetLine (return the Nth line of the loaded file). But It will
show you how to manage the scroll bar messages.
It's mostly based in Charles Petzold's books and translated by me to Pascal.
If after seeing this, you still think that programming using API is a good
idea, I don't know what would convince you :-)
program GCon03;
{$ifdef fpc}
{$mode delphi}
{$endif}
uses
Windows,
SysUtils,
FileTasks,
// MemStruct,
GCUtils
{$ifdef fpc}
//,FpcCompat
{$else}
,messages
{$endif}
;
var
cxCaps, cxChar, cyChar,
cxClient, cyClient, iMaxWidth: Integer;
{$ifdef fpc}
function ScrollWindow(hWnd:HWND; XAmount:longint; YAmount:longint; Rect:PRECT;
ClipRect:PRECT):WINBOOL; external 'user32' name 'ScrollWindow';
{$else}
{$endif}
function WndProc(Window: HWnd; Message, WParam, LParam: Longint): Longint;
stdcall; export;
var
dc: HDC;
i, x, y, iVertPos, iHorzPos, iPaintBeg, iPaintEnd: Integer;
ps: TPaintStruct;
si: TSCROLLINFO;
tm: TTextMetric;
// font: TagLOGFONTA;
Font: TLogFont;
s: string;
rect: TRect;
FileName: string;
begin
case Message of
WM_CREATE:
begin
FileName := 'c:\test.txt';
if not LoadFile(PChar(FileNAme)) then
Halt;
dc := GetDC(Window);
FillChar(font, SizeOf(Font), #0);
Font.lfHeight := FW_NORMAL;
Font.lfCharSet := ANSI_CHARSET;
Font.lfHeight := 18;
Font.lfWidth := 0;
Font.lfPitchAndFamily := FIXED_PITCH;
Font.lfFaceName := 'Courier New';
{$ifdef fpc}
SelectObject(dc, CreateFontIndirect(@Font)) ;
{$else}
SelectObject(dc, CreateFontIndirect(Font)) ;
{$endif}
GetTextMetrics(dc, tm);
cxChar := tm.tmAveCharWidth;
if (tm.tmPitchAndFamily and 1) = 1 then
cxCaps := 3 * cxChar div 2
else
cxCaps := 2 * cxChar div 2;
cyChar := tm.tmHeight + tm.tmExternalLeading ;
// Save the width of the three columns
//iMaxWidth := 40 * cxChar + 22 * cxCaps ;
iMaxWidth := Cardinal(MaxLineLength) * Cardinal(tm.tmAveCharWidth);
DeleteObject (SelectObject (dc, GetStockObject (SYSTEM_FONT))) ;
ReleaseDC(Window, dc) ;
end;
WM_SIZE:
begin
cxClient := LOWORD (lParam) ;
cyClient := HIWORD (lParam) ;
// Set vertical scroll bar range and page size
si.cbSize := SizeOf(si);
si.fMask := SIF_RANGE or SIF_PAGE or SIF_DISABLENOSCROLL ;
si.nMin := 0;
si.nMax := NUMLINES - 1;
si.nPage := cyClient div cyChar;
SetScrollInfo(Window, SB_VERT, si, TRUE) ;
// Set horizontal scroll bar range and page size
si.cbSize := sizeof (si) ;
si.fMask := SIF_RANGE or SIF_PAGE or SIF_DISABLENOSCROLL ;
si.nMin := 0 ;
//si.nMax := 2 + iMaxWidth div cxChar ;
si.nMax := MaxLineLength;
si.nPage := cxClient div cxChar ;
SetScrollInfo (Window, SB_HORZ, si, TRUE) ;
end;
WM_VSCROLL:
begin
// Get all the vertial scroll bar information
si.cbSize := sizeof (si) ;
si.fMask := SIF_ALL ;
GetScrollInfo(Window, SB_VERT, si) ;
// Save the position for comparison later on
iVertPos := si.nPos ;
case LOWORD (wParam) of
SB_TOP: si.nPos := si.nMin ;
SB_BOTTOM: si.nPos := si.nMax ;
SB_LINEUP: Dec(si.nPos);
SB_LINEDOWN: Inc(si.nPos, 1);
SB_PAGEUP: Dec(si.nPos, si.nPage);
SB_PAGEDOWN: Inc(si.nPos, si.nPage);
SB_THUMBTRACK: si.nPos := si.nTrackPos;
end;
// Set the position and then retrieve it. Due to adjustments
// by Windows it may not be the same as the value set.
si.fMask := SIF_POS ;
SetScrollInfo (Window, SB_VERT, si, TRUE) ;
GetScrollInfo (Window, SB_VERT, si) ;
// If the position has changed, scroll the window and update it
if si.nPos <> iVertPos then begin
ScrollWindow (Window, 0, cyChar * (iVertPos - si.nPos), nil, nil) ;
UpdateWindow(Window);
end;
end;
WM_HSCROLL:
begin
// Get all the vertical scroll bar information
si.cbSize := sizeof (si) ;
si.fMask := SIF_ALL ;
// Save the position for comparison later on
GetScrollInfo (Window, SB_HORZ, si) ;
iHorzPos := si.nPos ;
case LOWORD (wParam) of
SB_LINELEFT: Dec(si.nPos);
SB_LINERIGHT: Inc(si.nPos);
SB_PAGELEFT: Dec(si.nPos, si.nPage);
SB_PAGERIGHT: Inc(si.nPos, si.nPage);
SB_THUMBPOSITION: si.nPos := si.nTrackPos;
end;
{ Set the position and then retrieve it. Due to adjustments
by Windows it may not be the same as the value set. }
si.fMask := SIF_POS ;
SetScrollInfo(Window, SB_HORZ, si, TRUE) ;
GetScrollInfo (Window, SB_HORZ, si) ;
{ If the position has changed, scroll the window }
if si.nPos <> iHorzPos then
ScrollWindow(Window, cxChar * (iHorzPos - si.nPos), 0, nil, nil);
end;
wm_EraseBkgnd:
begin
Result := 1;
Exit;
end;
WM_PAINT :
begin
dc := BeginPaint(Window, ps) ;
// Get vertical scroll bar position
si.cbSize := sizeof (si) ;
si.fMask := SIF_POS ;
GetScrollInfo (Window, SB_VERT, si) ;
iVertPos := si.nPos ;
// Get horizontal scroll bar position
GetScrollInfo (Window, SB_HORZ, si) ;
iHorzPos := si.nPos ;
// Find painting limits
iPaintBeg := max(0, iVertPos + ps.rcPaint.top div cyChar) ;
iPaintEnd := min(NUMLINES - 1,
iVertPos + ps.rcPaint.bottom div cyChar) ;
FillChar(font, SizeOf(Font), #0);
Font.lfHeight := FW_NORMAL;
Font.lfCharSet := OEM_CHARSET;
Font.lfHeight := 17;
Font.lfWidth := 0;
Font.lfPitchAndFamily := FIXED_PITCH;
//Font.lfFaceName := 'Courier New';
{$ifdef fpc}
SelectObject(dc, CreateFontIndirect(@Font)) ;
{$else}
SelectObject(dc, CreateFontIndirect(Font)) ;
{$endif}
Rect := ps.rcPaint;
GetClipBox(dc, Rect);
FillRect(dc, Rect, 0);
for i := iPaintBeg {+1} to iPaintEnd do
begin
x := cxChar * (1 - iHorzPos) ;
y := cyChar * (i - iVertPos) ;
s := GetLine(i);
ExtTextOut(dc, x, y, ETO_CLIPPED , @Rect ,PChar(s),Length(s), nil) ;
end;
DeleteObject (SelectObject (dc, GetStockObject (SYSTEM_FONT))) ;
EndPaint (Window, ps) ;
end;
WM_DESTROY: PostQuitMessage(0);
else begin
Result := DefWindowProc (Window, message, wParam, lParam) ;
Exit;
end;
end;
Result := 0;
end;
var
hwnd: THandle;
msg: TagMsg;
wndclass: TWndClass;
ProgramName: string = 'GCon03';
begin
{$ifdef fpc}
wndclass.hInstance := hInstance;
{$else}
wndclass.hInstance := SysInit.hInstance;
{$endif}
with wndclass do begin
style := 0;
lpfnWndProc := @WndProc;
cbClsExtra := 0;
cbWndExtra := 0;
hIcon := LoadIcon(0, IDI_APPLICATION);
hCursor := LoadCursor(0, IDC_ARROW);
hbrBackground := HBRUSH(GetStockObject(WHITE_BRUSH));
lpszMenuName := nil;
lpszClassName := PChar(ProgramName);
if Windows.RegisterClass(wndclass) = 0 then begin
MessageBox(0, 'Program requires Windows NT!', PChar(ProgramName),
MB_ICONERROR);
Halt(0);
end;
hwnd := CreateWindow(PChar(ProgramName), PChar(ProgramName),
WS_OVERLAPPEDWINDOW or WS_VSCROLL or WS_HSCROLL,
LongInt(CW_USEDEFAULT), LongInt(CW_USEDEFAULT),
LongInt(CW_USEDEFAULT), LongInt(CW_USEDEFAULT),
0, 0, hInstance, nil) ;
ShowWindow(hwnd, System.CmdShow) ;
UpdateWindow (hwnd) ;
while GetMessage(msg, 0, 0, 0) do begin
TranslateMessage(msg);
DispatchMessage(msg);
end;
Halt(msg.wParam);
end;
end.
--
saludos,
Nico Aragón
[EMAIL PROTECTED]
http://espira.net/nico/
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
