home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sibyl_cw.zip / ColorWheel.PAS < prev    next >
Pascal/Delphi Source File  |  1998-07-27  |  17KB  |  367 lines
  1. UNIT ColorWheel;
  2.  
  3. (*                                                                      *)
  4. (* AUTHOR: Michael G. Slack (slack@ibm.net)    DATE WRITTEN: 1998/02/09 *)
  5. (* ENVIRONMENT: Speedsoft Sibyl.                                        *)
  6. (*                                                                      *)
  7. (* Component defines the undocumented color wheel OS/2 control.  Based  *)
  8. (* on code originally coded by Paul Ratcliffe (paulr@orac.clara.co.uk). *)
  9. (* Component/dialog can be used in two ways, interactive by intercepting*)
  10. (* the wm_ColorWheelChanged message by the main window or by using the  *)
  11. (* color property after dialog execution.                               *)
  12. (* Note: I couldn't figure out how to get the undocumented control for  *)
  13. (*       the dialog in a Sibyl resource, so the dialog was compiled     *)
  14. (*       using RC.EXE and then loaded into a byte array to pass into the*)
  15. (*       WinCreateDlg procedure.                                        *)
  16. (*                                                                      *)
  17. (* -------------------------------------------------------------------- *)
  18. (*                                                                      *)
  19. (* REVISED: 1998/02/12 - Initial version complete.                      *)
  20. (*          1998/02/14 - Added in fix for dialog color.                 *)
  21. (*             (thanks to hint from Cindy Ross-rossc@us.ibm.com)        *)
  22. (*          1998/07/27 - Changed the original author of the code per    *)
  23. (*                       original author (whoops).  Removed erroneous   *)
  24. (*                       warp 3 messages from the component.  (1.01)    *)
  25. (*                                                                      *)
  26.  
  27. INTERFACE
  28.  
  29.  USES Classes, Forms;
  30.  
  31.  CONST cwMaxTitleSize = 128; {max dialog title size}
  32.        {undocumented color wheel messages         }
  33.        { - both: mp1 = RGB color, mp2 = 0         }
  34.        { - SetVal sent to colorwheel, Changed sent}
  35.        {   to parent as color is changed.         }
  36.        wm_ColorWheelChanged = $0601;
  37.        cwm_ColorWheelSetVal = $0602;
  38.  
  39.  TYPE {Color return type - from color property}
  40.       PCLR = ^TCLR;
  41.       TCLR = RECORD
  42.               CASE BYTE OF
  43.                0 : (lColor : LONGWORD);
  44.                1 : (Blu, Grn, Red, X : BYTE);
  45.              END;
  46.       {Declare new class}
  47.       TColorWheel=Class(TComponent)
  48.                   Private
  49.                     FColor    : TCLR;
  50.                     FDlgTitle : STRING[cwMaxTitleSize+1];
  51.                   Protected
  52.                     Procedure SetupComponent; Override;
  53.                     FUNCTION  GetDlgTitle : STRING;
  54.                     PROCEDURE SetDlgTitle(NewTitle : STRING);
  55.                     FUNCTION  GetVersion : STRING;
  56.                   Public
  57.                     Destructor Destroy; Override;
  58.                     FUNCTION Execute : BOOLEAN;
  59.                     PROPERTY Color : TCLR Read FColor Write FColor;
  60.                   Published
  61.                     PROPERTY DlgTitle : STRING Read GetDlgTitle
  62.                                                Write SetDlgTitle;
  63.                     PROPERTY Version : STRING Read GetVersion
  64.                                               stored FALSE;
  65.                   End;
  66.  
  67. (************************************************************************)
  68.  
  69.  EXPORTS TColorWheel,'Custom','ColorWheel.BMP';
  70.  
  71. (************************************************************************)
  72.  
  73. IMPLEMENTATION
  74.  
  75.  USES SysUtils, OS2Def, BseDos, PMWin, PMStdDlg, Messages;
  76.  
  77.  CONST IVersion : STRING[20] = 'Version 1.01';
  78.        {color edit dialog definition - RC follows:}
  79.        (*
  80.        DLGTEMPLATE DLG_CWHEEL LOADONCALL MOVEABLE DISCARDABLE
  81.        BEGIN
  82.          DIALOG  "", DLG_CWHEEL, 0, 0, 228, 170, NOT WS_VISIBLE | NOT WS_SAVEBITS,
  83.                    FCF_SYSMENU | FCF_TITLEBAR | FCF_CLOSEBUTTON  | FCF_NOBYTEALIGN
  84.            BEGIN
  85.                CONTROL         "", CWHEEL, -10, 43, 248, 135, WC_COLORWHEEL,
  86.                                WS_GROUP | WS_TABSTOP | WS_VISIBLE
  87.                LTEXT           SZ_RED, TXT_RED, 4, 32, 36, 8, DT_BOTTOM |
  88.                                DT_MNEMONIC
  89.                SPINBUTTON      SPN_RED, 39, 31, 38, 12, SPBS_NUMERICONLY |
  90.                                SPBS_MASTER | SPBS_JUSTRIGHT | SPBS_FASTSPIN |
  91.                                WS_GROUP
  92.                                CTLDATA 24,0,  0,0,  0,0,  255,0,  0,0,  0,0
  93.                LTEXT           SZ_GREEN, TXT_GREEN, 4, 18, 36, 8, DT_VCENTER |
  94.                                DT_MNEMONIC
  95.                SPINBUTTON      SPN_GREEN, 39, 17, 38, 12, SPBS_NUMERICONLY |
  96.                                SPBS_MASTER | SPBS_JUSTRIGHT | SPBS_FASTSPIN |
  97.                                WS_GROUP
  98.                                CTLDATA 24,0,  0,0,  0,0,  255,0,  0,0,  0,0
  99.                LTEXT           SZ_BLUE, TXT_BLUE, 4, 4, 36, 8, DT_VCENTER |
  100.                                DT_MNEMONIC
  101.                SPINBUTTON      SPN_BLUE, 39, 3, 38, 12, SPBS_NUMERICONLY |
  102.                                SPBS_MASTER | SPBS_JUSTRIGHT | SPBS_FASTSPIN |
  103.                                WS_GROUP
  104.                                CTLDATA 24,0,  0,0,  0,0,  255,0,  0,0,  0,0
  105.                DEFPUSHBUTTON   SZ_OK, BTN_OK, 88, 2, 45, 14, WS_GROUP
  106.                PUSHBUTTON      SZ_UNDO, BTN_UNDO, 134, 2, 45, 14, NOT WS_TABSTOP
  107.                PUSHBUTTON      SZ_CANCEL, BTN_CANCEL, 180, 2, 45, 14, NOT WS_TABSTOP
  108.            END
  109.        END
  110.        *)
  111.        ClrDlg : ARRAY[1..481] OF BYTE =
  112.          ($E1,$01,$00,$00,$52,$03,$0E,$00,$01,$00,$FF,$FF,$00,$00,$00,$00,
  113.           $0A,$00,$00,$00,$01,$00,$00,$00,$58,$01,$80,$00,$00,$10,$00,$00,
  114.           $00,$00,$E4,$00,$AA,$00,$64,$00,$FF,$FF,$59,$01,$00,$00,$00,$00,
  115.           $10,$00,$5D,$01,$00,$00,$6E,$01,$00,$00,$03,$80,$F6,$FF,$2B,$00,
  116.           $F8,$00,$87,$00,$65,$00,$FF,$FF,$FF,$FF,$00,$00,$00,$00,$00,$00,
  117.           $05,$00,$05,$00,$6F,$01,$01,$28,$01,$80,$04,$00,$20,$00,$24,$00,
  118.           $08,$00,$66,$00,$FF,$FF,$FF,$FF,$00,$00,$00,$00,$00,$00,$20,$00,
  119.           $00,$00,$75,$01,$15,$01,$03,$80,$27,$00,$1F,$00,$26,$00,$0C,$00,
  120.           $67,$00,$FF,$FF,$76,$01,$00,$00,$00,$00,$00,$00,$05,$00,$07,$00,
  121.           $8E,$01,$01,$24,$01,$80,$04,$00,$12,$00,$24,$00,$08,$00,$68,$00,
  122.           $FF,$FF,$FF,$FF,$00,$00,$00,$00,$00,$00,$20,$00,$00,$00,$96,$01,
  123.           $15,$01,$03,$80,$27,$00,$11,$00,$26,$00,$0C,$00,$69,$00,$FF,$FF,
  124.           $97,$01,$00,$00,$00,$00,$00,$00,$05,$00,$06,$00,$AF,$01,$01,$24,
  125.           $01,$80,$04,$00,$04,$00,$24,$00,$08,$00,$6A,$00,$FF,$FF,$FF,$FF,
  126.           $00,$00,$00,$00,$00,$00,$20,$00,$00,$00,$B6,$01,$15,$01,$03,$80,
  127.           $27,$00,$03,$00,$26,$00,$0C,$00,$6B,$00,$FF,$FF,$B7,$01,$00,$00,
  128.           $00,$00,$00,$00,$03,$00,$03,$00,$CF,$01,$00,$04,$03,$80,$58,$00,
  129.           $02,$00,$2D,$00,$0E,$00,$6C,$00,$FF,$FF,$FF,$FF,$00,$00,$00,$00,
  130.           $00,$00,$03,$00,$05,$00,$D3,$01,$00,$00,$00,$80,$86,$00,$02,$00,
  131.           $2D,$00,$0E,$00,$6D,$00,$FF,$FF,$FF,$FF,$00,$00,$00,$00,$00,$00,
  132.           $03,$00,$07,$00,$D9,$01,$00,$00,$00,$80,$B4,$00,$02,$00,$2D,$00,
  133.           $0E,$00,$6E,$00,$FF,$FF,$FF,$FF,$00,$03,$10,$00,$04,$43,$6F,$6C,
  134.           $6F,$72,$53,$65,$6C,$65,$63,$74,$43,$6C,$61,$73,$73,$00,$00,$7E,
  135.           $52,$65,$64,$3A,$00,$00,$18,$00,$00,$00,$00,$00,$00,$00,$00,$00,
  136.           $00,$00,$FF,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$7E,$47,
  137.           $72,$65,$65,$6E,$3A,$00,$00,$18,$00,$00,$00,$00,$00,$00,$00,$00,
  138.           $00,$00,$00,$FF,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$7E,
  139.           $42,$6C,$75,$65,$3A,$00,$00,$18,$00,$00,$00,$00,$00,$00,$00,$00,
  140.           $00,$00,$00,$FF,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$7E,
  141.           $4F,$4B,$00,$7E,$55,$6E,$64,$6F,$00,$7E,$43,$61,$6E,$63,$65,$6C,
  142.           $00);
  143.  
  144. (************************************************************************)
  145. (***** Internal functions/constants/types used by component         *****)
  146.  
  147.  CONST ClassLib : CSTRING = 'WPCONFIG.DLL'; {color wheel defined here}
  148.        {dialog constants}
  149.        dlg_CWheel = 100;
  150.        cWheel     = 101;
  151.        txt_Red    = 102;
  152.        spn_Red    = 103;
  153.        txt_Green  = 104;
  154.        spn_Green  = 105;
  155.        txt_Blue   = 106;
  156.        spn_Blue   = 107;
  157.        btn_OK     = 108;
  158.        btn_Undo   = 109;
  159.        btn_Cancel = 110;
  160.  
  161.  TYPE PAPPDATA = ^TAPPDATA;
  162.       TAPPDATA = RECORD {modified from original code}
  163.                   bSize    : WORD;
  164.                   ParentWnd,
  165.                   OwnerWnd : HWND;
  166.                   ChgMsg   : LONGWORD;
  167.                   SetMsg   : LONGWORD;
  168.                   DlgTitle : STRING[cwMaxTitleSize+1];
  169.                   UpdFlg   : BOOLEAN;
  170.                   UndoClr  : TCLR;
  171.                   CurClr   : TCLR;
  172.                   ParRect  : RECTL;
  173.                   DlgRect  : RECTL;
  174.                  END;
  175.  
  176. (************************************************************************)
  177.  
  178.  PROCEDURE SetSpins(Wnd : HWND; Clr : TCLR);
  179.      (* procedure to set spin buttons to defined values *)
  180.  
  181.   BEGIN (*setspins*)
  182.    WinSendDlgItemMsg(Wnd,spn_Red,spbm_SetCurrentValue,Clr.Red,0);
  183.    WinSendDlgItemMsg(Wnd,spn_Green,spbm_SetCurrentValue,Clr.Grn,0);
  184.    WinSendDlgItemMsg(Wnd,spn_Blue,spbm_SetCurrentValue,Clr.Blu,0);
  185.   END; (*setspins*)
  186.  
  187. (************************************************************************)
  188.  
  189.  FUNCTION EditColorDlgProc(Wnd : HWND; Msg : ULONG;
  190.                            mp1, mp2 : MPARAM) : MRESULT; APIENTRY;
  191.      (* function to handle the edit color dialog *)
  192.  
  193.     VAR pp     : PAPPDATA;
  194.         I1, I2 : INTEGER;
  195.         FF     : BOOLEAN;
  196.         ulVal  : LONGWORD;
  197.  
  198.   BEGIN (*editcolordlgproc*)
  199.    Result := MRESULT(FALSE);
  200.    CASE Msg OF
  201.     wm_InitDlg : BEGIN {initdlg}
  202.                   pp := PAPPDATA(mp2);
  203.                   WinSetWindowPtr(Wnd,0,POINTER(mp2));
  204.                   WinSetWindowText(Wnd,pp^.DlgTitle);
  205.                   SetSpins(Wnd,pp^.UndoClr);
  206.                   WinSendDlgItemMsg(Wnd,cWheel,pp^.SetMsg,
  207.                                     pp^.UndoClr.lColor,0);
  208.                   pp^.UpdFlg := TRUE; {set update flag}
  209.                   {set dialog in middle of parent}
  210.                   WinQueryWindowRect(pp^.ParentWnd,pp^.ParRect);
  211.                   WinQueryWindowRect(Wnd,pp^.DlgRect);
  212.                   I1 := (pp^.ParRect.xRight-pp^.DlgRect.xRight) DIV 2;
  213.                   I2 := (pp^.ParRect.yTop-pp^.DlgRect.yTop) DIV 2;
  214.                   WinSetWindowPos(Wnd,0,I1,I2,0,0,swp_Move OR swp_Show);
  215.                   {make sure dialog is dialog color}
  216.                   ulVal := sysClr_DialogBackground;
  217.                   WinSetPresParam(Wnd,pp_BackgroundColorIndex,
  218.                                   SizeOf(ulVal),ulVal);
  219.                  END; {initdlg}
  220.     wm_ColorWheelChanged : BEGIN {wheel changed msg}
  221.                             pp := WinQueryWindowPtr(Wnd,0);
  222.                             pp^.CurClr.lColor := LONGWORD(mp1);
  223.                             pp^.UpdFlg := FALSE; {reset flag}
  224.                             SetSpins(Wnd,pp^.CurClr);
  225.                             pp^.UpdFlg := TRUE; {set flag}
  226.                             {was ParentWnd}
  227.                             WinSendMsg(pp^.OwnerWnd,Msg,mp1,mp2);
  228.                            END; {chg msg}
  229.     wm_Control : BEGIN {control message recvd}
  230.                   pp := WinQueryWindowPtr(Wnd,0);
  231.                   FF := (Short1FromMP(mp1) = spn_Red) OR
  232.                         (Short1FromMP(mp1) = spn_Green) OR
  233.                         (Short1FromMP(mp1) = spn_Blue);
  234.                   FF := FF AND ((Short2FromMP(mp1) = spbn_Change) OR
  235.                                 (Short2FromMP(mp1) = spbn_EndSpin));
  236.                   IF FF AND pp^.UpdFlg
  237.                    THEN BEGIN {handle it}
  238.                          WinSendMsg(HWNDFromMP(mp2),spbm_QueryValue,
  239.                                     MPARAM(@ulVal),
  240.                                     MPFrom2Short(0,spbq_AlwaysUpdate));
  241.                          CASE Short1FromMP(mp1) OF
  242.                           spn_Red   : pp^.CurClr.Red := BYTE(ulVal);
  243.                           spn_Green : pp^.CurClr.Grn := BYTE(ulVal);
  244.                           ELSE pp^.CurClr.Blu := BYTE(ulVal);
  245.                          END; {case}
  246.                          WinSendDlgItemMsg(Wnd,cWheel,pp^.SetMsg,
  247.                                            pp^.CurClr.lColor,0);
  248.                          {was ParentWnd}
  249.                          WinSendMsg(pp^.OwnerWnd,pp^.ChgMsg,
  250.                                     pp^.CurClr.lColor,0);
  251.                         END; {then}
  252.                  END; {ctrl msg}
  253.     wm_Command : BEGIN {command msg recvd}
  254.                   pp := WinQueryWindowPtr(Wnd,0);
  255.                   CASE WORD(mp1) OF
  256.                    btn_OK   : WinDismissDlg(Wnd,pp^.CurClr.lColor);
  257.                    btn_Undo : BEGIN {undo pressed = reset to start clr}
  258.                                SetSpins(Wnd,pp^.UndoClr);
  259.                                WinSendDlgItemMsg(Wnd,cWheel,pp^.SetMsg,
  260.                                                  pp^.CurClr.lColor,0);
  261.                               END; {undo}
  262.                    ELSE WinDismissDlg(Wnd,pp^.UndoClr.lColor); {cancel}
  263.                   END; {case}
  264.                  END; {cmd msg}
  265.     wm_Close : BEGIN {close button pressed}
  266.                 pp := WinQueryWindowPtr(Wnd,0);
  267.                 WinDismissDlg(Wnd,pp^.UndoClr.lColor);
  268.                END; {close}
  269.     ELSE Result := WinDefDlgProc(Wnd,Msg,mp1,mp2);
  270.    END; {case}
  271.   END; (*editcolordlgproc*)
  272.  
  273. (************************************************************************)
  274. (***** TColorWheel component                                        *****)
  275.  
  276.  Procedure TColorWheel.SetupComponent;
  277.   Begin
  278.    Inherited SetupComponent;
  279.    FColor.Blu := 204; {gray window color}
  280.    FColor.Grn := 204;
  281.    FColor.Red := 204;
  282.    FColor.X := 0;
  283.    FDlgTitle := 'Edit Color';
  284.   End;
  285.  
  286. (************************************************************************)
  287.  
  288.  FUNCTION TColorWheel.GetDlgTitle : STRING;
  289.      (* function to return dlg title to property *)
  290.  
  291.   BEGIN (*tcolorwheel.getdlgtitle*)
  292.    Result := FDlgTitle;
  293.   END; (*tcolorwheel.getdlgtitle*)
  294.  
  295. (************************************************************************)
  296.  
  297.  PROCEDURE TColorWheel.SetDlgTitle(NewTitle : STRING);
  298.      (* procedure to set the dialog title *)
  299.  
  300.   BEGIN (*tcolorwheel.setdlgtitle*)
  301.    FDlgTitle := Copy(NewTitle,1,cwMaxTitleSize);
  302.   END; (*tcolorwheel.setdlgtitle*)
  303.  
  304. (************************************************************************)
  305.  
  306.  FUNCTION TColorWheel.GetVersion : STRING;
  307.      (* function to return version string *)
  308.  
  309.   BEGIN (*tcolorwheel.getversion*)
  310.    Result := IVersion;
  311.   END; (*tcolorwheel.getversion*)
  312.  
  313. (************************************************************************)
  314.  
  315.  Destructor TColorWheel.Destroy;
  316.   Begin
  317.    Inherited Destroy;
  318.   End;
  319.  
  320. (************************************************************************)
  321.  
  322.  FUNCTION TColorWheel.Execute : BOOLEAN;
  323.     TYPE PDLGTEMPLATE = ^DLGTEMPLATE;
  324.     VAR pAppD  : PAPPDATA;
  325.         pp     : PDLGTEMPLATE;
  326.         Dw     : HWND;
  327.         R      : LONGWORD;
  328.         LibHnd : HLIB;
  329.   BEGIN
  330.    Result := FALSE;
  331.    IF DosAllocMem(pAppD,SizeOf(TAPPDATA),
  332.                   pag_Read OR pag_Write OR pag_Commit) <> 0
  333.     THEN Exit;
  334.    pAppD^.bSize := SizeOf(TAPPDATA);
  335.    pAppD^.ParentWnd := hwnd_Desktop;
  336.    pAppD^.OwnerWnd := Application.MainForm.Handle;
  337.    pAppD^.ChgMsg := wm_ColorWheelChanged;
  338.    pAppD^.SetMsg := cwm_ColorWheelSetVal;
  339.    LibHnd := WinLoadLibrary(AppHandle,ClassLib); {wpconfig}
  340.    IF LibHnd = 0
  341.     THEN BEGIN {couldn't load library to register color class}
  342.           DosFreeMem(pAppD); Exit;
  343.          END; {then}
  344.    pAppD^.UndoClr := FColor;
  345.    pAppD^.CurClr  := FColor;
  346.    pAppD^.DlgTitle := FDlgTitle;
  347.    pp := PDLGTEMPLATE(@ClrDlg);
  348.    Dw := WinCreateDlg(pAppD^.ParentWnd,pAppD^.OwnerWnd,
  349.                       @EditColorDlgProc,pp^,pAppD);
  350.    IF Dw <> 0
  351.     THEN BEGIN {run it}
  352.           R := WinProcessDlg(Dw);
  353.           WinDestroyWindow(Dw);
  354.          END; {then}
  355.    WinDeleteLibrary(AppHandle,LibHnd); {release wpconfig}
  356.    DosFreeMem(pAppD);
  357.    Result := (Dw <> 0) AND (R <> FColor.lColor);
  358.    IF Result THEN FColor.lColor := R;
  359.   END;
  360.  
  361. (************************************************************************)
  362.  
  363. INITIALIZATION
  364.   {Register class}
  365.   RegisterClasses([TColorWheel]);
  366. END.
  367.