zoukankan      html  css  js  c++  java
  • 《windows程序设计》滚动条Ⅱ(08)

    代码如下:

    program Project2;
    
    {$APPTYPE CONSOLE}
    
    {$R *.res}
    
    uses
      System.SysUtils,
      windows,
      Winapi.Messages,
      Vcl.Dialogs;
    
    var
      swndClass: tagWNDCLASS;
      message: MSG;
      mHwnd: hwnd;
      cxChar, cyChar: Integer;
      cxClient, cyClient: Integer;
      ScrollPos: Integer = 0;
    
    function WindowProc(hwnd: hwnd; uMsg: UINT; wParam: wParam; lParam: lParam): LRESULT; stdcall;
    var
      i: integer;
      uHdc: HDC;
      ps: tagPAINTSTRUCT;
      tm: tagTEXTMETRIC;
      str: string;
    begin
      case uMsg of
        WM_CREATE:
          begin
            {获取文本尺寸}
            uHdc := GetDC(hwnd);
            GetTextMetrics(uHdc, tm);
            ReleaseDC(hwnd, uHdc);
            cxChar := tm.tmAveCharWidth;
            cyChar := tm.tmHeight + tm.tmExternalLeading;
    
            {设置滚动条最大位置}
            SetScrollRange(hwnd, SB_VERT, 0, 100, False);
            SetScrollPos(hwnd, SB_VERT, 20, True);
          end;
        WM_SIZE:
          begin
            cxClient := loword(lParam);
            cyClient := HiWord(lParam);
          end;
        WM_PAINT:
          begin
            uHdc := BeginPaint(hwnd, ps);
            for i := ScrollPos to 100 do
            begin
              str := 'Hello world num:' + i.ToString;
              TextOut(uHdc, 0, (i - ScrollPos) * cychar, PWideChar(str), Length(str));
            end;
            EndPaint(hwnd, ps);
          end;
        WM_VSCROLL:
          begin
            case LOWORD(wParam) of
              SB_BOTTOM:
                begin
                  {滚动到底端}
                  scrollpos := 100;
                end;
              SB_ENDSCROLL:
                begin
                 {完成滚动,松开鼠标}
                 //scrollpos := hiword(wParam);
                end;
              SB_LINEDOWN:
                begin
                  {向下滚动一行}
                  Inc(ScrollPos);
                end;
              SB_LINEUP:
                begin
                 {向上滚动一行}
                  Dec(ScrollPos);
                end;
              SB_PAGEDOWN:
                begin
                  {向下滚动一页}
                  scrollpos := scrollpos + (cyclient div cyChar);
                end;
              SB_PAGEUP:
                begin
                 {向上滚动一页}
                  scrollpos := scrollpos - (cyclient div cyChar);
                end;
              SB_THUMBPOSITION:
                begin
                 {用户拖动滚动条,且松开鼠标}
                  scrollpos := hiword(wParam);
                end;
              SB_THUMBTRACK:
                begin
                 {用户正在拖动滚动条}
                  scrollpos := hiword(wParam);
                end;
              sb_top:
                begin
                  {滚动条到顶端}
                  scrollpos := 0;
                end;
    
            end;
            {限制最大值,最小值}
            if ScrollPos < 0 then
            begin
              scrollpos := 0;
            end;
            if ScrollPos > 100 then
            begin
              scrollpos := 100;
            end;
            {有改动才更新}
            if ScrollPos <> GetScrollPos(hwnd, SB_VERT) then
            begin
              SetScrollPos(hwnd, SB_VERT, ScrollPos, true);
              InvalidateRect(hwnd, nil, true);
            end;
          end;
    
      end;
      result := DefWindowProc(hwnd, uMsg, wParam, lParam);
    end;
    
    begin
      swndClass.cbClsExtra := 0; //窗口类扩展,无
      swndClass.cbWndExtra := 0; //窗口实例扩展
      swndClass.hbrBackground := COLOR_BACKGROUND; //窗口背景颜色黑色
      //LoadCursor()
      swndClass.hCursor := LoadCursor(0, IDC_ARROW); //窗口采用箭头光标
      swndClass.hIcon := LoadIcon(0, IDI_APPLICATION); //窗口最小化图标:采用缺省图标
      swndClass.hInstance := hInstance; //窗口实例句柄
      swndClass.lpfnWndProc := @WindowProc; //窗口处理函数
      swndClass.lpszClassName := 'myWnd'; //窗口类名
      swndClass.lpszMenuName := nil; //窗口菜单
      swndClass.style := CS_DBLCLKS; //窗口样式
      if RegisterClass(swndClass) = 0 then
      begin
        Writeln('windows class register error!');
        Exit;
      end;
    
      mHwnd := CreateWindowEx(0, 'myWnd', 'Delphi Windows', WS_OVERLAPPEDWINDOW or WS_VSCROLL or WS_HSCROLL,  {滚动条添加}
        CW_USEDEFAULT, CW_USEDEFAULT, 544, 375, HWND_DESKTOP, 0, hInstance, 0);
    
      ShowWindow(mHwnd, SW_SHOW);
      UpdateWindow(mHwnd);
      while GetMessage(message, 0, 0, 0) do
      begin
        TranslateMessage(message);
        DispatchMessage(message);
      end;
    end.
  • 相关阅读:
    Java8新特性-日期时间
    解决有道云笔记导入md文件无法加载文件内的图片方式
    Mac安装Navicat Premium 12 永久破解
    MacBook Pro安装和配置Tomcat
    MySQL不支持DELETE使用表别名?
    JAVA设计模式之模板方法
    Lombok中的@Builder注解
    JAVA设计模式之策略模式
    Stream中的Peek操作
    MySql插入一条数据不提交事务主键仍自增的理解
  • 原文地址:https://www.cnblogs.com/YiShen/p/9745666.html
Copyright © 2011-2022 走看看