Search code examples
winapigdi+gdi

How to increase the spacing between points in a line?


When using a standard pen (PS_DOT) and drawing a line with it, the result is as shown in the image below (magnified) enter image description here

There are two problems for me with that line, the first one is that, it's setting more than one pixel for a dot. The second one is, the dots are too close together for what I'd like to do (draw a very soft line.)

I could use SetPixel but, the performance leaves a great deal to desire.

My question is: is there a reasonably fast way to draw a line where it is possible to control the number of pixels used to draw a dot and the spacing between dots ?

Essentially, a faster way of doing it than using SetPixel (which could be used to solved the problem were it not so slow.)

A snippet of code showing how it's done in C, C++ or Delphi would be great.

Thank you for your help.

EDIT: I tried IInspectable's answer of using ExtCreatePen and it is very close. It seems that the only way to get pixels/dots instead of dashes is to use PS_ALTERNATE but, when that is used, there is no way to specify the spacing.

For reference and, in case, I am making a mistake I am not seeing, below is the test program I wrote. What I would like is a repeating sequence of 1 dot (not a dash) followed by 2 spaces. The output I got from the test program is shown (magnified) below: (the top line is obtained using PS_ALTERNATE, the bottom line using the array that specifies 1 dot, 2 spaces - which gives 2 dots and 2 spaces.)

enter image description here

test program:

{$APPTYPE        GUI}

{$LONGSTRINGS    OFF}
{$WRITEABLECONST ON}

program _ExtCreatePen;

uses Windows, Messages;

const
  AppName  = 'ExtCreatePen';

{$ifdef VER90} { Delphi 2.0 }
type
  ptrint  = longint;        // NativeInt  for newer versions
  ptruint = dword;          // NativeUint  "    "      "
{$endif}

{-----------------------------------------------------------------------------}

function WndProc (Wnd : HWND; Msg : UINT; wParam, lParam : ptrint)
         : ptrint; stdcall;
const
  PenPattern   : packed array[1..4] of DWORD = (1, 2, 1, 2); { 1 dot, 2 spaces}

  PenBrush     : TLOGBRUSH = (lbStyle:BS_SOLID; lbColor:0; lbHatch:0);
  PenWidth     : DWORD     = 1;

  { !! this doesn't seem to work as expected, expected 1 dot, 2 spaces !!     }

  PenStyle     : DWORD     = PS_COSMETIC or PS_USERSTYLE;
  StyleCount   : DWORD     = high(PenPattern);
  StylePattern : PDWORD    = @PenPattern[low(PenPattern)];

  { this gives 1 dot, 1 space.                                                }

  //PenStyle     : DWORD     = PS_COSMETIC or PS_ALTERNATE;
  //StyleCount   : DWORD     = 0;
  //StylePattern : PDWORD    = nil;

  Pen          : HPEN      = 0;

var
  ps          : TPAINTSTRUCT;
  ClientRect  : TRECT;

begin
  WndProc := 0;

  case Msg of
    WM_CREATE:
    begin
      PenBrush.lbColor := RGB(255, 0, 0);

      Pen := ExtCreatePen(PenStyle,
                          PenWidth,
                          PenBrush,
                          StyleCount,
                          StylePattern);
      exit;
    end;

    WM_PAINT:
    begin
      BeginPaint(Wnd, ps);
        GetClientRect(Wnd, ClientRect);

        SelectObject(ps.hdc, Pen);  { use the pen we created    }

        MoveToEx(ps.hdc, 0, ClientRect.Bottom div 2, nil);
        LineTo(ps.hdc, ClientRect.Right, ClientRect.Bottom div 2);
      EndPaint(Wnd, ps);

      exit;
    end;

    WM_CLOSE: PostMessage(Wnd, WM_DESTROY, 0, 0);

    WM_DESTROY:
       begin
         if Pen <> 0 then DeleteObject(Pen);

         PostQuitMessage(0);

         exit;
       end; { WM_DESTROY }
  end; { case msg }

  WndProc := DefWindowProc (Wnd, Msg, wParam, lParam);
end;

{-----------------------------------------------------------------------------}

function InitAppClass: WordBool;
  { registers the application's window classes                                }
var
  cls : TWndClassEx;

begin
  cls.cbSize          := sizeof(TWndClassEx);           { must be initialized }

  if not GetClassInfoEx (hInstance, AppName, cls) then
  begin
    with cls do
    begin
      { cbSize has already been initialized as required above                 }

      style           := CS_BYTEALIGNCLIENT;
      lpfnWndProc     := @WndProc;                    { window class handler  }
      cbClsExtra      := 0;
      cbWndExtra      := 0;
      hInstance       := system.hInstance;
      hIcon           := LoadIcon (hInstance, IDI_APPLICATION);
      hCursor         := LoadCursor(0, IDC_ARROW);
      hbrBackground   := COLOR_WINDOW + 1;
      lpszMenuName    := nil;
      lpszClassName   := AppName;                     { Window Class name     }
      hIconSm         := 0;
    end; { with }

    InitAppClass := WordBool(RegisterClassEx(cls));
  end
  else InitAppClass := TRUE;
end;

{-----------------------------------------------------------------------------}

function WinMain : integer;
  { application entry point                                                   }
var
  Wnd : hWnd;
  Msg : TMsg;

begin
  if not InitAppClass then Halt (255);  { register application's class        }

  { Create the main application window                                        }

  Wnd := CreateWindowEx(WS_EX_CLIENTEDGE,
                        AppName,                { class name                  }
                        AppName,                { window caption text         }
                        ws_Overlapped       or  { window style                }
                        ws_SysMenu          or
                        ws_MinimizeBox      or
                        ws_ClipSiblings     or
                        ws_ClipChildren     or  { don't affect children       }
                        ws_visible,             { make showwindow unnecessary }
                        20,                     { x pos on screen             }
                        20,                     { y pos on screen             }
                        400,                    { window width                }
                        200,                    { window height               }
                        0,                      { parent window handle        }
                        0,                      { menu handle 0 = use class   }
                        hInstance,              { instance handle             }
                        nil);                   { parameter sent to WM_CREATE }

  if Wnd = 0 then Halt;                         { could not create the window }

  while GetMessage (Msg, 0, 0, 0) do            { wait for message            }
  begin
    TranslateMessage (Msg);                     { key conversions             }
    DispatchMessage  (Msg);                     { send to window procedure    }
  end;

  WinMain := Msg.wParam;                        { terminate with return code  }
end;

begin
  WinMain;
end.

Solution

  • There's nothing wrong with your code. It took me a little time to implement the GDI custom dashed line, just as you described it.

    In GDI, custom dashed lines are drawn in dashes, as mentioned in MSDN.

    If dwPenStyle is PS_COSMETIC and PS_USERSTYLE, the entries in the lpStyle array specify lengths of dashes and spaces in style units. A style unit is defined by the device where the pen is used to draw a line.

    If dwPenStyle is PS_GEOMETRIC and PS_USERSTYLE, the entries in the lpStyle array specify lengths of dashes and spaces in logical units.

    This functionality can be implemented in GDI +, as mentioned at the beginning by @Michael Chourdakis