ChooseColor

[Rapinto]

Código para escolher uma COR :

O código da Cor é devolvido em 4 Bytes.

01 W-RGB GLOBAL.
03 W-RED PIC X.
03 W-GREEN PIC X.
03 W-BLUE PIC X.
03 W-COLORFILLER PIC X VALUE LOW-VALUE.




INITIALIZE LNKHANDLE.
CALL "CHOOSECOLOR" USING LNKCOLOR LNKHANDLE.
MOVE LNKCOLOR TO W-RGB.
MOVE LOW-VALUES TO W-COLORFILLER.
MOVE W-RGB TO "BackColor" OF CMSTATIC315.




Chamada á API do Windows:


@OPTIONS NOALPHA
************************************************** ***************
* Copyright (c) 2005 RUI PINTO SOFTWARE.
*
* Last Modified: Jun 2008.
************************************************** ***************
IDENTIFICATION DIVISION.
PROGRAM-ID. CHOOSECOLOR.
AUTHOR. Rui Pinto - JUN 2008.
*-----------------------------------------------------------------
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
*-----------------------------------------------------------------
DATA DIVISION.
BASED-STORAGE SECTION.
FILE SECTION.
WORKING-STORAGE SECTION.
01 WSCHOOSECOLOR.
03 LSTRUCTSIZE PIC S9(009) COMP-5.
03 HWNDOWNER PIC S9(009) COMP-5.
03 HINSTANCE PIC S9(009) COMP-5.
03 RGBRESULT PIC X(004).
03 LPCUSTCOLOR POINTER.
03 FLAGS PIC S9(009) COMP-5.
03 CUSTDATA PIC S9(009) COMP-5.
03 FNHOOK PIC S9(009) COMP-5.
03 TEMPLATENAME POINTER.
*
01 CUSTCOLOR PIC X(064) VALUE ALL ZERO.
01 TMLP PIC X(001) VALUE X"00".
01 RESULT PIC S9(009) COMP-5.
01 OLDRGB PIC X(004).
LINKAGE SECTION.
01 LNKCOLOR PIC X(004).
01 LNKHANDLE PIC S9(009) COMP-5.
*
PROCEDURE DIVISION USING LNKCOLOR LNKHANDLE.
MAIN SECTION.
MAIN-00.
MOVE LNKCOLOR TO OLDRGB CUSTCOLOR(1:4).
INITIALIZE WSCHOOSECOLOR.
MOVE 36 TO LSTRUCTSIZE.
MOVE LNKHANDLE TO HWNDOWNER.
MOVE FUNCTION ADDR (CUSTCOLOR) TO LPCUSTCOLOR.
MOVE FUNCTION ADDR (TMLP) TO TEMPLATENAME.
MOVE 3 TO FLAGS.
MOVE LNKCOLOR TO RGBRESULT.
CALL "ChooseColorA" WITH STDCALL USING BY REFERENCE WSCHOOSECOLOR
RETURNING RESULT.
IF RESULT = 0 MOVE OLDRGB TO LNKCOLOR
ELSE MOVE RGBRESULT TO LNKCOLOR.
MAIN-99.
END PROGRAM CHOOSECOLOR.