romfast/comun
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
5f944e8bfa48fb51d665f1608343fa7cf932b641
comun/clase/locale.vc2

4078 lines
149 KiB
Plaintext
Raw Blame History

*--------------------------------------------------------------------------------------------------------------------------------------------------------
* (EN) AUTOGENERATED - ATTENTION!! - NOT INTENDED FOR EXECUTION!! USE ONLY FOR MERGING CHANGES AND STORING WITH SCM TOOLS!!
*--------------------------------------------------------------------------------------------------------------------------------------------------------
*< FOXBIN2PRG: Version="1.21" SourceFile="locale.vcx" CPID="1252" /> (Solo para binarios VFP 9 / Only for VFP 9 binaries)
*
*
DEFINE CLASS admin AS form
*< CLASSDATA: Baseclass="form" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="pf" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.cboSrc" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.Label1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.Label2" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.Line1" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.cboDst" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.Label3" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.Label4" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.edtSrc" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.edtDst" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.lstPhrase" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.Label5" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.cmdUpdateAll" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.txtNotes" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgPhrase.lblNotes" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.lstSites" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.txtName" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.lblName" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.txtUrl" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.lblUrl" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.edtMarkers" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.lblMarkers" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.txtNotes" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.lblNotes" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.edtPage" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.lblPage" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.txtTimeout" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.lblTimeout" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.txtAttempt" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.lblAttempt" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.txtExclude" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.lblExclude" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.txtHits" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.lblHits" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.txtDuration" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.lblDuration" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.cmdSave" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="pf.pgSite.cmdLang" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cmdClose" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*m: getphrases
*p: olocale
*</DefinedPropArrayMethod>
*<PropValue>
AlwaysOnTop = .T.
AutoCenter = .T.
BorderStyle = 2
Caption = "Locale Administration"
DataSession = 2
DoCreate = .T.
Height = 400
MaxButton = .F.
MinButton = .F.
Name = "admin"
Width = 500
WindowType = 1
*</PropValue>
ADD OBJECT 'cmdClose' AS commandbutton WITH ;
Cancel = .T., ;
Caption = "\<Close", ;
Default = .T., ;
Height = 27, ;
Left = 408, ;
Name = "cmdClose", ;
TabIndex = 1, ;
Top = 366, ;
Width = 84
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'pf' AS pageframe WITH ;
ErasePage = .T., ;
Height = 360, ;
Left = 0, ;
Name = "pf", ;
PageCount = 2, ;
TabIndex = 2, ;
Top = 0, ;
Width = 502, ;
Page1.Caption = "Phrases", ;
Page1.Name = "pgPhrase", ;
Page2.Caption = "Sites & Languages", ;
Page2.Name = "pgSite"
*< END OBJECT: BaseClass="pageframe" />
ADD OBJECT 'pf.pgPhrase.cboDst' AS combobox WITH ;
Height = 24, ;
Left = 324, ;
Name = "cboDst", ;
TabIndex = 4, ;
Top = 165, ;
Width = 160
*< END OBJECT: BaseClass="combobox" />
ADD OBJECT 'pf.pgPhrase.cboSrc' AS combobox WITH ;
Height = 24, ;
Left = 324, ;
Name = "cboSrc", ;
TabIndex = 8, ;
Top = 8, ;
Width = 160
*< END OBJECT: BaseClass="combobox" />
ADD OBJECT 'pf.pgPhrase.cmdUpdateAll' AS commandbutton WITH ;
Caption = "\<Retranslate All Phrases for All Languages", ;
Height = 27, ;
Left = 12, ;
Name = "cmdUpdateAll", ;
TabIndex = 7, ;
Top = 294, ;
Width = 472
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'pf.pgPhrase.edtDst' AS editbox WITH ;
Height = 54, ;
Left = 11, ;
Name = "edtDst", ;
TabIndex = 5, ;
Top = 206, ;
Width = 473
*< END OBJECT: BaseClass="editbox" />
ADD OBJECT 'pf.pgPhrase.edtSrc' AS editbox WITH ;
DisabledBackColor = 235,235,235, ;
Height = 109, ;
Left = 170, ;
Name = "edtSrc", ;
ReadOnly = .T., ;
TabIndex = 2, ;
Top = 44, ;
Width = 314
*< END OBJECT: BaseClass="editbox" />
ADD OBJECT 'pf.pgPhrase.Label1' AS label WITH ;
Alignment = 1, ;
BackStyle = 0, ;
Caption = "Source Language:", ;
Height = 17, ;
Left = 11, ;
Name = "Label1", ;
TabIndex = 9, ;
Top = 11, ;
Width = 308
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgPhrase.Label2' AS label WITH ;
BackStyle = 0, ;
Caption = "Phrase", ;
Height = 17, ;
Left = 167, ;
Name = "Label2", ;
TabIndex = 10, ;
Top = 29, ;
Width = 192
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgPhrase.Label3' AS label WITH ;
Alignment = 1, ;
BackStyle = 0, ;
Caption = "Destination Language:", ;
Height = 17, ;
Left = 95, ;
Name = "Label3", ;
TabIndex = 12, ;
Top = 168, ;
Width = 224
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgPhrase.Label4' AS label WITH ;
BackStyle = 0, ;
Caption = "Phrase", ;
Height = 17, ;
Left = 11, ;
Name = "Label4", ;
TabIndex = 13, ;
Top = 191, ;
Width = 192
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgPhrase.Label5' AS label WITH ;
BackStyle = 0, ;
Caption = "Phrases", ;
Height = 17, ;
Left = 11, ;
Name = "Label5", ;
TabIndex = 14, ;
Top = 29, ;
Width = 144
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgPhrase.lblNotes' AS label WITH ;
Alignment = 1, ;
BackStyle = 0, ;
Caption = "Notes", ;
Height = 17, ;
Left = 11, ;
Name = "lblNotes", ;
TabIndex = 11, ;
Top = 262, ;
Width = 82, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgPhrase.Line1' AS line WITH ;
Height = 0, ;
Left = 11, ;
Name = "Line1", ;
Top = 160, ;
Width = 473
*< END OBJECT: BaseClass="line" />
ADD OBJECT 'pf.pgPhrase.lstPhrase' AS listbox WITH ;
Height = 109, ;
Left = 11, ;
Name = "lstPhrase", ;
TabIndex = 1, ;
Top = 44, ;
Width = 153
*< END OBJECT: BaseClass="listbox" />
ADD OBJECT 'pf.pgPhrase.txtNotes' AS textbox WITH ;
Height = 23, ;
Left = 95, ;
Name = "txtNotes", ;
TabIndex = 6, ;
Top = 260, ;
Width = 389
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'pf.pgSite.cmdLang' AS commandbutton WITH ;
Caption = "\<Languages", ;
Height = 27, ;
Left = 275, ;
Name = "cmdLang", ;
TabIndex = 12, ;
Top = 296, ;
Width = 120
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'pf.pgSite.cmdSave' AS commandbutton WITH ;
Caption = "\<Save", ;
Enabled = .F., ;
Height = 27, ;
Left = 407, ;
Name = "cmdSave", ;
TabIndex = 13, ;
Top = 296, ;
Width = 84
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'pf.pgSite.edtMarkers' AS editbox WITH ;
Height = 108, ;
Left = 83, ;
Name = "edtMarkers", ;
TabIndex = 6, ;
Top = 176, ;
Width = 156
*< END OBJECT: BaseClass="editbox" />
ADD OBJECT 'pf.pgSite.edtPage' AS editbox WITH ;
Height = 75, ;
Left = 83, ;
Name = "edtPage", ;
TabIndex = 5, ;
Top = 92, ;
Width = 408
*< END OBJECT: BaseClass="editbox" />
ADD OBJECT 'pf.pgSite.lblAttempt' AS label WITH ;
Alignment = 1, ;
AutoSize = .F., ;
BackStyle = 0, ;
Caption = "Attempt", ;
Left = 257, ;
Name = "lblAttempt", ;
TabIndex = 20, ;
Top = 204, ;
Width = 75, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgSite.lblDuration' AS label WITH ;
Alignment = 1, ;
AutoSize = .F., ;
BackStyle = 0, ;
Caption = "Duration", ;
Left = 381, ;
Name = "lblDuration", ;
TabIndex = 23, ;
Top = 204, ;
Width = 68, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgSite.lblExclude' AS label WITH ;
Alignment = 1, ;
AutoSize = .F., ;
BackStyle = 0, ;
Caption = "Exclude", ;
Left = 257, ;
Name = "lblExclude", ;
TabIndex = 21, ;
Top = 228, ;
Width = 75, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgSite.lblHits' AS label WITH ;
Alignment = 1, ;
AutoSize = .F., ;
BackStyle = 0, ;
Caption = "Hits", ;
Left = 381, ;
Name = "lblHits", ;
TabIndex = 22, ;
Top = 180, ;
Width = 68, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgSite.lblMarkers' AS label WITH ;
Alignment = 1, ;
AutoSize = .F., ;
BackStyle = 0, ;
Caption = "Markers", ;
Left = 5, ;
Name = "lblMarkers", ;
TabIndex = 16, ;
Top = 176, ;
Width = 75, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgSite.lblName' AS label WITH ;
Alignment = 1, ;
BackStyle = 0, ;
Caption = "Name", ;
Left = 173, ;
Name = "lblName", ;
TabIndex = 14, ;
Top = 12, ;
Width = 50, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgSite.lblNotes' AS label WITH ;
Alignment = 1, ;
BackStyle = 0, ;
Caption = "Notes", ;
Left = 173, ;
Name = "lblNotes", ;
TabIndex = 17, ;
Top = 60, ;
Width = 50, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgSite.lblPage' AS label WITH ;
Alignment = 1, ;
AutoSize = .F., ;
BackStyle = 0, ;
Caption = "Page", ;
Left = 5, ;
Name = "lblPage", ;
TabIndex = 18, ;
Top = 92, ;
Width = 75, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgSite.lblTimeout' AS label WITH ;
Alignment = 1, ;
AutoSize = .F., ;
BackStyle = 0, ;
Caption = "Timeout", ;
Left = 257, ;
Name = "lblTimeout", ;
TabIndex = 19, ;
Top = 180, ;
Width = 75, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgSite.lblUrl' AS label WITH ;
Alignment = 1, ;
BackStyle = 0, ;
Caption = "Url", ;
Left = 173, ;
Name = "lblUrl", ;
TabIndex = 15, ;
Top = 36, ;
Width = 50, ;
WordWrap = .T.
*< END OBJECT: BaseClass="label" />
ADD OBJECT 'pf.pgSite.lstSites' AS listbox WITH ;
Height = 72, ;
Left = 11, ;
Name = "lstSites", ;
TabIndex = 1, ;
Top = 8, ;
Width = 156
*< END OBJECT: BaseClass="listbox" />
ADD OBJECT 'pf.pgSite.txtAttempt' AS textbox WITH ;
Height = 23, ;
Left = 335, ;
Name = "txtAttempt", ;
TabIndex = 8, ;
Top = 200, ;
Width = 39
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'pf.pgSite.txtDuration' AS textbox WITH ;
Height = 23, ;
Left = 450, ;
Name = "txtDuration", ;
TabIndex = 11, ;
Top = 200, ;
Width = 40
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'pf.pgSite.txtExclude' AS textbox WITH ;
Height = 23, ;
Left = 335, ;
Name = "txtExclude", ;
TabIndex = 9, ;
Top = 224, ;
Width = 39
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'pf.pgSite.txtHits' AS textbox WITH ;
Height = 23, ;
Left = 450, ;
Name = "txtHits", ;
TabIndex = 10, ;
Top = 176, ;
Width = 40
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'pf.pgSite.txtName' AS textbox WITH ;
Height = 23, ;
Left = 227, ;
MaxLength = 30, ;
Name = "txtName", ;
TabIndex = 2, ;
Top = 8, ;
Width = 219
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'pf.pgSite.txtNotes' AS textbox WITH ;
Height = 23, ;
Left = 227, ;
MaxLength = 250, ;
Name = "txtNotes", ;
TabIndex = 4, ;
Top = 56, ;
Width = 264
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'pf.pgSite.txtTimeout' AS textbox WITH ;
Height = 23, ;
Left = 335, ;
Name = "txtTimeout", ;
TabIndex = 7, ;
Top = 176, ;
Width = 39
*< END OBJECT: BaseClass="textbox" />
ADD OBJECT 'pf.pgSite.txtUrl' AS textbox WITH ;
Height = 23, ;
Left = 227, ;
MaxLength = 100, ;
Name = "txtUrl", ;
TabIndex = 3, ;
Top = 32, ;
Width = 264
*< END OBJECT: BaseClass="textbox" />
PROCEDURE Destroy
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.oLocale = .NULL.
ENDPROC
PROCEDURE getphrases
ENDPROC
PROCEDURE Init
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
THISFORM.oLocale.setLocale( THISFORM )
ENDPROC
PROCEDURE Load
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
DO CASE
CASE TYPE("thisform.oLocale")="O"
this.oLocale = THISFORM.oLocale
CASE TYPE("oLocale")="O"
this.oLocale = m.oLocale
CASE TYPE("_screen.oLocale")="O"
this.oLocale = _SCREEN.oLocale
OTHERWISE
THISFORM.NewObject("oLocale","Locale","Locale.vcx")
this.oLocale = THISFORM.oLocale
ENDCASE
RETURN
ENDPROC
PROCEDURE cmdClose.Click
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
RELEASE THISFORM
ENDPROC
PROCEDURE pf.pgPhrase.cboDst.Error
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS nError, cMethod, nLine
RETURN
ENDPROC
PROCEDURE pf.pgPhrase.cboDst.Init
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
THISFORM.oLocale.SQlexec( "select distinct language from locale order by 1 ","qDst", THISFORM.DataSessionId )
this.RowSourceType = 2
this.RowSource = 'qDst'
GOTO Top IN qDst
this.DisplayValue = qDst.language
ENDPROC
PROCEDURE pf.pgPhrase.cboDst.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
THISFORM.oLocale.SQlexec( "SELECT Phrase, Notes FROM locale WHERE TRIM(LANGUAGE)='"+ALLTRIM(this.VALUE) +"' AND ID="+TRANSFORM(qSrcPhrase.ID) ,"qDstPhrase", THISFORM.DataSessionId )
this.parent.edtDst.VALUE = qDstPhrase.Phrase
this.parent.txtNotes.VALUE = qDstPhrase.Notes
ENDPROC
PROCEDURE pf.pgPhrase.cboDst.ProgrammaticChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.InteractiveChange
ENDPROC
PROCEDURE pf.pgPhrase.cboSrc.Error
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS nError, cMethod, nLine
RETURN
ENDPROC
PROCEDURE pf.pgPhrase.cboSrc.Init
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
THISFORM.oLocale.SQlexec( "select distinct language from locale order by 1 ","qSrc", THISFORM.DataSessionId )
this.RowSourceType = 2
this.RowSource = 'qSrc'
GOTO Top IN qSrc
this.DisplayValue = qSrc.language
ENDPROC
PROCEDURE pf.pgPhrase.cboSrc.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
THISFORM.oLocale.SQlexec( "SELECT left(Phrase,100) AS phrase2, ID, Phrase FROM locale WHERE TRIM(LANGUAGE)='"+ALLTRIM(this.VALUE) +"' ORDER BY phrase2 ","qSrcPhrase", THISFORM.DataSessionId )
this.parent.lstPhrase.Init
ENDPROC
PROCEDURE pf.pgPhrase.cboSrc.ProgrammaticChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.InteractiveChange
ENDPROC
PROCEDURE pf.pgPhrase.cmdUpdateAll.Click
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
THISFORM.oLocale.ConvertAll( .T., .T. )
RETURN
ENDPROC
PROCEDURE pf.pgPhrase.edtDst.LostFocus
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
THISFORM.oLocale.SQlexec(" Select ID from Locale WHERE TRIM(LANGUAGE)='"+ALLTRIM(this.parent.cboDst.DisplayValue) +"' AND ID=" + TRANSFORM(qSrcPhrase.ID ), "qtemp", THISFORM.DataSessionId )
IF NOT EOF("qtemp")
THISFORM.oLocale.SQlexec(" UPDATE Locale SET Phrase='"+this.VALUE+"', Notes='"+this.parent.txtNotes.VALUE+"' WHERE TRIM(LANGUAGE)='"+ALLTRIM(this.parent.cboDst.DisplayValue) +"' AND ID=" + TRANSFORM(qSrcPhrase.ID ), , THISFORM.DataSessionId )
ELSE
THISFORM.oLocale.SQlexec(" Insert into Locale (ID,Language, Phrase,Notes) value ("+TRANSFORM(qSrcPhrase.ID)+",'"+ALLTRIM(this.parent.cboDst.DisplayValue) +"','"+this.VALUE+"','"+this.parent.txtNotes.VALUE+"')",, THISFORM.DataSessionId )
ENDIF
ENDPROC
PROCEDURE pf.pgPhrase.edtSrc.Init
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
GOTO Top IN qSrcPhrase
this.VALUE = qSrcPhrase.Phrase
ENDPROC
PROCEDURE pf.pgPhrase.Init
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.cboSrc.DisplayValue = THISFORM.oLocale.BaseLang
this.cboDst.DisplayValue = THISFORM.oLocale.Locale
this.lstPhrase.ListIndex = 1
ENDPROC
PROCEDURE pf.pgPhrase.lstPhrase.Init
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.RowSourceType = 2
this.RowSource = 'qSrcPhrase'
this.ColumnCount = 2
this.ColumnWidths = '1000,0'
this.BoundTo = .T.
this.BoundColumn = 1
ENDPROC
PROCEDURE pf.pgPhrase.lstPhrase.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.edtSrc.VALUE = qSrcPhrase.Phrase
this.parent.cboDst.InteractiveChange
ENDPROC
PROCEDURE pf.pgPhrase.lstPhrase.ProgrammaticChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.InteractiveChange
ENDPROC
PROCEDURE pf.pgPhrase.txtNotes.LostFocus
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.edtDst.LostFocus
ENDPROC
PROCEDURE pf.pgSite.Activate
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.lstSites.ListIndex = 1
this.lstSites.InteractiveChange
ENDPROC
PROCEDURE pf.pgSite.cmdLang.Click
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LOCAL dbfLang
dbfLang = SYS(3)
*--------------------------------------------
* get copy of language for this site.
*--------------------------------------------
THISFORM.oLocale.SQlexec( "Select * from Locale_Lang where Locale_lang.SiteID="+TRANSFORM(q_Sites.ID)+" order by name asc", "qLang1", THISFORM.DataSessionId )
SELECT qLang1
COPY TO (dbfLang)
USE (dbfLang) ALIAS qLang IN (SELECT("qLang"))
*--------------------------------------------
* Open Browse window to modify
*--------------------------------------------
BROWSE Fields Name:20:H=oLocale.GetString("Name"), ;
Abbr:10:H=oLocale.GetString("Abbreviation"), ;
CP:10:H=oLocale.GetString("Code Page"), ;
Rule1:H=oLocale.GetString("Rule 1"), ;
Rule2:H=oLocale.GetString("Rule 2"), ;
Exclude:H=oLocale.GetString("Exclude") ;
TITLE oLocale.GetString("Locale - Languages for selected site.")
*--------------------------------------------
* Update original table.
*--------------------------------------------
SELECT qLang
SCAN all
THISFORM.oLocale.SQlexec( "Update Locale_Lang "+;
"set Name='"+ALLTRIM(TRANSFORM(qLang.Name))+"',"+;
"Abbr='"+ALLTRIM(TRANSFORM(qLang.Abbr))+"',"+;
"CP="+ALLTRIM(TRANSFORM(qLang.CP))+","+;
"Rule1='"+ALLTRIM(TRANSFORM(qLang.Rule1))+"',"+;
"Rule2='"+ALLTRIM(TRANSFORM(qLang.Rule2))+"',"+;
"Exclude="+alltrim(TRANSFORM(qLang.Exclude))+" "+;
"where Id="+TRANSFORM(qLang.ID),, THISFORM.DataSessionId )
ENDSCAN
*--------------------------------------------
* Close temporarty table, and erase
*--------------------------------------------
USE IN qLang
ERASE (dbfLang)
RETURN
ENDPROC
PROCEDURE pf.pgSite.cmdSave.Click
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
THISFORM.oLocale.SQlexec("Update Locale_Source Set "+;
"Name='"+TRANSFORM(this.parent.txtName.VALUE)+"',"+;
"url='"+TRANSFORM(this.parent.txturl.VALUE)+"',"+;
"Markers='"+TRANSFORM(this.parent.edtMarkers.VALUE)+"',"+;
"Page='"+TRANSFORM(this.parent.edtPage.VALUE)+"',"+;
"Notes='"+TRANSFORM(this.parent.txtNotes.VALUE)+"',"+;
"Timeout="+TRANSFORM(this.parent.txtTImeout.VALUE)+","+;
"Attempt="+TRANSFORM(this.parent.txtAttempt.VALUE)+","+;
"Exclude="+TRANSFORM(this.parent.txtExclude.VALUE)+","+;
"Hits="+TRANSFORM(this.parent.txtHits.VALUE)+","+;
"Duration="+TRANSFORM(this.parent.txtDuration.VALUE)+" "+;
"where ID="+TRANSFORM(q_Sites.ID),, THISFORM.DataSessionId )
this.parent.cmdSave.Enabled = .F.
RETURN
ENDPROC
PROCEDURE pf.pgSite.edtMarkers.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.cmdSave.Enabled = .T.
ENDPROC
PROCEDURE pf.pgSite.edtPage.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.cmdSave.Enabled = .T.
ENDPROC
PROCEDURE pf.pgSite.lstSites.Init
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
THISFORM.oLocale.SQlexec( "Select Name, id from Locale_Source order by Name","q_Sites", THISFORM.DataSessionId )
this.RowSourceType = 2
this.RowSource = 'q_Sites'
this.ColumnCount = 2
this.ColumnWidths = '1000,0'
this.BoundTo = .T.
this.BoundColumn = 1
ENDPROC
PROCEDURE pf.pgSite.lstSites.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/19/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
THISFORM.oLocale.SQlexec( "Select * from Locale_Source where ID="+TRANSFORM(q_Sites.ID), "q_Sites2", THISFORM.DataSessionId )
this.parent.txtName.VALUE = q_sites2.Name
this.parent.txturl.VALUE = q_sites2.url
this.parent.edtMarkers.VALUE = q_sites2.Markers
this.parent.edtPage.VALUE = q_sites2.Page
this.parent.txtNotes.VALUE = q_sites2.Notes
this.parent.txtTImeout.VALUE = q_sites2.Timeout
this.parent.txtAttempt.VALUE = q_sites2.Attempt
this.parent.txtExclude.VALUE = q_sites2.Exclude
this.parent.txtHits.VALUE = q_sites2.Hits
this.parent.txtDuration.VALUE = q_sites2.Duration
ENDPROC
PROCEDURE pf.pgSite.txtAttempt.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.cmdSave.Enabled = .T.
ENDPROC
PROCEDURE pf.pgSite.txtDuration.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.cmdSave.Enabled = .T.
ENDPROC
PROCEDURE pf.pgSite.txtExclude.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.cmdSave.Enabled = .T.
ENDPROC
PROCEDURE pf.pgSite.txtHits.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.cmdSave.Enabled = .T.
ENDPROC
PROCEDURE pf.pgSite.txtName.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.cmdSave.Enabled = .T.
ENDPROC
PROCEDURE pf.pgSite.txtNotes.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.cmdSave.Enabled = .T.
ENDPROC
PROCEDURE pf.pgSite.txtTimeout.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.cmdSave.Enabled = .T.
ENDPROC
PROCEDURE pf.pgSite.txtUrl.InteractiveChange
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
this.parent.cmdSave.Enabled = .T.
ENDPROC
ENDDEFINE
DEFINE CLASS display AS container && Allow for interactive changing of Locale
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*-- OBJECTDATA items order determines ZOrder / El orden de los items OBJECTDATA determina el ZOrder
*< OBJECTDATA: ObjPath="cmdUpdate" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="cboLocale" UniqueID="" Timestamp="" />
*< OBJECTDATA: ObjPath="Label2" UniqueID="" Timestamp="" />
*<DefinedPropArrayMethod>
*p: cthisform && Override the references to public oLocale
*p: olocale
*</DefinedPropArrayMethod>
*<PropValue>
BackStyle = 0
BorderWidth = 0
cthisform =
Height = 24
Name = "display"
olocale = .NULL.
Width = 395
*</PropValue>
ADD OBJECT 'cboLocale' AS combobox WITH ;
Height = 24, ;
Left = 156, ;
Name = "cboLocale", ;
RowSource = "SELECT DISTINCT name from locale_lang ORDER BY name where not exclude into CURSOR qLang", ;
RowSourceType = 3, ;
StatusBarText = "Change languages for this form", ;
Style = 2, ;
ToolTipText = "Change languages for this form", ;
Top = 0, ;
Width = 100, ;
ZOrderSet = 28
*< END OBJECT: BaseClass="combobox" />
ADD OBJECT 'cmdUpdate' AS commandbutton WITH ;
Caption = "Locale Options", ;
Height = 22, ;
Left = 264, ;
Name = "cmdUpdate", ;
StatusBarText = "Manage the languages and translated phrases.", ;
ToolTipText = "Regenerate all captions and tips", ;
Top = 1, ;
Width = 130
*< END OBJECT: BaseClass="commandbutton" />
ADD OBJECT 'Label2' AS label WITH ;
Alignment = 1, ;
BackStyle = 0, ;
Caption = "Language:", ;
Height = 17, ;
Left = 0, ;
Name = "Label2", ;
ToolTipText = "Change language to change captions to that language.", ;
Top = 5, ;
Width = 153, ;
ZOrderSet = 29
*< END OBJECT: BaseClass="label" />
PROCEDURE Destroy
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/16/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
USE IN (SELECT("qLang"))
this.oLocale = .NULL.
ENDPROC
PROCEDURE Init
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/16/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
DO CASE
*%% Gregory L Reichert 06/12/2004 DISPLAY.INIT : 600 : Added as a suggestion from Bhavbhuti
case (NOT EMPTY("THIS.cThisform")) AND TYPE(THIS.cThisform + ".oLocale")="O"
this.oLocale = evaluate( THIS.cThisNewProperty + ".oLocale" )
CASE TYPE("thisform.oLocale")="O"
this.oLocale = THISFORM.oLocale
CASE TYPE("m.oLocale")="O"
this.oLocale = m.oLocale
CASE TYPE("_screen.oLocale")="O"
this.oLocale = _SCREEN.oLocale
OTHERWISE
THISFORM.NewObject("oLocale","Locale","Locale.vcx")
this.oLocale = THISFORM.oLocale
ENDCASE
this.cboLocale.ControlSource = "this.parent.oLocale.Locale"
this.cboLocale.BoundTo = .T.
RETURN
ENDPROC
PROCEDURE cmdUpdate.Click
*------------------------------------------------------------
* Description: Open the Administration Form
* Parameters: n/a
* Return: n/a
* Use: n/a
*------------------------------------------------------------
* Id Date By Description
* 1 08/14/2003 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LOCAL oAdmin
oAdmin=NewObject("Admin","Locale.vcx")
oAdmin.Show
*--------------------------------------------
* upon return, bring the form forward
*--------------------------------------------
LOCAL aot
aot = THISFORM.AlwaysOnTop
THISFORM.AlwaysOnTop =.T.
THISFORM.AlwaysOnTop = aot
this.SetFocus
*--------------------------------------------
* re-establish the translated phrases
*--------------------------------------------
this.parent.oLocale.Locale = this.parent.oLocale.Locale
RETURN
ENDPROC
ENDDEFINE
DEFINE CLASS locale AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: arraylookup && Search the aLocale array for a phrase
*m: callsite && Call a site and retreives the translated text
*m: captioncount && Count all possible text that can be trnaslated
*m: closepopup && Closes popup internet window. This sometimes occurs with access Dictionary.com
*m: convertall && Convert all Base phrases to all Languages
*m: dolabel && Translates and runs a Label
*m: doreport && Translated and runs a report,
*m: getstring && Translate a string from the BaseLang to a specific language
*m: getwindows
*m: loadarray && Loads the internal array with the current language translations.
*m: locale_assign
*m: ping && Test to see if Internet is available.
*m: registry && Get and Put to the Registry
*m: setlocale && Translates a object and child objects.
*m: setmenu && Runs and translates captions on menu.
*m: setup
*m: sqlexec && Executes SQL statement either locally or remotely.
*m: translate && Translate a phrase to a different language
*m: translate_property && Translates a single property of an object
*m: unescape && Remove HTML conversions
*p: baselang && Base source locale
*p: debug && If true, display debug information while translating.
*p: disable_images && Disables the images on the page. They are not downloaded for speed.
*p: fromregistry && if True, the current locale is store and retreived from the Registry. HKEY_CURRENT_USER\Software\Locale\Locale
*p: lastphrase && Last phrase translated, if the next phrase is the same, then LastTrasnlation is return instead of quering the Internet.
*p: lasttranslation && Last translated phrase
*p: lclosepopup && If true, any popup browser window that opens while translating is closed.
*p: llocale
*p: llsucces
*p: locale && Current Locale
*p: ltranslateactiveform
*p: nallsitesattempt && The number a times any single site is queried before giving up and moving to the next site.
*p: ncount && Number of words translated during this session.
*p: notranslation_attempt && If true, none of the site tested could produce a translation.
*p: online && if true, the internet is accessable.
*p: property_list && List of properties that need to be translated.
*p: quite && Pervents the WAIT window during translation.
*p: resetsites && Reset all sites to give each a equal change at trtanslating.
*p: searchinternet
*p: sqlconnect && SQL Connection Handle. default -1
*p: sqlconnectionstring && Valid SQL Connection String. If blank, SQL statement are called as VFP.
*p: translate_color && The color the text assumes will translation is occuring. If -1, color does not change.
*p: usedchar && Used to Hot Key buttons.
*p: version && Class Vesion Number
*a: alocale[1,2] && Collection of language translations
*a: amenu[1,3]
*a: awindows[1,2] && List of openned OS Windows.
*</DefinedPropArrayMethod>
HIDDEN ActiveControl,AddObject,AddProperty,BackColor,BackStyle,BorderColor,BorderWidth,Click,CloneObject,ColorSource,ControlCount,Controls,DblClick,Destroy,DragDrop,DragIcon,DragMode,DragOver,Drag,Draw,ForeColor,GotFocus,Height,HelpContextID,LostFocus,MiddleClick,MouseDown,MouseEnter,MouseIcon,MouseLeave,MouseMove,MousePointer,MouseUp,MouseWheel,Moved,Move,NewObject,Objects,OLECompleteDrag,OLEDragDrop,OLEDragMode,OLEDragOver,OLEDragPicture,OLEDrag,OLEDropEffects,OLEDropHasData,OLEDropMode,OLEGiveFeedback,OLESetData,OLEStartDrag,Picture,ReadExpression,ReadMethod,Refresh,RemoveObject,ResetToDefault,Resize,RightClick,SaveAsClass,SetAll,SetFocus,ShowWhatsThis,SpecialEffect,StatusBarText,Style,TabIndex,TabStop,Tag,ToolTipText,UIEnable,Visible,WhatsThisHelpID,Width,WriteExpression,WriteMethod,ZOrder
PROTECTED alocale,amenu,awindows,lastphrase,lasttranslation,Name,ncount,sqlconnect,usedchar,version
*<PropValue>
BackStyle = 0
baselang = Romana
BorderColor = 255,0,255
Comment = "8/18/2003"
debug = .F.
disable_images = .F.
Enabled = .T.
fromregistry = .T.
Height = 20
lastphrase =
lasttranslation =
lclosepopup = .T.
llocale = .F.
llsucces = .F.
locale = English
ltranslateactiveform = .F.
nallsitesattempt = 1
Name = "locale"
ncount = 0
notranslation_attempt = .F.
online = .NULL.
property_list = Caption,ToolTipText,StatusBarText
quite = .F.
resetsites = .F.
searchinternet = .F.
sqlconnect = -1
sqlconnectionstring =
TabStop = .F.
translate_color = (rgb(255,0,0))
usedchar = ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
version = 1.50.00299
Width = 20
*</PropValue>
PROTECTED PROCEDURE arraylookup && Search the aLocale array for a phrase
*------------------------------------------------------------
* Description: Locate phrase in translated array.
* Parameters:
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/28/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS tcPhrase, tnColumn
LOCAL x, i
*--------------------------------------------
* if array is empty, attempt to load it.
*--------------------------------------------
IF EMPTY(THIS.aLocale[1,1])
THIS.LoadArray()
ENDIF
*--------------------------------------------
* Lookup phrase
*--------------------------------------------
#IF VERSION(5)>=700
x = ASCAN(THIS.aLocale,tcPhrase,1,ALEN(THIS.aLocale,1),tnColumn,1+2+4+8)
#ELSE
x = 0
FOR i=1 TO ALEN(THIS.aLocale,1)
IF tcPhrase==THIS.aLocale[i,tnColumn]
x=i
EXIT
ENDIF
NEXT
#ENDIF
RETURN x
ENDPROC
PROCEDURE callsite && Call a site and retreives the translated text
*------------------------------------------------------------
* Description: Generatces and calles Googles translate page.
* Parameters: tcPhrase, req, Def=, Phrase to be translated.
* Return: String: Translated phrase, or original if not able to translated.
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 08/18/2003 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS tcPhrase
*--------------------------------------------
* if object diabled, return original phrase
*--------------------------------------------
IF THIS.ENABLED= .F.
RETURN tcStr
ENDIF
*--------------------------------------------
* if not online, do nothing (suggested by: Bhavbhuti Nathwani )
*--------------------------------------------
IF ISNULL(this.online)
*------------------------------------------------------------
* Is the internet accessable?
*------------------------------------------------------------
THIS.online = THIS.ping("http://www.google.com")
MESSAGEBOX(TRANSFORM(this.online))
ENDIF
IF NOT THIS.online
RETURN tcPhrase
ENDIF
*--------------------------------------------
* get the Source and Destination language abbreveations.
*--------------------------------------------
#DEFINE READYSTATE_UNINITIALIZED 0
#DEFINE READYSTATE_LOADING 1
#DEFINE READYSTATE_LOADED 2
#DEFINE READYSTATE_INTERACTIVE 3
#DEFINE READYSTATE_COMPLETE 4
LOCAL lcSafety
lcSafety = SET("Safety")
SET SAFETY OFF
*--------------------------------------------
* Get the sites and info for source and destination languages.
*--------------------------------------------
THIS.SQlexec( "SELECT "+ ;
"Locale_source.NAME AS sitename, "+ ;
"Locale_source.PAGE, "+ ;
"sLanguages.abbr AS src_abbr, "+ ;
"dLanguages.abbr AS dst_abbr, "+ ;
"sLanguages.rule1 AS src_rule, "+ ;
"dLanguages.rule2 AS dst_rule, "+ ;
"sLanguages.NAME AS src_Name, "+ ;
"dLanguages.NAME AS dst_name, "+ ;
"Locale_source.TIMEOUT, "+ ;
"Locale_Source.Attempt, "+ ;
"Locale_source.Markers, "+ ;
"Locale_source.ID, "+ ;
"Locale_source.duration/Locale_source.Hits AS Weight "+ ;
"FROM locale_xref "+ ;
"INNER JOIN Locale_source ON locale_xref.siteid = Locale_source.ID "+ ;
"INNER JOIN Locale_Lang dLanguages ON dLanguages.ID = locale_xref.dst_langid "+ ;
"INNER JOIN Locale_Lang sLanguages ON sLanguages.ID = locale_xref.src_langid "+ ;
"WHERE TRIM(sLanguages.NAME) = '"+ THIS.BaseLang +"' "+ ;
"AND TRIM(dLanguages.NAME) = '"+ THIS.Locale +"' "+ ;
"AND Locale_source.exclude=0 "+ ;
"", "qSites2" )
SELECT * FROM qSites2 ORDER BY Weight ASC INTO CURSOR qSites NOFILTER
USE IN qSites2
LOCAL cHTML, Abbr
LOCAL slang, dlang
LOCAL lnTimeOut, lnAttempt, lcMarkers, lcMark, lcTmplName
LOCAL x,Y, F, ia
LOCAL lntsec, st
LOCAL cResult, lcRetValue
cResult=""
lcRetValue = tcPhrase
IF TYPE("_VFP.HWND")="N"
THIS.GetWindows()
ENDIF
DECLARE Sleep IN kernel32 INTEGER millisec
IF NOT THIS.quite
*--------------------------------------------
* Display progress
*--------------------------------------------
#DEFINE kkMeterString "....:....|....:....|"
WAIT WINDOW NOWAIT NOCLEAR "Translating to "+THIS.Locale+CHR(13)+CHR(10);
+"Words:"+LEFT(kkMeterString,(THIS.ncount%LEN(kkMeterString))+1)+CHR(13)+CHR(10);
+"Sites:"+LEFT(kkMeterString,(RECNO("qSites")%LEN(kkMeterString))+1)
ENDIF
SELECT qSites
THIS.notranslation_attempt = EOF("qSites")
IF NOT EOF("qSites")
lcRetValue = ""
*--------------------------------------------
* Walk through each site that have the language
*--------------------------------------------
SCAN ALL FOR NOT EOF("qSites")
IF NOT THIS.quite
#DEFINE kkMeterString "....:....|....:....|"
WAIT WINDOW NOWAIT NOCLEAR "Translating to "+THIS.Locale+CHR(13)+CHR(10);
+"Words:"+LEFT(kkMeterString,(THIS.ncount%LEN(kkMeterString))+1)+CHR(13)+CHR(10);
+"Sites:"+LEFT(kkMeterString,(RECNO("qSites")%LEN(kkMeterString))+1)
ENDIF
IF THIS.DEBUG
ACTIVATE SCREEN
? qSites.sitename,TRANSFORM(qSites.Weight),tcPhrase," ===> "
ENDIF
IF THIS.DEBUG
lcTmplName = FULLPATH("Locale_"+ALLTRIM(qSites.sitename)+".htm")
ELSE
lcTmplName = FULLPATH("translate.htm")
ENDIF
*--------------------------------------------
* Create HTML page
*--------------------------------------------
tcPhrase = ALLTRIM(tcPhrase)
cHTML = ALLTRIM(qSites.PAGE)
cHTML = STRTRAN(cHTML, "@phrase@", tcPhrase )
m.Abbr = ALLTRIM(qSites.src_abbr)
m.Abbr = IIF(EMPTY(ALLTRIM(qSites.src_rule)),m.Abbr,EVALUATE(STRTRAN(ALLTRIM(qSites.src_rule),"@","m.abbr")))
cHTML = STRTRAN(cHTML, "@src_lang@", m.Abbr )
m.Abbr = ALLTRIM(qSites.dst_abbr)
m.Abbr = IIF(EMPTY(ALLTRIM(qSites.dst_rule)),m.Abbr,EVALUATE(STRTRAN(ALLTRIM(qSites.dst_rule),"@","m.abbr")))
cHTML = STRTRAN(cHTML, "@dst_lang@", m.Abbr)
*--------------------------------------------
* write HTML page
*--------------------------------------------
DO WHILE .T.
*- Gregory L Reichert 01/30/2004 07:24:25 LOCALE.CALLSITE : (3) : backward compatibility - changed parameter 0 to .F.
F = STRTOFILE(cHTML,lcTmplName,.F.)
DO CASE
CASE F # LENC(cHTML)
LOOP
CASE FILETOSTR(lcTmplName) # cHTML
LOOP
OTHERWISE
EXIT
ENDCASE
ENDDO
*--------------------------------------------
* Get parsing markers
*--------------------------------------------
m.slang = ALLTRIM(qSites.src_Name)
m.dlang = ALLTRIM(qSites.dst_name)
m.lcMarkers = ALLTRIM(qSites.Markers)
LOCAL ARRAY amarkers[ MEMLINES(lcMarkers) ]
Y=0
FOR x=1 TO MEMLINES(lcMarkers)
lcMark = MLINE(lcMarkers,x)
IF NOT EMPTY(lcMark)
Y=Y+1
lcMark = STRTRAN(lcMark,"@slang@",m.slang)
lcMark = STRTRAN(lcMark,"@dlang@",m.dlang)
*- Gregory L Reichert 02/26/2004 07:49:57 LOCALE.CALLSITE : (1) : IE has a bad tendency of reformatting html pages from that of the original. Strip quote marks.
amarkers[y] = CHRTRANC(lcMark,["'],[])
ENDIF
NEXT
*--------------------------------------------
* Save original values, and turn off images adn sound.
*--------------------------------------------
IF THIS.disable_images
LOCAL ARRAY aKeyVal[4,3]
aKeyVal[1,1]="Play_Animations"
aKeyVal[2,1]="Play_Background_Sounds"
aKeyVal[3,1]="Display Inline Videos"
aKeyVal[4,1]="Display Inline Images"
FOR ia=1 TO ALEN(aKeyVal,1)
aKeyVal[ia,3]= THIS.Registry( "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\Main\"+aKeyVal[ia,1] )
THIS.Registry( "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\Main\"+aKeyVal[ia,1] ,"no" )
ENDFOR
ENDIF
*--------------------------------------------
* Execute the HTML page
*--------------------------------------------
*- Gregory L Reichert 02/11/2004 07:03:00 LOCALE.CALLSITE : (1) : use IE directly.
LOCAL loIE
loIE=CREATEOBJECT('internetexplorer.application')
loIE.Silent = .t. && no dialogs
m.lnTimeOut = MAX(20,qSites.TIMEOUT)
m.lnAttempt = MAX(1,qSites.Attempt)
FOR x=1 TO lnAttempt
lntsec = SECONDS()
loIE.Navigate( lcTmplName )
*--------------------------------------------
* wait until complete
*--------------------------------------------
st = SECONDS()
Sleep(50)
DO WHILE .T.
IF NOT VERSION(5)=700
DOEVENTS && In 7.0, the DoEvents behavior changed to stop and wait for event. In 8.0, the behavior was changed back to 6.0 behavior.
ENDIF
DO CASE
CASE loIE.readyState=4 AND NOT loIE.busy
EXIT
CASE loIE.readyState=3 AND SECONDS()-st > 5
EXIT
CASE SECONDS()-st > m.lnTimeOut
EXIT
ENDCASE
Sleep(50)
ENDDO
*--------------------------------------------
* Update site weight for best site for translating
*--------------------------------------------
THIS.SQlexec("UPDATE Locale_source SET duration=duration+"+TRANSFORM(SECONDS()-lntsec)+" WHERE ID="+TRANSFORM(qSites.ID) )
IF TYPE("loIE.DOCUMENT.Body.innerHTML")="C"
cResult = loIE.DOCUMENT.body.innerHTML
*--------------------------------------------
* output the resulting page for auditing
*--------------------------------------------
IF THIS.DEBUG
STRTOFILE( cResult, STRTRAN(lcTmplName , ".HTM","_OUT.HTM"),.F.)
ENDIF
DO CASE
CASE EMPTY(cResult)
CASE ATCC(amarkers[1],cResult)=0
OTHERWISE
*- Gregory L Reichert 02/11/2004 07:04:53 LOCALE.CALLSITE : (1)
*!* THIS.web.VISIBLE = .F.
EXIT
ENDCASE
ENDIF
NEXT
*--------------------------------------------
* Reinstate the original values.
*--------------------------------------------
IF THIS.disable_images
FOR ia=1 TO ALEN(aKeyVal,1)
THIS.Registry( "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Internet Explorer\Main\"+aKeyVal[ia,1] ,aKeyVal[ia,3] )
ENDFOR
ENDIF
*--------------------------------------------
* if expected return, parse out the translation
*--------------------------------------------
*- Gregory L Reichert 02/26/2004 07:49:57 LOCALE.CALLSITE : (1) : IE has a bad tendency of reformatting html pages from that of the original. Strip quote marks.
cResult = CHRTRANC(cResult,["'],[])
IF ATCC(amarkers[2], cResult)>0
cResult = SUBSTRC(cResult,ATCC(amarkers[2],cResult))
cResult = SUBSTRC(cResult, ATCC(amarkers[3],cResult)+LENC(amarkers[3]))
cResult = ALLTRIM(LEFTC(cResult, ATCC(amarkers[4],cResult)-1))
IF OCCURS(",",cResult)>OCCURS(",",tcPhrase)
cResult = LEFTC(cResult,AT_C(",",cResult)-1)
ENDIF
ELSE
cResult = ""
ENDIF
IF THIS.DEBUG
ACTIVATE SCREEN
?? "("+TRANSFORM(cResult)+")"
ENDIF
*--------------------------------------------
* if a popup is openned by the web site, close it.
*--------------------------------------------
IF TYPE("_VFP.HWND")="N"
THIS.closepopup()
ENDIF
*--------------------------------------------
* Check and de-encode text
*--------------------------------------------
cResult = THIS.UnEscape( cResult )
IF LEFT(cResult,1)="_" AND LEFT(tcPhrase,1)#"_"
cResult = ALLTRIM(SUBSTR(cResult,2))
ENDIF
IF RIGHT(cResult,1)="_" AND RIGHT(tcPhrase,1)#"_"
cResult = ALLTRIM(SUBSTR(cResult,LEN(cResult)-1))
ENDIF
*--------------------------------------------
* test for proper translation
*--------------------------------------------
DO CASE
CASE EMPTY(cResult)
*- found nothing
CASE OCCURS("?",cResult)>1
*- failed to translate correctly
CASE "<"$cResult
*- skip if pure html
CASE NOT (cResult==tcPhrase)
*--------------------------------------------
* update hit count
*--------------------------------------------
THIS.SQlexec( "UPDATE Locale_source SET Hits=Hits+1 WHERE ID="+TRANSFORM(qSites.ID) )
IF THIS.DEBUG
ACTIVATE SCREEN
?? cResult
ENDIF
lcRetValue = cResult
EXIT
OTHERWISE
lcRetValue = MAX(lcRetValue, cResult) && take the one that is not ""
ENDCASE
cResult = "" && reset
IF FILE(lcTmplName) AND NOT THIS.DEBUG
ERASE (lcTmplName)
ENDIF
ENDSCAN
ENDIF
*--------------------------------------------
* clear the web page and disable it
*--------------------------------------------
*- Gregory L Reichert 02/11/2004 07:04:37 LOCALE.CALLSITE : (1)
SET SAFETY &lcSafety
RETURN lcRetValue
ENDPROC
PROCEDURE captioncount && Count all possible text that can be trnaslated
*------------------------------------------------------------
* Description: Scan for Caption properties, and changes them to Localized version.
* Child objects are recurred and change also.
* Parameters: tcObj, req, def=, Base object to be translated.
* Return: Count of caption to translate
* Use: n = oLocale.CaptionCount( Thisform )
*------------------------------------------------------------
* Id Date By Description
* 1 07/31/2003 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETER tcObj
LOCAL oObj
LOCAL lnCount
lnCount = 0
FOR EACH oObj IN tcObj.OBJECTS
lnCount = lnCount + IIF( PEMSTATUS(oObj,"Caption",5) AND (TYPE("oObj.Caption")<>"U") AND NOT EMPTY(oObj.CAPTION) ,1,0)
lnCount = lnCount + IIF( PEMSTATUS(oObj,"TooltipText",5) AND (TYPE("oObj.TooltipText")<>"U") AND NOT EMPTY(oObj.TOOLTIPTEXT) ,1,0)
lnCount = lnCount + IIF( PEMSTATUS(oObj,"StatusbarText",5) AND (TYPE("oObj.StatusbarText")<>"U") AND NOT EMPTY(oObj.STATUSBARTEXT) ,1,0)
IF PEMSTATUS(oObj,"Objects",5)
IF oObj.OBJECTS.COUNT>0
lnCount = lnCount + THIS.captioncount( oObj )
ENDIF
ENDIF
NEXT
RETURN lnCount
ENDPROC
PROCEDURE closepopup && Closes popup internet window. This sometimes occurs with access Dictionary.com
*------------------------------------------------------------
* Description: Attempts to close untitled popup browser windows caused by calling translating web sites.
* Parameters: tcWindowName, req, def=, Window Title to close.
* Return: n/a
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 08/18/2003 Gregory L Reichert Initial Creation
*------------------------------------------------------------
*-- ignore popup windows
IF NOT THIS.lclosepopup
RETURN .T.
ENDIF
LOCAL HWND, x,N, stuffer, lFound
* Get the HWND (handle) to the main FoxPro window
#IF VERSION(5)>=700
HWND = _VFP.HWND
#ELSE
IF FILE(HOME()+"FoxTools.fll")
SET LIBRARY TO (HOME()+"FoxTools.fll") ADDITIVE
HWND = EVALUATE("MainHWND()")
RELEASE LIBRARY (HOME()+"FoxTools.fll")
ELSE
THIS.lclosepopup = .F.
RETURN
ENDIF
#ENDIF
* Register the Windows API functions that will be called
DECLARE INTEGER GetWindowText IN WIN32API;
INTEGER HWND, ;
STRING @ lpString, ;
INTEGER nMaxCount
DECLARE INTEGER GetWindow IN user32;
INTEGER HWND,;
INTEGER wFlag
DECLARE SHORT PostMessage IN user32;
INTEGER HWND,;
INTEGER Msg,;
STRING @ wParam,;
INTEGER LPARAM
DO WHILE HWND <> 0
stuffer = REPLICATE(CHR(0),512)
x = GetWindowText(HWND,@stuffer,511)
stuffer = LEFTC(stuffer,AT_C(CHR(0),stuffer)-1)
IF LENC(TRIM(stuffer)) > 0
lFound = .F.
FOR N=1 TO ALEN(THIS.aWindows,1)
lFound = lFound OR (HWND==THIS.aWindows[n,1] ;
AND stuffer==THIS.aWindows[ n,2 ] ;
AND NOT LEFTC(stuffer,22)="Visual FoxPro Debugger")
IF lFound
EXIT
ENDIF
NEXT
IF NOT lFound
*-- popup window, close it.
ACTIVATE SCREEN
PostMessage(HWND, 0x10, 0, 0)
ENDIF
ENDIF
HWND = GetWindow(HWND,2)
ENDDO
*!* dimension this.aWindows[1,2]
*!* this.aWindows[1,1] = 0
*!* this.aWindows[1,2] = ""
*- Gregory L Reichert 02/09/2004 07:00:22 LOCALE.CLOSEPOPUP : (1) : remove CLEAR DLLS, in VFP 6.0, it clears all DLLS. (suggested by: Bhavbhuti Nathwani )
ENDPROC
PROCEDURE convertall && Convert all Base phrases to all Languages
*------------------------------------------------------------
* Description: re-translate all phrases from base to all other languages.
* Parameters: n/a
* Return: n/a
* Use: oLocale.ConvertAll( .T., .T. )
*------------------------------------------------------------
* Id Date By Description
* 1 09/22/2003 Gregory L Reichert Initial Creation
* 2 03/08/2004 glr remove all, allow the baseLang to be addded too.
*------------------------------------------------------------
LPARAMETERS tlClearOld, tlResetLang
*--------------------------------------------
* if object diabled, return original phrase
*--------------------------------------------
IF THIS.ENABLED= .F.
RETURN .T.
ENDIF
IF tlResetLang
THIS.SQlexec("UPDATE Locale_Lang SET exclude = .f." )
ENDIF
LOCAL ARRAY d_lang[1]
LOCAL ARRAY aPhrase[1]
THIS.SQlexec( "SELECT distinct Name from Locale_lang WHERE not TRIM(Name)='"+THIS.BaseLang+"' order by 1","qtemp")
SELECT * FROM qtemp INTO ARRAY d_aLang
THIS.SQlexec( "SELECT Phrase, padr(Phrase,100) as Phrase2 from Locale WHERE TRIM(Language)='"+THIS.BaseLang+"' order by 2", "qtemp" )
SELECT * FROM qtemp INTO ARRAY aPhrase
*-- remove all translated phrases.
IF tlClearOld
* this.SQLexec("DELETE FROM Locale" )
*- Gregory L Reichert 03/08/2004 06:24:56 LOCALE.CONVERTALL : (2) : remove all, allow the baseLang to be addded too.
THIS.SQlexec("DELETE FROM Locale WHERE not TRIM(Language)='"+THIS.BaseLang+"'" )
IF ATC("foxpro",THIS.sqlconnectionstring)>0 OR EMPTY(THIS.sqlconnectionstring)
SELECT Locale
USE Locale EXCLUSIVE
PACK
USE
ENDIF
ENDIF
LOCAL x, Y, N, cLast, cResult
FOR x=1 TO ALEN(d_aLang,1)
IF THIS.resetsites
*-- reset all sites to try all equally.
THIS.SQlexec( "UPDATE Locale_source SET duration=0.001, hits=1" )
ENDIF
*-- set destination language
THIS.Locale = d_aLang[x,1]
*-- translate phrases
N=0
cLast = ""
FOR Y=1 TO ALEN(aPhrase,1)
IF cLast==aPhrase[y,1]
LOOP
ENDIF
_VFP.CAPTION = TRANSFORM(THIS.Locale)+": "+TRANSFORM(aPhrase[y,1])
cResult = THIS.GetString( aPhrase[y,1] )
IF THIS.notranslation_attempt
N=ALEN(aPhrase,1)
EXIT
ENDIF
N = N + IIF(cResult==aPhrase[y,1],1,0)
NEXT
IF N=ALEN(aPhrase,1)
*- none translated, exclude Langauge
THIS.SQlexec( "UPDATE Locale_Lang SET Exclude=.t. where TRIM(Name)='"+THIS.Locale+"'" )
ENDIF
NEXT
_VFP.CAPTION = "Microsoft Visual FoxPro"
RETURN .T.
ENDPROC
HIDDEN PROCEDURE Destroy
*------------------------------------------------------------
* Description: Destory method
* Parameters: none
* Return: n/a
* Use: n/a
*------------------------------------------------------------
* Id Date By Description
* 1 08/11/2003 Gregory L Reichert Initial Creation
* 2 02/12/2004 GLR Drop dependency on WSH
*------------------------------------------------------------
*--------------------------------------------
* clear aMenu to remove references to objects.
*--------------------------------------------
THIS.aMenu = ""
*--------------------------------------------
* close Locale tables
*--------------------------------------------
IF THIS.SQLCONNECT >0
SQLDISCONNECT( THIS.SQLCONNECT )
ENDIF
USE IN (SELECT("locale"))
USE IN (SELECT("locale_lang"))
USE IN (SELECT("locale_xref"))
USE IN (SELECT("locale_source"))
IF THIS.fromregistry
*- Gregory L Reichert 02/12/2004 13:33:25 LOCALE.DESTROY : (2) : remove dependancy on WSH
THIS.Registry( "HKEY_CURRENT_USER\Software\Locale\"+JUSTFNAME(_vfp.DefaultFilePath)+"\"+PROPER(JUSTSTEM(JUSTFNAME(SYS(16,0))))+"\Locale", THIS.Locale )
ENDIF
ENDPROC
PROCEDURE dolabel && Translates and runs a Label
*------------------------------------------------------------
* Description: Executes a Label after transslating the Labels
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS clbx, cClauses, tnSession
*--------------------------------------------
* change to correct datasession if passed.
*--------------------------------------------
IF NOT EMPTY(tnSession)
LOCAL nDS
nDS = SET("DataSession")
SET DATASESSION TO (tnSession)
ENDIF
tnDataSession = SET("DataSession")
LOCAL lbxName, ls
ls = SELECT()
SELECT 0
lbxName = FULLPATH(SYS(3)+".lbx")
*--------------------------------------------
* Make a copy of the label file
*--------------------------------------------
USE (FORCEEXT(clbx,"lbx")) NOUPDATE
COPY TO (lbxName)
USE (lbxName) EXCLUSIVE ALIAS Locale_label
*--------------------------------------------
* Translate the Labels
*--------------------------------------------
IF THIS.ENABLED= .T.
LOCAL cExpr
SCAN ALL FOR INLIST( ObjType, 5 ) AND LEFT(EXPR,1)=["] AND RIGHT(EXPR,1)=["]
cExpr = THIS.GetString( ALLTRIM(EXPR))
SET DATASESSION TO (tnDataSession)
SELECT Locale_label
REPLACE EXPR WITH m.cExpr
ENDSCAN
USE
ENDIF
*--------------------------------------------
* rename the Memo file to match the table
*--------------------------------------------
IF FILE(FORCEEXT(lbxName,"fpt"))
RENAME (FORCEEXT(lbxName,"fpt")) TO (FORCEEXT(lbxName,"lbt"))
ENDIF
*--------------------------------------------
* Run the Label
*--------------------------------------------
SELECT (ls)
LABEL FORM (lbxName) &cClauses
*--------------------------------------------
* erase the temporary label files.
*--------------------------------------------
ERASE (lbxName)
ERASE (FORCEEXT(lbxName,"lbt"))
IF NOT EMPTY(tnSession)
SET DATASESSION TO (nDS)
ENDIF
RETURN
ENDPROC
PROCEDURE doreport && Translated and runs a report,
*------------------------------------------------------------
* Description: Executes a Report after transslating the Labels
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/26/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS cFRX, cClauses, tnSession
*--------------------------------------------
* change to correct datasession if passed.
*--------------------------------------------
IF NOT EMPTY(tnSession)
LOCAL nDS
nDS = SET("DataSession")
SET DATASESSION TO (tnSession)
ENDIF
tnDataSession = SET("DataSession")
LOCAL frxName, ls
ls = SELECT()
SELECT 0
frxName = FULLPATH(SYS(3)+".frx")
*--------------------------------------------
* Make temporary copy of report file
*--------------------------------------------
USE (FORCEEXT(cFRX,"frx")) NOUPDATE
COPY TO (frxName)
USE (frxName) EXCLUSIVE ALIAS Locale_Report
*--------------------------------------------
* Translate the Labels
*--------------------------------------------
IF THIS.ENABLED=.T.
LOCAL cExpr
SCAN ALL FOR INLIST( ObjType, 5 ) AND LEFT(EXPR,1)=["] AND RIGHT(EXPR,1)=["]
cExpr = THIS.GetString( ALLTRIM(EXPR))
SET DATASESSION TO (tnDataSession)
SELECT Locale_Report
REPLACE EXPR WITH m.cExpr
ENDSCAN
USE
ENDIF
*--------------------------------------------
* rename the memo file
*--------------------------------------------
IF FILE(FORCEEXT(frxName,"fpt"))
RENAME (FORCEEXT(frxName,"fpt")) TO (FORCEEXT(frxName,"frt"))
ENDIF
*--------------------------------------------
* run report
*--------------------------------------------
SELECT (ls)
REPORT FORM (frxName) &cClauses
*--------------------------------------------
* clean up
*--------------------------------------------
ERASE (frxName)
ERASE (FORCEEXT(frxName,"frt"))
IF NOT EMPTY(tnSession)
SET DATASESSION TO (nDS)
ENDIF
RETURN
ENDPROC
PROCEDURE Error
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/25/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
Lparameters nError, cMethod, nLine
If _vfp.StartMode = 0
Debug
Suspend
Endif
Do Case
Case Lower(cMethod)="callsite" And nError=1426
Return
Otherwise
* DODEFAULT( nError, cMethod, nLine )
Error nError
Endcase
ENDPROC
PROCEDURE getstring && Translate a string from the BaseLang to a specific language
*------------------------------------------------------------
* Description: Looks up the phrase in the this.aLocale array.
* If found, the trasnslated phrase is returned,
* otherwise, calling the web site is performed.
* Parameters: tcPhrase, req, def=, Phrase to translate.
* Return: String: translated phrase.
* Use: lcPhrase = oLocale.GetString( "This is a test" )
*------------------------------------------------------------
* Id Date By Description
* 1 08/04/2003 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS tcStr
*--------------------------------------------
* if object diabled, return original phrase
*--------------------------------------------
IF THIS.ENABLED= .F.
RETURN tcStr
ENDIF
LOCAL lcStr
lcStr = tcStr
*--------------------------------------------
* Exception List
*--------------------------------------------
DO CASE
CASE EMPTY(tcStr)
CASE ALLTRIM(tcStr)=="\-"
CASE ALLTRIM(tcStr)=="..."
CASE ALLTRIM(tcStr)=="("
OTHERWISE
LOCAL lcLocale, llresult, x, isKey, isColon, lctmp, isQuoted, lcQuoteMark
lcLocale = THIS.Locale
isKey = "\<"$tcStr
lcStr = STRTRAN(tcStr,"\<","")
isColon = RIGHTC(ALLTRIM(tcStr),1)=":"
isQuoted = ((LEFTC(tcStr,1)=["]) AND (RIGHTC(tcStr,1)=["])) ;
OR ((LEFTC(tcStr,1)=[']) AND (RIGHTC(tcStr,1)=['])) ;
OR ((LEFTC(tcStr,1)="[") AND (RIGHTC(tcStr,1)="]"))
lcQuoteMark = IIF(isQuoted, LEFTC(tcStr,1)+RIGHTC(tcStr,1),"")
*--------------------------------------------
* Locate base language phrase
*--------------------------------------------
x = THIS.ArrayLookup( lcStr, 1 )
llresult = .F.
IF x>0 AND LOWER(lcStr)==LOWER(THIS.aLocale[x,1])
lcStr = ALLTRIM(THIS.aLocale[x,2])
ELSE
lcStr = THIS.Translate( lcStr )
IF EMPTY(lcStr)
lcStr = tcStr
ENDIF
ENDIF
*--------------------------------------------
* preserve hotkey indicator
*--------------------------------------------
IF isKey
lctmp = CHRTRANC(UPPER(lcStr), THIS.usedchar, '' )
lctmp = CHRTRANC(lcStr, lctmp, '')
lctmp = LEFTC(ALLTRIM(lctmp),1)
IF NOT EMPTY(lctmp)
THIS.usedchar = CHRTRANC(THIS.usedchar,lctmp,"") && remove from list
x = ATCC(lctmp,tcStr)
IF x>0
lcStr = STUFFC( lcStr,x,1,"\<"+SUBSTRC(lcStr,x,1))
ENDIF
ENDIF
ENDIF
IF RIGHTC(ALLTRIM(lcStr),1)#":" AND isColon
lcStr = ALLTRIM(lcStr) + ":"
ENDIF
IF (LEFTC(lcStr,1)#LEFTC(lcQuoteMark,1)) AND isQuoted
lcStr = LEFTC(lcQuoteMark,1) + lcStr + RIGHTC(lcQuoteMark,1)
ENDIF
ENDCASE
WAIT CLEAR
RETURN lcStr
ENDPROC
PROCEDURE getwindows
*------------------------------------------------------------
* Description: build list of window hwnd
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 09/04/2003 Gregory L Reichert Initial Creation
* 2 02/04/2004 GLR dont clear DLL, may be needed in actual application.
*------------------------------------------------------------
*-- ignore popup windows
IF NOT THIS.lclosepopup
RETURN .T.
ENDIF
LOCAL HWND, x,N, stuffer
* Get the HWND (handle) to the main FoxPro window
#IF VERSION(5)>=700
HWND = _VFP.HWND
#ELSE
IF FILE(HOME()+"FoxTools.fll")
SET LIBRARY TO (HOME()+"FoxTools.fll") ADDITIVE
HWND = EVALUATE("MainHWND()")
RELEASE LIBRARY (HOME()+"FoxTools.fll")
ELSE
THIS.lclosepopup = .F.
RETURN
ENDIF
#ENDIF
* Register the Windows API functions that will be called
DECLARE INTEGER GetWindowText IN WIN32API;
INTEGER HWND, ;
STRING @ lpString, ;
INTEGER nMaxCount
DECLARE INTEGER GetWindow IN user32;
INTEGER HWND,;
INTEGER wFlag
N = 0
DO WHILE HWND <> 0
stuffer = REPLICATE(CHR(0),512)
x = GetWindowText(HWND,@stuffer,511)
stuffer = LEFTC(stuffer,AT_C(CHR(0),stuffer)-1)
IF LEN(TRIM(stuffer)) > 0
N = N + 1
DIMENSION THIS.aWindows[ n, 2]
THIS.aWindows[ n,1 ] = HWND
THIS.aWindows[ n,2 ] = stuffer
ENDIF
HWND = GetWindow(HWND,2)
ENDDO
*- Gregory L Reichert 02/04/2004 06:43:23 LOCALE.GETWINDOWS : (2) : dont clear, may be needed in actual application.
RETURN
ENDPROC
PROCEDURE Init
*------------------------------------------------------------
* Description: Initialize Object
* Parameters: tcBaseLang, Opt, Def=.F., Base Language used to create form and controls.
* tcDestLang, Opt, Def=.F., Destination Language to be translated to.
* Return: N/A
* Use: oLocale= NewObject("Locale","Locale.vcx","","English","Spanish" )
*------------------------------------------------------------
* Id Date By Description
* 1 08/18/2003 Gregory L Reichert Initial Creation
* 2 2/16/2004 GLR Drop WebBrowser control.
*------------------------------------------------------------
LPARAMETERS tcBaseLang, tcDestLang
SET SAFETY OFF
ERASE ("Locale.log")
*------------------------------------------------------------
* Establish the base and locale languages.
*------------------------------------------------------------
IF NOT EMPTY(tcBaseLang)
THIS.BaseLang = tcBaseLang
ENDIF
IF NOT EMPTY(tcDestLang)
THIS.Locale = tcDestLang
ELSE
THIS.SETUP
ENDIF
RETURN
*="DSN=Visual FoxPro Database;UID=;PWD=;SourceDB="+fullpath("")+"locale.dbc;SourceType=DBC;Exclusive=No;BackgroundFetch=No;Collate=Machine;Null=Yes;Deleted=Yes;"
ENDPROC
PROTECTED PROCEDURE loadarray && Loads the internal array with the current language translations.
*------------------------------------------------------------
* Description: Loads the internal trnaslated array from the Locale for the current Locale.
* Parameters: none
* Return: none
* Use: this.LoadArray()
*------------------------------------------------------------
* Id Date By Description
* 1 08/05/2003 Gregory L Reichert Initial Creation
* 2 02/27/2004 GLR Remove property DBF.
*------------------------------------------------------------
*--------------------------------------------
* if object diabled, return original phrase
*--------------------------------------------
IF THIS.ENABLED= .F.
RETURN .T.
ENDIF
LOCAL dbLocale
*- Gregory L Reichert 02/27/2004 07:52:52 LOCALE.LOADARRAY : (2) : Obsolete - not used.
LOCAL fl
fl = SELECT()
SELECT (SELECT("locale"))
*USE (dbLocale)
LOCAL BASE, LANG
BASE = THIS.BaseLang
LANG = THIS.Locale
THIS.SQlexec( "SELECT aa.phrase, bb.phrase, aa.ID FROM Locale aa "+ ;
"INNER JOIN Locale bb "+;
"ON aa.ID=bb.ID "+;
"WHERE TRIM(aa.LANGUAGE)='"+m.BASE+"' "+ ;
"AND TRIM(bb.LANGUAGE)='"+m.LANG+"' "+ ;
"ORDER BY aa.ID ASC ", "qtemp2" )
IF _TALLY>0
LOCAL ARRAY laLocale[_tally,3]
laLocale = ""
SELECT * FROM qtemp2 INTO ARRAY laLocale
DIMENSION THIS.aLocale[_tally,3]
=ACOPY(laLocale,THIS.aLocale)
ELSE
DIMENSION THIS.aLocale[1,3]
THIS.aLocale = ""
ENDIF
USE IN qtemp2
USE IN (SELECT("locale"))
SELECT (fl)
RETURN
ENDPROC
PROTECTED PROCEDURE locale_assign
*------------------------------------------------------------
* Description: Assign method to Locale. When the property is changed, the object
* attempts to translate all the controls on the form to the new assigned
* Locale.
* Parameters: n/a
* Return: n/a
* Use: internal
*------------------------------------------------------------
* Id Date By Description
* 1 08/07/2003 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS vNewVal
THIS.Locale = ALLTRIM(m.vNewVal)
THIS.usedchar = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
THIS.LoadArray()
IF this.ltranslateactiveform
IF TYPE("_Screen.ActiveForm")="O"
IF TYPE("_SCREEN.ACTIVEFORM.Locale_Original")#"C"
LOCAL PropList
PropList = STRTRAN(THIS.property_list,[,],CHR(13)+CHR(10))
_SCREEN.ACTIVEFORM.ADDPROPERTY("Locale_Original["+TRANSFORM(MEMLINES(m.PropList))+"]","")
ENDIF
LOCAL cTag
cTag = _SCREEN.ACTIVEFORM.Locale_Original[1]
IF EMPTY(cTag)
STORE _SCREEN.ACTIVEFORM.CAPTION TO cTag, _SCREEN.ACTIVEFORM.Locale_Original[1]
ENDIF
_SCREEN.ACTIVEFORM.CAPTION = THIS.GetString( cTag )
THIS.setLocale( _SCREEN.ACTIVEFORM )
ENDIF
ENDIF
RETURN
ENDPROC
PROCEDURE ping && Test to see if Internet is available.
* Program: Ping.PRG
* Description: Test that a internet URL is valid.
* Developer: Gregory L Reichert - www.GLRsoftware.com
*------------------------------------------------------------
* From the original work of...
* readurl.prg 06-Mar-98
* 06-Mar-98 pulled from Q174524 on March 98 Technet CD
* 06-Mar-98 bug fixed about the length of the sReadBuffer
*Any Internet or intranet URL can be passed as a parameter. Microsoft.com
*was chosen for this example.
*Note that Microsoft Internet Explorer must be installed on the computer.
* passed: URLName, in the form "http://www.microsoft.com"
* returns: the content of the URL
* usage:
* uWebContent = ReadURL( "http://www.microsoft.com" )
* uWebContent = ReadURL( "http://www.SomeSite.com/SomeJPG.jpg" )
* notes:
* 1 - IE does not need to be running to use this, but must be installed,
* as the program uses an option that gets information from the registry
LPARAMETERS pcUrlName
DECLARE INTEGER InternetOpen IN wininet STRING sAgent, ;
INTEGER lAccessType, STRING sProxyName, ;
STRING sProxyBypass, INTEGER lFlags
DECLARE INTEGER InternetOpenUrl IN wininet ;
INTEGER hInternetSession, STRING sUrl, STRING sHeaders,;
INTEGER lHeadersLength, INTEGER lFlags, INTEGER lContext
DECLARE INTEGER InternetReadFile IN wininet INTEGER hfile, ;
STRING @sBuffer, INTEGER lNumberofBytesToRead, INTEGER @lBytesRead
DECLARE short InternetCloseHandle IN wininet INTEGER hInst
#DEFINE INTERNET_OPEN_TYPE_PRECONFIG 0
#DEFINE INTERNET_OPEN_TYPE_DIRECT 1
#DEFINE INTERNET_OPEN_TYPE_PROXY 3
#DEFINE SYNCHRONOUS 0
#DEFINE INTERNET_FLAG_RELOAD 2147483648
#DEFINE CR CHR(13)
LOCAL lsAgent, lhInternetSession, lhUrlFile, llOk, lnOk, lcReadBuffer, lnBytesRead
* what application is using Internet services?
lsAgent = "Locale"
lhInternetSession = InternetOpen( lsAgent, INTERNET_OPEN_TYPE_PRECONFIG, ;
'', '', SYNCHRONOUS)
* debugging line - uncomment to see session handle
* WAIT WINDOW "Internet session handle: " + LTRIM(STR(hInternetSession))
IF lhInternetSession = 0
* WAIT WINDOW "Internet session cannot be established" TIME 2
RETURN .F.
ENDIF
lhUrlFile = InternetOpenUrl( lhInternetSession, pcUrlName, '', 0, ;
INTERNET_FLAG_RELOAD, 0)
* debugging line - uncomment to see URL handle
* WAIT WINDOW "URL Handle: " + LTRIM(STR(hUrlFile))
IF lhUrlFile = 0
* WAIT WINDOW "URL cannot be opened"
RETURN .F.
ENDIF
LOCAL lcRetVal
lcRetVal = ""
llOk = .T.
DO WHILE llOk
* set aside a big buffer
LOCAL lsReadBuffer
lsReadBuffer = SPACE(32767)
lnBytesRead = 0
lnOk = InternetReadFile( lhUrlFile, @lsReadBuffer, LEN(lsReadBuffer), @lnBytesRead)
IF ( lnBytesRead > 0 )
lcRetVal = lcRetVal + LEFTC( lsReadBuffer, lnBytesRead )
ENDIF
* error trap - either a read failure or read past eof()
llOk = ( lnOk = 1 ) AND ( lnBytesRead > 0 )
ENDDO
_CLIPTEXT = lcRetVal
lcRetVal = ATCC("<title>Google</title>",lcRetVal)>0
* close all the handles we opened
InternetCloseHandle( lhUrlFile )
InternetCloseHandle( lhInternetSession )
RETURN lcRetVal
* Eof Ping.PRG
ENDPROC
PROCEDURE registry && Get and Put to the Registry
*------------------------------------------------------------
* Description: Get and Set values in the Registry
* Parameters: tAction, req, D=, Either GET or PUT
* Return: n/a
* Use: n/a
*------------------------------------------------------------
* Id Date By Description
* 1 08/11/2003 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS tKey, tValue
LOCAL nPara
nPara = PARAMETERS()
* Registry roots
LOCAL HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, HKEY_LOCAL_MACHINE, HKEY_USERS
HKEY_CLASSES_ROOT = -2147483648 && BITSET(0,31)
HKEY_CURRENT_USER = -2147483647 && BITSET(0,31)+1
HKEY_LOCAL_MACHINE = -2147483646 && BITSET(0,31)+2
HKEY_USERS = -2147483645 && BITSET(0,31)+3
#DEFINE REG_SZ 1 && Data string
#DEFINE REG_BINARY 3 && Binary data in any form.
#DEFINE REG_DWORD 4 && A 32-bit number.
DECLARE INTEGER RegCreateKey IN Win32API ;
INTEGER nHKey, STRING @cSubKey, INTEGER @nResult
DECLARE INTEGER RegDeleteKey IN Win32API ;
INTEGER nHKey, STRING @cSubKey
DECLARE INTEGER RegOpenKey IN Win32API ;
INTEGER nHKey, STRING @cSubKey, INTEGER @nResult
DECLARE INTEGER RegCloseKey IN Win32API ;
INTEGER nHKey
DECLARE INTEGER RegQueryValueEx IN Win32API ;
INTEGER nHKey, STRING lpszValueName, INTEGER dwReserved,;
INTEGER @lpdwType, STRING @lpbData, INTEGER @lpcbData
DECLARE INTEGER RegSetValueEx IN Win32API ;
INTEGER hKey, STRING lpszValueName, INTEGER dwReserved,;
INTEGER fdwType, STRING lpbData, INTEGER cbData
*--------------------------------------------
* parse cKey
*--------------------------------------------
LOCAL hKey, cKey, cData
hKey = LEFTC( tKey, AT_C("\", tKey)-1)
tKey = SUBSTRC( tKey, AT_C("\",tKey)+1)
cKey = LEFTC( tKey, RATC("\",tKey)-1)
tKey = SUBSTRC( tKey, RATC("\",tKey)+1)
cData = tKey
LOCAL nCurrentKey,nErrCode
nCurrentKey = 0
nErrCode = RegOpenKey(&hKey,cKey,@nCurrentKey)
IF nErrCode>0
nErrCode = RegCreateKey(&hKey,cKey,@nCurrentKey)
ENDIF
LOCAL lpdwReserved,lpdwType,lpbData,lpcbData,nErrCode, cKeyValue, nValueSize
STORE 0 TO lpdwReserved,lpdwType
STORE SPACE(256) TO lpbData
STORE LEN(m.lpbData) TO m.lpcbData
cKeyValue = ""
DO CASE
CASE nPara = 2
* Make sure we null terminate this guy
lpcbData = TRANSFORM(m.tValue)+CHR(0)
nValueSize = LEN(m.lpcbData)
* Set the key value here
m.nErrCode = RegSetValueEx(nCurrentKey,m.cData,0,;
REG_SZ,m.lpcbData ,m.nValueSize)
cKeyValue = m.nErrCode=0
CASE nPara = 1
m.nErrCode=RegQueryValueEx(nCurrentKey,cData, m.lpdwReserved,@lpdwType,@lpbData,@lpcbData)
m.cKeyValue = LEFTC(m.lpbData,m.lpcbData-1)
OTHERWISE
*-- do nothing
ENDCASE
=RegCloseKey(nCurrentKey)
#IF VERSION(5)>600
CLEAR DLLS RegCreateKey
CLEAR DLLS RegDeleteKey
CLEAR DLLS RegOpenKey
CLEAR DLLS RegCloseKey
CLEAR DLLS RegQueryValueEx
#ENDIF
RETURN cKeyValue
ENDPROC
PROCEDURE setlocale && Translates a object and child objects.
*------------------------------------------------------------
* Description: Scan for Caption properties, and changes them to Localized version.
* Child objects are recurred and change also.
* Parameters: toObj, req, def=, Base object to be translated.
* Return: none
* Use: oLocale.SetLocale( Thisform )
*------------------------------------------------------------
* Id Date By Description
* 1 07/31/2003 Gregory L Reichert Initial Creation
* 2 03/01/2004 GLR Change looking for specfic object, to properties that are objects.
*------------------------------------------------------------
Lparameter toObj
*--------------------------------------------
* if object diabled, return original phrase
*--------------------------------------------
Do Case
Case This.Enabled= .F.
Return
Case Isnull(toObj)
RETURN
CASE TYPE('toObj.baseclass') <> 'C'
RETURN
Endcase
Local oObj, cText, nFore, nDFore, lcCRLF, isFirst, i,j,k
Private cTag
lcCRLF = Chr(13)+Chr(10)
isFirst = .F.
If Type("xx_marker")="U"
*-- first time in
isFirst = .T.
This.ncount = 0
Private xx_marker
xx_marker = .T.
This.online=.Null. && Test for internet connection again. This only occurs if a translation is needed, otherwise, the translation comes from table.
*------------------------------------------------------------
* reset to help find the most optimal site for the current language.
*------------------------------------------------------------
If Pemstatus(toObj,"Datasession",5)
If toObj.DataSession=2 && Private
Set DataSession To (toObj.DataSessionId)
Endif
Endif
*--------------------------------------------
* Add start up of run, reset site to give all equal chance.
*--------------------------------------------
If This.resetsites
This.SQLExec( "UPDATE Locale_source SET duration=0.001,hits=1" )
Endif
*--
Endif
*--------------------------------------------
* Initialize and translate Menus
*--------------------------------------------
If .F. && Lower(toObj.BaseClass) == "form"
*--------------------------------------------
* if there menus in the aMenu array, process them first.
*--------------------------------------------
If .F.
This.setMenu( .T.,, (toObj) )
Endif
Endif
*--------------------------------------------
* if it has forecolor, highlight current control
*--------------------------------------------
If Between(This.translate_color, 0, Rgb(255,255,255))
If (Pemstatus(toObj,"ForeColor",5) ;
AND Type("toObj.ForeColor")<>"U")
nFore = toObj.ForeColor
toObj.ForeColor = This.translate_color
loOldError = On("error")
Endif
If (Pemstatus(toObj,"DisabledForeColor",5) ;
AND Type("toObj.DisabledForeColor")<>"U")
nDFore = toObj.DisabledForeColor
toObj.DisabledForeColor = This.translate_color
Endif
Endif
*--------------------------------------------
* load Localized Captions.
*--------------------------------------------
Local PropList
PropList = Strtran(This.property_list,[,],Chr(13)+Chr(10))
If Type("toObj.Locale_Original[1]")#"C"
toObj.AddProperty("Locale_Original["+Transform(Memlines(m.PropList))+"]","")
Endif
*- Gregory L Reichert 03/08/2004 06:37:55 LOCALE.SETLOCALE : (3) : read the properties to translate from comma delimited list.
For i=1 To Memlines(m.PropList)
This.Translate_Property( toObj, Mline(m.PropList,i), i)
Next
*- Gregory L Reichert 03/08/2004 06:29:01 LOCALE.SETLOCALE : (2) : Change looking for specfic object, to properties that are objects.
Local Array aMems[1,3]
k = Amembers( aMems, toObj, 1 )
For j=1 To k
*--------------------------------------------
* get next control on this container
*--------------------------------------------
Do Case
Case Inlist(Lower(aMems[j,1]), "parent")
Case Type("toObj."+aMems[j,1])#"O"
Case Isnull(Evaluate("toObj."+aMems[j,1]))
Otherwise
*--------------------------------------------
* If the Property is Object, check for text to translate.
*--------------------------------------------
oObj = Evaluate("toObj."+aMems[j,1])
*--------------------------------------------
* Transverse to check for controls on this control.
*--------------------------------------------
*- Gregory L Reichert 01/30/2004 07:21:06 LOCALE.SETLOCALE : (1) : Include other object collections (by Bhavbhuti Nathwani, Venus Software Operatcions )
*- Gregory L Reichert 02/03/2004 06:34:25 LOCALE.SETLOCALE : (2) : Restructured to be both compatible with 6.0 with no Objects collection with other collections, and 8.0 both sets of collections.
*- Gregory L Reichert 02/11/2004 09:18:20 LOCALE.SETLOCALE : (3) : do not recurs if the object is the same as main object and not first time in this method.
If Not (Vartype(oObj)="O" And Compobj( oObj, toObj ) And Not isFirst)
This.setLocale( oObj )
Endif
Endcase
Next
*--------------------------------------------
* reset forecolor to original
*--------------------------------------------
If Between(This.translate_color, 0, Rgb(255,255,255))
If (Pemstatus(toObj,"ForeColor",5) ;
AND Type("toObj.ForeColor")<>"U")
toObj.ForeColor = nFore
Endif
If (Pemstatus(toObj,"DisabledForeColor",5) ;
AND Type("toObj.DisabledForeColor")<>"U")
toObj.DisabledForeColor = nDFore
Endif
Endif
If isFirst
*--------------------------------------------
* clean up if this recurs is the first level
*--------------------------------------------
Use In (Select("qSites"))
Use In (Select("qSites0"))
Use In (Select("Locale_Source"))
Use In (Select("Locale_xref"))
Use In (Select("Locale_Lang"))
*-- refresh the entire object.
*!* modificare ROAGEST v 2.0.105
*!* toObj.Refresh
*!* modificare ROAGEST v 2.0.105 ^
Wait Clear
Endif
Return
ENDPROC
PROCEDURE setmenu && Runs and translates captions on menu.
*------------------------------------------------------------
* Description: Register and execute MPR code.
* Parameters: cMenuName, Filename and extension of MPR file.
* cMenuType,
* Return:
* Use: oLocale.SetMenu( "MyMenu.mpr","formmenu",thisform )
*------------------------------------------------------------
* Id Date By Description
* 1 02/16/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS cMenuName, cMenuType, othisform
IF TYPE("cMenuName")="L"
IF TYPE("this.aMenu[1,1]")#"L"
LOCAL i
FOR i=1 TO ALEN(THIS.aMenu,1)
DO CASE
CASE LOWER(THIS.aMenu[i,2])="menu"
DO (THIS.aMenu[i,1])
CASE LOWER(THIS.aMenu[i,2])="formmenu" AND (not ISNULL(THIS.aMenu[i,3])) AND COMPOBJ(THIS.aMenu[i,3],othisform)
KEYBOARD "{Enter}" CLEAR PLAIN
THIS.aMenu[i,3].ZORDER(0)
DO (THIS.aMenu[i,1]) WITH THIS.aMenu[i,3], .T.
CLEAR TYPEAHEAD
CASE LOWER(THIS.aMenu[i,2])="shortcut" && AND COMPOBJ(THIS.aMenu[i,3],othisform)
THIS.aMenu[i,3].ZORDER(0)
DO (THIS.aMenu[i,1])
ENDCASE
NEXT
ENDIF
ELSE
IF TYPE("this.aMenu[1,1]")#"L"
DIMENSION THIS.aMenu[ ALEN(this.aMenu,1)+1, 3]
ENDIF
THIS.aMenu[ALEN(this.aMenu,1),1] = cMenuName
THIS.aMenu[ALEN(this.aMenu,1),2] = cMenuType
THIS.aMenu[ALEN(this.aMenu,1),3] = othisform
DO CASE
CASE LOWER(cMenuType)="menu"
DO (cMenuName)
CASE LOWER(cMenuType)="formmenu"
KEYBOARD "{Enter}" CLEAR PLAIN
othisform.ZORDER(0)
DO (cMenuName) WITH othisform, .T.
CLEAR TYPEAHEAD
CASE LOWER(cMenuType)="shortcut"
DO (cMenuName)
ENDCASE
ENDIF
RETURN
ENDPROC
PROTECTED PROCEDURE setup
*------------------------------------------------------------
* Description: Attempt to determine the Locale of the VFP version, User OS setting, or default OS setting.
* Parameters: none
* Return: none
* Use: this.Setup
*------------------------------------------------------------
* Id Date By Description
* 1 08/04/2003 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LOCAL ow, lcLocale, lnLocale, cPath
lcLocale = []
*--------------------------------------------
* try registry
*--------------------------------------------
IF THIS.fromregistry
*- Gregory L Reichert 02/12/2004 13:31:22 LOCALE.SETUP : (1) : drop dependancy on WSH
lcLocale = THIS.Registry( "HKEY_CURRENT_USER\Software\Locale\"+JUSTFNAME(_vfp.DefaultFilePath)+"\"+PROPER(JUSTSTEM(JUSTFNAME(SYS(16,0))))+"\Locale" )
ENDIF
IF EMPTY(lcLocale)
*--------------------------------------------
* Try Foxpro level
*--------------------------------------------
lcLocale = IIF(VERSION(3)='00','English', lcLocale)
lcLocale = IIF(VERSION(3)='07','Russian', lcLocale)
lcLocale = IIF(VERSION(3)='33','French', lcLocale)
lcLocale = IIF(VERSION(3)='34','Spanish', lcLocale)
lcLocale = IIF(VERSION(3)='39','Italian', lcLocale)
lcLocale = IIF(VERSION(3)='48','Polish', lcLocale)
lcLocale = IIF(VERSION(3)='49','German', lcLocale)
lcLocale = IIF(VERSION(3)='55','Portuguese', lcLocale)
lcLocale = IIF(VERSION(3)='42','Czech', lcLocale)
lcLocale = IIF(VERSION(3)='82','Korean', lcLocale)
lcLocale = IIF(VERSION(3)='86','Simplified_Chinese', lcLocale)
lcLocale = IIF(VERSION(3)='88','Traditional_Chinese', lcLocale)
IF EMPTY(lcLocale)
*-- default English
lcLocale = "Romana"
*--------------------------------------------
* User Level
*--------------------------------------------
DECLARE SHORT GetUserDefaultLangID IN kernel32
lnLocale = GetUserDefaultLangID()
*- Gregory L Reichert 02/09/2004 07:02:23 LOCALE.SETUP : (1) : remove CLEAR DLLS, in VFP 6.0, it clears all DLLS. (suggested by: Bhavbhuti Nathwani )
IF lnLocale # 0x0800
*lcLocale = IIF(lnLocale=0x0000 ,"Neutral",lcLocale)
*lcLocale = IIF(lnLocale=0x007f ,"The language for the invariant locale (LOCALE_INVARIANT). See MAKELCID.",lcLocale)
*lcLocale = IIF(lnLocale=0x0400 ,"Process or User Default Language",lcLocale)
*lcLocale = IIF(lnLocale=0x0800 ,"System Default Language",lcLocale)
*lcLocale = IIF(lnLocale=0x0436 ,"Afrikaans",lcLocale)
*lcLocale = IIF(lnLocale=0x041c ,"Albanian",lcLocale)
*lcLocale = IIF(lnLocale=0x0401 ,"Arabic",lcLocale) && (Saudi Arabia)
*lcLocale = IIF(lnLocale=0x0801 ,"Arabic",lcLocale) && (Iraq)
*lcLocale = IIF(lnLocale=0x0c01 ,"Arabic",lcLocale) && (Egypt)
*lcLocale = IIF(lnLocale=0x1001 ,"Arabic",lcLocale) && (Libya)
*lcLocale = IIF(lnLocale=0x1401 ,"Arabic",lcLocale) && (Algeria)
*lcLocale = IIF(lnLocale=0x1801 ,"Arabic",lcLocale) && (Morocco)
*lcLocale = IIF(lnLocale=0x1c01 ,"Arabic",lcLocale) && (Tunisia)
*lcLocale = IIF(lnLocale=0x2001 ,"Arabic",lcLocale) && (Oman)
*lcLocale = IIF(lnLocale=0x2401 ,"Arabic",lcLocale) && (Yemen)
*lcLocale = IIF(lnLocale=0x2801 ,"Arabic",lcLocale) && (Syria)
*lcLocale = IIF(lnLocale=0x2c01 ,"Arabic",lcLocale) && (Jordan)
*lcLocale = IIF(lnLocale=0x3001 ,"Arabic",lcLocale) && (Lebanon)
*lcLocale = IIF(lnLocale=0x3401 ,"Arabic",lcLocale) && (Kuwait)
*lcLocale = IIF(lnLocale=0x3801 ,"Arabic",lcLocale) && (U.A.E.)
*lcLocale = IIF(lnLocale=0x3c01 ,"Arabic",lcLocale) && (Bahrain)
*lcLocale = IIF(lnLocale=0x4001 ,"Arabic",lcLocale) && (Qatar)
*lcLocale = IIF(lnLocale=0x042b ,"Armenian",lcLocale)
*lcLocale = IIF(lnLocale=0x042c ,"Azeri",lcLocale) && (Latin)
*lcLocale = IIF(lnLocale=0x082c ,"Azeri",lcLocale) && (Cyrillic)
*lcLocale = IIF(lnLocale=0x042d ,"Basque",lcLocale)
*lcLocale = IIF(lnLocale=0x0423 ,"Belarusian",lcLocale)
*lcLocale = IIF(lnLocale=0x0402 ,"Bulgarian",lcLocale)
*lcLocale = IIF(lnLocale=0x0455 ,"Burmese",lcLocale)
*lcLocale = IIF(lnLocale=0x0403 ,"Catalan",lcLocale)
*lcLocale = IIF(lnLocale=0x0404 ,"Chinese",lcLocale) && (Taiwan)
*lcLocale = IIF(lnLocale=0x0804 ,"Chinese",lcLocale) && (PRC)
*lcLocale = IIF(lnLocale=0x0c04 ,"Chinese",lcLocale) && (Hong Kong SAR, PRC)
*lcLocale = IIF(lnLocale=0x1004 ,"Chinese",lcLocale) && (Singapore)
*lcLocale = IIF(lnLocale=0x1404 ,"Chinese",lcLocale) && (Macau SAR)
*lcLocale = IIF(lnLocale=0x041a ,"Croatian",lcLocale)
*lcLocale = IIF(lnLocale=0x0405 ,"Czech",lcLocale)
*lcLocale = IIF(lnLocale=0x0406 ,"Danish",lcLocale)
*lcLocale = IIF(lnLocale=0x0465 ,"Divehi",lcLocale)
lcLocale = IIF(lnLocale=0x0413 ,"Dutch",lcLocale) && (Netherlands)
lcLocale = IIF(lnLocale=0x0813 ,"Dutch",lcLocale) && (Belgium)
lcLocale = IIF(lnLocale=0x0409 ,"English",lcLocale) && (United States)
lcLocale = IIF(lnLocale=0x0809 ,"English",lcLocale) && (United Kingdom)
lcLocale = IIF(lnLocale=0x0c09 ,"English",lcLocale) && (Australian)
lcLocale = IIF(lnLocale=0x1009 ,"English",lcLocale) && (Canadian)
lcLocale = IIF(lnLocale=0x1409 ,"English",lcLocale) && (New Zealand)
lcLocale = IIF(lnLocale=0x1809 ,"English",lcLocale) && (Ireland)
lcLocale = IIF(lnLocale=0x1c09 ,"English",lcLocale) && (South Africa)
lcLocale = IIF(lnLocale=0x2009 ,"English",lcLocale) && (Jamaica)
lcLocale = IIF(lnLocale=0x2409 ,"English",lcLocale) && (Caribbean)
lcLocale = IIF(lnLocale=0x2809 ,"English",lcLocale) && (Belize)
lcLocale = IIF(lnLocale=0x2c09 ,"English",lcLocale) && (Trinidad)
lcLocale = IIF(lnLocale=0x3009 ,"English",lcLocale) && (Zimbabwe)
lcLocale = IIF(lnLocale=0x3409 ,"English",lcLocale) && (Philippines)
*lcLocale = IIF(lnLocale=0x0425 ,"Estonian",lcLocale)
*lcLocale = IIF(lnLocale=0x0438 ,"Faeroese",lcLocale)
*lcLocale = IIF(lnLocale=0x0429 ,"Farsi",lcLocale)
*lcLocale = IIF(lnLocale=0x040b ,"Finnish",lcLocale)
lcLocale = IIF(lnLocale=0x040c ,"French",lcLocale) && (Standard)
lcLocale = IIF(lnLocale=0x080c ,"French",lcLocale) && (Belgian)
lcLocale = IIF(lnLocale=0x0c0c ,"French",lcLocale) && (Canadian)
lcLocale = IIF(lnLocale=0x100c ,"French",lcLocale) && (Switzerland)
lcLocale = IIF(lnLocale=0x140c ,"French",lcLocale) && (Luxembourg)
lcLocale = IIF(lnLocale=0x180c ,"French",lcLocale) && (Monaco)
*lcLocale = IIF(lnLocale=0x0456 ,"Galician",lcLocale)
*lcLocale = IIF(lnLocale=0x0437 ,"Georgian",lcLocale)
lcLocale = IIF(lnLocale=0x0407 ,"German",lcLocale) && (Standard)
lcLocale = IIF(lnLocale=0x0807 ,"German",lcLocale) && (Switzerland)
lcLocale = IIF(lnLocale=0x0c07 ,"German",lcLocale) && (Austria)
lcLocale = IIF(lnLocale=0x1007 ,"German",lcLocale) && (Luxembourg)
lcLocale = IIF(lnLocale=0x1407 ,"German",lcLocale) && (Liechtenstein)
*lcLocale = IIF(lnLocale=0x0408 ,"Greek",lcLocale)
*lcLocale = IIF(lnLocale=0x0447 ,"Gujaratci",lcLocale)
*lcLocale = IIF(lnLocale=0x040d ,"Hebrew",lcLocale)
*lcLocale = IIF(lnLocale=0x0439 ,"Hindi",lcLocale)
*lcLocale = IIF(lnLocale=0x040e ,"Hungarian",lcLocale)
*lcLocale = IIF(lnLocale=0x040f ,"Icelandic",lcLocale)
*lcLocale = IIF(lnLocale=0x0421 ,"Indonesian",lcLocale)
lcLocale = IIF(lnLocale=0x0410 ,"Italian",lcLocale) && (Standard)
lcLocale = IIF(lnLocale=0x0810 ,"Italian",lcLocale) && (Switzerland)
*lcLocale = IIF(lnLocale=0x0411 ,"Japanese",lcLocale)
*lcLocale = IIF(lnLocale=0x044b ,"Kannada",lcLocale)
*lcLocale = IIF(lnLocale=0x0457 ,"Konkani",lcLocale)
*lcLocale = IIF(lnLocale=0x0412 ,"Korean",lcLocale)
*lcLocale = IIF(lnLocale=0x0812 ,"Korean",lcLocale) && (Johab)
*lcLocale = IIF(lnLocale=0x0440 ,"Kyrgyz",lcLocale)
*lcLocale = IIF(lnLocale=0x0426 ,"Latvian",lcLocale)
*lcLocale = IIF(lnLocale=0x0427 ,"Lithuanian",lcLocale)
*lcLocale = IIF(lnLocale=0x0827 ,"Lithuanian",lcLocale) && (Classic)
*lcLocale = IIF(lnLocale=0x042f ,"FYRO Macedonian",lcLocale)
*lcLocale = IIF(lnLocale=0x043e ,"Malay",lcLocale) && (Malaysian)
*lcLocale = IIF(lnLocale=0x083e ,"Malay",lcLocale) && (Brunei Darussalam)
*lcLocale = IIF(lnLocale=0x044e ,"Maratchi",lcLocale)
*lcLocale = IIF(lnLocale=0x0450 ,"Mongolian",lcLocale)
*lcLocale = IIF(lnLocale=0x0414 ,"Norwegian",lcLocale) && (Bokmal)
*lcLocale = IIF(lnLocale=0x0814 ,"Norwegian",lcLocale) && (Nynorsk)
*lcLocale = IIF(lnLocale=0x0415 ,"Polish",lcLocale)
lcLocale = IIF(lnLocale=0x0416 ,"Portuguese",lcLocale) && (Brazil)
lcLocale = IIF(lnLocale=0x0816 ,"Portuguese",lcLocale) && (Portugal)
*lcLocale = IIF(lnLocale=0x0446 ,"Punjabi",lcLocale)
lcLocale = IIF(lnLocale=0x0418 ,"Romana",lcLocale)
lcLocale = IIF(lnLocale=0x0419 ,"Russian",lcLocale)
*lcLocale = IIF(lnLocale=0x044f ,"Sanskrit",lcLocale)
*lcLocale = IIF(lnLocale=0x0c1a ,"Serbian",lcLocale) && (Cyrillic)
*lcLocale = IIF(lnLocale=0x081a ,"Serbian",lcLocale) && (Latin)
*lcLocale = IIF(lnLocale=0x041b ,"Slovak",lcLocale)
*lcLocale = IIF(lnLocale=0x0424 ,"Slovenian",lcLocale)
lcLocale = IIF(lnLocale=0x040a ,"Spanish",lcLocale) && (Spain, Traditional Sort)
lcLocale = IIF(lnLocale=0x080a ,"Spanish",lcLocale) && (Mexican)
lcLocale = IIF(lnLocale=0x0c0a ,"Spanish",lcLocale) && (Spain, Modern Sort)
lcLocale = IIF(lnLocale=0x100a ,"Spanish",lcLocale) && (Guatemala)
lcLocale = IIF(lnLocale=0x140a ,"Spanish",lcLocale) && (Costa Rica)
lcLocale = IIF(lnLocale=0x180a ,"Spanish",lcLocale) && (Panama)
lcLocale = IIF(lnLocale=0x1c0a ,"Spanish",lcLocale) && (Dominican Republic)
lcLocale = IIF(lnLocale=0x200a ,"Spanish",lcLocale) && (Venezuela)
lcLocale = IIF(lnLocale=0x240a ,"Spanish",lcLocale) && (Colombia)
lcLocale = IIF(lnLocale=0x280a ,"Spanish",lcLocale) && (Peru)
lcLocale = IIF(lnLocale=0x2c0a ,"Spanish",lcLocale) && (Argentina)
lcLocale = IIF(lnLocale=0x300a ,"Spanish",lcLocale) && (Ecuador)
lcLocale = IIF(lnLocale=0x340a ,"Spanish",lcLocale) && (Chile)
lcLocale = IIF(lnLocale=0x380a ,"Spanish",lcLocale) && (Uruguay)
lcLocale = IIF(lnLocale=0x3c0a ,"Spanish",lcLocale) && (Paraguay)
lcLocale = IIF(lnLocale=0x400a ,"Spanish",lcLocale) && (Bolivia)
lcLocale = IIF(lnLocale=0x440a ,"Spanish",lcLocale) && (El Salvador)
lcLocale = IIF(lnLocale=0x480a ,"Spanish",lcLocale) && (Honduras)
lcLocale = IIF(lnLocale=0x4c0a ,"Spanish",lcLocale) && (Nicaragua)
lcLocale = IIF(lnLocale=0x500a ,"Spanish",lcLocale) && (Puerto Rico)
*lcLocale = IIF(lnLocale=0x0430 ,"Sutu",lcLocale)
*lcLocale = IIF(lnLocale=0x0441 ,"Swahili",lcLocale) && (Kenya)
*lcLocale = IIF(lnLocale=0x041d ,"Swedish",lcLocale)
*lcLocale = IIF(lnLocale=0x081d ,"Swedish",lcLocale) && (Finland)
*lcLocale = IIF(lnLocale=0x045a ,"Syriac",lcLocale)
*lcLocale = IIF(lnLocale=0x0449 ,"Tamil",lcLocale)
*lcLocale = IIF(lnLocale=0x0444 ,"Tatar",lcLocale) && (Tatarstan)
*lcLocale = IIF(lnLocale=0x044a ,"Telugu",lcLocale)
*lcLocale = IIF(lnLocale=0x041e ,"Thai",lcLocale)
*lcLocale = IIF(lnLocale=0x041f ,"Turkish",lcLocale)
*lcLocale = IIF(lnLocale=0x0422 ,"Ukrainian",lcLocale)
*lcLocale = IIF(lnLocale=0x0420 ,"Urdu",lcLocale) && (Pakistan)
*lcLocale = IIF(lnLocale=0x0820 ,"Urdu",lcLocale) && (India)
*lcLocale = IIF(lnLocale=0x0443 ,"Uzbek",lcLocale) && (Latin)
*lcLocale = IIF(lnLocale=0x0843 ,"Uzbek",lcLocale) && (Cyrillic)
*lcLocale = IIF(lnLocale=0x042a ,"Vietnamese",lcLocale)
ELSE
*--------------------------------------------
* System Level
*--------------------------------------------
* - get from System Default
DECLARE INTEGER GetSystemDefaultLangID IN kernel32
lnLocale = BITAND( GetSystemDefaultLangID(),0x1FF)
*- Gregory L Reichert 02/09/2004 07:02:43 LOCALE.SETUP : (1) : remove CLEAR DLLS, in VFP 6.0, it clears all DLLS. (suggested by: Bhavbhuti Nathwani )
*lcLocale = IIF(lnLocale=0x00 ,"Neutral", lcLocale )
*lcLocale = IIF(lnLocale=0x01 ,"Arabic", lcLocale )
*lcLocale = IIF(lnLocale=0x02 ,"Bulgarian", lcLocale )
*lcLocale = IIF(lnLocale=0x03 ,"Catalan", lcLocale )
*lcLocale = IIF(lnLocale=0x04 ,"Chinese", lcLocale )
*lcLocale = IIF(lnLocale=0x05 ,"Czech", lcLocale )
lcLocale = IIF(lnLocale=0x06 ,"Danish", lcLocale )
lcLocale = IIF(lnLocale=0x07 ,"German", lcLocale )
lcLocale = IIF(lnLocale=0x08 ,"Greek", lcLocale )
lcLocale = IIF(lnLocale=0x09 ,"English", lcLocale )
lcLocale = IIF(lnLocale=0x0a ,"Spanish", lcLocale )
*lcLocale = IIF(lnLocale=0x0b ,"Finnish", lcLocale )
lcLocale = IIF(lnLocale=0x0c ,"French", lcLocale )
*lcLocale = IIF(lnLocale=0x0d ,"Hebrew", lcLocale )
*lcLocale = IIF(lnLocale=0x0e ,"Hungarian", lcLocale )
*lcLocale = IIF(lnLocale=0x0f ,"Icelandic", lcLocale )
lcLocale = IIF(lnLocale=0x10 ,"Italian", lcLocale )
*lcLocale = IIF(lnLocale=0x11 ,"Japanese", lcLocale )
*lcLocale = IIF(lnLocale=0x12 ,"Korean", lcLocale )
lcLocale = IIF(lnLocale=0x13 ,"Dutch", lcLocale )
lcLocale = IIF(lnLocale=0x14 ,"Norwegian", lcLocale )
*lcLocale = IIF(lnLocale=0x15 ,"Polish", lcLocale )
lcLocale = IIF(lnLocale=0x16 ,"Portuguese", lcLocale )
lcLocale = IIF(lnLocale=0x18 ,"Romana", lcLocale )
lcLocale = IIF(lnLocale=0x19 ,"Russian", lcLocale )
*lcLocale = IIF(lnLocale=0x1a ,"Croatian", lcLocale )
*lcLocale = IIF(lnLocale=0x1a ,"Serbian", lcLocale )
*lcLocale = IIF(lnLocale=0x1b ,"Slovak", lcLocale )
*lcLocale = IIF(lnLocale=0x1c ,"Albanian", lcLocale )
*lcLocale = IIF(lnLocale=0x1d ,"Swedish", lcLocale )
*lcLocale = IIF(lnLocale=0x1e ,"Thai", lcLocale )
*lcLocale = IIF(lnLocale=0x1f ,"Turkish", lcLocale )
*lcLocale = IIF(lnLocale=0x20 ,"Urdu", lcLocale )
*lcLocale = IIF(lnLocale=0x21 ,"Indonesian", lcLocale )
*lcLocale = IIF(lnLocale=0x22 ,"Ukrainian", lcLocale )
*lcLocale = IIF(lnLocale=0x23 ,"Belarusian", lcLocale )
*lcLocale = IIF(lnLocale=0x24 ,"Slovenian", lcLocale )
*lcLocale = IIF(lnLocale=0x25 ,"Estonian", lcLocale )
*lcLocale = IIF(lnLocale=0x26 ,"Latvian", lcLocale )
*lcLocale = IIF(lnLocale=0x27 ,"Lithuanian", lcLocale )
*lcLocale = IIF(lnLocale=0x29 ,"Farsi", lcLocale )
*lcLocale = IIF(lnLocale=0x2a ,"Vietnamese", lcLocale )
*lcLocale = IIF(lnLocale=0x2b ,"Armenian", lcLocale )
*lcLocale = IIF(lnLocale=0x2c ,"Azeri", lcLocale )
*lcLocale = IIF(lnLocale=0x2d ,"Basque", lcLocale )
*lcLocale = IIF(lnLocale=0x2f ,"FYRO Macedonian", lcLocale )
*lcLocale = IIF(lnLocale=0x36 ,"Afrikaans", lcLocale )
*lcLocale = IIF(lnLocale=0x37 ,"Georgian", lcLocale )
*lcLocale = IIF(lnLocale=0x38 ,"Faeroese", lcLocale )
*lcLocale = IIF(lnLocale=0x39 ,"Hindi", lcLocale )
*lcLocale = IIF(lnLocale=0x3e ,"Malay", lcLocale )
*lcLocale = IIF(lnLocale=0x3f ,"Kazak", lcLocale )
*lcLocale = IIF(lnLocale=0x40 ,"Kyrgyz", lcLocale )
*lcLocale = IIF(lnLocale=0x41 ,"Swahili", lcLocale )
*lcLocale = IIF(lnLocale=0x43 ,"Uzbek", lcLocale )
*lcLocale = IIF(lnLocale=0x44 ,"Tatar", lcLocale )
*lcLocale = IIF(lnLocale=0x46 ,"Punjabi", lcLocale )
*lcLocale = IIF(lnLocale=0x47 ,"Gujaratci", lcLocale )
*lcLocale = IIF(lnLocale=0x49 ,"Tamil", lcLocale )
*lcLocale = IIF(lnLocale=0x4a ,"Telugu", lcLocale )
*lcLocale = IIF(lnLocale=0x4b ,"Kannada", lcLocale )
*lcLocale = IIF(lnLocale=0x4e ,"Maratchi", lcLocale )
*lcLocale = IIF(lnLocale=0x4f ,"Sanskrit", lcLocale )
*lcLocale = IIF(lnLocale=0x50 ,"Mongolian", lcLocale )
*lcLocale = IIF(lnLocale=0x56 ,"Galician", lcLocale )
*lcLocale = IIF(lnLocale=0x57 ,"Konkani", lcLocale )
*lcLocale = IIF(lnLocale=0x5a ,"Syriac", lcLocale )
*lcLocale = IIF(lnLocale=0x65 ,"Divehi", lcLocale )
ENDIF
ENDIF
ENDIF
THIS.Locale = lcLocale
RETURN
ENDPROC
PROCEDURE sqlexec && Executes SQL statement either locally or remotely.
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 02/17/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS tcSQL, tcCursor, tnSession
Local llUsed, lcLocaleDb
llUsed = .F.
*--------------------------------------------
* change to correct datasession if passed.
*--------------------------------------------
IF NOT EMPTY(tnSession)
LOCAL nDS
nDS = SET("DataSession")
SET DATASESSION TO (tnSession)
ENDIF
If Dbused('locale')
llUsed = .T.
Else
lcLocaleDb = gcLocalePath + "locale.dbc"
Open Database (m.lcLocaleDb)
Endif
LOCAL fl, crlf
crlf = CHR(13)+CHR(10)
fl = SELECT()
SELECT (SELECT("qtemp"))
IF THIS.SQLCONNECT<=0 AND NOT EMPTY(THIS.sqlconnectionstring)
THIS.SQLCONNECT = SQLSTRINGCONNECT( THIS.sqlconnectionstring )
IF THIS.SQLCONNECT<=0
*--------------------------------------------
* If connecting to Driver fails, attempt to proceed with
* direct FOX statements for remainder of the life of the Locale object
*--------------------------------------------
THIS.sqlconnectionstring = ""
ENDIF
ENDIF
LOCAL lcDel, lcExact
lcDel = SET("Deleted")
lcExact = SET("Exact")
SET DELETED ON && always ignore all deleted record if table is VFP based.
SET EXACT ON
DO CASE
CASE EMPTY( THIS.sqlconnectionstring ) AND EMPTY( tcCursor )
&tcSQL
CASE EMPTY( THIS.sqlconnectionstring ) AND NOT EMPTY( tcCursor )
&tcSQL INTO CURSOR &tcCursor
CASE NOT EMPTY( THIS.sqlconnectionstring ) AND EMPTY( tcCursor )
lnResult = SQlexec(THIS.SQLCONNECT, tcSQL)
CASE NOT EMPTY( THIS.sqlconnectionstring ) AND NOT EMPTY( tcCursor )
lnResult = SQlexec( THIS.SQLCONNECT, tcSQL , tcCursor )
ENDCASE
SET DELETED &lcDel
SET EXACT &lcExact
LOCAL ARRAY aEr[1]
IF ERROR()<>0
=AERROR(aEr)
WAIT WINDOW aEr[2] NOWAIT NOCLEAR
ERROR aEr[1]
WAIT CLEAR
ENDIF
IF THIS.SQLCONNECT>-1
SQLDISCONNECT( THIS.SQLCONNECT )
THIS.SQLCONNECT = -1
ENDIF
SELECT (fl)
IF NOT EMPTY(tnSession)
SET DATASESSION TO (nDS)
ENDIF
If !llUsed And Dbused('locale')
Close Databases
Endif
RETURN .T.
ENDPROC
PROCEDURE translate && Translate a phrase to a different language
*------------------------------------------------------------
* Description: Translate phrase using Web Site. Generally this method is not called
* by outside rotuines, and is used internal when prior translation is
* not found in the aLocale array. if not found, the web site called to
* obtain the translation.
* Parameters: tcPhrase, req, def=, Phrase to be translated.
* tcLanguage, opt, def=this.Locale, Language to translate to.
* Return: String: Translated phrase, or original if unable to translate.
* Use: lcPhrase = oLocale.Translate( "This is a test" )
*------------------------------------------------------------
* Id Date By Description
* 1 08/04/2003 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS tcPhrase
*--------------------------------------------
* if object diabled, return original phrase
*--------------------------------------------
IF THIS.ENABLED= .F.
RETURN tcPhrase
ENDIF
LOCAL cHTML,lcTranslated, x, lp, o, F, i, crlf
crlf = CHR(13)+CHR(10)
*- Gregory L Reichert 02/09/2004 07:18:16 LOCALE.TRANSLATE : (2) : Moved to CallSite.
*--------------------------------------------
* Array columns in aLocale
*--------------------------------------------
#DEFINE kSource 1
#DEFINE kDestination 2
#DEFINE kID 3
*--------------------------------------------
* if tcLanguage missing, use .Locale
*--------------------------------------------
THIS.Locale = ALLTRIM(THIS.Locale)
IF NOT THIS.quite
THIS.ncount = THIS.ncount + 1
ENDIF
*--------------------------------------------
* try google first.
*--------------------------------------------
lcTranslated=tcPhrase
x = THIS.ArrayLookup( tcPhrase, kDestination)
IF x>0
*-- already translated.
RETURN tcPhrase
ENDIF
LOCAL nAll
FOR nAll = 1 TO THIS.nallsitesattempt
*--------------------------------------------
* call the sites and translate
*--------------------------------------------
IF THIS.BaseLang == THIS.Locale
lcTranslated = tcPhrase
ELSE
IF This.Searchinternet
lcTranslated = THIS.CallSite( tcPhrase )
ENDIF
ENDIF
*--------------------------------------------
* did it translate?
*--------------------------------------------
DO CASE
CASE lcTranslated == THIS.lasttranslation AND tcPhrase # THIS.lastphrase
LOOP
CASE EMPTY(lcTranslated)
lcTranslated = tcPhrase
CASE OCCURS("??",lcTranslated)>0 && unable to tranlate
lcTranslated = tcPhrase
OTHERWISE
*--------------------------------------------
* for debug: log trnalation
*--------------------------------------------
*!* modificare ROAGEST v 2.0.105
*!* STRTOFILE( THIS.Locale+ ": " + tcPhrase + " => " + lcTranslated + CHR(13)+CHR(10), "Locale.log",.T.)
*!* modificare ROAGEST v 2.0.105 ^
LOCAL fl, lnID
fl = SELECT()
SELECT (SELECT("qtemp"))
*--------------------------------------------
* Insert into Locale
*--------------------------------------------
*- find original phrases
tcPhrase = STRTRAN(STRTRAN(tcPhrase,crlf,"/r"),['],["])
THIS.SQlexec( "SELECT ID FROM Locale" ;
+" WHERE TRIM(Phrase)='" + tcPhrase + "'" ;
+" AND TRIM(LANGUAGE)='"+THIS.BaseLang+"'" ;
+" and LEN(Phrase)=LEN('"+tcPhrase+"') " ;
+IIF(ATC("foxpro",THIS.sqlconnectionstring)>0 OR EMPTY(THIS.sqlconnectionstring)," AND NOT DELETED()","") ;
, "qtemp" )
IF EOF("qtemp") && not found, add
*- find highest ID number
THIS.SQlexec( "SELECT ID FROM Locale" ;
+" WHERE TRIM(LANGUAGE)='"+THIS.BaseLang+"'" ;
+" ORDER BY 1 DESC " ;
, "qtemp" )
IF EOF("qtemp" )
lnID = 1
ELSE
*- increment
lnID = VAL(TRANSFORM(qtemp.ID))+1
ENDIF
*- add original phrase
IF this.llocale
THIS.SQlexec( "INSERT INTO Locale (Phrase,LANGUAGE,Notes,ID) VALUES ( STRTRAN('"+tcPhrase+"','/r',crlf),'"+ THIS.BaseLang+"','',"+TRANSFORM(lnID)+" )")
*--------------------------------------------
* update internal array
*--------------------------------------------
THIS.LoadArray()
ENDIF
ELSE
lnID = qtemp.ID
ENDIF
*- Gregory L Reichert 02/19/2004 10:18:43 LOCALE.TRANSLATE : (1) : also, if the phrase did not change, don't save as destination language.
DO CASE
CASE (THIS.BaseLang == THIS.Locale)
CASE THIS.notranslation_attempt
OTHERWISE
IF this.llocale
*--------------------------------------------
* insert new tranlated record
*--------------------------------------------
LOCAL lcNotes
lcNotes = IIF(tcPhrase==lcTranslated,"Could not be properly translated.","")
lcTranslated = STRTRAN(STRTRAN(lcTranslated,crlf,"/r"),['],["])
THIS.SQlexec( "INSERT INTO Locale (Phrase,LANGUAGE,Notes,ID) VALUES ( STRTRAN('"+lcTranslated+"','/r',crlf),'"+ THIS.Locale+"','"+lcNotes+"',"+TRANSFORM(lnID)+" )")
*--------------------------------------------
* update internal array
*--------------------------------------------
THIS.LoadArray()
ENDIF
ENDCASE
*--------------------------------------------
* clean up
*--------------------------------------------
USE IN (SELECT("qtemp"))
SELECT (fl)
EXIT
ENDCASE
NEXT
THIS.lasttranslation = lcTranslated
THIS.lastphrase = tcPhrase
*WAIT CLEAR
RETURN lcTranslated
ENDPROC
PROCEDURE translate_property && Translates a single property of an object
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 03/05/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS oObj, tcProp, tcPos
LOCAL lcCRLF, cText
DO CASE
CASE NOT PEMSTATUS(oObj,tcProp,5)
CASE TYPE("oObj."+tcProp)="U"
CASE EMPTY(EVALUATE("oObj."+tcProp))
OTHERWISE
IF NOT EMPTY(oObj.Locale_Original[tcPos])
*-- reset caption to original
cText = oObj.Locale_Original[tcPos]
ELSE
cText = EVALUATE("oObj."+tcProp)
IF ALEN(oObj.Locale_Original,1) < tcPos
DIMENSION oObj.Locale_Original[ tcPos ]
ENDIF
oObj.Locale_Original[tcPos] = cText
ENDIF
IF NOT EMPTY(cText)
STORE THIS.GetString(cText) TO ("oObj."+tcProp)
ENDIF
ENDCASE
RETURN
ENDPROC
PROCEDURE unescape && Remove HTML conversions
*------------------------------------------------------------
* Description:
* Parameters: <para>, <req/opt>, D=<def>, <desc>
* Return:
* Use:
*------------------------------------------------------------
* Id Date By Description
* 1 03/01/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS tcStr
LOCAL lcStr
lcStr = tcStr
IF "&"$lcStr
lcStr = STRTRAN(lcStr,"&"+"amp;","&")
lcStr = STRTRAN(lcStr,"&"+"nbsp;"," ")
lcStr = STRTRAN(lcStr,"&"+"tab;"," ")
lcStr = STRTRAN(lcStr,"&"+"gt;",">")
lcStr = STRTRAN(lcStr,"&"+"lt;","<")
ENDIF
RETURN lcStr
ENDPROC
ENDDEFINE
DEFINE CLASS locale_dummy AS container
*< CLASSDATA: Baseclass="container" Timestamp="" Scale="Pixels" Uniqueid="" />
*<DefinedPropArrayMethod>
*m: arraylookup && Search the aLocale array for a phrase
*m: callsite && Call a site and retreives the translated text
*m: captioncount && Count all possible text that can be trnaslated
*m: closepopup && Closes popup internet window. This sometimes occurs with access Dictionary.com
*m: convertall && Convert all Base phrases to all Languages
*m: dolabel && Translates and runs a Label
*m: doreport && Translated and runs a report,
*m: getstring && Translate a string from the BaseLang to a specific language
*m: getwindows
*m: loadarray && Loads the internal array with the current language translations.
*m: locale_assign
*m: ping && Test to see if Internet is available.
*m: registry && Get and Put to the Registry
*m: setlocale && Translates a object and child objects.
*m: setmenu && Runs and translates captions on menu.
*m: setup
*m: sqlexec && Executes SQL statement either locally or remotely.
*m: translate && Translate a phrase to a different language
*m: translate_property && Translates a single property of an object
*m: unescape && Remove HTML conversions
*p: baselang && Base source locale
*p: debug && If true, display debug information while translating.
*p: disable_images && Disables the images on the page. They are not downloaded for speed.
*p: fromregistry && if True, the current locale is store and retreived from the Registry. HKEY_CURRENT_USER\Software\Locale\Locale
*p: lastphrase && Last phrase translated, if the next phrase is the same, then LastTrasnlation is return instead of quering the Internet.
*p: lasttranslation && Last translated phrase
*p: lclosepopup && If true, any popup browser window that opens while translating is closed.
*p: llocale
*p: llsucces
*p: locale && Current Locale
*p: ltranslateactiveform
*p: nallsitesattempt && The number a times any single site is queried before giving up and moving to the next site.
*p: ncount && Number of words translated during this session.
*p: notranslation_attempt && If true, none of the site tested could produce a translation.
*p: online && if true, the internet is accessable.
*p: property_list && List of properties that need to be translated.
*p: quite && Pervents the WAIT window during translation.
*p: resetsites && Reset all sites to give each a equal change at trtanslating.
*p: searchinternet
*p: sqlconnect && SQL Connection Handle. default -1
*p: sqlconnectionstring && Valid SQL Connection String. If blank, SQL statement are called as VFP.
*p: translate_color && The color the text assumes will translation is occuring. If -1, color does not change.
*p: usedchar && Used to Hot Key buttons.
*p: version && Class Vesion Number
*a: alocale[1,2] && Collection of language translations
*a: amenu[1,3]
*a: awindows[1,2] && List of openned OS Windows.
*</DefinedPropArrayMethod>
HIDDEN ActiveControl,AddObject,AddProperty,BackColor,BackStyle,BorderColor,BorderWidth,Click,CloneObject,ColorSource,ControlCount,Controls,DblClick,Destroy,DragDrop,DragIcon,DragMode,DragOver,Drag,Draw,ForeColor,GotFocus,Height,HelpContextID,LostFocus,MiddleClick,MouseDown,MouseEnter,MouseIcon,MouseLeave,MouseMove,MousePointer,MouseUp,MouseWheel,Moved,Move,NewObject,Objects,OLECompleteDrag,OLEDragDrop,OLEDragMode,OLEDragOver,OLEDragPicture,OLEDrag,OLEDropEffects,OLEDropHasData,OLEDropMode,OLEGiveFeedback,OLESetData,OLEStartDrag,Picture,ReadExpression,ReadMethod,Refresh,RemoveObject,ResetToDefault,Resize,RightClick,SaveAsClass,SetAll,SetFocus,ShowWhatsThis,SpecialEffect,StatusBarText,Style,TabIndex,TabStop,Tag,ToolTipText,UIEnable,Visible,WhatsThisHelpID,Width,WriteExpression,WriteMethod,ZOrder
PROTECTED alocale,amenu,awindows,lastphrase,lasttranslation,Name,ncount,sqlconnect,usedchar,version
*<PropValue>
BackStyle = 0
baselang = Romana
BorderColor = 255,0,255
Comment = "8/18/2003"
debug = .F.
disable_images = .F.
Enabled = .T.
fromregistry = .T.
Height = 20
lastphrase =
lasttranslation =
lclosepopup = .T.
llocale = .F.
llsucces = .F.
locale = English
ltranslateactiveform = .F.
nallsitesattempt = 1
Name = "locale_dummy"
ncount = 0
notranslation_attempt = .F.
online = .NULL.
property_list = Caption,ToolTipText,StatusBarText
quite = .F.
resetsites = .F.
searchinternet = .F.
sqlconnect = -1
sqlconnectionstring =
TabStop = .F.
translate_color = (rgb(255,0,0))
usedchar = ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
version = 1.50.00299
Width = 20
*</PropValue>
PROTECTED PROCEDURE arraylookup && Search the aLocale array for a phrase
ENDPROC
PROCEDURE callsite && Call a site and retreives the translated text
ENDPROC
PROCEDURE captioncount && Count all possible text that can be trnaslated
ENDPROC
PROCEDURE closepopup && Closes popup internet window. This sometimes occurs with access Dictionary.com
ENDPROC
PROCEDURE convertall && Convert all Base phrases to all Languages
ENDPROC
HIDDEN PROCEDURE Destroy
*------------------------------------------------------------
* Description: Destory method
* Parameters: none
* Return: n/a
* Use: n/a
*------------------------------------------------------------
* Id Date By Description
* 1 08/11/2003 Gregory L Reichert Initial Creation
* 2 02/12/2004 GLR Drop dependency on WSH
*------------------------------------------------------------
*--------------------------------------------
* clear aMenu to remove references to objects.
*--------------------------------------------
THIS.aMenu = ""
*--------------------------------------------
* close Locale tables
*--------------------------------------------
IF THIS.SQLCONNECT >0
SQLDISCONNECT( THIS.SQLCONNECT )
ENDIF
USE IN (SELECT("locale"))
USE IN (SELECT("locale_lang"))
USE IN (SELECT("locale_xref"))
USE IN (SELECT("locale_source"))
IF THIS.fromregistry
*- Gregory L Reichert 02/12/2004 13:33:25 LOCALE.DESTROY : (2) : remove dependancy on WSH
THIS.Registry( "HKEY_CURRENT_USER\Software\Locale\"+JUSTFNAME(_vfp.DefaultFilePath)+"\"+PROPER(JUSTSTEM(JUSTFNAME(SYS(16,0))))+"\Locale", THIS.Locale )
ENDIF
ENDPROC
PROCEDURE dolabel && Translates and runs a Label
ENDPROC
PROCEDURE doreport && Translated and runs a report,
ENDPROC
PROCEDURE getstring && Translate a string from the BaseLang to a specific language
LPARAMETERS tcStr
RETURN tcStr
ENDPROC
PROCEDURE getwindows
ENDPROC
PROCEDURE Init
*------------------------------------------------------------
* Description: Initialize Object
* Parameters: tcBaseLang, Opt, Def=.F., Base Language used to create form and controls.
* tcDestLang, Opt, Def=.F., Destination Language to be translated to.
* Return: N/A
* Use: oLocale= NewObject("Locale","Locale.vcx","","English","Spanish" )
*------------------------------------------------------------
* Id Date By Description
* 1 08/18/2003 Gregory L Reichert Initial Creation
* 2 2/16/2004 GLR Drop WebBrowser control.
*------------------------------------------------------------
LPARAMETERS tcBaseLang, tcDestLang
SET SAFETY OFF
ERASE ("Locale.log")
*------------------------------------------------------------
* Establish the base and locale languages.
*------------------------------------------------------------
IF NOT EMPTY(tcBaseLang)
THIS.BaseLang = tcBaseLang
ENDIF
IF NOT EMPTY(tcDestLang)
THIS.Locale = tcDestLang
ELSE
THIS.SETUP
ENDIF
RETURN
*="DSN=Visual FoxPro Database;UID=;PWD=;SourceDB="+fullpath("")+"locale.dbc;SourceType=DBC;Exclusive=No;BackgroundFetch=No;Collate=Machine;Null=Yes;Deleted=Yes;"
ENDPROC
PROTECTED PROCEDURE loadarray && Loads the internal array with the current language translations.
ENDPROC
PROTECTED PROCEDURE locale_assign
ENDPROC
PROCEDURE ping && Test to see if Internet is available.
ENDPROC
PROCEDURE registry && Get and Put to the Registry
ENDPROC
PROCEDURE setlocale && Translates a object and child objects.
Lparameter toObj
Return
ENDPROC
PROCEDURE setmenu && Runs and translates captions on menu.
*------------------------------------------------------------
* Description: Register and execute MPR code.
* Parameters: cMenuName, Filename and extension of MPR file.
* cMenuType,
* Return:
* Use: oLocale.SetMenu( "MyMenu.mpr","formmenu",thisform )
*------------------------------------------------------------
* Id Date By Description
* 1 02/16/2004 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LPARAMETERS cMenuName, cMenuType, othisform
IF TYPE("cMenuName")="L"
IF TYPE("this.aMenu[1,1]")#"L"
LOCAL i
FOR i=1 TO ALEN(THIS.aMenu,1)
DO CASE
CASE LOWER(THIS.aMenu[i,2])="menu"
DO (THIS.aMenu[i,1])
CASE LOWER(THIS.aMenu[i,2])="formmenu" AND (not ISNULL(THIS.aMenu[i,3])) AND COMPOBJ(THIS.aMenu[i,3],othisform)
KEYBOARD "{Enter}" CLEAR PLAIN
THIS.aMenu[i,3].ZORDER(0)
DO (THIS.aMenu[i,1]) WITH THIS.aMenu[i,3], .T.
CLEAR TYPEAHEAD
CASE LOWER(THIS.aMenu[i,2])="shortcut" && AND COMPOBJ(THIS.aMenu[i,3],othisform)
THIS.aMenu[i,3].ZORDER(0)
DO (THIS.aMenu[i,1])
ENDCASE
NEXT
ENDIF
ELSE
IF TYPE("this.aMenu[1,1]")#"L"
DIMENSION THIS.aMenu[ ALEN(this.aMenu,1)+1, 3]
ENDIF
THIS.aMenu[ALEN(this.aMenu,1),1] = cMenuName
THIS.aMenu[ALEN(this.aMenu,1),2] = cMenuType
THIS.aMenu[ALEN(this.aMenu,1),3] = othisform
DO CASE
CASE LOWER(cMenuType)="menu"
DO (cMenuName)
CASE LOWER(cMenuType)="formmenu"
KEYBOARD "{Enter}" CLEAR PLAIN
othisform.ZORDER(0)
DO (cMenuName) WITH othisform, .T.
CLEAR TYPEAHEAD
CASE LOWER(cMenuType)="shortcut"
DO (cMenuName)
ENDCASE
ENDIF
RETURN
ENDPROC
PROTECTED PROCEDURE setup
*------------------------------------------------------------
* Description: Attempt to determine the Locale of the VFP version, User OS setting, or default OS setting.
* Parameters: none
* Return: none
* Use: this.Setup
*------------------------------------------------------------
* Id Date By Description
* 1 08/04/2003 Gregory L Reichert Initial Creation
*------------------------------------------------------------
LOCAL ow, lcLocale, lnLocale, cPath
lcLocale = []
*--------------------------------------------
* try registry
*--------------------------------------------
IF THIS.fromregistry
*- Gregory L Reichert 02/12/2004 13:31:22 LOCALE.SETUP : (1) : drop dependancy on WSH
lcLocale = THIS.Registry( "HKEY_CURRENT_USER\Software\Locale\"+JUSTFNAME(_vfp.DefaultFilePath)+"\"+PROPER(JUSTSTEM(JUSTFNAME(SYS(16,0))))+"\Locale" )
ENDIF
IF EMPTY(lcLocale)
*--------------------------------------------
* Try Foxpro level
*--------------------------------------------
lcLocale = IIF(VERSION(3)='00','English', lcLocale)
lcLocale = IIF(VERSION(3)='07','Russian', lcLocale)
lcLocale = IIF(VERSION(3)='33','French', lcLocale)
lcLocale = IIF(VERSION(3)='34','Spanish', lcLocale)
lcLocale = IIF(VERSION(3)='39','Italian', lcLocale)
lcLocale = IIF(VERSION(3)='48','Polish', lcLocale)
lcLocale = IIF(VERSION(3)='49','German', lcLocale)
lcLocale = IIF(VERSION(3)='55','Portuguese', lcLocale)
lcLocale = IIF(VERSION(3)='42','Czech', lcLocale)
lcLocale = IIF(VERSION(3)='82','Korean', lcLocale)
lcLocale = IIF(VERSION(3)='86','Simplified_Chinese', lcLocale)
lcLocale = IIF(VERSION(3)='88','Traditional_Chinese', lcLocale)
IF EMPTY(lcLocale)
*-- default English
lcLocale = "Romana"
*--------------------------------------------
* User Level
*--------------------------------------------
DECLARE SHORT GetUserDefaultLangID IN kernel32
lnLocale = GetUserDefaultLangID()
*- Gregory L Reichert 02/09/2004 07:02:23 LOCALE.SETUP : (1) : remove CLEAR DLLS, in VFP 6.0, it clears all DLLS. (suggested by: Bhavbhuti Nathwani )
IF lnLocale # 0x0800
*lcLocale = IIF(lnLocale=0x0000 ,"Neutral",lcLocale)
*lcLocale = IIF(lnLocale=0x007f ,"The language for the invariant locale (LOCALE_INVARIANT). See MAKELCID.",lcLocale)
*lcLocale = IIF(lnLocale=0x0400 ,"Process or User Default Language",lcLocale)
*lcLocale = IIF(lnLocale=0x0800 ,"System Default Language",lcLocale)
*lcLocale = IIF(lnLocale=0x0436 ,"Afrikaans",lcLocale)
*lcLocale = IIF(lnLocale=0x041c ,"Albanian",lcLocale)
*lcLocale = IIF(lnLocale=0x0401 ,"Arabic",lcLocale) && (Saudi Arabia)
*lcLocale = IIF(lnLocale=0x0801 ,"Arabic",lcLocale) && (Iraq)
*lcLocale = IIF(lnLocale=0x0c01 ,"Arabic",lcLocale) && (Egypt)
*lcLocale = IIF(lnLocale=0x1001 ,"Arabic",lcLocale) && (Libya)
*lcLocale = IIF(lnLocale=0x1401 ,"Arabic",lcLocale) && (Algeria)
*lcLocale = IIF(lnLocale=0x1801 ,"Arabic",lcLocale) && (Morocco)
*lcLocale = IIF(lnLocale=0x1c01 ,"Arabic",lcLocale) && (Tunisia)
*lcLocale = IIF(lnLocale=0x2001 ,"Arabic",lcLocale) && (Oman)
*lcLocale = IIF(lnLocale=0x2401 ,"Arabic",lcLocale) && (Yemen)
*lcLocale = IIF(lnLocale=0x2801 ,"Arabic",lcLocale) && (Syria)
*lcLocale = IIF(lnLocale=0x2c01 ,"Arabic",lcLocale) && (Jordan)
*lcLocale = IIF(lnLocale=0x3001 ,"Arabic",lcLocale) && (Lebanon)
*lcLocale = IIF(lnLocale=0x3401 ,"Arabic",lcLocale) && (Kuwait)
*lcLocale = IIF(lnLocale=0x3801 ,"Arabic",lcLocale) && (U.A.E.)
*lcLocale = IIF(lnLocale=0x3c01 ,"Arabic",lcLocale) && (Bahrain)
*lcLocale = IIF(lnLocale=0x4001 ,"Arabic",lcLocale) && (Qatar)
*lcLocale = IIF(lnLocale=0x042b ,"Armenian",lcLocale)
*lcLocale = IIF(lnLocale=0x042c ,"Azeri",lcLocale) && (Latin)
*lcLocale = IIF(lnLocale=0x082c ,"Azeri",lcLocale) && (Cyrillic)
*lcLocale = IIF(lnLocale=0x042d ,"Basque",lcLocale)
*lcLocale = IIF(lnLocale=0x0423 ,"Belarusian",lcLocale)
*lcLocale = IIF(lnLocale=0x0402 ,"Bulgarian",lcLocale)
*lcLocale = IIF(lnLocale=0x0455 ,"Burmese",lcLocale)
*lcLocale = IIF(lnLocale=0x0403 ,"Catalan",lcLocale)
*lcLocale = IIF(lnLocale=0x0404 ,"Chinese",lcLocale) && (Taiwan)
*lcLocale = IIF(lnLocale=0x0804 ,"Chinese",lcLocale) && (PRC)
*lcLocale = IIF(lnLocale=0x0c04 ,"Chinese",lcLocale) && (Hong Kong SAR, PRC)
*lcLocale = IIF(lnLocale=0x1004 ,"Chinese",lcLocale) && (Singapore)
*lcLocale = IIF(lnLocale=0x1404 ,"Chinese",lcLocale) && (Macau SAR)
*lcLocale = IIF(lnLocale=0x041a ,"Croatian",lcLocale)
*lcLocale = IIF(lnLocale=0x0405 ,"Czech",lcLocale)
*lcLocale = IIF(lnLocale=0x0406 ,"Danish",lcLocale)
*lcLocale = IIF(lnLocale=0x0465 ,"Divehi",lcLocale)
lcLocale = IIF(lnLocale=0x0413 ,"Dutch",lcLocale) && (Netherlands)
lcLocale = IIF(lnLocale=0x0813 ,"Dutch",lcLocale) && (Belgium)
lcLocale = IIF(lnLocale=0x0409 ,"English",lcLocale) && (United States)
lcLocale = IIF(lnLocale=0x0809 ,"English",lcLocale) && (United Kingdom)
lcLocale = IIF(lnLocale=0x0c09 ,"English",lcLocale) && (Australian)
lcLocale = IIF(lnLocale=0x1009 ,"English",lcLocale) && (Canadian)
lcLocale = IIF(lnLocale=0x1409 ,"English",lcLocale) && (New Zealand)
lcLocale = IIF(lnLocale=0x1809 ,"English",lcLocale) && (Ireland)
lcLocale = IIF(lnLocale=0x1c09 ,"English",lcLocale) && (South Africa)
lcLocale = IIF(lnLocale=0x2009 ,"English",lcLocale) && (Jamaica)
lcLocale = IIF(lnLocale=0x2409 ,"English",lcLocale) && (Caribbean)
lcLocale = IIF(lnLocale=0x2809 ,"English",lcLocale) && (Belize)
lcLocale = IIF(lnLocale=0x2c09 ,"English",lcLocale) && (Trinidad)
lcLocale = IIF(lnLocale=0x3009 ,"English",lcLocale) && (Zimbabwe)
lcLocale = IIF(lnLocale=0x3409 ,"English",lcLocale) && (Philippines)
*lcLocale = IIF(lnLocale=0x0425 ,"Estonian",lcLocale)
*lcLocale = IIF(lnLocale=0x0438 ,"Faeroese",lcLocale)
*lcLocale = IIF(lnLocale=0x0429 ,"Farsi",lcLocale)
*lcLocale = IIF(lnLocale=0x040b ,"Finnish",lcLocale)
lcLocale = IIF(lnLocale=0x040c ,"French",lcLocale) && (Standard)
lcLocale = IIF(lnLocale=0x080c ,"French",lcLocale) && (Belgian)
lcLocale = IIF(lnLocale=0x0c0c ,"French",lcLocale) && (Canadian)
lcLocale = IIF(lnLocale=0x100c ,"French",lcLocale) && (Switzerland)
lcLocale = IIF(lnLocale=0x140c ,"French",lcLocale) && (Luxembourg)
lcLocale = IIF(lnLocale=0x180c ,"French",lcLocale) && (Monaco)
*lcLocale = IIF(lnLocale=0x0456 ,"Galician",lcLocale)
*lcLocale = IIF(lnLocale=0x0437 ,"Georgian",lcLocale)
lcLocale = IIF(lnLocale=0x0407 ,"German",lcLocale) && (Standard)
lcLocale = IIF(lnLocale=0x0807 ,"German",lcLocale) && (Switzerland)
lcLocale = IIF(lnLocale=0x0c07 ,"German",lcLocale) && (Austria)
lcLocale = IIF(lnLocale=0x1007 ,"German",lcLocale) && (Luxembourg)
lcLocale = IIF(lnLocale=0x1407 ,"German",lcLocale) && (Liechtenstein)
*lcLocale = IIF(lnLocale=0x0408 ,"Greek",lcLocale)
*lcLocale = IIF(lnLocale=0x0447 ,"Gujaratci",lcLocale)
*lcLocale = IIF(lnLocale=0x040d ,"Hebrew",lcLocale)
*lcLocale = IIF(lnLocale=0x0439 ,"Hindi",lcLocale)
*lcLocale = IIF(lnLocale=0x040e ,"Hungarian",lcLocale)
*lcLocale = IIF(lnLocale=0x040f ,"Icelandic",lcLocale)
*lcLocale = IIF(lnLocale=0x0421 ,"Indonesian",lcLocale)
lcLocale = IIF(lnLocale=0x0410 ,"Italian",lcLocale) && (Standard)
lcLocale = IIF(lnLocale=0x0810 ,"Italian",lcLocale) && (Switzerland)
*lcLocale = IIF(lnLocale=0x0411 ,"Japanese",lcLocale)
*lcLocale = IIF(lnLocale=0x044b ,"Kannada",lcLocale)
*lcLocale = IIF(lnLocale=0x0457 ,"Konkani",lcLocale)
*lcLocale = IIF(lnLocale=0x0412 ,"Korean",lcLocale)
*lcLocale = IIF(lnLocale=0x0812 ,"Korean",lcLocale) && (Johab)
*lcLocale = IIF(lnLocale=0x0440 ,"Kyrgyz",lcLocale)
*lcLocale = IIF(lnLocale=0x0426 ,"Latvian",lcLocale)
*lcLocale = IIF(lnLocale=0x0427 ,"Lithuanian",lcLocale)
*lcLocale = IIF(lnLocale=0x0827 ,"Lithuanian",lcLocale) && (Classic)
*lcLocale = IIF(lnLocale=0x042f ,"FYRO Macedonian",lcLocale)
*lcLocale = IIF(lnLocale=0x043e ,"Malay",lcLocale) && (Malaysian)
*lcLocale = IIF(lnLocale=0x083e ,"Malay",lcLocale) && (Brunei Darussalam)
*lcLocale = IIF(lnLocale=0x044e ,"Maratchi",lcLocale)
*lcLocale = IIF(lnLocale=0x0450 ,"Mongolian",lcLocale)
*lcLocale = IIF(lnLocale=0x0414 ,"Norwegian",lcLocale) && (Bokmal)
*lcLocale = IIF(lnLocale=0x0814 ,"Norwegian",lcLocale) && (Nynorsk)
*lcLocale = IIF(lnLocale=0x0415 ,"Polish",lcLocale)
lcLocale = IIF(lnLocale=0x0416 ,"Portuguese",lcLocale) && (Brazil)
lcLocale = IIF(lnLocale=0x0816 ,"Portuguese",lcLocale) && (Portugal)
*lcLocale = IIF(lnLocale=0x0446 ,"Punjabi",lcLocale)
lcLocale = IIF(lnLocale=0x0418 ,"Romana",lcLocale)
lcLocale = IIF(lnLocale=0x0419 ,"Russian",lcLocale)
*lcLocale = IIF(lnLocale=0x044f ,"Sanskrit",lcLocale)
*lcLocale = IIF(lnLocale=0x0c1a ,"Serbian",lcLocale) && (Cyrillic)
*lcLocale = IIF(lnLocale=0x081a ,"Serbian",lcLocale) && (Latin)
*lcLocale = IIF(lnLocale=0x041b ,"Slovak",lcLocale)
*lcLocale = IIF(lnLocale=0x0424 ,"Slovenian",lcLocale)
lcLocale = IIF(lnLocale=0x040a ,"Spanish",lcLocale) && (Spain, Traditional Sort)
lcLocale = IIF(lnLocale=0x080a ,"Spanish",lcLocale) && (Mexican)
lcLocale = IIF(lnLocale=0x0c0a ,"Spanish",lcLocale) && (Spain, Modern Sort)
lcLocale = IIF(lnLocale=0x100a ,"Spanish",lcLocale) && (Guatemala)
lcLocale = IIF(lnLocale=0x140a ,"Spanish",lcLocale) && (Costa Rica)
lcLocale = IIF(lnLocale=0x180a ,"Spanish",lcLocale) && (Panama)
lcLocale = IIF(lnLocale=0x1c0a ,"Spanish",lcLocale) && (Dominican Republic)
lcLocale = IIF(lnLocale=0x200a ,"Spanish",lcLocale) && (Venezuela)
lcLocale = IIF(lnLocale=0x240a ,"Spanish",lcLocale) && (Colombia)
lcLocale = IIF(lnLocale=0x280a ,"Spanish",lcLocale) && (Peru)
lcLocale = IIF(lnLocale=0x2c0a ,"Spanish",lcLocale) && (Argentina)
lcLocale = IIF(lnLocale=0x300a ,"Spanish",lcLocale) && (Ecuador)
lcLocale = IIF(lnLocale=0x340a ,"Spanish",lcLocale) && (Chile)
lcLocale = IIF(lnLocale=0x380a ,"Spanish",lcLocale) && (Uruguay)
lcLocale = IIF(lnLocale=0x3c0a ,"Spanish",lcLocale) && (Paraguay)
lcLocale = IIF(lnLocale=0x400a ,"Spanish",lcLocale) && (Bolivia)
lcLocale = IIF(lnLocale=0x440a ,"Spanish",lcLocale) && (El Salvador)
lcLocale = IIF(lnLocale=0x480a ,"Spanish",lcLocale) && (Honduras)
lcLocale = IIF(lnLocale=0x4c0a ,"Spanish",lcLocale) && (Nicaragua)
lcLocale = IIF(lnLocale=0x500a ,"Spanish",lcLocale) && (Puerto Rico)
*lcLocale = IIF(lnLocale=0x0430 ,"Sutu",lcLocale)
*lcLocale = IIF(lnLocale=0x0441 ,"Swahili",lcLocale) && (Kenya)
*lcLocale = IIF(lnLocale=0x041d ,"Swedish",lcLocale)
*lcLocale = IIF(lnLocale=0x081d ,"Swedish",lcLocale) && (Finland)
*lcLocale = IIF(lnLocale=0x045a ,"Syriac",lcLocale)
*lcLocale = IIF(lnLocale=0x0449 ,"Tamil",lcLocale)
*lcLocale = IIF(lnLocale=0x0444 ,"Tatar",lcLocale) && (Tatarstan)
*lcLocale = IIF(lnLocale=0x044a ,"Telugu",lcLocale)
*lcLocale = IIF(lnLocale=0x041e ,"Thai",lcLocale)
*lcLocale = IIF(lnLocale=0x041f ,"Turkish",lcLocale)
*lcLocale = IIF(lnLocale=0x0422 ,"Ukrainian",lcLocale)
*lcLocale = IIF(lnLocale=0x0420 ,"Urdu",lcLocale) && (Pakistan)
*lcLocale = IIF(lnLocale=0x0820 ,"Urdu",lcLocale) && (India)
*lcLocale = IIF(lnLocale=0x0443 ,"Uzbek",lcLocale) && (Latin)
*lcLocale = IIF(lnLocale=0x0843 ,"Uzbek",lcLocale) && (Cyrillic)
*lcLocale = IIF(lnLocale=0x042a ,"Vietnamese",lcLocale)
ELSE
*--------------------------------------------
* System Level
*--------------------------------------------
* - get from System Default
DECLARE INTEGER GetSystemDefaultLangID IN kernel32
lnLocale = BITAND( GetSystemDefaultLangID(),0x1FF)
*- Gregory L Reichert 02/09/2004 07:02:43 LOCALE.SETUP : (1) : remove CLEAR DLLS, in VFP 6.0, it clears all DLLS. (suggested by: Bhavbhuti Nathwani )
*lcLocale = IIF(lnLocale=0x00 ,"Neutral", lcLocale )
*lcLocale = IIF(lnLocale=0x01 ,"Arabic", lcLocale )
*lcLocale = IIF(lnLocale=0x02 ,"Bulgarian", lcLocale )
*lcLocale = IIF(lnLocale=0x03 ,"Catalan", lcLocale )
*lcLocale = IIF(lnLocale=0x04 ,"Chinese", lcLocale )
*lcLocale = IIF(lnLocale=0x05 ,"Czech", lcLocale )
lcLocale = IIF(lnLocale=0x06 ,"Danish", lcLocale )
lcLocale = IIF(lnLocale=0x07 ,"German", lcLocale )
lcLocale = IIF(lnLocale=0x08 ,"Greek", lcLocale )
lcLocale = IIF(lnLocale=0x09 ,"English", lcLocale )
lcLocale = IIF(lnLocale=0x0a ,"Spanish", lcLocale )
*lcLocale = IIF(lnLocale=0x0b ,"Finnish", lcLocale )
lcLocale = IIF(lnLocale=0x0c ,"French", lcLocale )
*lcLocale = IIF(lnLocale=0x0d ,"Hebrew", lcLocale )
*lcLocale = IIF(lnLocale=0x0e ,"Hungarian", lcLocale )
*lcLocale = IIF(lnLocale=0x0f ,"Icelandic", lcLocale )
lcLocale = IIF(lnLocale=0x10 ,"Italian", lcLocale )
*lcLocale = IIF(lnLocale=0x11 ,"Japanese", lcLocale )
*lcLocale = IIF(lnLocale=0x12 ,"Korean", lcLocale )
lcLocale = IIF(lnLocale=0x13 ,"Dutch", lcLocale )
lcLocale = IIF(lnLocale=0x14 ,"Norwegian", lcLocale )
*lcLocale = IIF(lnLocale=0x15 ,"Polish", lcLocale )
lcLocale = IIF(lnLocale=0x16 ,"Portuguese", lcLocale )
lcLocale = IIF(lnLocale=0x18 ,"Romana", lcLocale )
lcLocale = IIF(lnLocale=0x19 ,"Russian", lcLocale )
*lcLocale = IIF(lnLocale=0x1a ,"Croatian", lcLocale )
*lcLocale = IIF(lnLocale=0x1a ,"Serbian", lcLocale )
*lcLocale = IIF(lnLocale=0x1b ,"Slovak", lcLocale )
*lcLocale = IIF(lnLocale=0x1c ,"Albanian", lcLocale )
*lcLocale = IIF(lnLocale=0x1d ,"Swedish", lcLocale )
*lcLocale = IIF(lnLocale=0x1e ,"Thai", lcLocale )
*lcLocale = IIF(lnLocale=0x1f ,"Turkish", lcLocale )
*lcLocale = IIF(lnLocale=0x20 ,"Urdu", lcLocale )
*lcLocale = IIF(lnLocale=0x21 ,"Indonesian", lcLocale )
*lcLocale = IIF(lnLocale=0x22 ,"Ukrainian", lcLocale )
*lcLocale = IIF(lnLocale=0x23 ,"Belarusian", lcLocale )
*lcLocale = IIF(lnLocale=0x24 ,"Slovenian", lcLocale )
*lcLocale = IIF(lnLocale=0x25 ,"Estonian", lcLocale )
*lcLocale = IIF(lnLocale=0x26 ,"Latvian", lcLocale )
*lcLocale = IIF(lnLocale=0x27 ,"Lithuanian", lcLocale )
*lcLocale = IIF(lnLocale=0x29 ,"Farsi", lcLocale )
*lcLocale = IIF(lnLocale=0x2a ,"Vietnamese", lcLocale )
*lcLocale = IIF(lnLocale=0x2b ,"Armenian", lcLocale )
*lcLocale = IIF(lnLocale=0x2c ,"Azeri", lcLocale )
*lcLocale = IIF(lnLocale=0x2d ,"Basque", lcLocale )
*lcLocale = IIF(lnLocale=0x2f ,"FYRO Macedonian", lcLocale )
*lcLocale = IIF(lnLocale=0x36 ,"Afrikaans", lcLocale )
*lcLocale = IIF(lnLocale=0x37 ,"Georgian", lcLocale )
*lcLocale = IIF(lnLocale=0x38 ,"Faeroese", lcLocale )
*lcLocale = IIF(lnLocale=0x39 ,"Hindi", lcLocale )
*lcLocale = IIF(lnLocale=0x3e ,"Malay", lcLocale )
*lcLocale = IIF(lnLocale=0x3f ,"Kazak", lcLocale )
*lcLocale = IIF(lnLocale=0x40 ,"Kyrgyz", lcLocale )
*lcLocale = IIF(lnLocale=0x41 ,"Swahili", lcLocale )
*lcLocale = IIF(lnLocale=0x43 ,"Uzbek", lcLocale )
*lcLocale = IIF(lnLocale=0x44 ,"Tatar", lcLocale )
*lcLocale = IIF(lnLocale=0x46 ,"Punjabi", lcLocale )
*lcLocale = IIF(lnLocale=0x47 ,"Gujaratci", lcLocale )
*lcLocale = IIF(lnLocale=0x49 ,"Tamil", lcLocale )
*lcLocale = IIF(lnLocale=0x4a ,"Telugu", lcLocale )
*lcLocale = IIF(lnLocale=0x4b ,"Kannada", lcLocale )
*lcLocale = IIF(lnLocale=0x4e ,"Maratchi", lcLocale )
*lcLocale = IIF(lnLocale=0x4f ,"Sanskrit", lcLocale )
*lcLocale = IIF(lnLocale=0x50 ,"Mongolian", lcLocale )
*lcLocale = IIF(lnLocale=0x56 ,"Galician", lcLocale )
*lcLocale = IIF(lnLocale=0x57 ,"Konkani", lcLocale )
*lcLocale = IIF(lnLocale=0x5a ,"Syriac", lcLocale )
*lcLocale = IIF(lnLocale=0x65 ,"Divehi", lcLocale )
ENDIF
ENDIF
ENDIF
THIS.Locale = lcLocale
RETURN
ENDPROC
PROCEDURE sqlexec && Executes SQL statement either locally or remotely.
ENDPROC
PROCEDURE translate && Translate a phrase to a different language
ENDPROC
PROCEDURE translate_property && Translates a single property of an object
ENDPROC
PROCEDURE unescape && Remove HTML conversions
ENDPROC
ENDDEFINE
Reference in New Issue View Git Blame Copy Permalink