When using a standard pen (PS_DOT) and drawing a line with it, the result is as shown in the image below (magnified)
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.)
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.
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
isPS_COSMETIC
andPS_USERSTYLE
, the entries in thelpStyle
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
isPS_GEOMETRIC
andPS_USERSTYLE
, the entries in thelpStyle
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