Module Colr_dlg.pkg
1//************************************************************************
2//--- Colr_Dlg.pkg
3//
4// Copyright (c) 1983-1997 Data Access Corporation, Miami Florida,
5// All rights reserved.
6// DataFlex is a registered trademark of Data Access Corporation.
7//
8//************************************************************************
9// Description:
10// Provides a DataFlex class that acts as a wrapper to the Windows'
11// Color-Dialog
12//
13// Author: Stuart W. Booth
14// 07/23/96 JJT - New Class names
15// 09/05/02 SWB - Reworked the class to derive from cObject (with embedded
16// Array for Custom Colors). General code cleanup.
17//************************************************************************
18
19Use VDFBase.pkg
20Use DLL.pkg
21Use RGB.pkg
22Use GlobalFunctionsProcedures.pkg
23
24#REPLACE CC_RGBINIT 1
25#REPLACE CC_FULLOPEN 2
26#REPLACE CC_PREVENTFULLOPEN 4
27
28External_Function ChooseColor 'ChooseColorA' COMDLG32.dll Pointer lpCC Returns DWord
29
30TYPE CHOOSECOLOR
31 Field CHOOSECOLOR.lStructSize as DWORD
32 Field CHOOSECOLOR.hWndOwner as HANDLE
33 Field CHOOSECOLOR.hInstance as HANDLE
34 Field CHOOSECOLOR.rgbResult as DWORD
35 Field CHOOSECOLOR.lpCustColors as POINTER
36 Field CHOOSECOLOR.flags as DWORD
37 Field CHOOSECOLOR.lCustData as DWORD
38 Field CHOOSECOLOR.lpfnHook as DWORD
39 Field CHOOSECOLOR.lpTemplateName as POINTER
40END_TYPE
41
42{ ClassLibrary=Windows }
43{ HelpTopic=ColorDialog }
44Class ColorDialog Is a cObject
45 Procedure Construct_Object
46 Integer iLoop
47 Handle hoCustomColors
48
49 Forward Send Construct_Object
50
51 { Category=Appearance }
52 Property Boolean FullOpen_State True
53 { Category=Appearance }
54 Property Boolean PreventFullOpen_State False
55 { Category=Appearance }
56 Property Boolean SelectedColor_State True
57 { PropertyType=Color }
58 { EnumList="clScrollBar, clBackground, clActiveCaption, clInactiveCaption, clMenu, clWindow, clWindowFrame, clMenuText, clWindowText, clCaptionText, clActiveBorder, clInactiveBorder" }
59 { EnumList+="clAppWorkSpace, clHighlight, clHighlightText, clBtnFace, clBtnShadow, clGrayText, clBtnText, clInactiveCaptionText, clBtnHighlight, cl3DDkShadow, cl3DLight, clInfoText, clInfoBk, clDefault, clNone" }
60 { EnumList+="clAqua, clBlack, clBlue, clDkGray, clFuchsia, clGray, clGreen, clLime, clLtGray, clMaroon, clNavy, clOlive, clPurple, clRed, clSilver, clTeal, clWhite, clYellow" }
61 { Category=Appearance }
62 { InitialValue=clBlack }
63 Property Integer SelectedColor 0
64
65 { Visibility=Private }
66 Property Handle phoCustomColors (Create(self, U_Array)) // create an array to hold the custom colors
67
68 // Set all custom colors to white...
69 Get phoCustomColors To hoCustomColors
70 For iLoop From 0 To 15
71 Set Value of hoCustomColors iLoop To clWhite
72 Loop
73
74 End_Procedure
75
76 { MethodType=Property }
77 Procedure Set Custom_Color Integer iItem Integer rgbColor
78 Set Value of (phoCustomColors(self)) iItem To rgbColor
79 End_Procedure
80
81 { MethodType=Property }
82 Function Custom_Color Integer iItem Returns Integer
83 Function_Return (Integer_Value(phoCustomColors(self), iItem))
84 End_Function
85
86 Procedure AssignCustomColors Handle hoSourceColorDialog
87 // Copies the custom colors from another ColorDialog instance
88 Integer iColor
89
90 For iColor From 0 To 15
91 Set Custom_Color iColor To (Value(hoSourceColorDialog, iColor))
92 Loop
93 End_Procedure
94
95 { MethodType=Property Visibility=Private }
96 Function Value Integer iItem Returns String
97 // Provides support for the AssignCustomColors procedure, which requires
98 // that a "Get Value" interface is supported
99 Function_Return (Custom_Color(self, iItem))
100 End_Function
101
102 { Visibility=Private }
103 Function OwnerHandle returns handle
104 Handle hWnd
105 Handle hoObj
106 Get Focus of desktop to hoObj // start with the focus
107 Move (gOwnerWindowHandle(hoObj)) to hWnd // global function finds the right handle for us
108 function_return hWnd
109 End_Function
110
111 Function Show_Dialog Returns Boolean
112 //Shows the dialog. Returns True if the OK button was clicked.
113 Handle hContainer hoCustomColors
114 Boolean bSelected bFullOpen bNoOpen bSelColor
115 Integer rgbColor iFlags iLoop
116 String sCC sColors
117
118 //Delegate Get Container_Handle To hContainer
119 Get OwnerHandle To hContainer
120
121 Get phoCustomColors To hoCustomColors
122 ZeroType CHOOSECOLOR To sCC
123
124 Move '' To sColors
125 For iLoop from 0 To 15
126 Get Value of hoCustomColors iLoop To rgbColor
127 Move (sColors + DWORDToBytes(rgbColor)) To sColors
128 Loop
129
130 Get FullOpen_State To bFullOpen
131 Get PreventFullOpen_State To bNoOpen
132 Get SelectedColor_State To bSelColor
133 Get SelectedColor To rgbColor
134
135 Move 0 To iFlags
136 If bFullOpen Move (iFlags +CC_FULLOPEN) To iFlags
137 If bNoOpen Move (iFlags +CC_PREVENTFULLOPEN) To iFlags
138 If bSelColor Move (iFlags +CC_RGBINIT) To iFlags
139
140 Put CHOOSECOLOR_size To sCC At CHOOSECOLOR.lStructSize
141 Put hContainer To sCC At CHOOSECOLOR.hWndOWner
142 Put rgbColor To sCC At CHOOSECOLOR.rgbResult
143 Put (AddressOf(sColors)) To sCC At CHOOSECOLOR.lpCustColors
144 Put iFlags To sCC At CHOOSECOLOR.flags
145
146 Move (ChooseColor(AddressOf(sCC))) To bSelected
147
148 If bSelected Begin
149 For iLoop from 0 To 15
150 Move (BytesToDword(sColors, iLoop *4 +1)) To rgbColor
151 Set Value of hoCustomColors iLoop To rgbColor
152 Loop
153 GetBuff From sCC At CHOOSECOLOR.rgbResult To rgbColor
154 Set SelectedColor To rgbColor
155 End
156 Function_Return bSelected
157 End_Function
158
159End_Class
160