Added: Ability to change properties of FolderBrowserDialog, FontDialo…

…g and ColorDialog through the Properties window, Fixed: Regress on Design
XusinboyBekchanov · Sep 8, 2022 · 8b0b3f2 · 8b0b3f2
1 parent f59f865
commit 8b0b3f2
Show file tree

Hide file tree

Showing 2 changed files with 137 additions and 69 deletions.
diff --git a/mff/Dialogs.bas b/mff/Dialogs.bas
@@ -44,6 +44,20 @@ Private Destructor OpenFileOptions
 	If Options Then Deallocate_(Options)
 End Destructor
 
+Private Function Dialog.ReadProperty(PropertyName As String) As Any Ptr
+	Select Case LCase(PropertyName)
+	Case Else: Return Base.ReadProperty(PropertyName)
+	End Select
+	Return 0
+End Function
+
+Private Function Dialog.WriteProperty(PropertyName As String, Value As Any Ptr) As Boolean
+	Select Case LCase(PropertyName)
+	Case Else: Return Base.WriteProperty(PropertyName, Value)
+	End Select
+	Return True
+End Function
+
 Private Function OpenFileDialog.ReadProperty(PropertyName As String) As Any Ptr
 	Select Case LCase(PropertyName)
 	Case "caption": Return FCaption
@@ -53,9 +67,6 @@ Private Function OpenFileDialog.ReadProperty(PropertyName As String) As Any Ptr
 	Case "filetitle": Return FFileTitle
 	Case "filter": Return FFilter
 	Case "filterindex": Return @FilterIndex
-	#ifndef __USE_GTK__
-	Case "handle": Return @Handle
-	#endif
 	Case "initialdir": Return FInitialDir
 	Case "multiselect": Return @FMultiSelect
 	Case Else: Return Base.ReadProperty(PropertyName)
@@ -72,9 +83,6 @@ Private Function OpenFileDialog.WriteProperty(PropertyName As String, Value As A
 	Case "filetitle": If Value <> 0 Then This.FileTitle = QWString(Value)
 	Case "filter": If Value <> 0 Then This.Filter = QWString(Value)
 	Case "filterindex": If Value <> 0 Then This.FilterIndex = QInteger(Value)
-	#ifndef __USE_GTK__
-	Case "handle": If Value <> 0 Then This.Handle = *Cast(HWND Ptr, Value)
-	#endif
 	Case "initialdir": If Value <> 0 Then This.InitialDir = QWString(Value)
 	Case "multiselect": If Value <> 0 Then This.MultiSelect = QBoolean(Value)
 	Case Else: Return Base.WriteProperty(PropertyName, Value)
@@ -365,9 +373,6 @@ Private Function SaveFileDialog.ReadProperty(PropertyName As String) As Any Ptr
 	Case "filename": Return FFileName
 	Case "filter": Return FFilter
 	Case "filterindex": Return @FilterIndex
-	#ifndef __USE_GTK__
-	Case "handle": Return @Handle
-	#endif
 	Case "initialdir": Return FInitialDir
 	Case Else: Return Base.ReadProperty(PropertyName)
 	End Select
@@ -382,9 +387,6 @@ Private Function SaveFileDialog.WriteProperty(PropertyName As String, Value As A
 	Case "filename": If Value <> 0 Then This.FileName = QWString(Value)
 	Case "filter": If Value <> 0 Then This.Filter = QWString(Value)
 	Case "filterindex": If Value <> 0 Then This.FilterIndex = QInteger(Value)
-	#ifndef __USE_GTK__
-	Case "handle": If Value <> 0 Then This.Handle = *Cast(HWND Ptr, Value)
-	#endif
 	Case "initialdir": If Value <> 0 Then This.InitialDir = QWString(Value)
 	Case Else: Return Base.WriteProperty(PropertyName, Value)
 	End Select
@@ -476,7 +478,7 @@ End Property
 						W = R.Right - R.Left
 						H = R.Bottom - R.Top
 						L = (GetSystemMetrics(SM_CXSCREEN) - W)\2
-						T = (GetSysTemMetrics(SM_CYSCREEN) - H)\2:Print L,T
+						T = (GetSystemMetrics(SM_CYSCREEN) - H)\2:Print L,T
 						SetWindowPos GetParent(FWindow),0,L,T,0,0,SWP_NOACTIVATE Or SWP_NOSIZE Or SWP_NOZORDER
 					End If
 				End If
@@ -582,8 +584,8 @@ Private Function SaveFileDialog.Execute As Boolean
 		If Len(*FCaption) Then ofn.lpstrTitle = FCaption
 		ofn.Flags = dwFlags
 		'If FDefaultExt Then ofn.lpstrDefExt = FDefaultExt
-		ofn.lpstrDefExt = Null
-		If GetSaveFilename(@ofn) Then
+		ofn.lpstrDefExt = NULL
+		If GetSaveFileName(@ofn) Then
 			If ofn.nFileExtension = 0 Then
 				FilterIndex = ofn.nFilterIndex
 				Dim As UString res()
@@ -642,20 +644,40 @@ Private Destructor SaveFileDialog
 	If FFilter <> 0 Then Deallocate_( FFilter)
 End Destructor
 
+Private Function FontDialog.ReadProperty(PropertyName As String) As Any Ptr
+	Select Case LCase(PropertyName)
+	Case "font": Return @This.Font
+	Case "maxfontsize": Return @MaxFontSize
+	Case "minfontsize": Return @MinFontSize
+	Case Else: Return Base.ReadProperty(PropertyName)
+	End Select
+	Return 0
+End Function
+
+Private Function FontDialog.WriteProperty(PropertyName As String, Value As Any Ptr) As Boolean
+	Select Case LCase(PropertyName)
+	Case "font": If Value <> 0 Then This.Font = *Cast(My.Sys.Drawing.Font Ptr, Value)
+	Case "maxfontsize": If Value <> 0 Then This.MaxFontSize = QInteger(Value)
+	Case "minfontsize": If Value <> 0 Then This.MinFontSize = QInteger(Value)
+	Case Else: Return Base.WriteProperty(PropertyName, Value)
+	End Select
+	Return True
+End Function
+
 Private Function FontDialog.Execute As Boolean
 	Static As Integer FWidth(2) = {400,700}
 	#ifdef __USE_GTK__
 		Dim As Boolean bResult
 		#ifdef __USE_GTK3__
 			Dim As GtkWindow Ptr win
 			If pApp->MainForm Then
-				win = Gtk_Window(pApp->MainForm->widget)
+				win = GTK_WINDOW(pApp->MainForm->widget)
 			End If
-			widget =  gtk_font_chooser_dialog_new (ToUTF8("Choose Font"), win)
-			gtk_font_chooser_set_font(GTK_FONT_CHOOSER (widget), TOUTF8(Font.Name & " " & WStr(Font.Size)))
+			widget =  gtk_font_chooser_dialog_new (ToUtf8("Choose Font"), win)
+			gtk_font_chooser_set_font(GTK_FONT_CHOOSER (widget), ToUtf8(Font.Name & " " & WStr(Font.Size)))
 		#else
-			widget =  gtk_font_selection_dialog_new(ToUTF8("Choose Font"))
-			gtk_font_selection_dialog_set_font_name(gtk_font_selection_dialog(widget), ToUTF8(Font.Name & " " & WStr(Font.Size)))
+			widget =  gtk_font_selection_dialog_new(ToUtf8("Choose Font"))
+			gtk_font_selection_dialog_set_font_name(GTK_FONT_SELECTION_DIALOG(widget), ToUtf8(Font.Name & " " & WStr(Font.Size)))
 		#endif
 		Dim As Integer res = gtk_dialog_run (GTK_DIALOG (widget))
 		bResult = res = GTK_RESPONSE_OK
@@ -664,20 +686,20 @@ Private Function FontDialog.Execute As Boolean
 				Dim As PangoFontDescription Ptr desc = gtk_font_chooser_get_font_desc (GTK_FONT_CHOOSER (widget))
 				Font.Name        = WStr(*pango_font_description_get_family(desc))
 				Font.Italic      = pango_font_description_get_style(desc) = PANGO_STYLE_ITALIC
-				Font.UnderLine   = False
+				Font.Underline   = False
 				Font.StrikeOut   = False
 				Font.Color       = 0
 				Font.Size        = gtk_font_chooser_get_font_size(GTK_FONT_CHOOSER (widget)) / PANGO_SCALE
 				Font.Bold        = pango_font_description_get_weight(desc) <> PANGO_WEIGHT_THIN
 			#else
-				Dim As GtkWidget Ptr sel = gtk_font_selection_dialog_get_font_selection(gtk_font_selection_dialog(widget))
-				Dim As PangoFontFamily Ptr pff = gtk_font_selection_get_family(gtk_font_selection(sel))
+				Dim As GtkWidget Ptr sel = gtk_font_selection_dialog_get_font_selection(GTK_FONT_SELECTION_DIALOG(widget))
+				Dim As PangoFontFamily Ptr pff = gtk_font_selection_get_family(GTK_FONT_SELECTION(sel))
 				Font.Name        = WStr(*pango_font_family_get_name(pff))
 				Font.Italic      = False
-				Font.UnderLine   = False
+				Font.Underline   = False
 				Font.StrikeOut   = False
 				Font.Color       = 0
-				Font.Size        = gtk_font_selection_get_size(gtk_font_selection(sel)) / PANGO_SCALE
+				Font.Size        = gtk_font_selection_get_size(GTK_FONT_SELECTION(sel)) / PANGO_SCALE
 				Font.Bold        = False
 			#endif
 		End If
@@ -725,6 +747,30 @@ End Constructor
 Private Destructor FontDialog
 End Destructor
 
+Private Function FolderBrowserDialog.ReadProperty(PropertyName As String) As Any Ptr
+	Select Case LCase(PropertyName)
+	Case "caption": Return FCaption
+	Case "center": Return @Center
+	Case "directory": Return FDirectory
+	Case "title": Return FTitle
+	Case "initialdir": Return FInitialDir
+	Case Else: Return Base.ReadProperty(PropertyName)
+	End Select
+	Return 0
+End Function
+
+Private Function FolderBrowserDialog.WriteProperty(PropertyName As String, Value As Any Ptr) As Boolean
+	Select Case LCase(PropertyName)
+	Case "caption": If Value <> 0 Then This.Caption = QWString(Value)
+	Case "center": If Value <> 0 Then This.Center = QBoolean(Value)
+	Case "directory": If Value <> 0 Then This.Directory = QWString(Value)
+	Case "title": If Value <> 0 Then This.Title = QWString(Value)
+	Case "initialdir": If Value <> 0 Then This.InitialDir = QWString(Value)
+	Case Else: Return Base.WriteProperty(PropertyName, Value)
+	End Select
+	Return True
+End Function
+
 Private Property FolderBrowserDialog.Caption ByRef As WString
 	Return WGet(FCaption)
 End Property
@@ -762,7 +808,7 @@ Private Property FolderBrowserDialog.Directory(ByRef Value As WString)
 End Property
 
 #ifndef __USE_GTK__
-	Private Function FolderBrowserDialog.Hook(FWindow As HWND, uMsg As uINT, lParam As LPARAM, lpData As LPARAM) As Long
+	Private Function FolderBrowserDialog.Hook(FWindow As HWND, uMsg As UINT, lParam As LPARAM, lpData As LPARAM) As Long
 		Dim As FolderBrowserDialog Ptr BrowseDial
 		Dim As My.Sys.Forms.Control Ptr Ctrl
 		Dim R As Rect
@@ -792,13 +838,13 @@ Private Function FolderBrowserDialog.Execute As Boolean
 	#ifdef __USE_GTK__
 		Dim As GtkWindow Ptr win
 		If pApp->MainForm Then
-			win = Gtk_Window(pApp->MainForm->widget)
+			win = GTK_WINDOW(pApp->MainForm->widget)
 		End If
-		widget =  gtk_file_chooser_dialog_new (ToUTF8("Choose Folder"), _
+		widget =  gtk_file_chooser_dialog_new (ToUtf8("Choose Folder"), _
 		win, _
 		GTK_FILE_CHOOSER_ACTION_SELECT_FOLDER, _
-		ToUTF8("Cancel"), GTK_RESPONSE_CANCEL, _
-		ToUTF8("Open"), GTK_RESPONSE_ACCEPT, _
+		ToUtf8("Cancel"), GTK_RESPONSE_CANCEL, _
+		ToUtf8("Open"), GTK_RESPONSE_ACCEPT, _
 		NULL)
 		'gtk_file_chooser_set_current_name(GTK_FILE_CHOOSER (widget), *FFileName)
 		'gtk_file_chooser_set_do_overwrite_confirmation (GTK_FILE_CHOOSER (widget), TRUE)
@@ -820,7 +866,7 @@ Private Function FolderBrowserDialog.Execute As Boolean
 		*sPath = WString(MAX_PATH,0)
 		*xPath = WString(MAX_PATH,0)                             '
 		InitialDir        = InitialDir + Chr(0)
-		BI.hWndOwner      = MainHandle
+		BI.hwndOwner      = MainHandle
 		BI.pszDisplayName = xPath
 		BI.lpszTitle      = FTitle
 		BI.lpfn           = @FolderBrowserDialog.Hook
@@ -865,36 +911,62 @@ Private Destructor FolderBrowserDialog
 	If FDirectory <> 0 Then Deallocate_( FDirectory)
 End Destructor
 
+Private Function ColorDialog.ReadProperty(PropertyName As String) As Any Ptr
+	Select Case LCase(PropertyName)
+	Case "caption": Return _Caption
+	Case "center": Return @Center
+	Case "color": Return @Color
+	Case "backcolor": Return @BackColor
+	Case "parent": Return Parent
+	Case "style": Return @Style
+	Case Else: Return Base.ReadProperty(PropertyName)
+	End Select
+	Return 0
+End Function
+
+Private Function ColorDialog.WriteProperty(PropertyName As String, Value As Any Ptr) As Boolean
+	Select Case LCase(PropertyName)
+	Case "caption": If Value <> 0 Then This.Caption = QWString(Value)
+	Case "center": If Value <> 0 Then This.Center = QInteger(Value)
+	Case "color": If Value <> 0 Then This.Color = QInteger(Value)
+	Case "backcolor": If Value <> 0 Then This.BackColor = QInteger(Value)
+	Case "parent": This.Parent = Value
+	Case "style": If Value <> 0 Then This.BackColor = QInteger(Value)
+	Case Else: Return Base.WriteProperty(PropertyName, Value)
+	End Select
+	Return True
+End Function
+
 #ifndef __USE_GTK__
 	Private Function ColorDialog.Hook(FWindow As HWND,Msg As UINT,wParam As WPARAM,lParam As LPARAM) As UInteger
-		Static As HBrush Brush
+		Static As HBRUSH Brush
 		Select Case Msg
-		Case wm_initdialog
-			Dim As ColorDialog Ptr CommonDialog = Cast(ColorDialog Ptr,*Cast(lpChooseColor,lParam).lCustData)
+		Case WM_INITDIALOG
+			Dim As ColorDialog Ptr CommonDialog = Cast(ColorDialog Ptr,*Cast(LPCHOOSECOLOR,lParam).lCustData)
 			If CommonDialog Then
 				CommonDialog->Handle = FWindow
 				SetWindowLongPtr(FWindow,DWLP_MSGRESULT,CInt(CommonDialog))
 				SetWindowText(FWindow, CommonDialog->_Caption)
 				If CommonDialog->Center Then
 					Dim As ..Rect R,Wr
 					GetWindowRect(FWindow, @Wr)
-					SystemParametersInfo(spi_getworkarea,0,@R,0)
+					SystemParametersInfo(SPI_GETWORKAREA,0,@R,0)
 					MoveWindow(FWindow,(R.Right  - (Wr.Right - Wr.Left))/2,(R.Bottom - (Wr.Bottom - Wr.Top))/2,Wr.Right - Wr.Left,Wr.Bottom - Wr.Top,1)
 				End If
 				Brush = CreateSolidBrush(CommonDialog->BackColor)
 			End If
 			Return True
-		Case wm_ctlcolordlg To wm_ctlcolorstatic
+		Case WM_CTLCOLORDLG To WM_CTLCOLORSTATIC
 			Dim As ColorDialog Ptr CommonDialog = Cast(ColorDialog Ptr,GetWindowLongPtr(FWindow,DWLP_MSGRESULT))
 			If CommonDialog Then
 				With *CommonDialog
-					SetBkMode(Cast(HDc,wParam),Transparent)
-					SetBkColor(Cast(HDc,wParam),.BackColor)
-					SetBkMode(Cast(HDc,wParam),Opaque)
+					SetBkMode(Cast(HDC,wParam),TRANSPARENT)
+					SetBkColor(Cast(HDC,wParam),.BackColor)
+					SetBkMode(Cast(HDC,wParam),OPAQUE)
 					Return CInt(Brush)
 				End With
 			End If
-		Case wm_erasebkgnd
+		Case WM_ERASEBKGND
 			Dim As ColorDialog Ptr CommonDialog = Cast(ColorDialog Ptr,GetWindowLongPtr(FWindow,DWLP_MSGRESULT))
 			If CommonDialog Then
 				With *CommonDialog
@@ -942,8 +1014,8 @@ Private Function ColorDialog.Execute As Boolean
 				RGBString = WStr(*gdk_rgba_to_string(@RGBAColor))
 			#else
 				Dim As GdkColor gColor
-				Dim As GtkWidget Ptr cs = gtk_color_selection_dialog_get_color_selection(gtk_color_selection_dialog(widget))
-				gtk_color_selection_get_current_color(GTK_COLOR_selection (cs), @gColor)
+				Dim As GtkWidget Ptr cs = gtk_color_selection_dialog_get_color_selection(GTK_COLOR_SELECTION_DIALOG(widget))
+				gtk_color_selection_get_current_color(GTK_COLOR_SELECTION (cs), @gColor)
 				RGBString = WStr(*gdk_color_to_string(@gColor))
 			#endif
 			Dim As UString res()
@@ -953,11 +1025,11 @@ Private Function ColorDialog.Execute As Boolean
 		gtk_widget_destroy( GTK_WIDGET(widget) )
 		Return bResult
 	#else
-		Dim As ChooseColor CC
+		Dim As CHOOSECOLOR CC
 		CC.lStructSize  = SizeOf(CC)
 		CC.lpCustColors = @Colors(0)
-		CC.hWndOwner    = IIf(Parent,Parent->Handle, 0)
-		CC.RGBResult    = This.Color
+		CC.hwndOwner    = IIf(Parent,Parent->Handle, 0)
+		CC.rgbResult    = This.Color
 		CC.Flags        = CC_RGBINIT
 		CC.Flags        = CC.Flags Or CC_ENABLEHOOK
 		Select Case Style
@@ -967,9 +1039,9 @@ Private Function ColorDialog.Execute As Boolean
 			CC.Flags    = CC.Flags Or CC_PREVENTFULLOPEN
 		End Select
 		CC.lpfnHook     = @Hook
-		CC.lCustData    = Cast(lParam,@This)
-		If ChooseColor(@CC) Then
-			This.Color = CC.RGBResult
+		CC.lCustData    = Cast(LPARAM,@This)
+		If CHOOSECOLOR(@CC) Then
+			This.Color = CC.rgbResult
 			Return True
 		End If
 		Return False
@@ -984,11 +1056,11 @@ Private Constructor ColorDialog
 	Caption = "Choose Color..."
 	WLet(FClassName, "ColorDialog")
 	#ifndef __USE_GTK__
-		BackColor = GetSysColor(color_btnface)
+		BackColor = GetSysColor(COLOR_BTNFACE)
 	#endif
 End Constructor
 
 Private Destructor ColorDialog
-	WDeallocate _Caption
+	WDeAllocate _Caption
 End Destructor