Announcement

Collapse
No announcement yet.

Hard to find error in dialog

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Michael Mattias
    replied
    > we are talking here about windows problems or problems with windows

    That is but one possibility.

    Leave a comment:


  • norbert doerre
    replied
    @Michael

    Michael, we are talking here about windows problems or problems with windows. I don't like windows and therefore it's part in my program is limited to perhaps two percent. My work has it's origin in unix, ran in the mid of the 70s with an Olivetti machine and was then transplanted first to dos, then windows and also linux. So, what we write about here is simply the changeable more or less ugly frame for a hopefully nice arranged picture.

    Leave a comment:


  • Michael Mattias
    replied
    100 of similiar DLLs all built with the same scheme and never causing problems at least since the past 20 years
    The PB/Windows compilers have not been around that long. Ergo your functions 'as written' have not been running without problems for twenty years.

    "Similar" is just not good enough for debugging.

    Leave a comment:


  • norbert doerre
    replied
    Relicts of yesterday

    Cliff and Gösta,
    there exist in the mean time about 100 of similiar DLLs all built with the same scheme and never causing problems at least since the past 20 years. Only language updates and updated OS conditions made it necessary for some changes. I had to update the current DLL because with XP SP3 it's result became a windows exception. On my second machine with SP2 it is running well like ever. Well, I changed from PB8 to PB9 and from SP2 to SP3 nearly at the same time, not a good idea.
    I always separate dialogs from other code, just to keep the best overview. So, I'm nearly able to add any dialog to any other code without conflicts. Using thes standard modules avoid many bugs und loss of time. But under some very rare conditions in fact problems are comming up, just like now. In the mean time I recompiled and tested all other DLLs with success. This faulty dialog sample here is one of the largest.

    All the others use the scheme:
    Code:
    CallBack Function DlgCallback() As Long
       Select Case CbMsg
    		Case %WM_COMMAND
             Select Case CbCtl
    Normally, I never use direct calls within a dialog definition, because You quickly loose overview. And just this is what I could demonstrate here.

    "Better to have Dialog End CbHndl":
    Yes, certainly this is better style. But my code has it's roots dated in 1983 and even earlier, and programming language conditions changed a lot in the mean time. So there exist still anwanted relicts of yesterday, including myself. Some are reparable, some others not. ;-)

    P.S.
    Changing the current code from "hDlg" global to CbHndl did not correct the windows exception with XPSP3 and unchanged code. So I have to look a bit deeper with my love "IDA".
    Last edited by norbert doerre; 11 Nov 2008, 03:13 AM.

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    It appears to me that
    Code:
             Case %ID_btnClose
                    'Applikation beenden '<< Dontcha just love it - gonna be in all me code after this {grin}
                     Dialog End hDlg '<<< Better to have DiaLog End CbHndl (or so I've been told)
    has a conflict with something happening in Call CloseDialog() - SubClass of %ID_btnClose (maybe it's closing itself in there or something).

    ==================================
    “If liberty means anything at all
    it means the right to tell people
    what they do not want to hear.”
    George Orwell.
    ==================================
    Last edited by Gösta H. Lovgren-2; 10 Nov 2008, 10:05 PM.

    Leave a comment:


  • Cliff Nichols
    replied
    Norbert, I hate to say it but...I amongst others can not see the problem, unless you can replicate the problem

    Most often just seeing, can solve the problem with a second pair of eyes on a minute point that is the cause, or even just prepping a submittable compilable code to demonstrate can cause a CNDS :doh:

    I welcome it, I look for it, and I promise for it...but when it eludes me, and how much it eludes me...I SEARCH for it...and eventually 99% of the time I find it, but only with the help of others in the forums. (Sometimes WAYYYY off base, sometimes just 1 word tips me to the true cause of the problem) and almost EVERY time its something that I can not see without breaking down larger code to smaller code (Imagine that )

    Since we are all Pb'ers or at least "Programmers of sort" I know its hard to swallow, but sometimes "The user is right, and the programmer is wrong"

    Leave a comment:


  • norbert doerre
    replied
    DLL crashing bug was found!

    Well two kinds of callback functions were interfering each other:

    a) CallBack Function DlgCallback() As Long

    b) Control Add ImgButton, hDlg, %ID_btnClose, "#" + Format$(%ID_ImgClose), 649, 3, 13, 13, %WS_CHILD Or %BS_PUSHBUTTON Or %BS_CENTER,%WS_EX_LEFT Or %WS_EX_LTRREADING Call CloseDialog()

    The definition of the Control Add function must not be added the Call CloseDialog() command as shown above.

    Instead the latter must be added inside the Callback Function at a) like:
    Code:
    CallBack Function DlgCallback() As Long
    '...
       Select Case CbMsg
    		Case %WM_COMMAND
             Select Case CbCtl
                Case %ID_imgMatch	
                	iFilterEntityKind = -1
                	iFilterLayerIndex = -1
                	iFilterColorIndex = -1
                	iFilterLineTypeIndex = -1
                	iFilterLineWidthIndex = -1
                	fFilterLineWidthValue = -1
                	'UserTool und Prompt initialisieren
                	MCSetUserTool(1, "SelFilter", " Get Filter Parameters =>")
                Case %ID_btnByLayer
                   '
                   '  
                   '
                Case %ID_btnClear
                   ResetDialog()
                Case %ID_btnHelp
                   FilterHelp()  
                Case %ID_btnClose
                	'Applikation beenden
                 	Dialog End hDlg
    That's all about syntax errors which are compiled with success, sometimes executed with success and sometimes with a crash.
    Last edited by norbert doerre; 10 Nov 2008, 04:24 PM.

    Leave a comment:


  • norbert doerre
    replied
    Cannot find the bug

    As a first result I could find out that in fact only the BUTTON controls are causing that error, when they have a call attached at their end. All other much more complicated functions are working well as ever before.

    Here once again some of the button definitions:

    Control Add Button, hDlg, %ID_btnClear, "Neu", 612, 3, 20, 13, %BS_PUSHBUTTON Call ResetDialog()

    Control Add ImgButton, hDlg, %ID_btnClose, "#" + Format$(%ID_ImgClose), 649, 3, 13, 13, %WS_CHILD Or %BS_PUSHBUTTON Or %BS_CENTER,%WS_EX_LEFT Or %WS_EX_LTRREADING Call CloseDialog()

    When I write:
    Control Add Button, hDlg, %ID_btnClear, "Neu", 612, 3, 20, 13, %BS_PUSHBUTTON '(w/o a call)
    Nothing happens. No crash. Dialog remains stable.

    As soon as there is a call attached at their end, the DLL crashes. It crashes even then, when the called function or sub consists of only two defining lines of code:

    Function xyz() as long
    End Function

    In the following Sub, it crashes after the msgbox is correctly executed.

    Sub xyz()
    Msgbox "xyz"
    End Sub

    Isn't that strange?

    -------------------------------------
    By the way:

    A "Dialog End" attached to any other function inside DlgSelFilter.inc ends the dialog correctly without a crash.

    Perhaps somebody else has another idea???

    Leave a comment:


  • norbert doerre
    replied
    @Michael

    Michael, only to avoid misunderstatement:
    Index 0 is a valid choice. Color numbers also start with index 0 = black.
    But in most of these filter combos, there exists an item with index 0 which means "Don't mind" or "Don't use for filtering", hope You understand. So, index 0 of the box does not really correspond to color 0. Color 0 has index 1 in the box. No color would have index -1. But that's not possible in reality.
    With "Don't mind" the user can leave a filter criterium unused.

    Leave a comment:


  • norbert doerre
    replied
    I have still to work on it....

    Thank You all for Your comments.
    It is not possible to attach the Includes, because only these few ones have about 12 MB of code. The code of this DLL is puzzled together from the content of similiar former code which has been tested since 1983 and which is causing no trouble. Whenever a lot of code has to be changed because of a new Programming language or because of a different OS, there reveals mostly no problem because You have to develop nearly from scratch. But as soon as only a small syntax change has to be done You have to pay attention, not because they are really hidden, but because You are too blind to see. The problem here is so severe because I cannot really leave out any line of code. Otherwise, the DLL would not give back any result, just like now. It might compile well, but won't run the way it should. When I compile it with PB8 under XP SP2, it runs fine, but not with PB9 and XP SP3. As soon as I will manage I'll attach here the correct syntax. Perhaps some others of You can share the correct syntax.

    Leave a comment:


  • Michael Mattias
    replied
    Just a thought..

    Code:
    Control Send CbHndl, %ID_cboColor, %CB_GETCURSEL, 0, 0 To lRes
    						If lres = 0 Then
    							iFilterColorIndex = -1
    						ElseIf lRes > 0 Then
    							iFilterColorIndex = CInt(lRes - 1) 'Die Color-Liste startet mit "*Alle*" bei Index 0
    						End If
    It looks like you might be setting -1& to mean "no selection;" however, zero is a valid 'selected index' when using CONTROL SEND here.

    'No selection' would be returned as CB_ERR (-1&).

    MCM

    Leave a comment:


  • Gösta H. Lovgren-2
    replied
    I hope someone of You might be able to see the bug at 'first sight'.
    Norbert one thing that struck me is:
    Code:
    '----------------------------------------------------------------------------------
    ' CALLBACK DECLARATIONS
    '----------------------------------------------------------------------------------
    Declare CallBack Function CBDlgProc() ' AS LONG <<< Missing here
    Declare CallBack Function CBDlgHelp()  'AS LONG <<< Missing here
    Declare CallBack Function CBDlgSubClassTextbox() As Long
    There is no AS LONG in the first 2 CallBack Function Declares, nor is there at the actual Function. I don't know if that has anything to do with it or not.

    Another is that when Handles are assigned, they usually are assigned as DWORD, not LONG. At least in most code I see posted here by the experts. Probably not relevant either though.

    The code is not compileable though, as the INCLUDEs are not included (not that I would expect them to be).

    One other thought. It may be easier to get others to take a look at long stretches of code (like this is) if it were as an attachment rather than posted. The code window here is so narrow, long lines confuse the logic to the human eye (at least these old eyes). It's best viewed with an IDE editor. An attachment is easier (at least for me anyway) to load than C&P'ing long code.

    ======================================================
    "I don't want to achieve immortality through my work;
    I want to achieve immortality through not dying."
    Woody Allen (1935-)
    ======================================================
    Last edited by Gösta H. Lovgren-2; 10 Nov 2008, 09:09 AM.

    Leave a comment:


  • Michael Mattias
    replied
    The following dialog is a small part of one of many DLLs recompiled by PB9 for my project.
    ..It seems that the sub cannot return to the control of the DLL
    The DIALOG NEW for all those CALLBACK FUNCTIONs *is* in that DLL module, right?

    (DDT requirement)

    Leave a comment:


  • Simon Morgan
    replied
    It's not normally a good idea to store a dialog handle in a global, as you do (hDlg). There's too much chance of it not holding the handle of the dialog you think it does.

    But in a callback function it is especially dangerous to use it (as you do in CBDlgProc). Use CBHNDL instead, if it's a DDT callback, to ensure that you are using the handle of the dialog invoking the callback.

    That probably isn't the problem, though. Just an observation!
    Last edited by Simon Morgan; 10 Nov 2008, 06:32 AM.

    Leave a comment:


  • norbert doerre
    started a topic Hard to find error in dialog

    Hard to find error in dialog

    The following dialog is a small part of one of many DLLs recompiled by PB9 for my project.
    With PB8 the results were always OK. With PB9, this is the only one code which is compilable with success but is running into a windows crash whenever a call is done by clicking on one of the buttons defined in the 'Control Add' area. All other parts of the dialog are functioning well, however.
    Have for example a look at the last button added: "Control Add ImgButton, ...."
    It's definition also ends with a simple call: "Call CloseDialog()"
    When it is clicked by mouse click, the sub is in fact executed but at it's end the whole DLL crashes with one of those common windows messages without sense.
    It seems that the sub cannot return to the control of the DLL, but only if compiled with PB9 - not with PB8. (My OS here is XP SP3)
    This is the first time I publish some meore code here in the forum, and evidently it is not easy to read. But nevertheless, it is necessary not to abreviate it because every step might give You a hint.
    As far as necessary, I translated all my code comments to English. I hope someone of You might be able to see the bug at 'first sight'.

    Code:
    '==================================================================================
    '  MechaniCAD - SelFilter-Dialog
    '  Ingenieurbüro Dörre
    '==================================================================================
    
    '----------------------------------------------------------------------------------
    ' INCLUDE FILES
    '----------------------------------------------------------------------------------
    #RESOURCE "SelFilter.pbr"
    
    #IF NOT %DEF(%WINAPI)
    	#INCLUDE "WIN32API.INC"
    #EndIf
    #INCLUDE "PBForms.INC"
    #include "..\mcToolTips.inc"
    #Include "..\mcApiType.inc"
    #Include "..\mcApiMain.inc"
    #Include "..\mcApiDlg.inc"
    #Include "..\mcInitOK.inc"
    #Include "..\DebugWin.inc"
    
    '----------------------------------------------------------------------------------
    '	EQUATES
    '----------------------------------------------------------------------------------
    'ComboBox Control IDs
    %ID_imgMatch		=		1001
    %ID_imgByLayer		=		1002
    %ID_imgClose		=		1003
    %ID_imgFilter		=		1004
    %ID_cboEntity 		= 		1041
    %ID_cboLayer		=		1042
    %ID_cboColor		=		1043
    %ID_cboLtype		=		1044
    %ID_cboLwidth		=		1045
    %ID_btnFilter		=		1046
    %ID_btnHelp			=		1047
    %ID_btnMatch		=		1048
    %ID_txtRwidth		=		1049
    %ID_btnByLayer		=		1050
    %ID_btnClear		=		1051
    %ID_btnClose		=		1052
    
    '----------------------------------------------------------------------------------
    '	global DIALOG VARIABLES
    '----------------------------------------------------------------------------------
    'Farb-Datensatz
    Type COLOR_TRIPEL
      Red As word
      Green As word
      Blue As word
    End Type
    
    Type ColorTableRecord
      szRecName As ASCIIZ * 32
      ColTrip(1 to 256) As Color_Tripel 'Basis = 1 !
      Separator as asciiz * 16 'Wird von Chamaeleon als Datensatztrenner angehängt, wenn ein weiterer Datensatz folgt.
    End Type
    
    global ColorTripels() as COLOR_TRIPEL
    global ColTabRec As ColorTableRecord
    
    global hDlg AS LONG							'Handle des Ribalog
    global xDlg AS LONG 							'Rectangle des Ribalog
    global yDlg AS LONG 							'
    global xxDlg AS LONG							'
    global yyDlg AS LONG							'
    global lDlgStyle AS LONG					'Stil des Ribalog
    global lDlgExStyle AS LONG					'Ex-Stil des Ribalog
    global ToolBarUsed AS LONG					'Werzeugleiste links Status
    global SpeedBarUsed AS LONG				'Werzeugleiste rechts Status
    global mcClientRect AS RECT 				'WinTYPE nTop& nLeft& nRight& nBottom&
    global mcFrameRect  AS RECT 				'WinTYPE nTop& nLeft& nRight& nBottom&
    global hToolBarWnd AS LONG             'Handle des ToolBar-Fensters
    global oldCBprocCboColor AS LONG 		'for subclassing, to hold original window procedure address
    global oldCBprocCboLayer AS LONG 		'for subclassing, to hold original window procedure address
    global tfFileRead as integer				'Flag wenn *.pal gelesen ist
    global hCboEntity AS LONG 					'Handle der Elemente-ComboBox
    global hCboLayer AS LONG 					'Handle der Layer-ComboBox
    global hCboColor AS LONG 					'Handle der Farb-ComboBox
    global hCboLtype AS LONG  					'Handle der Linientyp-ComboBox
    global hCboLwidth AS LONG 					'Handle der Linienbreite-ComboBox
    global hBtnFilter as long					'Handle des Filter-Buttons
    global hTxtRwidth as long 					'Handle zu 'Wahre Linienbreite'
    global hBtnByLayer as long 				'Handle des ByLayer-Buttons
    global hBtnMatch as long 					'Handle des Übernehmen-Buttons
    global hBtnClear as long 					'Handle Zurücksetzen-Buttons
    global hBtnHelp as long 					'Handle des Hilfe-Buttons
    Global hBtnClose As Long 					'Handle des Beenden-Buttons
    
    '----------------------------------------------------------------------------------
    '	CALLBACK DECLARATIONS
    '----------------------------------------------------------------------------------
    declare callback function CBDlgProc()
    declare callback function CBDlgHelp()
    declare CALLBACK function CBDlgSubClassTextbox() as long
    
    '----------------------------------------------------------------------------------
    '  FUNCTION DECLARATIONS
    '----------------------------------------------------------------------------------
    Declare Sub CloseDialog()
    Declare Sub SetupRibalog()
    Declare Sub ResizeRibalog()
    Declare Sub FillRibalogControls()
    Declare Sub MatchFilterByEntity()
    Declare Sub RefillLayerCombo()
    Declare Sub ShowDlgSelFilter()
    Declare Sub ControlProgramaticallyChangeFocus(ByVal hDlg As Long, ByVal CtlIdOld As Long, ByVal CtlIdNew As Long)
    Declare Sub RefreshDialog()
    Declare Function CBprocCboLayer(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Function CBprocCboColor(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Declare Function GetQBColor(ByVal c As Long) As Long
    Declare Function ReadPaletteFromFile(ColorTripels() As COLOR_TRIPEL) As Long
    Declare Function Combo_SetItemData(ByVal hComboBox As Long, ByVal index As Long, ByVal nData As Long) As Long
    Declare Function Combo_GetItemData(ByVal hComboBox As Long, ByVal index As Long) As Long
    
    '----------------------------------------------------------------------------------
    '  DIALOG ENTRY POINT (Dialog muß MODELESS sein.)
    '----------------------------------------------------------------------------------
    Sub ShowDlgSelFilter()
    	'Zuerst den Dialog erzeugen
    	SetupRibalog()
    	FillRibalogControls()
    	'if style has DS_ABSALIGN bit set, then we are using
    	'screen coordinates and need to calculate the appropriate
    	'dialog units - resize and locate the ribalog as required
    	IF (lDlgStyle AND %DS_ABSALIGN) THEN ResizeRibalog
    	'turn speedbar and/or toolbar off, if used
    	IF SpeedBarUsed THEN EnableWindow MCGetToolBar(%TBTOP), 0&
    	hToolBarWnd = MCGetToolBar(%TBLEFT)
    	IF ToolBarUsed THEN EnableWindow MCGetToolBar(%TBLEFT), 0&
    	'display ribalog and wait for a button to be activated
    	Dialog Show Modeless hDlg Call CBDlgProc
    	'program resumes here when ribalog is destroyed
    	'turn speedbar and/or toolbar back on, if used
    	IF SpeedBarUsed THEN EnableWindow MCGetToolBar(%TBTOP), 1&
    	IF ToolBarUsed THEN EnableWindow MCGetToolBar(%TBLEFT), 1&
    End Sub
    
    '----------------------------------------------------------------------------------
    '  SUB ResizeRibalog (Der Dialog beginnt am linken Rand der MCADD client area)
    '----------------------------------------------------------------------------------
    SUB ResizeRibalog()
    	LOCAL xPix as long
    	local yPix as long
    	local xxPix as long
    	local yyPix as long
    	local mcFrameRectH as long
    	local cyCaption as long
    	local cyMenu as long
    	mcFrameRectH = MCGethWndFrame() 'Handle des MCADD Fensterrahmens
    	GetWindowRect(mcFrameRectH, mcFrameRect) 'MCADD Fensterrahmen
    	GetClientRect(mcFrameRectH, mcClientRect) 'MCADD Fenster Client
    	'pixel height of window caption
    	cyCaption = GetSystemMetrics(%SM_CYCAPTION)
    	'pixel height of menu area
    	cyMenu = GetSystemMetrics(%SM_CYMENUSIZE)
    	xPix = 0& 'Ursprung-x des SpeedBar
    	yPix = 0& 'Ursprung-y des SpeedBar
    	'set Ribalog Width to current client area size
    	xxPix = mcClientRect.nRight - mcClientRect.nLeft
    	yyPix = 30 'entspricht yyDlg = 18 (s.o.)
    	'--- convert PIXELS to DIALOG UNITS
    	DIALOG PIXELS hDlg,  xPix,  yPix TO UNITS  xDlg,  yDlg
    	DIALOG PIXELS hDlg, xxPix, yyPix TO UNITS xxDlg, yyDlg
    	'--- set dialog to new location
    	DIALOG SET LOC  hDlg,  xDlg,  yDlg
    	'--- set dialog to new size
    	DIALOG SET SIZE hDlg, xxDlg, yyDlg
    	'--- set dialog topmost
    	SetWindowPos(hDlg, %HWND_TOPMOST, MCGetHwndFrame(), 0&, 0&, 0&, %SWP_SHOWWINDOW Or %SWP_DRAWFRAME Or %SWP_NOSIZE Or %SWP_NOMOVE)
    end sub
    
    '----------------------------------------------------------------------------------
    '  SUB SetupRibalog
    '----------------------------------------------------------------------------------
    SUB SetupRibalog
    	local mcFrameRectH as long
    	local hToolTip as long
    	local lRes as long
       lDlgStyle& = %WS_POPUP Or %DS_SETFONT Or %DS_NOFAILCREATE
    	mcFrameRectH = MCGethWndFrame() 		  		'Handle des MCADD Fensterrahmens
    	GetWindowRect(mcFrameRectH, mcFrameRect)  'MCADD Fensterrahmen-Abmessungen
    	GetClientRect(mcFrameRectH, mcClientRect) 'MCADD Fenster Client-Abmessungen
    	If xxDlg = 0 Or mcFrameRect.nLeft < -4 Or mcFrameRect.nRight > GetSystemMetrics(%SM_CXSCREEN) Then
    		xDlg = mcFrameRect.nLeft
    		yDlg = mcFrameRect.nTop
    		xxDlg = 250
    		yyDlg = 18 'entspricht yyPix& = 30 (s.u.)
    		lDlgStyle = lDlgStyle OR %DS_ABSALIGN
    	End If
    	' reset flags and get current speedbar and toolbar status
    	SpeedBarUsed& = 0&
    	ToolBarUsed& = 0&
    	If MCGetToolBar(%TBTOP) Then SpeedBarUsed& = 1&
    	If MCGetToolBar(%TBLEFT) Then ToolBarUsed& = 1&
    	Dialog New MCGethWndFrame(), "", xDlg, yDlg, xxDlg, yyDlg, lDlgStyle, lDlgExStyle To hDlg
    	'create the static controls (labels) immediately before the
    	'real control so that the keyboard accelerators (hotkeys)
    	'switch focus to the real control.
    	CONTROL ADD LABEL, 		hDlg, -1, 				"Filter" & $CRLF & _
    																"Selektion",		  2, 1, 32, 16
    	CONTROL ADD LABEL,   	hDlg, -1, 				"", 					 34, 0,  0, 19, %SS_ETCHEDVERT
    	CONTROL ADD LABEL, 		hDlg, -1, 				"Elem.:",			 37, 5, 19,  9
       CONTROL ADD COMBOBOX, 	hDlg, %ID_cboEntity,,						 57, 3, 70, 120, %CBS_DROPDOWNLIST or %WS_VSCROLL
    	CONTROL ADD LABEL, 		hDlg, -1, 				"Layer:",			129, 5, 19,  9
       CONTROL ADD COMBOBOX, 	hDlg, %ID_cboLayer,,							149, 3,105, 120, %CBS_OWNERDRAWFIXED OR %CBS_HASSTRINGS OR %CBS_DROPDOWNLIST OR %WS_TABSTOP OR %CBS_DISABLENOSCROLL OR %WS_VSCROLL
    	CONTROL ADD LABEL, 		hDlg, -1, 				"Farbe:",			256, 5, 19,  9
       CONTROL ADD COMBOBOX, 	hDlg, %ID_cboColor,,							276, 3, 45, 120, %CBS_OWNERDRAWFIXED OR %CBS_HASSTRINGS OR %CBS_DROPDOWNLIST OR %WS_TABSTOP OR %CBS_DISABLENOSCROLL OR %WS_VSCROLL
    	CONTROL ADD LABEL, 		hDlg, -1, 				"LTyp:",			 	323, 5, 18,  9
       CONTROL ADD COMBOBOX, 	hDlg, %ID_cboLtype,,							342, 3,110, 120, %CBS_DROPDOWNLIST or %WS_VSCROLL
    	CONTROL ADD LABEL, 		hDlg, -1, 				"LBreite:",			454, 5, 23,  9
       Control Add ComboBox, 	hDlg, %ID_cboLwidth,,						478, 3, 30, 120, %CBS_DROPDOWNLIST Or %WS_VSCROLL
    	CONTROL ADD LABEL, 		hDlg, -1, "Wahre" & $CRLF & "LBreite:",510, 1, 24, 16
    	CONTROL ADD TEXTBOX, 	hDlg, %ID_txtRwidth, "0.0", 				535, 3, 30, 13, %ES_LEFT or %WS_TABSTOP, %WS_EX_CLIENTEDGE
       CONTROL ADD IMGBUTTON, 	hDlg, %ID_btnByLayer,"#" + FORMAT$(%ID_imgByLayer),567, 3, 13, 13, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_BITMAP OR %BS_PUSHLIKE OR %BS_AUTOCHECKBOX OR _
    																															  %BS_CENTER Or %BS_MCENTER, %WS_EX_LEFT Or %WS_EX_LTRREADING Call UseByLayerProps()
    	CONTROL ADD IMGBUTTON,  hDlg, %ID_btnMatch,  "#" + FORMAT$(%ID_imgMatch),  582, 3, 13, 13, %WS_CHILD OR %BS_PUSHBUTTON OR %BS_CENTER,%WS_EX_LEFT OR %WS_EX_LTRREADING call MatchFilterByEntity()
       CONTROL ADD IMGBUTTON, 	hDlg, %ID_btnFilter, "#" + FORMAT$(%ID_imgFilter), 597, 3, 13, 13, %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR %BS_BITMAP OR %BS_PUSHLIKE OR %BS_AUTOCHECKBOX OR _
    																															  %BS_CENTER OR %BS_MCENTER, %WS_EX_LEFT OR %WS_EX_LTRREADING
    	Control Add Button,  	hDlg, %ID_btnClear, 	"Neu", 				612, 3, 20, 13, %BS_PUSHBUTTON Call RefreshDialog()
    	Control Add Button,  	hDlg, %ID_btnHelp, 	"?", 					634, 3, 13, 13, %BS_PUSHBUTTON Call CBDlgHelp()
    	CONTROL ADD IMGBUTTON,  hDlg, %ID_btnClose,  "#" + FORMAT$(%ID_ImgClose), 649, 3, 13, 13, %WS_CHILD OR %BS_PUSHBUTTON OR %BS_CENTER,%WS_EX_LEFT OR %WS_EX_LTRREADING call CloseDialog()
    
    	'SubClassing der Eingabefelder für Dezimalzahlen. Nur Ziffern und ein Dezimalpunkt sind erlaubt
    	CONTROL SET USER hDlg, %ID_txtRwidth, 1, SetWindowLong(GetDlgItem(hDlg, %ID_txtRwidth), %GWL_WNDPROC, CODEPTR(CBDlgSubClassTextbox))
    
    	'Handles der Controls
    	CONTROL HANDLE hDlg, %ID_cboEntity TO hCboEntity 'Handle der Elemente-ComboBox
    	CONTROL HANDLE hDlg, %ID_cboLayer TO hCboLayer 'Handle der Layer-ComboBox
    	CONTROL HANDLE hDlg, %ID_cboColor TO hCboColor 'Handle der Farb-ComboBox
    	CONTROL HANDLE hDlg, %ID_cboLtype TO hCboLtype  'Handle der Linientyp-ComboBox
    	CONTROL HANDLE hDlg, %ID_cboLwidth TO hCboLwidth 'Handle der Linienbreite-ComboBox
    	CONTROL HANDLE hDlg, %ID_txtRwidth TO hTxtRwidth 'Handle zu 'Wahre Linienbreite'
    	CONTROL HANDLE hDlg, %ID_btnByLayer TO hBtnByLayer 'Handle des ByLayer-Buttons
    	CONTROL HANDLE hDlg, %ID_btnMatch TO hBtnMatch 'Handle des Übernehmen-Buttons
    	CONTROL HANDLE hDlg, %ID_btnFilter TO hBtnFilter 'Handle des Filter-Buttons
    	CONTROL HANDLE hDlg, %ID_btnClear TO hBtnClear 'Handle Zurücksetzen-Buttons
    	CONTROL HANDLE hDlg, %ID_btnHelp TO hBtnHelp 'Handle des Hilfe-Buttons
    	CONTROL HANDLE hDlg, %ID_btnClose TO hBtnClose 'Handle des Beenden-Buttons
    
    	'Entity-ComboBox füllen
    	combobox add hDlg, %ID_cboEntity, "*Alle*"
    	combobox add hDlg, %ID_cboEntity, "{0} Null-Element"
    	combobox add hDlg, %ID_cboEntity, "{1} Einzellinie"
    	combobox add hDlg, %ID_cboEntity, "{2} Bogen"
    	combobox add hDlg, %ID_cboEntity, "{3} Kreis"
    	combobox add hDlg, %ID_cboEntity, "{4} Ellipse"
    	combobox add hDlg, %ID_cboEntity, "{5} Bezierbogen"
    	combobox add hDlg, %ID_cboEntity, "{6} Hilfspunkt"
    	combobox add hDlg, %ID_cboEntity, "{7} Block"
    	combobox add hDlg, %ID_cboEntity, "{8} Text"
    	combobox add hDlg, %ID_cboEntity, "{9} LinearBem"
    	combobox add hDlg, %ID_cboEntity, "{10} WinkelBem"
    	combobox add hDlg, %ID_cboEntity, "{11} RadiusBem"
    	combobox add hDlg, %ID_cboEntity, "{12} DurchmBem"
    	combobox add hDlg, %ID_cboEntity, "{13} Füllung"
    	combobox add hDlg, %ID_cboEntity, "{14} Schraffur"
    	combobox add hDlg, %ID_cboEntity, "{15} Attribut"
    	combobox add hDlg, %ID_cboEntity, "{16} SplineBogen"
    	combobox add hDlg, %ID_cboEntity, "{17} PolySpline"
    	combobox add hDlg, %ID_cboEntity, "{18} ElliptBogen"
    	combobox add hDlg, %ID_cboEntity, "{19} PolyLinie"
    	combobox add hDlg, %ID_cboEntity, "{20} PolyBezier"
    	combobox add hDlg, %ID_cboEntity, "{21} Führung"
    	combobox add hDlg, %ID_cboEntity, "{22} Referenz"
    	combobox add hDlg, %ID_cboEntity, "{23} OrdinateBem"
      'In der Entity-Box das Item mit Index 0 selektieren
    	CONTROL SEND hDlg, %ID_cboEntity, %CB_SETCURSEL, 0, 0
    	'ByLayer-Button übernimmt den ByLayer-Wert von MCADD
    	control set check hDlg, %ID_btnByLayer, MCDrawingHasLayerProperties()
    	'ToolTips anfügen
    	hToolTip = ToolTip_Create(hCboEntity)
    	lRes = ToolTip_SetToolTip(hCboEntity,"Liste der filterbaren Elemente")
    	hToolTip = ToolTip_Create(hCboLayer)
    	lRes = ToolTip_SetToolTip(hCboLayer,"Liste der filterbaren Layer")
    	hToolTip = ToolTip_Create(hCboColor)
    	lRes = ToolTip_SetToolTip(hCboColor,"Liste der filterbaren Farben")
    	hToolTip = ToolTip_Create(hCboLtype)
    	lRes = ToolTip_SetToolTip(hCboLtype,"Liste der filterbaren Linientypen")
    	hToolTip = ToolTip_Create(hCboLwidth)
    	lRes = ToolTip_SetToolTip(hCboLwidth,"Liste der filterbaren Linienbreiten")
    	hToolTip = ToolTip_Create(hTxtRwidth)
    	lRes = ToolTip_SetToolTip(hTxtRwidth,"Eingabe der wahren Linienbreite")
    	hToolTip = ToolTip_Create(hBtnByLayer)
    	lRes = ToolTip_SetToolTip(hBtnByLayer,"Layerparameter verwenden/nicht verwenden")
    	hToolTip = ToolTip_Create(hBtnMatch)
    	lRes = ToolTip_SetToolTip(hBtnMatch,"Parameter von Objekt übernehmen")
    	hToolTip = ToolTip_Create(hBtnFilter)
    	lRes = ToolTip_SetToolTip(hBtnFilter,"Filter aktivieren/deaktivieren")
    	hToolTip = ToolTip_Create(hBtnClear)
    	lRes = ToolTip_SetToolTip(hBtnClear,"Filter zurücksetzen")
    	hToolTip = ToolTip_Create(hBtnHelp)
    	lRes = ToolTip_SetToolTip(hBtnHelp,"Hilfe")
    	hToolTip = ToolTip_Create(hBtnClose)
    	lRes = ToolTip_SetToolTip(hBtnClose,"Filterwerkzeug beenden")
    end sub
    
    '----------------------------------------------------------------------------------
    '  SUB FillRibalogControls
    '----------------------------------------------------------------------------------
    sub FillRibalogControls()
    	local iError as integer
    	local sLayerName as string
    	local szName as asciiz * 64
    	local iRes as integer
    	local sProps as string
    	local sLtName as string
    	local szLtName as asciiz * 64
    	local ItemIndex as long
    	local i as long
    	'Layer-ComboBox füllen
    	ItemIndex = 0 'ItemIndex zurücksetzen
    	combobox add hDlg, %ID_cboLayer, "*Alle*"	'für "nichts selektiert"
    	For i = 0 to 1023 'Prüfen, ob Layer Daten enthält
    		if MCGetLayerHasData(iError, i) then 'Layer enthält Elemente?
    			'Properties anhängen
    			if MCLayerHasProperties(iError, i) then 'Layer hat Layerparameter?
    				fLayerLineWidthValue = -1
    				if MCGetLayerProperties(iError, i, iLayerColorIndex, iLayerLineTypeIndex, iLayerLineWidthIndex, fLayerLineWidthValue) then
    					if fLayerLineWidthValue <= 0 then fLayerLineWidthValue = -1
    					'Property-Einträge in Combobox
    					sProps = "{--} "
    					if iLayerLineTypeIndex > -1 then mid$(sProps, 2, 1) = "t"
    					if iLayerLineWidthIndex > -1 then
    						mid$(sProps, 3, 1) = "w"
    					elseif fLayerLineWidthValue > 0.0 then
    						mid$(sProps, 3, 1) = "r"
    					end if
    				end if
    			else 'Layer hat keine Layerparameter
    				sProps = "{--} "
    			end if
    			'Layernamen abfragen
    			iRes = MCGetLayerNameFromIndex(iError, i, szName)
    			sLayerName = left$(szName, iRes)
    			if len(sLayerName) = 0 then sLayername = trim$(str$(i)) 'Hat der Layer keinen Namen, dann LayerIndex verwenden.
    			'Item an ComboBox anhängen
    			ItemIndex = ItemIndex + 1 'ItemIndex für neues ComboBox-Item inkrementieren
    			combobox add hDlg, %ID_cboLayer, sProps & sLayerName 'Neue ComboBox anfügen
    			if Combo_SetItemData(hCboLayer, ItemIndex, i) = %CB_ERR then
    				msgbox "%CB_ERR",%MB_SYSTEMMODAL, "SelFilter" 'LayerIndex als Itemdata anfügen
    			end if
    		end if
    	next i
     	'Layerfarben hinzufügen
    	IF hCboLayer THEN oldCBprocCboLayer = GetWindowLong(hCboLayer, %GWL_WNDPROC)
    	IF oldCBprocCboLayer THEN SetWindowLong hCboLayer, %GWL_WNDPROC, CODEPTR(CBprocCboLayer)
       'Item mit Index 0 selektieren
    	ItemIndex = 0
    	CONTROL SEND hDlg, %ID_cboLayer, %CB_SETCURSEL, ItemIndex, 0
    
    	'Linienfarben-ComboBox füllen
    	combobox add hDlg, %ID_cboColor, "*Alle*"	'für "nichts selektiert"
    	For i = 0 to 255	'Es folgen 256 Farbnummern, mit ItemIndex = 1 startend
    		combobox add hDlg, %ID_cboColor, str$(i)
    	next i
    	'Linienfarben hinzufügen
    	IF hCboColor THEN oldCBprocCboColor = GetWindowLong(hCboColor, %GWL_WNDPROC)
    	IF oldCBprocCboColor THEN SetWindowLong hCboColor, %GWL_WNDPROC, CODEPTR(CBprocCboColor)
       'Item mit Index 0 selektieren
    	CONTROL SEND hDlg, %ID_cboColor, %CB_SETCURSEL, 0, 0
    
    	'Linientypen-ComboBox füllen (kein Subclassing)
    	combobox add hDlg, %ID_cboLtype, "*Alle*"		'für "nichts selektiert"
    	for i = 0 to 255	'Es folgen 256 Linientypen, mit ItemIndex = 1 startend
    		iRes = MCGetLineTypeNameFromIndex(iError, i, szLtName)
    		sLtName = left$(szLtName, iRes)
    		if len(sLtName) > 0 then
    			combobox add hDlg, %ID_cboLtype, "{" & trim$(str$(i)) & "} " & sLtName
    		end if
    	next i
       'Item mit Index 0 selektieren (kein Subclassing)
    	CONTROL SEND hDlg, %ID_cboLtype, %CB_SETCURSEL, 0, 0
    
    	'Linienbreiten-ComboBox füllen
     	combobox add hDlg, %ID_cboLwidth, "*Alle*"	'für "nichts selektiert"
    	for i = 0 to 15 '	'Es folgen 16 Linienbreiten, mit ItemIndex = 1 startend
    		combobox add hDlg, %ID_cboLwidth, str$(i)
    	next i
      'Item mit Index 0 selektieren
    	CONTROL SEND hDlg, %ID_cboLwidth, %CB_SETCURSEL, 0, 0
    
    	'TextBox für wahre Linienbreite vorbelegen
    	CONTROL SET TEXT hDlg, %ID_txtRwidth, "*Alle*"
    END SUB
    
    '----------------------------------------------------------------------------------
    '  SUB ControlChangeFocus
    '----------------------------------------------------------------------------------
    SUB ControlProgramaticallyChangeFocus(BYVAL hDlg AS LONG, BYVAL CtlIdOld AS LONG, Byval CtlIdNew as long)
    	'Wechsel des Focus von %CtlID_A zu %CtlId_B
    '	 CONTROL SEND hDlg, CtlId_A, %BM_SETSTYLE, %BS_PUSHBUTTON, %TRUE
    '   CONTROL SET FOCUS hDlg, CtlId_B
    '   CONTROL SEND hDlg, CtlId_B, %BM_SETSTYLE, %BS_DEFPUSHBUTTON, %TRUE
    END SUB
    
    '----------------------------------------------------------------------------------
    '  CALLBACK FUNCTION DlgProc
    '----------------------------------------------------------------------------------
    CallBack Function CBDlgProc()
    	Local sRet As String
    	Local lRes As Long
    	Local iError As Integer
    	Local SelectedItem As Long
    	Local ItemData As Integer
    	Local X As Dword
    	Local ItemIndex As Long
    	'Dialog Messages auswerten
       Select Case CbMsg
    		Case %WM_COMMAND
             Select Case CbCtl
                Case %ID_btnFilter
    					Control Get Check hDlg, %ID_btnFilter To lRes
    					If lRes = 1 Then
    						'Entity
    						Control Send CbHndl, %ID_cboEntity, %CB_GETCURSEL, 0, 0 To lRes
    						If lres = 0 Then
    							iFilterEntityKind = -1
    						Else
    							iFilterEntityKind = CInt(lRes - 1) 'Die Entity-Liste startet mit "*Alle*" bei Index 0
    						End If
    						'Layer
    						Control Send CbHndl, %ID_cboLayer, %CB_GETCURSEL, 0, 0 To ItemIndex
    						If ItemIndex = 0 Then
    							iFilterLayerIndex = -1
    						Else
    							lRes = Combo_GetItemData(hCboLayer, ItemIndex)
    							iFilterLayerIndex = CInt(lRes)
    						End If
    						'Color
    						Control Send CbHndl, %ID_cboColor, %CB_GETCURSEL, 0, 0 To lRes
    						If lres = 0 Then
    							iFilterColorIndex = -1
    						ElseIf lRes > 0 Then
    							iFilterColorIndex = CInt(lRes - 1) 'Die Color-Liste startet mit "*Alle*" bei Index 0
    						End If
    						'LineType
    						Control Send CbHndl, %ID_cboLtype, %CB_GETCURSEL, 0, 0 To lRes
    						If lres = 0 Then
    							iFilterLineTypeIndex = -1
    						ElseIf lRes > 0 Then
    							iFilterLineTypeIndex = CInt(lRes - 1) 'Die lineType startet mit "*Alle*" bei Index 0
    						End If
    						'LineWidth
    						Control Send CbHndl, %ID_cboLwidth, %CB_GETCURSEL, 0, 0 To lRes
    						If lres = 0 Then
    							iFilterLineWidthIndex = -1
    						ElseIf lRes > 0 Then
    							iFilterLineWidthIndex = CInt(lRes - 1)
    						End If
    						'LineWidthValue
    						Control Get Text hDlg, %ID_txtRwidth To sRet
    						If sRet = "*Alle*" Then
    							fFilterLineWidthValue = -1
    						ElseIf Val(sRet) > 0 Then
    							fFilterLineWidthValue = CSng(Val(sRet))
    						End If
    						'Filterkriterien anwenden
    						MCSetHighLight(iError, 1)
    						'Filter deaktivieren
    						MCSetFilterActive(iError, 0)
    						'Filter zurücksetzen
    						MCFilterReset(iError)
    						MCSetFilterKind(iError, iFilterEntityKind)
    						MCSetFilterLayer(iError, iFilterLayerIndex)
    						MCSetFilterColor(iError, iFilterColorIndex)
    						MCSetFilterLineType(iError, iFilterLineTypeIndex)
    						MCSetFilterWidth(iError, iFilterLineWidthIndex)
    						'Filter aktivieren
    						MCSetFilterActive(iError, 1)
    						'Es muß nach Aktivierung des Filters sofort selektiert werden.
    						'Ein Klick in die Zeichnung, der nicht zur Selektion führt, setzt das Filter inaktiv.
    						'Zur Selektion meherer Objekte muß unmittelbar ein Selektionsbefehl eingegeben werden.
    					End If
    					Exit Function
    				Case %ID_btnByLayer
    					Control Get Check hDlg, %ID_btnByLayer To lRes
    					MCSetByLayerStatus(lRes)
    					RefillLayerCombo()
    				Case %ID_cboEntity
                   If HiWrd(CbWParam) = %CBN_SELENDOK Then
    						SelectedItem = SendMessage(CbLParam, %CB_GETCURSEL, 0, 0)
    						iFilterEntityKind = SelectedItem - 1 'In ItemIndex = 0 befindet sich '----'.
    						'Edit-Liste der Elementparameter öffnen
    						Select Case iFilterEntityKind
    							Case %SYMBOL2D, %DIMLINEAR2D, %DIMANGULAR2D, %DIMRADIAL2D, %DIMDIAMETER2D, %LEADER2D, %ORDDIM2D
    								'Bemaßung kann Entity-Layer und Entity-Farbe besitzen.
    								iEntityLineTypeIndex = -1
    								iEntityLineWidthIndex = -1
    								fEntityLineWidthValue = -1
    								Control Disable hDlg, %ID_cboLtype
    								Control Disable hDlg, %ID_cboLwidth
    								Control Disable hDlg, %ID_txtRwidth
     						End Select
    						Function = 0
    						Exit Function
                   End If
    				Case %ID_cboLayer
    					'Wenn LP verwendet werden, dann ggf. Farbe, LTyp und LBreite als LP anzeigen
                   If HiWrd(CbWParam) = %CBN_SELENDOK Then
    						SelectedItem = SendMessage(CbLParam, %CB_GETCURSEL, 0, 0) 'der gewählte LayerIndex
    						'Auslesen der Layernummer als ItemData:
    						If SelectedItem > 0 Then
    							ItemData = Combo_GetItemData(hCboLayer, SelectedItem)
    							iFilterLayerIndex = ItemData
    							'Testen, ob Layerparameter vorhanden
    							fFilterLineWidthValue = -1 'Die wahre Linienbreite wird nicht automatisch zurückgesetzt.
    							'ItemData enthält den LayerIndex des aktuellen Items. Layerparameter dieses Layerindex ermitteln.
    							If MCLayerHasProperties(iError, iFilterLayerIndex) Then 'Layer hat Layerparameter
    								iLayerColorIndex = -1
    								iLayerLineTypeIndex = -1
    								iLayerLineWidthIndex = -1
    								fLayerLineWidthValue = -1
    								MCGetLayerProperties(iError, ItemData, iLayerColorIndex, iLayerLineTypeIndex, iLayerLineWidthIndex, fLayerLineWidthValue)
    								If fLayerLineWidthValue <= 0.0 Then
    									fLayerLineWidthValue = -1
    								End If
    								'Die ComboBox-Items selektieren, bezogen auf Layerparameter
    								ComboBox Select hDlg, %ID_cboColor, iLayerColorIndex + 2 'Offset = 2
    								iFilterColorIndex = iLayerColorIndex
    								ComboBox Select hDlg, %ID_cboLtype, iLayerLineTypeIndex + 2
    								iFilterLineTypeIndex = iLayerLineTypeIndex
    								ComboBox Select hDlg, %ID_cboLwidth, iLayerLineWidthIndex + 2
    								iFilterLineWidthIndex = iLayerLineWidthIndex
    								'Wahre Linienbreite
    								If fLayerLineWidthValue > 0.0 Then
    									fFilterLineWidthValue = fLayerLineWidthValue
    									Control Set Text hDlg, %ID_txtRwidth, Str$(fFilterLineWidthValue * dUCF)
    								ElseIf fLayerLineWidthValue = -1 Then
    									fFilterLineWidthValue = -1
    									If fEntityLineWidthValue > 0.0 Then
    										fFilterLineWidthValue = fEntityLineWidthValue
    									End If
    								End If
    								If fFilterLineWidthValue = -1 Then
    									Control Set Text hDlg, %ID_txtRwidth, "*Alle*"
    								ElseIf fFilterLineWidthValue > 0.0 Then
    									Control Set Text hDlg, %ID_txtRwidth, Str$(fLayerLineWidthValue * dUCF)
    								End If
    							End If
    						End If
    					End If
                Case %ID_cboColor
                   If HiWrd(CbWParam) = %CBN_SELENDOK Then
    						SelectedItem = SendMessage(CbLParam, %CB_GETCURSEL, 0, 0)
    						iFilterColorIndex = SelectedItem - 1 'In ItemIndex = 0 befindet sich '----'.
                     Function = 0
    					  Exit Function
                   End If
    				Case %ID_cboLtype
                   If HiWrd(CbWParam) = %CBN_SELENDOK Then
    						SelectedItem = SendMessage(CbLParam, %CB_GETCURSEL, 0, 0)
    						iFilterLineTypeIndex = SelectedItem - 1 'In ItemIndex = 0 befindet sich '----'.
                     Function = 0
    					  Exit Function
                   End If
    				Case %ID_cboLwidth
                   If HiWrd(CbWParam) = %CBN_SELENDOK Then
    						SelectedItem = SendMessage(CbLParam, %CB_GETCURSEL, 0, 0)
    						iFilterLineWidthIndex = SelectedItem - 1'In ItemIndex = 0 befindet sich '----'.
                     Function = 0
    					  Exit Function
                   End If
             End Select
          Case %WM_DESTROY 'Un-subclass Combobox
             If oldCBprocCboColor Then
                SetWindowLong GetDlgItem(CbHndl, %ID_cboColor), %GWL_WNDPROC, oldCBprocCboColor
    			ElseIf oldCBprocCboLayer Then
                SetWindowLong GetDlgItem(CbHndl, %ID_cboLayer), %GWL_WNDPROC, oldCBprocCboLayer
             End If
    			Control Get User CbHndl, %ID_txtRwidth, 1 To X 'Unsubclass the control... it is not wise to skip this step!
    			SetWindowLong GetDlgItem(CbHndl, %ID_txtRwidth), %GWL_WNDPROC, X
          Case %WM_DRAWITEM, %WM_MEASUREITEM 'Pass these on to CBprocCbo ...
    			Select Case CbWParam
    				Case %ID_cboColor 'ComboBox mit Grafik
    					CBprocCboColor GetDlgItem(CbHndl, %ID_cboColor), CbMsg, CbWParam, CbLParam
    					Function = 0
    					Exit Function
    				Case %ID_cboLayer 'ComboBox mit Grafik
    					CBprocCboLayer GetDlgItem(CbHndl, %ID_cboLayer), CbMsg, CbWParam, CbLParam
    					Function = 0
    					Exit Function
             End Select
       End Select
    End Function
    
    '----------------------------------------------------------------------------------
    '	Subclassed Layer Combobox
    '----------------------------------------------------------------------------------
    FUNCTION CBProcCboLayer(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG
    	SELECT CASE wMsg
    		CASE %WM_MEASUREITEM 'Don't need it here, keep it for ev. future use
    		CASE %WM_DRAWITEM
    			LOCAL hBrush AS LONG
    			local hBrushOld AS LONG
    			local rct AS RECT
    			local szText AS ASCIIZ * 128
    			LOCAL lpdis  AS DRAWITEMSTRUCT PTR
    			local iError as integer
    			local ItemData as long
    
    			lpdis = lParam
    			IF @lpdis.itemID < 0 THEN EXIT FUNCTION 'Der Item-Index der Layer-ComboBox
    			SELECT CASE @lpdis.itemAction
    			  CASE %ODA_DRAWENTIRE, %ODA_SELECT
    				  'CLEAR BACKGROUND
    				  hBrush = CreateSolidBrush(GetSysColor(%COLOR_WINDOW)) 'Create a background brush
    				  hBrushOld = SelectObject(@lpdis.hDC, hBrush) 'Select brush into device context
    				  FillRect(@lpdis.hDC, @lpdis.rcItem, hBrush)  'Paint background color rectangle
    				  SelectObject(@lpdis.hDC, hBrushOld)          'Select old brush back
    				  DeleteObject(hBrush)                         'Delete brush
    				  'DRAW TEXT
    				  SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOW))            			'Set text Background
    				  SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOWTEXT))      			'Set text color
    				  SendMessage(hWnd, %CB_GETLBTEXT, @lpdis.itemID, VARPTR(szText)) 		'Get text
    				  TextOut(@lpdis.hDC, 16, @lpdis.rcItem.ntop + 2, szText, LEN(szText)) 	'Draw text
    				  'ITEM SELECTED
    				  IF (@lpdis.itemState AND %ODS_SELECTED) THEN	'Item ist selektiert
    					  rct.nLeft   = 16  'Set cordinates
    					  rct.nRight = @lpdis.rcItem.nRight
    					  rct.ntop    = @lpdis.rcItem.ntop
    					  rct.nbottom = @lpdis.rcItem.nbottom
    					  '# InvertRect(@lpdis.hDC, rct)             'invert area around text only
    					  DrawFocusRect(@lpdis.hDC, @lpdis.rcItem)  	'and draw a focus rectangle around all
    				  END IF
    				  'PAINT COLOR RECTANGLE (using RoundRect for nicer looks.. :-)
    				  'Here you can customize if you like - like BitBlt bitmaps via a memDC
    				  'instead, or use DrawFrameControl to draw a "fake" checkbox, etc...
    				  'Layerfarben auslesen und in Combo eintragen
    				  rct.nLeft   = 4  'Set cordinates
    				  rct.nRight = 14
    				  rct.ntop    = @lpdis.rcItem.ntop + 3
    				  rct.nbottom = @lpdis.rcItem.nbottom - 3
    				  if @lpdis.itemID > 0 then 'Item 0 ist ja mit "*Alle*" belegt
    					  ItemData = Combo_GetItemData(hCboLayer, @lpdis.itemID) 'Den LayerIndex aus Itemdata lesen
    					  if MCGetLayerProperties(iError, ItemData, iFilterColorIndex, iFilterLineTypeIndex, iFilterLineWidthIndex, fFilterLineWidthValue) then 'Farbe aus LP lesen
    						  if iFilterColorIndex > -1 then 'nur wenn Layerfarbe vorhanden
    							  hBrush = CreateSolidBrush(GetQBColor(iFilterColorIndex + 1))	'Pinsel mit Farbe erzeugen. (+ 1, da Combo mit '----' = Index 0 startet.)
    							  hBrushOld = SelectObject(@lpdis.hDC, hBrush)			'Select brush into device context
    							  RoundRect(@lpdis.hDC, rct.nLeft, rct.ntop, rct.nRight, rct.nbottom, 3, 3) 'Abgerundetes Rechteck zeichnen
    							  SelectObject(@lpdis.hDC, hBrushOld)             		'Select old brush back
    							  DeleteObject(hBrush)                            		'Delete brush
    						  end if
    					  end if
    				  end if
    			END SELECT
    			FUNCTION = %TRUE
    			EXIT FUNCTION
    	END SELECT
    	FUNCTION = CallWindowProc(oldCBprocCboLayer, hWnd, wMsg, wParam, lParam) 'process other messages
    END FUNCTION
    
    '----------------------------------------------------------------------------------
    '	Subclassed Color Combobox CBprocCboColor
    '----------------------------------------------------------------------------------
    Function CBprocCboColor(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
      SELECT CASE wMsg
         CASE %WM_MEASUREITEM 'Don't need it here, keep it for ev. future use
         CASE %WM_DRAWITEM
            LOCAL hBrush AS LONG
    		  local hBrushOld AS LONG
    		  local rct AS RECT
    		  local szText AS ASCIIZ * 128
            LOCAL lpdis  AS DRAWITEMSTRUCT PTR
    
            lpdis = lParam
            IF @lpdis.itemID = -1 THEN EXIT FUNCTION
            SELECT CASE @lpdis.itemAction
               CASE %ODA_DRAWENTIRE, %ODA_SELECT
                  'CLEAR BACKGROUND
                  hBrush = CreateSolidBrush(GetSysColor(%COLOR_WINDOW)) 'Create a background brush
                  hBrushOld = SelectObject(@lpdis.hDC, hBrush) 'Select brush into device context
                  FillRect(@lpdis.hDC, @lpdis.rcItem, hBrush)  'Paint background color rectangle
                  SelectObject(@lpdis.hDC, hBrushOld)          'Select old brush back
                  DeleteObject(hBrush)                         'Delete brush
                  'DRAW TEXT
                  SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOW))            			'Set text Background
                  SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOWTEXT))      			'Set text color
                  SendMessage(hWnd, %CB_GETLBTEXT, @lpdis.itemID, VARPTR(szText)) 		'Get text
                  TextOut(@lpdis.hDC, 24, @lpdis.rcItem.ntop + 2, szText, LEN(szText))	'Draw text
                  'SELECTED ITEM
                  IF (@lpdis.itemState AND %ODS_SELECTED) THEN	'if selected
                     rct.nLeft   = 22 'Set cordinates
    					  rct.nRight = @lpdis.rcItem.nRight
                     rct.ntop    = @lpdis.rcItem.ntop
                     rct.nbottom = @lpdis.rcItem.nbottom
    					  '# InvertRect(@lpdis.hDC, rct)            	'invert area around text only
                     DrawFocusRect(@lpdis.hDC, @lpdis.rcItem)  	'and draw a focus rectangle around all
                  END IF
                  'PAINT COLOR RECTANGLE (using RoundRect for nicer looks.. :-)
                  ' Here you can customize if you like - like BitBlt bitmaps via a memDC
                  ' instead, or use DrawFrameControl to draw a "fake" checkbox, etc...
    				  if @lpdis.itemID > 0 then  'Wegen "*Alle*" nur durchführen, wenn ListIndex > 0
    					  rct.nLeft   = 4  'Set cordinates
    					  rct.nRight = 20
    					  rct.ntop    = @lpdis.rcItem.ntop + 3
    					  rct.nbottom = @lpdis.rcItem.nbottom - 3
    					  hBrush = CreateSolidBrush(GetQBColor(@lpdis.itemID))		'Create brush with proper color (-1, weil "*Alle*" zusätzlich ist)
    					  hBrushOld = SelectObject(@lpdis.hDC, hBrush)    				'Select brush into device context
    					  RoundRect(@lpdis.hDC, rct.nLeft, rct.ntop, rct.nRight, rct.nbottom, 3, 3) 'Draw
    					  SelectObject(@lpdis.hDC, hBrushOld)             				'Select old brush back
    					  DeleteObject(hBrush)                            				'Delete brush
    				  end if
            END SELECT
            FUNCTION = %TRUE
    		  EXIT FUNCTION
      END SELECT
      FUNCTION = CallWindowProc(oldCBprocCboColor, hWnd, wMsg, wParam, lParam) 'process other messages
    END FUNCTION
    
    '-------------------------------------------------------------------------------------------------------
    '  Subclassed Textbox CBDlgSubClassTextbox, nur Eingabe von Ziffern und Dezimalpunkt möglich
    '-------------------------------------------------------------------------------------------------------
    CALLBACK function CBDlgSubClassTextbox() as long
    	LOCAL x AS DWORD
    	LOCAL y AS ASCIIZ * %MAX_PATH
    	SELECT CASE CBMSG
    		CASE %WM_CHAR
    			' Nur Eingabe von Zahlen und Dezimalpunkt möglich
    			IF ISFALSE INSTR("0123456789.-" + $BS + $TAB, CHR$(CBWPARAM)) THEN
    				BEEP
    				EXIT FUNCTION
    			end if
    			' Allow only one "." in the control, so discard any additional periods
    			IF CHR$(CBWPARAM) = "." THEN
    				GetWindowText CBHNDL, y, SIZEOF(y)
    				IF INSTR(y, ".") THEN
    					BEEP
    					EXIT FUNCTION
    				end if
    			elseif CHR$(CBWPARAM) = "-" THEN
    				control set text hDlg, %ID_txtRwidth, "---" 'drei '-' hinzufügen
    				fFilterLineWidthValue = -1
    			END IF
    		CASE %WM_PASTE
    		' We'll simply prevent pasting, but you might like to open the clipboard
    		' and validate the data before allowing or disallowing the paste
    		BEEP
    		EXIT FUNCTION
    	END SELECT
    	DIALOG GET USER CBHNDL, 1 TO x
    	FUNCTION = CallWindowProc(x, CBHNDL, CBMSG, CBWPARAM, CBLPARAM)
    END FUNCTION
    
    '----------------------------------------------------------------------------------
    '  FUNCTION GetQBColor
    '----------------------------------------------------------------------------------
    FUNCTION GetQBColor(BYVAL iIndex AS LONG) AS LONG
    	if tfFileRead = 0 then
    		function = rgb(ColTabRec.ColTrip(iIndex).Red, ColTabRec.ColTrip(iIndex).Green, ColTabRec.ColTrip(iIndex).Blue)
    	end if
    END FUNCTION
    
    '-------------------------------------------------------------------------------------------------------
    '  FUNCTION  ReadPaletteFromFile (Die Mcadd-Farbnummer 0 hat hier den Index 1)
    '-------------------------------------------------------------------------------------------------------
    Function ReadPaletteFromFile(ColorTripels() As COLOR_TRIPEL) As Long
    	'Farbtabelle einlesen als Farbtripel{R, G, B}
    	local iLastPalIndex as long
    	local i as long
    	local FH as long
    	local sMcaddPath as string
    	local sRes as string
    	local szFixed as asciiz * 32
    
    	sRes = RegGetVal(%HKEY_CURRENT_USER, "Software\I B D\MechaniCAD\Main\Addon\Chamaeleon", "LastPaletteIndex")
    	if len(sRes) = 0 then
    		iLastPalIndex = 1
    	else
    		iLastPalIndex = CInt(Val(sRes)) + 1 '1-basierend
    	End if
       sMcaddPath = RegGetVal(%HKEY_CURRENT_USER, "Software\I B D\MechaniCAD\Main\Paths\", "System")
    	redim ColorTripels(1 to 256) '---> Basis = 1
    	FH = freefile
    	OPEN sMcaddPath & "COLORS.DEF" For Random As #FH Len = len(ColTabRec)
    	if seek(FH) > 0 then
          Get #FH, iLastPalIndex, ColTabRec
    		szFixed = ColTabRec.szRecName 'Name des Farbdatensatzes
    		For i = 1 To 256 'nur Indizes 1...256 stammen aus COLORS.DEF, Index 1 ist fest programmiert mit (0,0,0), Index 47 mit (0,0,0 und Index 48 mit (255,255,255)
    			ColorTripels(i).Red = ColTabRec.ColTrip(i).RED '---> Basis = 1
    			ColorTripels(i).Green = ColTabRec.ColTrip(i).green
    			ColorTripels(i).Blue = ColTabRec.ColTrip(i).blue
    'debug left$(szFixed, 32)
    'debug str$(i) & " => " & str$(lowrd(ColorTripels(i).red)) & " " & str$(lowrd(ColorTripels(i).green)) & " " & str$(lowrd(ColorTripels(i).blue))
    		Next i
    		function = 0
    	else
    		msgbox "Die Datei 'COLORS.DEF' ist leer." & $crlf & _
    				"Zuerst mit 'Chamaeleon' die Farbpaletten" & $crlf & _
    				"*.pal einlesen und zu 'COLORS.DEF' sichern.",%MB_SYSTEMMODAL, "SelFilter Fehler"
    		close #FH
    		CloseDialog()
    	end if
    	close #FH
    end function
    
    '----------------------------------------------------------------------------------
    '  FUNCTION Combo_SetItemData (wenn ohne #INCLUDE CommCtrl.inc kompiliert)
    '----------------------------------------------------------------------------------
    'Fügt an die ComboBox mit Handle 'hComboBox' den Wert von ItemData 'nData' an das Item mit Index 'iItemIndex'
    'Fehlerrückgabe als %CB_ERR
    FUNCTION Combo_SetItemData(BYVAL hComboBox AS LONG, BYVAL iItemIndex AS LONG, BYVAL nData AS LONG) AS LONG
    	FUNCTION = SendMessage(hComboBox, %CB_SETITEMDATA, iItemIndex, nData)
    END FUNCTION
    
    '----------------------------------------------------------------------------------
    '  FUNCTION Combo_GetItemData (wenn ohne #INCLUDE CommCtrl.inc kompiliert)
    '----------------------------------------------------------------------------------
    'Liest von der ComboBox mit Handle hComboBox den Funktionswert als ItemData des Items mit Index 'iItemIndex'
    'Ein Index von -1 gibt das aktuell selektierte Item zurück.
    'Fehlerrückgabe als %CB_ERR
    FUNCTION Combo_GetItemData(BYVAL hComboBox AS LONG, BYVAL iItemIndex AS LONG) AS LONG
    	IF iItemIndex < 0 THEN
    		iItemIndex = SendMessage(hComboBox, %CB_GETCURSEL, 0, 0)
    	END IF
    	FUNCTION = SendMessage(hComboBox, %CB_GETITEMDATA, iItemIndex, 0)
    END FUNCTION
    
    '----------------------------------------------------------------------------------
    '  SUB MatchFilter
    '----------------------------------------------------------------------------------
    Sub MatchFilterByEntity()
    	iFilterEntityKind = -1
    	iFilterLayerIndex = -1
    	iFilterColorIndex = -1
    	iFilterLineTypeIndex = -1
    	iFilterLineWidthIndex = -1
    	fFilterLineWidthValue = -1.0
    	'UserTool und Prompt initialisieren 
    	MCSetUserTool(1, "SelFilter", " Filterparameter von Objekt kopieren =>")
    end sub
    
    '----------------------------------------------------------------------------------
    '  SUB RefillLayerCombo
    '----------------------------------------------------------------------------------
    sub RefillLayerCombo()
    	'Layer-ComboBox neu füllen
    	local iError as integer
    	local ItemIndex as integer
    	local sProps as string
    	local szName as asciiz * 64
    	local sLayerName as string
    	local iRes as integer
    	ItemIndex = 0 'ItemIndex zurücksetzen
    	combobox reset hDlg, %ID_cboLayer
    	combobox add hDlg, %ID_cboLayer, "*Alle*"	'für "nichts selektiert"
    	For iFilterLayerIndex = 0 to 1023	'Es folgen 1024 Layernummern
    		if MCGetLayerHasData(iError, iFilterLayerIndex) then 'Layer enthält Elemente
    			'Properties anhängen
    			if MCLayerHasProperties(iError, iFilterLayerIndex) then 'Layer hat Layerparameter
    				fLayerLineWidthValue = -1
    				if MCGetLayerProperties(iError, iFilterLayerIndex, iLayerColorIndex, iLayerLineTypeIndex, iLayerLineWidthIndex, fLayerLineWidthValue) then
    					if fLayerLineWidthValue <= 0 then fLayerLineWidthValue = -1
    					'Property-Einträge in Combobox
    					sProps = "{--} "
    					if iLayerLineTypeIndex > -1 then mid$(sProps, 2, 1) = "t"
    					if iLayerLineWidthIndex > -1 then
    						mid$(sProps, 3, 1) = "w"
    					elseif fLayerLineWidthValue > 0.0 then
    						mid$(sProps, 3, 1) = "r"
    					end if
    				end if
    			else 'Layer hat keine Layerparameter
    				sProps = "{--} "
    			end if
    			'Layernamen abfragen
    			iRes = MCGetLayerNameFromIndex(iError, iFilterLayerIndex, szName)
    			sLayerName = left$(szName, iRes)
    			if len(sLayerName) = 0 then sLayername = trim$(str$(iFilterLayerIndex)) 'Hat der Layer keinen Namen, dann LayerIndex verwenden.
    			'Item an ComboBox anhängen
    			ItemIndex = ItemIndex + 1 'ItemIndex für neues ComboBox-Item inkrementieren
    			combobox add hDlg, %ID_cboLayer, sProps & sLayerName 'Neue ComboBox anfügen
    			if Combo_SetItemData(hCboLayer, ItemIndex, iFilterLayerIndex) = %CB_ERR then
    				msgbox "%CB_ERR", %MB_SYSTEMMODAL, "SelFilter" 'LayerIndex als Itemdata anfügen
    			end if
    		end if
    	next iFilterLayerIndex
    	COMBOBOX SELECT hDlg, %ID_cboLayer, 1
    end sub
    
    '----------------------------------------------------------------------------------
    '  SUB ClearDialog
    '----------------------------------------------------------------------------------
    Sub RefreshDialog()
    	Local iError As Integer
    	Local lRet As Long
    	'Aktuellen Dialog beenden
    	Dialog End hDlg
    	If UBound(ColorTripels()) = -1 Then
    		lRet = ReadPaletteFromFile(ColorTripels())
    	end if
    	'Dialog neu aufrufen
    	ShowDlgSelFilter()
    	'Indizes der ComboBoxen zurücksetzen
    	ComboBox Select hDlg, %ID_cboEntity, 1
    	ComboBox Select hDlg, %ID_cboLayer, 1
    	ComboBox Select hDlg, %ID_cboColor, 1
    	ComboBox Select hDlg, %ID_cboLtype, 1
    	ComboBox Select hDlg, %ID_cboLwidth, 1
    	Control Set Text hDlg, %ID_txtRwidth, "*Alle*"
    	'Filterparameter zurücksetzen
    	iFilterEntityKind = -1
    	iFilterLayerIndex = -1
    	iFilterColorIndex = -1
    	iFilterLineTypeIndex = -1
    	iFilterLineWidthIndex = -1
    	fFilterLineWidthValue = -1
    End Sub
    
    '----------------------------------------------------------------------------------
    '  CALLBACK FUNCTION DlgHelp_CallBack
    '----------------------------------------------------------------------------------
    callback function CBDlgHelp()
    	local sMsg as string
    	local lRet as long
    	sMsg = "Das Werkzeug 'SelFilter' (Selektieren mit Filter) zeigt in seinem Dialog" & $CrLf & _
    			"die Comboboxen der Kriterien an, mit denen gefiltert werden kann. Die Wahl" & $crlf & _
    			"von '*Alle*' macht das entsprechende Filterkriterium unwirksam." & $CrLf & $CrLf & _
    			"1. Die Elemente-Box läßt die Auswahl des zu filternden Elements zu." & $CrLf & _
    			"2. Die Layer-Box zeigt nur Layer an, die Daten enthalten." & $CrLf & _
    			"3. Die Farb-Box zeigt die Filterfarben an. Dies geschieht abhängig vom" & $CrLf & _
    			"   gewählten Layer, der ggf. eine Layerfarbe bestimmt." & $CrLf & _
    			"4. Die Linientyp-Box zeigt die filterbaren Linientypen." & $CrLf & _
    			"5. Die Linienbreite-Box zeigt die 16 möglichen Linienbreiten." & $CrLf & _
    			"   Hier kann der Filterwert (0-15) auch manuell eingegeben werden." & $CrLf & _
    			"6. Die Box 'Wahre Linienbreite' übernimmt die aktuelle wahre Linienbreite" & $CrLf & _
    			"   eines Elements oder Layers, kann aber nur manuell editiert werden." & $CrLf & $CrLf & _
    			"A. Layerparameter haben immer Priorität gegenüber Elementparametern." & $CrLf & _
    			"   Sind Layerparameter aktiv, dann sind die entsprechenden Boxen für die" & $CrLf & _
    			"   Auswahl von Elementparametern gesperrt." & $CrLf & _
    			"B. Mit 'Filter aktivieren' werden die aktuellen Filterkriterien bestätigt." & $CrLf & _
    			"   Nach Bestätigung der Filterkriterien muß unmittelbar die Selektion mit" & $CrLf & _
    			"   einem Selektionsbefehl erfolgen. Durch einen nichtselektierenden Klick" & $CrLf & _
    			"   in die Zeichnung werden die aktiven Filterkriterien deaktiviert." & $CrLf & _
    			"   Mit den Selektionswerkzeugen können die eingestellten Filterkriterien" & $CrLf & _
    			"   mehrfach hintereinander für eine kumulierende Selektion eingesetzt" & $CrLf & _
    			"   werden." & $CrLf & _
    			"C. Mit <Neu> werden die aktuellen Filterkriterien zurückgesetzt." & $CrLf & $CrLf & _
    			"Bemerkung:" & $CrLf & _
    			"Die Nachricht <Klick auf 'ByLayer <BL> ergibt keine Veränderung> besagt," & $CrLf & _
    			"daß bereits vorhandene Layerparameter von Objekten mit individuellen" & $CrLf & _
    			"Elementparametern überschrieben wurden. Layerparameter können für diese" & $CrLf & _
    			"Elemente dann nicht mehr verwendet werden. Die aktuellen Layerparameter" & $CrLf & _
    			"können ihnen jedoch mit dem Befehl <EY> wieder neu zugewiesen werden."
    	lRet = MsgBox(sMsg, %MB_OK or %MB_SYSTEMMODAL, "SelFilter Kurzhilfe")
    End function
    
    '-------------------------------------------------------------------------------------------------------
    '  SUB CloseDialog
    '-------------------------------------------------------------------------------------------------------
    Sub CloseDialog()
    MsgBox "CLOSE"
    	local iError as integer
    	'Applikation beenden
    	Dialog End hDlg
    end sub
    
    '-------------------------------------------------------------------------------------------------------
    '  SUB UseByLayerProps
    '-------------------------------------------------------------------------------------------------------
    Sub UseByLayerProps()
       MsgBox "UseByLayerProps benutzen...."
    End Sub
    Last edited by norbert doerre; 10 Nov 2008, 05:17 AM.
Working...
X