Jonas Maebe wrote:
On 04 Jan 2006, at 21:51, Hans Mårtensson wrote:
The type of pBoxtemplate is ^word.
Is it not true that
(dword(pBoxtemplate) and 1)=1
evaluates to TRUE, if and only if pBoxtemplate is NOT aligned to a
word boundary (16 bit boundary)?
And then, assuming pBoxtemplate is aligned to word boundary, is it
not true, that
if (dword(pBoxtemplate) and 2)=2
evaluates to TRUE, if pBoxtemplate is NOT aligned to a dword
boundary (32 bit boudary), causing the statement
if (dword(pBoxtemplate) and 2)=2 then inc(pBoxtemplate);
to make the pBoxtemplate align to a dword boundary (by eventually
adding 2 to pBoxtemplate (because sizeof(word)=2)??
Yes, but this is independent of how the compiler handles alignment of
data.
OK, then I really don't understand where the problem is.
It seems difficult to me to supply a bug report, because it is still so
uncertain where the problem lies.
But I attach the source code to my test program, in case you can do
anything with it.
When I compile this source code with FPC 1.0.10, it produces a program
that makes a window with one menu item. When you click on it, a dialogue
box pops up.
But when I compile the same source code with FPC 2.0.2, I still get a
program that makes the window. But the dialogue box does not show, when
you click the menu item.
Hans Mårtensson
Program test;
// Program for testing dialogue boxes
{$APPTYPE GUI}
Uses windows;
Const
AppName = 'Lydexperiment';
var
AMessage: Msg; hWindow: HWnd;
pbox2: pointer; box2var1, box2var2: longint;
Boxtemplate: DlgTemplate;
Boxtemplatesize: word;
pBoxAllokate: ^word; //Start of allocated memory
pBoxtemplate: ^word; //Start of Boxtemplate
pBoxItem: ^word; //Start of free space after added items
{$Rangechecks off}
//**************************************************************
Procedure newboxtemplate(title: string; width, height, boxsize: word);
var i:integer;
begin boxtemplatesize:=boxsize; pBoxItem:=nil;
getmem(pBoxAllokate,boxsize); pBoxtemplate:=pBoxAllokate;
if (dword(pBoxtemplate) and 1)=1 then pBoxtemplate:=nil;
if (dword(pBoxtemplate) and 2)=2 then inc(pBoxtemplate);
if pBoxtemplate=nil then exit;
Boxtemplate.style:=DS_CENTER or WS_POPUP or WS_CAPTION or WS_SYSMENU or
DS_MODALFRAME;
Boxtemplate.dwextendedstyle:=0;
Boxtemplate.x:=0; Boxtemplate.y:=0; Boxtemplate.cx:=width;
Boxtemplate.cy:=height;
Boxtemplate.cdit:=0; pBoxItem:=pointer(pBoxtemplate) + sizeof(Boxtemplate);
pBoxItem^:=0; inc(pBoxItem); pBoxItem^:=0; inc(pBoxItem); // menu and class
for i:=1 to length(title) do begin pBoxItem^:=ord(title[i]); inc(pBoxItem)
end;
pBoxItem^:=0; inc(pBoxItem) end; // terminating 0 in titel
Procedure newboxtemplate(title: string; width, height: word);
begin newboxtemplate(title, width, height, 2000) end;
//**************************************************************
Procedure appendboxitem(id: word; style: DWORD; class: word; title: string;
x,y,width,height: WORD);
var i: word; Bi: Dlgitemtemplate;
begin if pBoxItem=nil then exit; if (dword(pBoxItem) and 2)=2 then
inc(pBoxItem);
Bi.style:=style or WS_VISIBLE or WS_CHILD;
if class<>$82 then Bi.style:=BI.style or WS_TABSTOP;
Bi.dwextendedstyle:=0;
Bi.x:=x; Bi.y:=y; Bi.cx:=width; Bi.cy:=height; Bi.id:=id;
move(Bi,pBoxItem^,sizeof(Bi)); inc(pBoxItem,sizeof(bi) div 2);
pBoxItem^:=$FFFF; inc(pBoxItem); pBoxItem^:=class; inc(pBoxItem);
//standard-class presumed
for i:=1 to length(title) do begin pBoxItem^:=ord(title[i]); inc(pBoxItem)
end;
pBoxItem^:=0; inc(pBoxItem); // terminating 0 in titel
pBoxItem^:=0; inc(pBoxItem); // creation data is not used
inc(Boxtemplate.cdit); move(Boxtemplate,pBoxtemplate^,sizeof(Boxtemplate));
end;
Function getboxtemplate: pointer;
var nbox: DWORD; pBoxny: ^word;
begin if pBoxItem=nil then begin
getboxtemplate:=nil; MessageBox (0,'WinCreate failed','Error',MB_OK); exit
end
else getboxtemplate:=pBoxtemplate;
nbox := pointer(pBoxItem) - pointer(pBoxAllokate); getmem(pBoxny,nbox+2);
if pBoxny=nil then exit;
if (dword(pBoxny) and 1)=1 then pBoxny:=nil;
if (dword(pBoxny) and 2)=2 then begin inc(pBoxny); dec(nbox,2) end;
move(pBoxtemplate^,pBoxny^,nbox); freemem(pBoxAllokate,Boxtemplatesize);
pBoxtemplate:=pBoxny; getboxtemplate:=pBoxny; pBoxItem:=nil end;
//**************************************************************
//End of dialogue box data structure making procedures
//Start of specific dialogue box definition
//******************************************************************************
Function Box2Proc(Box: hWnd; Message: UINT; WPrm : longint; LPrm: longint):
Longint; stdcall;
begin Box2Proc:=1; if LPrm=0 then ;
case Message of
WM_INITDIALOG: begin box2var1:=8000; box2var2:=2;
case box2var1 of
8000: Checkradiobutton(Box,2,7,2);
11025: Checkradiobutton(Box,2,7,3);
16000: Checkradiobutton(Box,2,7,4);
22050: Checkradiobutton(Box,2,7,5);
48000: Checkradiobutton(Box,2,7,6);
44100: Checkradiobutton(Box,2,7,7);
end;
if box2var2>1 then CheckDlgButton(Box,8,BST_CHECKED)
else CheckDlgButton(Box,8,BST_UNCHECKED);
setfocus(longint(Box)); Box2Proc:=0 end;
WM_COMMAND: case LOWORD(WPrm) of
2: begin Checkradiobutton(Box,2,7,2); box2var1:=8000 end;
3: begin Checkradiobutton(Box,2,7,3); box2var1:=11025 end;
4: begin Checkradiobutton(Box,2,7,4); box2var1:=16000 end;
5: begin Checkradiobutton(Box,2,7,5); box2var1:=22050 end;
6: begin Checkradiobutton(Box,2,7,6); box2var1:=48000 end;
7: begin Checkradiobutton(Box,2,7,7); box2var1:=44100 end;
8: if box2var2>1 then begin box2var2:=1;
CheckDlgButton(Box,8,BST_UNCHECKED) end
else begin box2var2:=2; CheckDlgButton(Box,8,BST_CHECKED) end;
9: begin enddialog(Box,1) end end;
WM_CLOSE: enddialog(Box,0);
else Box2Proc:=0 end end;
Procedure showbox(window: hWnd);
begin if DialogBoxIndirect(system.MainInstance,pBox2, Window, @Box2Proc)=0 then
exit end;
//******************************************************************************
Procedure setboxtemplates;
begin
newboxtemplate('Lydkvalitet',87,90);
appendboxitem(1,SS_SIMPLE,$82,'Samplerate (s. pr. sek.)',5,5,80,12);
appendboxitem(2,BS_AUTORADIOBUTTON,$80,'8000',5,20,40,12);
appendboxitem(3,BS_AUTORADIOBUTTON,$80,'11025',50,20,40,12);
appendboxitem(4,BS_AUTORADIOBUTTON,$80,'16000',5,35,40,12);
appendboxitem(5,BS_AUTORADIOBUTTON,$80,'22050',50,35,40,12);
appendboxitem(6,BS_AUTORADIOBUTTON,$80,'48000',5,50,40,12);
appendboxitem(7,BS_AUTORADIOBUTTON,$80,'44100',50,50,40,12);
appendboxitem(8,BS_CHECKBOX,$80,'Stereo',6,68,40,12);
appendboxitem(9,BS_DEFPUSHBUTTON,$80,'OK',50,70,30,12);
pBox2:=getboxtemplate;
end;
//*****************************************************************************
//End of specific dialogue box definition
//The rest of the program is for making a window
//*****************************************************************************
Function WindowProc(Window: hWnd; AMessage: UINT; WPrm: WParam; LPrm: LParam):
LResult; stdcall; export;
Var nrmenu: longint; //ps: paintstruct; dc: hdc; r: rect;
begin WindowProc := 0;
Case AMessage of
// wm_Paint: begin
// dc:=BeginPaint(Window,@ps);
// EndPaint(Window,ps);
// Exit;
// end;
wm_Close: ; //Lad DefWindowProc take care of close
wm_Destroy: begin PostQuitMessage(0); exit end;
wm_char: ;
wm_Command: begin
NrMenu := WPrm and $FFFF;
Case NrMenu Of
100: showbox(window);
End; End; End;
WindowProc := DefWindowProc(Window,AMessage,WPrm,LPrm); End;
//**************************************************************
Function WinRegister: Boolean;
var WindowClass: WndClass;
Begin With WindowClass Do Begin
Style := cs_hRedraw Or cs_vRedraw;
lpfnWndProc := WndProc(@WindowProc);
cbClsExtra := 0;
cbWndExtra := 0;
hInstance := system.MainInstance;
hIcon := LoadIcon(0,idi_Application);
hCursor := LoadCursor(0,idc_Arrow);
hbrBackground := GetStockObject(LTGRAY_BRUSH);
lpszMenuName := '';
lpszClassName := AppName;
End;
WinRegister := RegisterClass(WindowClass)<>0;
If not WinRegister then begin MessageBox(0,'Register failed',Nil, mb_Ok);
exit end;
end;
//**************************************************************
Function WinCreate: hWnd;
Var hWindow: hWnd;
Menu: hMenu;
Begin
hWindow := CreateWindow(AppName,AppName,ws_OverlappedWindow,
cw_UseDefault,cw_UseDefault,cw_UseDefault,cw_UseDefault,0,0,system.MainInstance,Nil);
If hWindow<>0 then begin
Menu := CreateMenu;
AppendMenu(Menu,MF_STRING,100,'&Show dialogbox for test');
SetMenu(hWindow,Menu);
ShowWindow(hWindow,CmdShow);
ShowWindow(hWindow,SW_SHOW);
UpdateWindow(hWindow);
end;
Wincreate := hWindow
end;
//*************** Main program **********************************
Begin
If not WinRegister then exit;
hWindow := WinCreate;
If longint(hWindow)=0 then begin MessageBox (0,'WinCreate failed',Nil,MB_OK);
exit end;
setboxtemplates;
While GetMessage(@AMessage,0,0,0) do
begin TranslateMessage(AMessage); DispatchMessage(AMessage) end;
Halt(AMessage.wParam) End.
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal
