See changelog 2001-07-22 18:00 GMT -3
This commit is contained in:
Luiz Rafael Culik
@@ -1,3 +1,24 @@
|
||||
2001-07-22 18:00 GMT -3 Luiz Rafael Culik <culik@sl.conex.net>
|
||||
* utils/hbmake/hbmake.prg
|
||||
* Added suport for !iffile/!else/!endif and !stdout
|
||||
* utils/hbdoc/hbdoc.prg
|
||||
* Updated Copyright Date
|
||||
+include/hbgetcmt.ch
|
||||
*Include file for Ca-Clippr 5.3 Get Compatible Controls
|
||||
+source/rtl/radiobtn.prg
|
||||
*Radio Button Class Compatible with Ca-Clipper 5.3
|
||||
+source/rtl/radiogrp.prg
|
||||
*Radio Group Class Compatible with Ca-Clipper 5.3
|
||||
*tests/tstchbx.prg
|
||||
*Updated to demostrate the work of RadioButton/RadioGroup Classes
|
||||
*hb_slex.bc
|
||||
makefile.bc
|
||||
hb_slex.vc
|
||||
makefile.vc
|
||||
source/rtl/makefile
|
||||
*Added radiobtn.prg and radiogrp.prg to dependencie list
|
||||
|
||||
|
||||
2001-07-22 20:15 UTC+0100 Ryszard Glab <rglab@imid.med.pl>
|
||||
|
||||
*include/hbapi.h
|
||||
|
||||
@@ -36,11 +36,11 @@
|
||||
* todos los *.DBF en la ruta SET DEFAULT. Esta información contiene:
|
||||
* - Nombre del archivo
|
||||
* - Numero de registros
|
||||
* - Fecha de la ultima actualización
|
||||
* - Tamaño de cada archivo.
|
||||
* - Fecha de la ultima actualización
|
||||
* - Tamaño de cada archivo.
|
||||
*
|
||||
* Si <cFileMask> es dada, __Dir() lista todos los archivos que coinciden
|
||||
* con la máscara en los siguientes detalles: Nombre, Extensión, Tamaño,
|
||||
* con la máscara en los siguientes detalles: Nombre, Extensión, Tamaño,
|
||||
* Fecha.
|
||||
*
|
||||
* El comando DIR es pre-procesado en la función __Dir() durante el
|
||||
@@ -103,11 +103,11 @@
|
||||
* todos los *.DBF en la ruta SET DEFAULT. esta información contiene:
|
||||
* - Nombre del archivo
|
||||
* - Número de registros
|
||||
* - Fecha de la ultima actualización
|
||||
* - Tamaño de cada archivo.
|
||||
* - Fecha de la ultima actualización
|
||||
* - Tamaño de cada archivo.
|
||||
*
|
||||
* Si <cFileMask> es dada, __Dir() lista todos los archivos que coinciden
|
||||
* con la máscara en los siguientes detalles: Nombre, Extensión, Tamaño,
|
||||
* con la máscara en los siguientes detalles: Nombre, Extensión, Tamaño,
|
||||
* Fecha.
|
||||
*
|
||||
* El comando DIR es pre-procesado en la función __Dir() durante el
|
||||
@@ -116,7 +116,7 @@
|
||||
* __Dir() es una función de compatibilidad, esta fué superada por
|
||||
* DIRECTORY(), la cual devuelve toda la información en un arreglo
|
||||
* multidimensional.
|
||||
* $EXAMPLES$
|
||||
* $EXAMPLES$
|
||||
<fixed>
|
||||
* __Dir() // Información de todos los DBF en el directorio actual
|
||||
*
|
||||
@@ -167,7 +167,7 @@
|
||||
*
|
||||
* <aNombre> Array para llenar con el Nombre de los archivos que cumplen
|
||||
* con <cFileMask>. Cada elemento es una cadena de caracteres que incluye
|
||||
* el Nombre y Extensión del archivo sin la ruta de acceso.
|
||||
* el Nombre y Extensión del archivo sin la ruta de acceso.
|
||||
* Nombre es el nombre largo de archivo como es reportado por el sistema
|
||||
* operativo y no necesariamente en el formato mayúsculas 8.3 del D.O.S.
|
||||
*
|
||||
@@ -188,7 +188,7 @@
|
||||
* Vea DIRECTORY() por información sobre los valores de los atributos.
|
||||
* Si Ud. pasa un array a <aAtrib>, la función va a devolver archivos
|
||||
* con los atributos Normal, Oculto (H), sistema (S) y directorio (D)
|
||||
* Si <aAtrib> no es especificado o es distinto de un array solo
|
||||
* Si <aAtrib> no es especificado o es distinto de un array solo
|
||||
* archivos con atributo normal porian ser devueltos.
|
||||
*
|
||||
* Nota: Al momento de escribir esta documentación todavia no había
|
||||
@@ -201,8 +201,8 @@
|
||||
* ADIR() retorna el número de archivos y/o directorios que cumplen con
|
||||
* un formato especificado, este tambien llena una serie de arrays con
|
||||
* Nombre, Tamaño, Fecha, Hora y Atributo de estos archivos.
|
||||
* El array pasado debe ser pre-inicializado al tamaño apropiado, vea el
|
||||
* ejemplo más abajo.
|
||||
* El array pasado debe ser pre-inicializado al tamaño apropiado, vea el
|
||||
* ejemplo más abajo.
|
||||
* Con motivo de incluir los atributos Oculto (H), sistema (S) o de
|
||||
* directorio (D) <aAtrib> debe ser especificado.
|
||||
*
|
||||
|
||||
@@ -306,6 +306,8 @@ RTL_LIB_OBJS = \
|
||||
$(OBJ_DIR)\memvarbl.obj \
|
||||
$(OBJ_DIR)\menuto.obj \
|
||||
$(OBJ_DIR)\objfunc.obj \
|
||||
$(OBJ_DIR)\radiobtn.obj \
|
||||
$(OBJ_DIR)\radiogrp.obj \
|
||||
$(OBJ_DIR)\readkey.obj \
|
||||
$(OBJ_DIR)\readvar.obj \
|
||||
$(OBJ_DIR)\setfunc.obj \
|
||||
@@ -1476,6 +1478,20 @@ $(OBJ_DIR)\philesx.obj : $(RTL_DIR)\philesx.c
|
||||
$(CC) $(CLIBFLAGS) -o$@ $**
|
||||
tlib $(RTL_LIB) $(ARFLAGS) -+$@,,
|
||||
|
||||
$(OBJ_DIR)\radiobtn.c : $(RTL_DIR)\radiobtn.prg
|
||||
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
|
||||
|
||||
$(OBJ_DIR)\radiobtn.obj : $(OBJ_DIR)\radiobtn.c
|
||||
$(CC) $(CLIBFLAGS) -o$@ $**
|
||||
tlib $(RTL_LIB) $(ARFLAGS) -+$@,,
|
||||
|
||||
$(OBJ_DIR)\radiogrp.c : $(RTL_DIR)\radiogrp.prg
|
||||
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
|
||||
|
||||
$(OBJ_DIR)\radiogrp.obj : $(OBJ_DIR)\radiogrp.c
|
||||
$(CC) $(CLIBFLAGS) -o$@ $**
|
||||
tlib $(RTL_LIB) $(ARFLAGS) -+$@,,
|
||||
|
||||
$(OBJ_DIR)\rat.obj : $(RTL_DIR)\rat.c
|
||||
$(CC) $(CLIBFLAGS) -o$@ $**
|
||||
tlib $(RTL_LIB) $(ARFLAGS) -+$@,,
|
||||
|
||||
@@ -340,6 +340,8 @@ RTL_LIB_OBJS = \
|
||||
$(OBJ_DIR)\memvarbl.obj \
|
||||
$(OBJ_DIR)\menuto.obj \
|
||||
$(OBJ_DIR)\objfunc.obj \
|
||||
$(OBJ_DIR)\radiobtn.obj \
|
||||
$(OBJ_DIR)\radiogrp.obj \
|
||||
$(OBJ_DIR)\readkey.obj \
|
||||
$(OBJ_DIR)\readvar.obj \
|
||||
$(OBJ_DIR)\setfunc.obj \
|
||||
|
||||
117
harbour/include/hbgetcmt.ch
Normal file
117
harbour/include/hbgetcmt.ch
Normal file
@@ -0,0 +1,117 @@
|
||||
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* Header file for Clipper 5.3 Compatible Get Commands
|
||||
*
|
||||
* Copyright 2001 Luiz Rafael Culik <culik@sl.conex.net>
|
||||
* www - http://www.harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
#include "hbsetup.ch"
|
||||
#ifndef _HBGETCMT_CH
|
||||
#define _HBGETCMT_CH
|
||||
#ifdef HB_COMPAT_C53
|
||||
|
||||
#command @ <row>, <col> GET <var> ;
|
||||
CHECKBOX ;
|
||||
[VALID <valid>] ;
|
||||
[WHEN <when>] ;
|
||||
[CAPTION <caption>] ;
|
||||
[MESSAGE <message>] ;
|
||||
[COLOR <color>] ;
|
||||
[FOCUS <fblock>] ;
|
||||
[STATE <sblock>] ;
|
||||
[STYLE <style>] ;
|
||||
[SEND <msg>] ;
|
||||
[GUISEND <guimsg>] ;
|
||||
;
|
||||
=> SetPos( <row>, <col> ) ;
|
||||
; AAdd( GetList, ;
|
||||
_GET_( <var>, <(var)>, NIL, <{valid}>, <{when}> ) ) ;
|
||||
; ATail(GetList):Control := _CheckBox_( <var>, <caption>, ;
|
||||
<message>, <color>, <{fblock}>, <{sblock}>, ;
|
||||
<style> ) ;
|
||||
; ATail(GetList):reader := { | a, b, c, d | ;
|
||||
GuiReader( a, b, c, d ) } ;
|
||||
[; ATail(GetList):<msg>] ;
|
||||
[; ATail(GetList):Control:<guimsg>] ;
|
||||
; ATail(GetList):Control:Display()
|
||||
|
||||
#command @ <top>, <left>, <bottom>, <right> GET <var> ;
|
||||
RADIOGROUP <buttons> ;
|
||||
[VALID <valid>] ;
|
||||
[WHEN <when>] ;
|
||||
[CAPTION <caption>] ;
|
||||
[MESSAGE <message>] ;
|
||||
[COLOR <color>] ;
|
||||
[FOCUS <fblock>] ;
|
||||
[STYLE <style>] ;
|
||||
[SEND <msg>] ;
|
||||
[GUISEND <guimsg>] ;
|
||||
;
|
||||
=> SetPos( <top>, <left> ) ;
|
||||
; AAdd( GetList, ;
|
||||
_GET_( <var>, <(var)>, NIL, <{valid}>, <{when}> ) ) ;
|
||||
; ATail(GetList):Control := _RadioGrp_( ATail(Getlist):row, ;
|
||||
ATail(Getlist):col, ;
|
||||
<bottom>, <right>, <var>, <buttons>, <caption>, <message>, ;
|
||||
<color>, <{fblock}>, <style> ) ;
|
||||
; ATail(GetList):reader := { | a, b, c, d | ;
|
||||
GuiReader( a, b, c, d ) } ;
|
||||
[; ATail(GetList):<msg>] ;
|
||||
[; ATail(GetList):Control:<guimsg>] ;
|
||||
; ATail(GetList):Control:Display()
|
||||
|
||||
#command READ [MSG AT <nRow>, <nLeft>, <nRight> ;
|
||||
[MSG COLOR <cColor>]] ;
|
||||
=> ReadModal( GetList, ;
|
||||
NIL, <nRow>, <nLeft>, <nRight>, <cColor> ) ;
|
||||
; GetList := {}
|
||||
|
||||
|
||||
#endif
|
||||
#endif
|
||||
@@ -307,6 +307,8 @@ RTL_LIB_OBJS = \
|
||||
$(OBJ_DIR)\menuto.obj \
|
||||
$(OBJ_DIR)\objfunc.obj \
|
||||
$(OBJ_DIR)\profiler.obj \
|
||||
$(OBJ_DIR)\radiobtn.obj \
|
||||
$(OBJ_DIR)\radiogrp.obj \
|
||||
$(OBJ_DIR)\readkey.obj \
|
||||
$(OBJ_DIR)\readvar.obj \
|
||||
$(OBJ_DIR)\setfunc.obj \
|
||||
@@ -1482,6 +1484,21 @@ $(OBJ_DIR)\profiler.obj : $(OBJ_DIR)\profiler.c
|
||||
$(CC) $(CLIBFLAGS) -o$@ $**
|
||||
tlib $(RTL_LIB) $(ARFLAGS) -+$@,,
|
||||
|
||||
$(OBJ_DIR)\radiobtn.c : $(RTL_DIR)\radiobtn.prg
|
||||
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
|
||||
|
||||
$(OBJ_DIR)\radiobtn.obj : $(OBJ_DIR)\radiobtn.c
|
||||
$(CC) $(CLIBFLAGS) -o$@ $**
|
||||
tlib $(RTL_LIB) $(ARFLAGS) -+$@,,
|
||||
|
||||
$(OBJ_DIR)\radiogrp.c : $(RTL_DIR)\radiogrp.prg
|
||||
$(HARBOUR_EXE) $(HARBOURFLAGS) $** -o$@
|
||||
|
||||
$(OBJ_DIR)\radiogrp.obj : $(OBJ_DIR)\radiogrp.c
|
||||
$(CC) $(CLIBFLAGS) -o$@ $**
|
||||
tlib $(RTL_LIB) $(ARFLAGS) -+$@,,
|
||||
|
||||
|
||||
$(OBJ_DIR)\rat.obj : $(RTL_DIR)\rat.c
|
||||
$(CC) $(CLIBFLAGS) -o$@ $**
|
||||
tlib $(RTL_LIB) $(ARFLAGS) -+$@,,
|
||||
|
||||
@@ -340,6 +340,8 @@ RTL_LIB_OBJS = \
|
||||
$(OBJ_DIR)\memvarbl.obj \
|
||||
$(OBJ_DIR)\menuto.obj \
|
||||
$(OBJ_DIR)\objfunc.obj \
|
||||
$(OBJ_DIR)\radiobtn.obj \
|
||||
$(OBJ_DIR)\radiogrp.obj \
|
||||
$(OBJ_DIR)\readkey.obj \
|
||||
$(OBJ_DIR)\readvar.obj \
|
||||
$(OBJ_DIR)\setfunc.obj \
|
||||
|
||||
@@ -135,6 +135,8 @@ PRG_SOURCES=\
|
||||
menuto.prg \
|
||||
objfunc.prg \
|
||||
profiler.prg \
|
||||
radiobtn.prg \
|
||||
radiogrp.prg \
|
||||
readkey.prg \
|
||||
readvar.prg \
|
||||
setfunc.prg \
|
||||
|
||||
267
harbour/source/rtl/radiobtn.prg
Normal file
267
harbour/source/rtl/radiobtn.prg
Normal file
@@ -0,0 +1,267 @@
|
||||
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* RADIOBUTTON class
|
||||
*
|
||||
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
|
||||
* www - http://www.harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
|
||||
#include "common.ch"
|
||||
#include "hbclass.ch"
|
||||
#include "hbsetup.ch"
|
||||
#ifdef HB_COMPAT_C53
|
||||
CLASS TRadioBtn
|
||||
|
||||
EXPORT:
|
||||
|
||||
DATA Buffer
|
||||
DATA CapRow
|
||||
DATA CapCol
|
||||
DATA Caption
|
||||
DATA Cargo
|
||||
DATA Col
|
||||
DATA pData
|
||||
DATA ColorSpec
|
||||
DATA Classname init "RADIOBUTTN"
|
||||
DATA fBlock
|
||||
DATA HasFocus
|
||||
DATA Row
|
||||
DATA sBlock
|
||||
DATA Style
|
||||
|
||||
METHOD SetData(xData)
|
||||
ACCESS Data inline ::SetData()
|
||||
ASSIGN Data(xData) inline if(xData!=NIL,::SetData(xData),)
|
||||
METHOD Display()
|
||||
METHOD HitTest(nrow,nCol)
|
||||
METHOD IsAccel(xVal)
|
||||
METHOD KillFocus()
|
||||
MESSAGE Select(lVal) METHOD _Select(LVal)
|
||||
METHOD SetFocus()
|
||||
METHOD New(nRow,nCol,cCaption,xData)
|
||||
ENDCLASS
|
||||
|
||||
METHOD New(nRow,nCol,cCaption,xData) CLASS TRadioBtn
|
||||
|
||||
::Buffer:= .f.
|
||||
::CapRow:= nRow
|
||||
::CapCol:= nCol+3+1
|
||||
::Caption:= cCaption
|
||||
::Cargo:=NIL
|
||||
::Col:= nCol
|
||||
if ( !isdefcolor() )
|
||||
::ColorSpec:="W/N,W+/N,W+/N,N/W,W/N,W/N,W+/N"
|
||||
else
|
||||
cColor := SetColor()
|
||||
::ColorSpec :=;
|
||||
__guicolor(cColor, 5) + "," + ;
|
||||
__guicolor(cColor, 5) + "," + __guicolor(cColor, 2) + ;
|
||||
"," + __guicolor(cColor, 2) + "," + __guicolor(cColor, ;
|
||||
1) + "," + __guicolor(cColor, 1) + "," + ;
|
||||
__guicolor(cColor, 4)
|
||||
endif
|
||||
|
||||
::fBlock := NIL
|
||||
|
||||
::HasFocus := .f.
|
||||
::Row:=nRow
|
||||
::sBlock:=nil
|
||||
|
||||
::Style:= "(* )"
|
||||
::Data := xData
|
||||
return Self
|
||||
|
||||
METHOD SETFOCus() CLASS TRadioBtn
|
||||
|
||||
if ( !::hasfocus .AND. ISBLOCK( ( ::hasfocus := .T., ;
|
||||
::display(), ::fblock ) ) )
|
||||
eval(::fblock)
|
||||
endif
|
||||
return Self
|
||||
|
||||
METHOD _SELECT(lStatus) CLASS TRadioBtn
|
||||
|
||||
local lOldBuffer := ::Buffer
|
||||
if ( ISLOGICAL( lStatus ) )
|
||||
::Buffer := lStatus
|
||||
else
|
||||
::Buffer := !::Buffer
|
||||
endif
|
||||
if ( lOldBuffer == ::Buffer )
|
||||
elseif ( ISBLOCK( ::sBlock ))
|
||||
eval(::sBlock)
|
||||
endif
|
||||
return self
|
||||
|
||||
METHOD kILLFOcus() CLASS TRadioBtn
|
||||
|
||||
if ( ::HasFocus )
|
||||
::HasFocus := .F.
|
||||
if ( ISBLOCK( ::fBlock ) )
|
||||
eval(::fBlock)
|
||||
endif
|
||||
::display()
|
||||
endif
|
||||
return Self
|
||||
METHOD DISPLAy() CLASS TRadioBtn
|
||||
|
||||
local cColor := SetColor(), cCurStyle, nCurRow:= Row(), nCurCol:= ;
|
||||
Col(), cPairs, cPairs3, nPos, cPairs4, cOldCaption
|
||||
|
||||
cCurStyle := ::Style
|
||||
dispbegin()
|
||||
if ( ::hasfocus )
|
||||
cPairs3 := __guicolor(::ColorSpec, 3)
|
||||
cPairs := __guicolor(::ColorSpec, 4)
|
||||
cPairs4 := __guicolor(::ColorSpec, 7)
|
||||
else
|
||||
cPairs3 := __guicolor(::ColorSpec, 1)
|
||||
cPairs := __guicolor(::ColorSpec, 2)
|
||||
cPairs4 := __guicolor(::ColorSpec, 6)
|
||||
endif
|
||||
if ( ::Buffer )
|
||||
set color to (cPairs)
|
||||
else
|
||||
set color to (cPairs3)
|
||||
endif
|
||||
SetPos(::Row, ::Col)
|
||||
?? Left(cCurStyle, 1)
|
||||
if ( ::Buffer )
|
||||
?? SubStr(cCurStyle, 2, 1)
|
||||
else
|
||||
?? SubStr(cCurStyle, 3, 1)
|
||||
endif
|
||||
?? right(cCurStyle, 1)
|
||||
if ( !Empty(cOldCaption := ::Caption) )
|
||||
if ( ( nPos := At("&", cOldCaption) ) == 0 )
|
||||
elseif ( nPos == Len(cOldCaption) )
|
||||
nPos := 0
|
||||
else
|
||||
cOldCaption := stuff(cOldCaption, nPos, 1, "")
|
||||
endif
|
||||
set color to (__guicolor(::ColorSpec, 5))
|
||||
SetPos(::CapRow, ::CapCol)
|
||||
?? cOldCaption
|
||||
if ( nPos != 0 )
|
||||
set color to (cPairs4)
|
||||
SetPos(::CapRow, ::CapCol + nPos - 1)
|
||||
?? SubStr(cOldCaption, nPos, 1)
|
||||
endif
|
||||
endif
|
||||
dispend()
|
||||
set color to (cColor)
|
||||
SetPos(nCurRow, nCurCol)
|
||||
return Self
|
||||
METHOD IsAccel( xValue ) CLASS TRadioBtn
|
||||
|
||||
local nPos, cCaption, xResult
|
||||
if ( ISNUMBER( xValue ) )
|
||||
xValue := Chr(xValue)
|
||||
elseif ( !( ISCHARACTER( xValue ) ) )
|
||||
return .F.
|
||||
endif
|
||||
xValue := Lower(xValue)
|
||||
cCaption := ::Caption
|
||||
if ( ( nPos := At("&", cCaption) ) == 0 )
|
||||
elseif ( ( xResult := Lower(SubStr(cCaption, nPos + 1, 1)), nPos ;
|
||||
< Len(cCaption) .AND. xResult == xValue ) )
|
||||
return .T.
|
||||
endif
|
||||
return .F.
|
||||
|
||||
METHOD HITTESt( nRow, nCol ) CLASS TRadioBtn
|
||||
|
||||
local nPos, nLen
|
||||
if ( nRow != ::Row )
|
||||
elseif ( nCol < ::Col )
|
||||
elseif ( nCol < ::Col + 3 )
|
||||
return -2049
|
||||
endif
|
||||
nLen := Len(::Caption)
|
||||
if ( ( nPos := At("&", ::Caption) ) == 0 )
|
||||
elseif ( nPos < nLen )
|
||||
nLen--
|
||||
endif
|
||||
if ( nRow != ::CapRow )
|
||||
elseif ( nCol < ::CapCol )
|
||||
elseif ( nCol < ::CapCol + nLen )
|
||||
return -2049
|
||||
endif
|
||||
return 0
|
||||
|
||||
METHOD SetData(Arg1) CLASS TRadioBtn
|
||||
|
||||
if ( PCount() == 0 )
|
||||
elseif ( ISNIL( Arg1 ) )
|
||||
::pData := Arg1
|
||||
else
|
||||
::pData := if(valtype(Arg1)=="C",arg1,"")
|
||||
endif
|
||||
if ( ISNIL( ::pData ) )
|
||||
return __caption(::Caption)
|
||||
endif
|
||||
return ::pData
|
||||
|
||||
function RADIOBUTTO( nRow, nCol,cCaption,xData)
|
||||
|
||||
default cCaption to ""
|
||||
if ( ( ISNUMBER( nRow ) ) ) .and. ( ( ISNUMBER( nCol ) ) )
|
||||
Return TRadioBtn():New(nRow, nCol,cCaption,xData)
|
||||
endif
|
||||
return nil
|
||||
|
||||
/** Return the Caption Letter of an Given Caption String */
|
||||
function __CAPTION( cCaption )
|
||||
|
||||
local nPos
|
||||
if ( ( nPos := At("&", cCaption) ) > 0 )
|
||||
cCaption := stuff(cCaption, nPos, 1, "")
|
||||
endif
|
||||
return cCaption
|
||||
#endif
|
||||
484
harbour/source/rtl/radiogrp.prg
Normal file
484
harbour/source/rtl/radiogrp.prg
Normal file
@@ -0,0 +1,484 @@
|
||||
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
|
||||
/*
|
||||
* Harbour Project source code:
|
||||
* RADIOGROUP class
|
||||
*
|
||||
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
|
||||
* www - http://www.harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2, or (at your option)
|
||||
* any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this software; see the file COPYING. If not, write to
|
||||
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
||||
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/).
|
||||
*
|
||||
* As a special exception, the Harbour Project gives permission for
|
||||
* additional uses of the text contained in its release of Harbour.
|
||||
*
|
||||
* The exception is that, if you link the Harbour libraries with other
|
||||
* files to produce an executable, this does not by itself cause the
|
||||
* resulting executable to be covered by the GNU General Public License.
|
||||
* Your use of that executable is in no way restricted on account of
|
||||
* linking the Harbour library code into it.
|
||||
*
|
||||
* This exception does not however invalidate any other reasons why
|
||||
* the executable file might be covered by the GNU General Public License.
|
||||
*
|
||||
* This exception applies only to the code released by the Harbour
|
||||
* Project under the name Harbour. If you copy code from other
|
||||
* Harbour Project or Free Software Foundation releases into a copy of
|
||||
* Harbour, as the General Public License permits, the exception does
|
||||
* not apply to the code that you add in this way. To avoid misleading
|
||||
* anyone as to the status of such modified files, you must delete
|
||||
* this exception notice from them.
|
||||
*
|
||||
* If you write modifications of your own for Harbour, it is your choice
|
||||
* whether to permit this exception to apply to your modifications.
|
||||
* If you do not wish that, delete this exception notice.
|
||||
*
|
||||
*/
|
||||
|
||||
#include "common.ch"
|
||||
#include "hbclass.ch"
|
||||
#include "hbsetup.ch"
|
||||
|
||||
#ifdef HB_COMPAT_C53
|
||||
CLASS TRadioGroup
|
||||
|
||||
export:
|
||||
|
||||
METHOD AddItem(xItem)
|
||||
METHOD DelItem(xItem)
|
||||
METHOD Display()
|
||||
METHOD GetAccel(xItem)
|
||||
METHOD GetItem(Xitem)
|
||||
METHOD HitTest(nRow,nCol)
|
||||
METHOD InsItem(nPos, oButtom )
|
||||
METHOD KillFocus()
|
||||
METHOD NextItem()
|
||||
METHOD PrevItem()
|
||||
MESSAGE Select(xItem) METHOD _Select(xItem)
|
||||
MESSAGE SetColor(xItem) METHOD _SetColor(xItem)
|
||||
METHOD SetFocus()
|
||||
METHOD SetStyle(xItem)
|
||||
METHOD New(nTop, nLeft, nBottom, nRight )
|
||||
METHOD GetColor(xColor)
|
||||
DATA Bottom
|
||||
|
||||
DATA Buffer init NIL
|
||||
|
||||
DATA CapCol
|
||||
|
||||
DATA CapRow
|
||||
|
||||
DATA Caption init ""
|
||||
|
||||
DATA Cargo init Nil
|
||||
|
||||
DATA ColdBox init "ÚÄ¿³ÙÄÀ³"
|
||||
|
||||
DATA fBlock init NIL
|
||||
|
||||
DATA HasFocus init .f.
|
||||
|
||||
DATA HotBox init "ÉÍ»º¼ÍȺ"
|
||||
|
||||
DATA ItemCount init 0
|
||||
|
||||
DATA Left
|
||||
|
||||
DATA Message init ""
|
||||
|
||||
DATA Right
|
||||
DATA aItems init {}
|
||||
DATA lCursor init 0
|
||||
|
||||
DATA TextValue init ""
|
||||
|
||||
DATA Top
|
||||
DATA CLASSName init "RADIOGROUP"
|
||||
DATA TypeOut init .f.
|
||||
|
||||
DATA Value init 0
|
||||
DATA Color
|
||||
ACCESS colorspec inline ::GetColor()
|
||||
ASSIGN Colorspec(xColor) inline if(xColor!=Nil,::GetColor(xColor),)
|
||||
|
||||
ENDCLASS
|
||||
|
||||
METHOD New(nTop, nLeft, nBottom, nRight ) CLASS TRadioGroup
|
||||
|
||||
Local cColor
|
||||
if ( isdefcolor() )
|
||||
::ColorSpec:= "W/N,W/N,W+/N"
|
||||
else
|
||||
cColor := SetColor()
|
||||
::ColorSpec:= __guicolor(cColor, 3) + "," + ;
|
||||
__guicolor(cColor, 1) + "," + __guicolor(cColor, 4)
|
||||
endif
|
||||
::Bottom:=nBottom
|
||||
::CapCol:= nLeft+2
|
||||
::CapRow:= nTop
|
||||
::Left:=nLeft
|
||||
::right:=nRight
|
||||
::top:=nTop
|
||||
return Self
|
||||
|
||||
METHOD ADDITEM( xItem ) CLASS TRadioGroup
|
||||
|
||||
|
||||
if ( !( ISOBJECT( xItem ) ) )
|
||||
elseif ( xItem:classname() == "RADIOBUTTN" )
|
||||
AAdd(::aItems, xItem)
|
||||
::ItemCount++
|
||||
endif
|
||||
return Self
|
||||
|
||||
METHOD SETSTYLE( xStyle ) CLASS TRadioGroup
|
||||
|
||||
local nPos, nLen, aItems := ::aItems
|
||||
nLen := ::ItemCount
|
||||
for nPos := 1 to nLen
|
||||
aItems[ nPos ]:style(xStyle)
|
||||
next
|
||||
return Self
|
||||
METHOD SETFOCus() CLASS TRadioGroup
|
||||
|
||||
|
||||
local Local1, Local2, aItems
|
||||
if ( !::HasFocus )
|
||||
::lCursor := setcursor(0)
|
||||
::HasFocus := .T.
|
||||
aItems := ::aItems
|
||||
nLen := ::ItemCount
|
||||
dispbegin()
|
||||
for nPos := 1 to nLen
|
||||
aItems[ nPos ]:setfocus()
|
||||
next
|
||||
::display()
|
||||
dispend()
|
||||
|
||||
if ( ISBLOCK( ::fBlock ) )
|
||||
eval(::fBlock)
|
||||
endif
|
||||
endif
|
||||
return self
|
||||
|
||||
METHOD _SETCOLor( Arg1 ) CLASS TRadioGroup
|
||||
|
||||
|
||||
local nPos, nLen, aItems := ::aItems
|
||||
nLen := ::ItemCount
|
||||
for nPos := 1 to nLen
|
||||
aItems[ nPos ]:colorspec :=Arg1
|
||||
next
|
||||
return Self
|
||||
METHOD _SELECT( xValue ) CLASS TRadioGroup
|
||||
|
||||
local nPos, nLen, cType := ValType(xValue)
|
||||
if ( cType == "C" )
|
||||
nLen := ::ItemCount
|
||||
for nPos := 1 to nLen
|
||||
if ( ::aItems[ nPos ]:data == xValue )
|
||||
default ::Buffer to ""
|
||||
changebutt(self, ::Value, nPos)
|
||||
exit
|
||||
endif
|
||||
next
|
||||
if ( nPos > nLen )
|
||||
::Buffer := xValue
|
||||
endif
|
||||
elseif ( cType != "U" .AND. xValue < 1 )
|
||||
elseif ( cType != "U" .AND. xValue <= ::ItemCount )
|
||||
default ::Buffer to 0
|
||||
changebutt(self, ::Value, xValue)
|
||||
endif
|
||||
return qself()
|
||||
METHOD PREVITem() CLASS TRadioGroup
|
||||
|
||||
|
||||
local xValue, nPos
|
||||
if ( !::HasFocus )
|
||||
elseif ( ::ItemCount > 0 )
|
||||
if ( ( xValue := ::Value ) == 0 )
|
||||
nPos := 1
|
||||
elseif ( xValue == 1 )
|
||||
nPos := ::ItemCount
|
||||
else
|
||||
nPos := xValue - 1
|
||||
endif
|
||||
changebutt(self, xValue, nPos)
|
||||
endif
|
||||
return self
|
||||
METHOD NEXTITem() CLASS TRadioGroup
|
||||
|
||||
|
||||
local xValue, nPos
|
||||
if ( !::HasFocus )
|
||||
elseif ( ::ItemCount > 0 )
|
||||
if ( ( xValue := ::Value ) == ::ItemCount )
|
||||
nPos := 1
|
||||
else
|
||||
nPos := xValue + 1
|
||||
endif
|
||||
changebutt(self, xValue, nPos)
|
||||
endif
|
||||
return Self
|
||||
METHOD KILLFOcus() CLASS TRadioGroup
|
||||
|
||||
local nPos, nCount, aItems
|
||||
if ( ::HasFocus )
|
||||
::HasFocus := .F.
|
||||
if ( ISBLOCK( ::fBlock ) )
|
||||
eval(::fBlock)
|
||||
endif
|
||||
aItems := ::aItems
|
||||
nCount := ::ItemCount
|
||||
|
||||
dispbegin()
|
||||
for nPos := 1 to nCount
|
||||
aItems[ nPos ]:killfocus()
|
||||
next
|
||||
::display()
|
||||
dispend()
|
||||
|
||||
setcursor(::lCursor)
|
||||
endif
|
||||
return self
|
||||
METHOD INSITEM( nPos, oButtom ) CLASS TRadioGroup
|
||||
|
||||
|
||||
if ( !( ISOBJECT( oButtom ) ) )
|
||||
elseif ( !( oButtom:classname() == "RADIOBUTTN" ) )
|
||||
elseif ( nPos < ::ItemCount )
|
||||
asize(::aItems, ++::ItemCount)
|
||||
ains(::aItems, nPos)
|
||||
::aItems[ nPos ] := oButtom
|
||||
endif
|
||||
return ::aItems[ nPos ]
|
||||
METHOD HITTEST( nRow, nCol ) CLASS TRadioGroup
|
||||
|
||||
local nPos, nCount, aItem := ::aItems, nLen, nPosition
|
||||
nCount := ::ItemCount
|
||||
do case
|
||||
case Empty(::Coldbox + ::HotBox)
|
||||
case nRow == ::Top
|
||||
if ( nCol == ::Left )
|
||||
return -1
|
||||
elseif ( nCol == ::Right )
|
||||
return -3
|
||||
elseif ( nCol >= ::Left .AND. nCol <= ::Right )
|
||||
return -2
|
||||
endif
|
||||
case nRow == ::Bottom
|
||||
if ( nCol == ::Left )
|
||||
return -7
|
||||
elseif ( nCol == ::Right )
|
||||
return -5
|
||||
elseif ( nCol >= ::Left .AND. nCol <= ::Right )
|
||||
return -6
|
||||
endif
|
||||
case nCol == ::Left
|
||||
if ( nRow >= ::Top .AND. nRow <= ::Bottom )
|
||||
return -8
|
||||
else
|
||||
return 0
|
||||
endif
|
||||
case nCol == ::Right
|
||||
if ( nRow >= ::Top .AND. nRow <= ::Bottom )
|
||||
return -4
|
||||
else
|
||||
return 0
|
||||
endif
|
||||
endcase
|
||||
nLen := Len(::Caption)
|
||||
if ( ( nPosition := At("&", ::Caption) ) == 0 )
|
||||
elseif ( nPosition < nLen )
|
||||
nLen--
|
||||
endif
|
||||
do case
|
||||
case Empty(::Caption)
|
||||
case nRow != ::CapRow
|
||||
case nCol < ::CapCol
|
||||
case nCol < ::CapCol + nLen
|
||||
return -1025
|
||||
endcase
|
||||
do case
|
||||
case nRow < ::Top
|
||||
case nRow > ::Bottom
|
||||
case nCol < ::Left
|
||||
case nCol <= ::Right
|
||||
for nPos := 1 to nCount
|
||||
if ( aItem[ nPos ]:hittest(nRow, nCol) != 0 )
|
||||
return nPos
|
||||
endif
|
||||
next
|
||||
return -2049
|
||||
endcase
|
||||
return 0
|
||||
METHOD GETITEm( xValue ) CLASS TRadioGroup
|
||||
local xReturn := Nil
|
||||
if ( xValue < 1 )
|
||||
elseif ( xValue <= ::ItemCount )
|
||||
xReturn := ::aItems[ xValue ]
|
||||
endif
|
||||
return xReturn
|
||||
METHOD GetAccel( xValue ) CLASS TRadioGroup
|
||||
|
||||
local nPos, nLen, aItem
|
||||
if ( ISNUMBER( xValue ) )
|
||||
xValue := Chr(xValue)
|
||||
elseif ( !ValType(xValue == "C") )
|
||||
return 0
|
||||
endif
|
||||
aItem := ::aItems
|
||||
nLen := Len(aItem)
|
||||
xValue := Lower(xValue)
|
||||
for nPos := 1 to nLen
|
||||
if ( aItem[ nPos ]:isaccel(xValue) )
|
||||
return nPos
|
||||
endif
|
||||
next
|
||||
return 0
|
||||
|
||||
METHOD DISPLAY() CLASS TRadioGroup
|
||||
|
||||
|
||||
local nPos, nCount, aItem, cColor := SetColor(), nCurRow:= ;
|
||||
Row(), nCurCol := Col(), cSelBox, cUnSelBox, cCaption, nPosition
|
||||
aItem := ::aItems
|
||||
nCount := ::ItemCount
|
||||
|
||||
dispbegin()
|
||||
if ( ::HasFocus )
|
||||
cSelBox := ::HotBox
|
||||
cUnSelBox := ::Coldbox
|
||||
else
|
||||
cSelBox := ::Coldbox
|
||||
cUnSelBox := ::HotBox
|
||||
endif
|
||||
set color to (__guicolor(::ColorSpec, 1))
|
||||
if ( !Empty(cSelBox) )
|
||||
@ ::Top, ::Left, ::Bottom, ::Right ;
|
||||
box cSelBox
|
||||
elseif ( !Empty(cUnSelBox) )
|
||||
@ ::Top, ::Left, ::Bottom, ::Right ;
|
||||
box cUnSelBox
|
||||
endif
|
||||
if ( !Empty(cCaption := ::Caption) )
|
||||
if ( ( nPosition := At("&", cCaption) ) == 0 )
|
||||
elseif ( nPosition == Len(cCaption) )
|
||||
nPosition := 0
|
||||
else
|
||||
cCaption := stuff(cCaption, nPosition, 1, "")
|
||||
endif
|
||||
set color to (__guicolor(::ColorSpec, 2))
|
||||
SetPos(::CapRow, ::CapCol)
|
||||
?? cCaption
|
||||
if ( nPosition != 0 )
|
||||
set color to (__guicolor(::ColorSpec, 3))
|
||||
SetPos(::CapRow, ::CapCol + nPosition - 1)
|
||||
?? SubStr(cCaption, nPosition, 1)
|
||||
endif
|
||||
endif
|
||||
for nPos := 1 to nCount
|
||||
aItem[ nPos ]:display()
|
||||
next
|
||||
dispend()
|
||||
|
||||
set color to (cColor)
|
||||
SetPos(nCurRow, nCurCol)
|
||||
return self
|
||||
|
||||
METHOD DELITEm( xItem ) CLASS TRadioGroup
|
||||
|
||||
if ( xItem < 1 )
|
||||
elseif ( xItem <= ::ItemCount )
|
||||
adel(::aItems[ xItem ])
|
||||
asize(::aItems, --::ItemCount)
|
||||
endif
|
||||
if ( !::HasFocus )
|
||||
elseif ( ::ItemCount < ::Value )
|
||||
::Value := ::ItemCount
|
||||
::TextValue := ::aItems[ ::Value ]:data
|
||||
if ( ISNUMBER( ::Buffer ) )
|
||||
::Buffer := ::Value
|
||||
else
|
||||
::Buffer := ::TextValue
|
||||
endif
|
||||
endif
|
||||
return self
|
||||
|
||||
METHOD GetColor(xColor) CLASS TRadioGroup
|
||||
if ( !( ISNIL( xColor ) ) )
|
||||
::Color := iif( Valtype(xColor)=="C" .and. !Empty(__guicolor(xColor, 3)) .AND. ;
|
||||
Empty(__guicolor(xColor, 4)),xColor,)
|
||||
|
||||
endif
|
||||
return ::Color
|
||||
|
||||
static function CHANGEBUTT( oItems, xVal, nPos )
|
||||
|
||||
|
||||
if ( xVal != nPos )
|
||||
|
||||
dispbegin()
|
||||
if ( xVal > 0 )
|
||||
oItems:aItems[ xVal ]:select(.F.)
|
||||
oItems:aItems[ xVal ]:display()
|
||||
endif
|
||||
if ( nPos > 0 )
|
||||
oItems:aItems[ nPos ]:select(.T.)
|
||||
oItems:aItems[ nPos ]:display()
|
||||
endif
|
||||
dispend()
|
||||
|
||||
oItems:Value := nPos
|
||||
oItems:TextValue := oItems:aItems[ nPos ]:data
|
||||
if ( ISNUMBER( oItems:Buffer ) )
|
||||
oItems:Buffer := nPos
|
||||
else
|
||||
oItems:Buffer := oItems:TextValue
|
||||
endif
|
||||
endif
|
||||
return .T.
|
||||
// Radio Group Class Constructor Function
|
||||
function RADIOGROUP( nTop, nLeft, nBottom, nRight )
|
||||
if ( ( ISNUMBER( nTop ) ) ) .and. ( ( ISNUMBER( nLeft ) ) ) .and. ( ( ISNUMBER( nBottom ) ) ) .and. ( ( ISNUMBER( nright ) ) )
|
||||
Return TRadioGroup():New(nTop, nLeft, nBottom, nRight )
|
||||
endif
|
||||
Return Nil
|
||||
|
||||
|
||||
function _RADIOGRP_( nTop, nLeft, nBottom, nRight, xValue, aItems, cCaption, cMessage, ;
|
||||
cColor, bFblock )
|
||||
|
||||
local oRadioGroup, nPos, nLen
|
||||
oRadioGroup := radiogroup(nTop, nLeft, nBottom, nRight)
|
||||
if ( !( ISNIL( oRadioGroup ) ) )
|
||||
oRadioGroup:caption:= if(cCaption!=NIL,cCaption,)
|
||||
oRadioGroup:colorspec:=if(cColor!=Nil,cColor,)
|
||||
oRadioGroup:message:=if(cMessage!=nil,cMessage,)
|
||||
oRadioGroup:fblock:=if(bFblock!=nil,bFblock,)
|
||||
nLen := Len(aItems)
|
||||
for nPos := 1 to nLen
|
||||
oRadioGroup:additem(aItems[ nPos ])
|
||||
next
|
||||
oRadioGroup:select(xValue)
|
||||
endif
|
||||
return oRadioGroup
|
||||
|
||||
#endif
|
||||
@@ -1,43 +1,27 @@
|
||||
/*
|
||||
* $Id$
|
||||
*/
|
||||
#include "hbgetcmt.ch"
|
||||
|
||||
#ifdef __HARBOUR__
|
||||
#command @ <row>, <col> GET <var> ;
|
||||
CHECKBOX ;
|
||||
[VALID <valid>] ;
|
||||
[WHEN <when>] ;
|
||||
[CAPTION <caption>] ;
|
||||
[MESSAGE <message>] ;
|
||||
[COLOR <color>] ;
|
||||
[FOCUS <fblock>] ;
|
||||
[STATE <sblock>] ;
|
||||
[STYLE <style>] ;
|
||||
[SEND <msg>] ;
|
||||
[GUISEND <guimsg>] ;
|
||||
;
|
||||
=> SetPos( <row>, <col> ) ;
|
||||
; AAdd( GetList, ;
|
||||
_GET_( <var>, <(var)>, NIL, <{valid}>, <{when}> ) ) ;
|
||||
; ATail(GetList):Control := _CheckBox_( <var>, <caption>, ;
|
||||
<message>, <color>, <{fblock}>, <{sblock}>, ;
|
||||
<style> ) ;
|
||||
; ATail(GetList):reader := { | a, b, c, d | ;
|
||||
GuiReader( a, b, c, d ) } ;
|
||||
[; ATail(GetList):<msg>] ;
|
||||
[; ATail(GetList):Control:<guimsg>] ;
|
||||
; ATail(GetList):Control:Display()
|
||||
#endif
|
||||
function Main
|
||||
Local lx :=.f.
|
||||
local ly :=.f.
|
||||
Local citem:="Windows NT/2000"
|
||||
Local aitems[4]
|
||||
aitems[1]:=RADIOBUTTO( 3,3,"&Windows NT/2000")
|
||||
aitems[2]:=RADIOBUTTO( 4,3,"W&indows 9x")
|
||||
aitems[3]:=RADIOBUTTO( 5,3,"&Linux")
|
||||
aitems[4]:=RADIOBUTTO( 6,3,"&Mac OS")
|
||||
|
||||
cls
|
||||
Setcolor('w/b+,w/b,w+/b,w/b+,w/b+,w/b+')
|
||||
@ 2,3 Say "Married"
|
||||
@ 2,12 Get lx CHECKBOX color 'w/b+,w/b,w+/r,w/g+'
|
||||
@ 3,3 Say "Single"
|
||||
@ 3,12 Get ly CHECKBOX color 'w/b+,w/b,w+/r,w/g+'
|
||||
read
|
||||
Setcolor('w/b+,r/b,g+/r,b+/r+,bg/n+,w/bg,rb/bg')
|
||||
@ 2,2,7,40 get citem radiogroup aitems color 'w/b+,r/b,g/b+' MESSAGE "Select Your Os"
|
||||
@ 8,3 Say "Married"
|
||||
@ 8,12 Get lx CHECKBOX color 'w/b+,w/b,w+/r,w/g+' MESSAGE "Is You Married?"
|
||||
@ 9,3 Say "Singer"
|
||||
@ 9,12 Get ly CHECKBOX color 'w/b+,w/b,w+/r,w/g+' MESSAGE "Are You a Singer"
|
||||
read MSG AT maxrow(), 0, maxcol() MSG Color "w/b+"
|
||||
? "Is the Person Married",if(lx," Yes ", " No ")
|
||||
? "Is the Person Single",if(ly," Yes ", " No ")
|
||||
? "Is the Person a Singer",if(ly," Yes ", " No ")
|
||||
? "Your Os is ",cItem
|
||||
return Nil
|
||||
|
||||
@@ -6,7 +6,7 @@
|
||||
* Harbour Project source code:
|
||||
* HBDOC document Extractor
|
||||
*
|
||||
* Copyright 2000 Luiz Rafael Culik <culik@sl.conex.net>
|
||||
* Copyright 1999-2001 Luiz Rafael Culik <culik@sl.conex.net>
|
||||
* www - http://www.harbour-project.org
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
@@ -245,7 +245,7 @@ FUNCTION MAIN( cFlags, cLinkName, cAtFile )
|
||||
|
||||
IF cLinkName = NIL
|
||||
?? "Harbour Doc Extractor"
|
||||
? "Copyright 1999-2000, http://www.harbour-project.org"
|
||||
? "Copyright 1999-2001, http://www.harbour-project.org"
|
||||
? ""
|
||||
? "Syntax: hbdoc [options] <linkname> [<ifile>]"
|
||||
? ""
|
||||
|
||||
@@ -375,7 +375,7 @@ While !leof
|
||||
|
||||
aTemp := listasArray2( Alltrim( cTemp ), "=" )
|
||||
If lmacrosec
|
||||
If Alltrim( Left( ctemp, 7 ) ) <> '!ifndef' .and. Alltrim( Left( ctemp, 6 ) ) <> "!endif" .and. Alltrim( Left( ctemp, 7 ) ) <> '!iffile'
|
||||
If Alltrim( Left( ctemp, 7 ) ) <> '!ifndef' .and. Alltrim( Left( ctemp, 6 ) ) <> "!endif" .and. Alltrim( Left( ctemp, 7 ) ) <> '!iffile' .and. Alltrim( Left( ctemp, 7 ) ) <> '!stdout' .and. Alltrim( Left( ctemp, 6 ) ) <> '!ifdef'
|
||||
|
||||
If Len( atemp ) > 1
|
||||
If At( "$", atemp[ 2 ] ) > 0
|
||||
@@ -429,10 +429,16 @@ While !leof
|
||||
|
||||
Else
|
||||
// cTemp1:=TRIM( SUBSTR( ReadLN( @lEof ),1 ) )
|
||||
|
||||
|
||||
if at('!ifndef',cTemp)>0
|
||||
checkDefine( cTemp )
|
||||
checkDefine( cTemp )
|
||||
elseif at('!ifdef',ctemp)>0
|
||||
CheckifDef(cTemp)
|
||||
elseif at('!iffile',cTemp)>0
|
||||
checkiffile(cTemp)
|
||||
elseif at('!stdout',cTemp)>0
|
||||
checkstdout(cTemp)
|
||||
endif
|
||||
// endif
|
||||
Endif
|
||||
@@ -2134,3 +2140,58 @@ if nPos>0
|
||||
endif
|
||||
endif
|
||||
return ctemp
|
||||
function checkstdout(cText)
|
||||
cText:=strtran(cText,"!stdout","")
|
||||
outstd(cText)
|
||||
return nil
|
||||
function CheckifDef(cTemp)
|
||||
Local cDef
|
||||
Local nPos
|
||||
Local cRead:=""
|
||||
Local aSet := {}
|
||||
Local nMakePos
|
||||
Local cTemp1:=''
|
||||
If cTemp == "!endif"
|
||||
Return nil
|
||||
Endif
|
||||
|
||||
While at("!endif",cRead)==0
|
||||
cRead := Trim( Substr( ReadLN( @lEof ), 1 ) )
|
||||
if at("!endif",cRead)>0
|
||||
FT_FSKIP(-1)
|
||||
exit
|
||||
endif
|
||||
|
||||
cTemp := Strtran( cTemp, "!ifdef ", "" )
|
||||
if at('=',cRead)>0
|
||||
aSet := listasarray2( cRead, "=" )
|
||||
nPos := Ascan( adefines, { | x, y | x[ 1 ] == cTemp } )
|
||||
|
||||
If nPos > 0
|
||||
cRead := Alltrim( Strtran( aset[ 1 ], "$(", "" ) )
|
||||
cRead := Strtran( cRead, ")\..", "" )
|
||||
nMakePos := Ascan( amaCros, { | x, y | x[ 1 ] == cRead } )
|
||||
If nMakePos == 0
|
||||
Aadd( amacros, { aset[ 1 ], aset[ 2 ] } )
|
||||
Endif
|
||||
ELSE /* Locate For !Else */
|
||||
While at("!endif",cRead)==0
|
||||
cRead := Trim( Substr( ReadLN( @lEof ), 1 ) )
|
||||
if at("!else",cRead)>0
|
||||
While at("!endif",cRead)==0
|
||||
cRead := Trim( Substr( ReadLN( @lEof ), 1 ) )
|
||||
if at("!endif",cRead)>0
|
||||
FT_FSKIP(-1)
|
||||
exit
|
||||
endif
|
||||
aSet := listasarray2( cRead, "=" )
|
||||
Aadd( amacros, { aset[ 1 ], aset[ 2 ] } )
|
||||
enddo
|
||||
endif
|
||||
Enddo
|
||||
Endif
|
||||
Elseif at('!stdout',cRead)>0
|
||||
checkstdout(cRead)
|
||||
Endif
|
||||
enddo
|
||||
Return nil
|
||||
|
||||
Reference in New Issue
Block a user