Sign in Join

Live chat for Free Pascal, Lazarus, Delphi and every Pascal programmer.

Mailing lists / fpc-pascal / 2004-11

Win32 API - Scroll Bar inactive

5 messages · 4 people · –

Reply by email Subscribe to this list Your subscription

Read-only archive. Use j and k to move between messages.

Unknown author

I am new to Windows programming so please bear with me if it is some trivial mistake.

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?

Regards,

Tux-Jsr

Jonas Maebe
to Unknown author
I am new to Windows programming so please bear with me if it is some trivial mistake.

FWIW, the reason that this message from 9 november only got distributed now, is that

a) the mailing list server does not have a virus scanner installed b) an incredible amount of viruses and bounces is sent daily to the mailing lists
c) I do not get any reminders anymore from the mailing list software when there are messages waiting for approval (and without those messages, I forget to go and look, even though I have to look every day).

One of the virus "filters" I put in the mailman configuration, is that every "multipart/alternative" mail is automatically held for approval (apart from mails from non-subscribers and mails >25KiB). This mail was one like that. So if you want your mails to come through swiftly, turn off html mails in your mail clients.

Jonas

Unknown author

I am new to Windows programming so please bear with me if it is some trivial mistake.

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?

Regards,

Tux-Jsr

Florian Klaempfl
to Unknown author
Show quoted text 10 lines
I am new to Windows programming so please bear with me if it is some trivial mistake. 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?

That's simply not how windows works. You've to do the scrollbar handling yourself. ws_vscroll only tells windows to draw a scroll.

Nico Aragón
to Unknown author: I am new to Windows programming so please bear with me if it is some trivial mistake. I…

El Martes, 9 de Noviembre de 2004 08:08, 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.

Show quoted text 10 lines
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         http://espira.net/nico/