[fpc-pascal] Win32 API - Scroll Bar inactive

[Nico Aragón]

El Martes, 9 de Noviembre de 2004 08:08, soumya at tatamotors.com 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
    nico at espira.net
    http://espira.net/nico/