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