Alaska Xbase++

Alaska Xbase++
Programiranje u Xbase++

20. 09. 2017.

Serbian (Latin, Serbia) Keyboard and Serbian cyrilic

1.
U Xbase++ programu (aplikaciji) mogu se istovremeno prikazivati i slova latinice i slova ćirilice ako se radi sa promenom codne strane (codepage) slova (fontova) i ako se za slova koriste fontovi koji imaju mogućnost prikaza ćirilice, a to su skoro svi standardni windows fontovi:
- Tahoma
- Arial
- Verdana
- Times New Roman
i ostali

Windows sistem se setuje u delu Region and Language na Serbian (Latin, Serbian)
Posle toga po defaultu Xbase++ programi rade sa kodnom stranom codepage=238/1250
ako se na startu programa zada SET CHARSET TO ANSI.

Ovo znači da će se sa tastature Serbian (Latin, Serbian) za svaki font dobijati slova ŠĐČĆŽ

Međutim, ako se za neki od navedenih fontova formira novi font objekat

oFont := XbpFont():new()
oFont:familyName := 'Arial'
oFont:nominalPointSize := 12
oFont:bold := .t.
oFont:italic := .t.
oFont:underScore := .t.
oFont:codePage := 204 // CodePage Serbian cyrilic=204/1251
oFont:create()

pa se nekom XbasePart objektu dodeli taj font sa
     oXbpBrowse:SetFont(oFont)
ili sa
     EVAL{|| oXbpBrowse:SetFont(oFont) }
taj objekat će na dalje imati tekst sa ćiriličnim slovima pod uslovom da se tekst piše sa tastature koja je postavljena na Serbian (Cyrilic, Serbian) u kom slučaju se koriste posebni tasteri za dobijanje ćiriličnih slova (slika 1)




U ovom slučaju slova u TitleBaru aplikacionih prozora biće uvek isti default font i iste default veličine i iste default kodne strane 238 i ne mogu se menjati.

Tek kada je Windows setovan na Serbian (Cyrilic, Serbian) slova u TitleBaru biće ćirilična: isti default font, iste default veličine i iste default kodne strane 204.

U ovom slučaju slova u CAPTION objekta za XbpPushbutton (komandno dugme) mogu se menjati po nazivu i po veličini, ali im se ne može menjati kodna strana, koja uvek ostaje default kodna strana = 238. To znači da ispisi na komandnim dugmadima ne mogu biti ćirilični kada je Windows setovan na Serbian (Latin, Serbian). Biće ćirilični kada Windows bude setovan na Serbian (Cyrilic, Serbian) ali tada neće moći da budu latinični ako to negde zatreba.


2.
Takođe mogu se prikazivati samo slova latinice ili samo slova ćirilice ako se kodna strana ne dira već se radi samo sa promenom fontova tako da se za neke tekstove koristi standardni windows latinični font, a za neke tekstove posebni windows ćirilični font, na primer:
za latinicu:
- Tahoma
- Arial
- Verdana
- Times New Roman
i ostali
a za ćirilicu:
- Arial Cirilica
- CHelv
- Book-Cirilica
- Bedrock Cirilica
- Cir Ardvark
- Cirilica 60
- Cirilica 80
i ostali.


I ovde se Windows sistem setuje u delu Region and Language na Serbian (Latin, Serbian)
Posle toga po defaultu Xbase++ programi rade sa kodnom stranom codepage=238/1250
ako se na startu programa zada SET CHARSET TO ANSI.

Ovo znači da će se sa tastature Serbian (Latin, Serbian) za svaki font dobijati slova ŠĐČĆŽ

Međutim, ako se za neki od navedenih fontova ćirilice formira novi font objekat

oFont := XbpFont():new()
oFont:familyName := 'Arial Cirilica'
oFont:nominalPointSize := 12
oFont:bold := .t.
oFont:italic := .t.
oFont:underScore := .t.
oFont:codePage := 238 // CodePage Serbian latin = 238/1250
oFont:create()

pa se nekom XbasePart objektu dodeli taj font sa
     oXbpBrowse:SetFont(oFont)
ili sa
     EVAL{|| oXbpBrowse:SetFont(oFont) }
taj objekat će na dalje imati tekst sa ćiriličnim slovima 'Arial Cirilica' pod uslovom da se tekst piše sa tastature koja je postavljena na Serbian (Cyrilic, Serbian) u kom slučaju se koriste posebni tasteri za dobijanje ćiriličnih slova, a drugačiji nego u prikazu iz tačke 1, (slika 2)



Upotreba ovih posebnih ćiriličnih fontova ne može se primeniti na TitleBar u aplikacionim prozorima.

U ovom slučaju slova u TitleBaru aplikacionih prozora biće uvek isti default font i iste default veličine i iste default kodne strane 238 i ne mogu se menjati.

Tek kada je Windows setovan na Serbian (Cyrilic, Serbian) slova u TitleBaru biće ćirilična: isti default font, iste default veličine i iste default kodne strane 204.






15. 03. 2015.

2.0 Alaska Xbase++ Bazne funkcije korišćene u svim demo primerima




BAZNE FUNKCIJE PRIMENJENE I KORIŠĆENE U SVIM DEMO PRIMERIMA I SVIM COBA Systems APLIKACIJAMA
Ovo su funkcije koje su neophodne svakoj COBA Systems aplikaciji i koje se stalno ponavljaju iz aplikacije u aplikaciju. Da se ne bi uvek iznova pisale u svakoj aplikaciji obično se izdvoje u LIB/DLL fajl iz koga ih može pozvati svaka aplikacija. Umesto ovih funkcija može svaki programer napisati i postaviti svoje funkcije koje otprilike rade iste stvari i daju isti rezultat. Korisničke COBA Systems funkcije izdvojene su u DLL fajlove biblioteke: BAZNE.LIB/BAZNE.DLL i BAZNEX.LIB/BAZNEX.DLL koji se koriste u svim COBA Systems aplikacijama. Ovde su te funkcije date u svojim PRG modulima koji se direktno mogu kompajlovati i linkovati u bilo koju aplikaciju pa u tom slučaju ne treba zbog njih koristiti BAZNE.DLL i BAZNEX.DLL biblioteke.


PREUZMI IZVORNI KOD ZA OVAJ PROGRAM


Korisničke COBA Systems funkcije c_poruka() i c_greska()

Poruka za korisnika: poruka o okončanju operacije i poruka o nastaloj grešci u operaciji

FUNCTION c_poruka(poruka,naslov)
DEFAULT naslov TO "PORUKA" ,;
        poruka TO "Operacija uspešno završena"
 confirmbox(,poruka,naslov,XBPMB_OK,;
 XBPMB_INFORMATION+XBPMB_APPMODAL+XBPMB_MOVEABLE)
RETURN(nil)

FUNCTION c_greska(poruka,naslov)
DEFAULT naslov TO "GREŠKA" ,;
        poruka TO "Operacija nije uspela"
 confirmbox(,poruka,naslov,XBPMB_OK,;
 XBPMB_CRITICAL+XBPMB_APPMODAL+XBPMB_MOVEABLE)
RETURN(nil)



Korisnička COBA Systems funkcija AlertBox()

Dijalog boks za izbor operacije ili akcije. Može da sadrži  do 5 komandnih dugmadi za izbor operacija, može da sadrži sistemsku ikonu i close dugme (u titlebaru prozora dijaloga), može da sadrži ikonu ili bitmapu na formi dijaloga (u prozoru), može da sadrži različite fontove i boju fontova teksta u dijalogu i može da sadrži tekst u više redova.

/*
  AlertBox()
  Dialog box za izbor operacije do 5 dugmadi, ikona ili bmp i sistemska ikona
  Ako nema ikone ili bitmape tekst se centrira u dialog box-u, a ako ima ikone
  ili bitmape tekst se ravna na levo
  Obrada i dorada Alaska Xbase++ programa: COBA Systems ®
  SINTAKSA    : AlertBox( oOwner, cText, aCaption,;
                          nBoxICO, cTitle, cFont, cBoja,;
                          nBoxBMP, nSysIcon, nBMP )
  PARAMETRI   :
  oOwner   TO SetAppWindow() , ; // Alertbox je modalan na AppWindow
  cText    TO "tekst",         ; // tekst u box-u
  aCaption TO { "  OK  " }   , ; // jedno dugme, ili max 5 dugmadi
  nBoxICO  TO nil            , ; // ICO ikona u box-u      (32 x 32)
  cTitle   TO "COBA Systems" , ; // naslov u Title baru
  cFont    TO "X"            , ; // font je Helvetika
  cBoja    TO "X"            , ; // boja fonta crna
  nBoxBMP  TO nil            , ; // BMP bitmapa u box-u    (50 x 60)
  nSysIcon TO nil            , ; // ICO ikona u Title baru (32 x 32)
  nBMP     TO nil                // broj BMP iz BAZNE.DLL
  RETURN      : 1,2,3,4, ili 5 zavisi koje dugme je pritisnuto, 0 za Cancel
  PRIMENA     :
  q = AlertBox(,"Ovo je test" +";"+;
                "za alertbox" +,;     // text
                 {"Kod","Izlaz"},;    // commandbuttons
                 101,;                // icon in Box
                 "COBA AlertBox",;    // Title
                 "C",;                // Font Courier
                 "R",;                // Color font = Red
                 95,;                 // Bitmap in Box
                 102,;                // SysIcon in TitleBar
                 10000)               // Bitmap i Box BAZNE.DLL

  Ako ima nSysIcon tada se u titlebaru pojavljuje sistemska ikona, naslov i close dugme. Ako nema nSysIcon tada se u titlebaru pojavljuje samo naslov bez ikone i close dugmeta. U naslovu prima ANSI slova a posle Cobine izmene:
   oFont:codepage := 238; oPS:setFont( oFont ) prima ih i u tekstu

  Svako dugme može da ima svoju bitmapu (jedno dugme mora da ima tekst)
  aCaption := { "Opis","Akcija","Pregled",bmp_help,bmp_exit }
  bmp_help i bmp_exit -> bitmapa 16 x 16 ili 24 x 24 pixel-a
*/

#include "Appevent.ch"
#include "Common.ch"
#include "Font.ch"
#include "Gra.ch"
#include "Xbp.ch"
/*
 * Maximalni broj dugmadi
 */
#define  MAX_BUTTONS   5
#define  BUTTON_FONT   "8.Helv"

// DIALOG BOX ZA IZBOR OPERACIJE DO 5 DUGMADI
// PRIKAZ IKONE ILI BMP I SISTEMSKE IKONE
FUNCTION AlertBox( oOwner, cText, aCaption, nBoxICO,;
                   cTitle, cFont, cBoja,;
                   nBoxBMP, nSysIcon, nBMP )

   LOCAL nEvent   , mp1 , mp2, oXbp , lExit
   LOCAL oParent  , oDlg, oPS, oFont, oFocus, oDesktop
   LOCAL aPushBtn , aPbSize, nPbWidth, nPbDist, nSelect
   LOCAL oIcon    , aIconSize
   LOCAL aTextSize, aText
   LOCAL bSelect  , bKeyboard
   LOCAL i, imax  , nPos   , aPos    , aPos1  , aSize  , nXsize, nYsize

   LOCAL oDlg_alert, nSelect_alert
   SET CHARSET TO ANSI
DEFAULT ;
oOwner   TO SetAppWindow() , ; // Alertbox je modalan na AppWindow
cText    TO "TEST;IZVRŠEN;SVE JE OK", ; // tekst u box-u u 3 reda
aCaption TO { "  OK  " }   , ; // jedno dugme, ili max 5 dugmadi
nBoxICO  TO nil            , ; // ICO ikona u box-u (32 x 32)
cTitle   TO "COBA Systems" , ; // naslov u Title baru
cFont    TO "X"            , ; // font je Helvetika
cBoja    TO "X"            , ; // boja fonta crna
nBoxBMP  TO nil            , ; // BMP bitmapa u box-u (50 x 60)
nSysIcon TO nil            , ; // ICO ikona u Title baru (32 x 32)
nBMP     TO nil                // broj BMP iz BAZNE.DLL

 // (nBoxBMP) PRIKAZ BMP UČITANE IZ RESURSA IZ RES/EXE
 // ILI IZ DLL FAJLA SA MERENJEM VELIČINE OBJEKTA BITMAPE
 IF nBoxBMP = NIL
    // ako nije zadat parametar - ne radi sa BMP !
 ELSE
    IF UPPER(var2char(nBoxBMP))=="XBPBITMAP" // ovo je objekat
       ***  msgbox( UPPER(var2char(nBoxBMP)) , "Objekat")
         // ako je nBoxBMP učitana iz RES/EXE ili DLL kao oBjekat,
         // radiće sa nBoxBMP:xSize pa utvrdi njenu veličinu:
         xBMP := nBoxBMP:xSize   // pikseli
         yBMP := nBoxBMP:ySize   // pikseli
         IF xBMP = 0  // ako BMP nije nađena u resursima xBMP=0
            xBMP := 16; yBMP := 16  // napravi levu marginu = 16
         ENDIF
    ELSE // ovo je numerik
       ***  msgbox( UPPER(var2char(nBoxBMP)) , "Numerik")
// ako je nBoxBMP učitana iz RES kao NUMERIK, ne radi sa nBoxBMP:xSize
// pretvori nBoxBMP u objekat - ponovnim učitavanjem kao objekta nBoxBMP
// pa postavi veličinu BMP sa nBoxBMP:xSize jer ona meri samo objekat:
   nRES := nBoxBMP
   nBoxBMP := NIL
   nBoxBMP := XbpBitmap():new():create()
   nBoxBMP:load( NIL, nRES)     // === učitaj BMP iz RES/EXE resursa ===
              xBMP := nBoxBMP:xSize   // postavi joj veličinu
              yBMP := nBoxBMP:ySize
              IF xBMP = 0  // ako BMP nije nađena u resursima
                 xBMP := 16; yBMP := 16  // napravi levu marginu = 16
              ENDIF
    ENDIF  // IF UPPER(var2char(nBoxBMP))=="XBPBITMAP"
 ENDIF
 // Ovaj sistem učitava BMP iz RES\EXE kao numerik i tako prosleđuje u AlertBox()
 // a takođe učitava BMP iz DLL fajla kao objekat i tako je prosleđuje u AlertBox()
 // AlertBox() utvrđuje da li je primljen numerik ili objekat i nastavlja dalju obradu.


 // (nBMP) PRIKAZ BMP UČITANE ISKLJUČIVO IZ COBA Systems biblioteke BAZNE.DLL
 // SA MERENJEM VELIČINE OBJEKTA BITMAPE - PRIKAZ BITMAPE U PUNOJ VELIČINI
 IF nBMP = NIL
 // ako nije zadat BROJ - Ne učitavaj BMP iz BAZNE.DLL - ne radi sa BMP !
 ELSE
   IF nBMP > 100 // samo ako je broj ID bitmape veći od 100
    // Poništi sve prethodno, pa učitaj BMP iz BAZNE.DLL *
    nBoxICO  := nil
    nBoxBMP  := nil
     nBoxBMP := XbpBitmap():new():create()
     * nDll := DllLoad("BAZNE.DLL")
     * nBoxBMP:load( nDll, nBMP )
     nBoxBMP:load( "BAZNE.DLL", nBMP ) // === učitaj BMP iz BAZNE.DLL ===
         xBMP := nBoxBMP:xSize             // postavi joj veličinu
         yBMP := nBoxBMP:ySize
         IF xBMP = 0                // ako BMP nije nađena u BAZNE.DLL
            xBMP := 16; yBMP := 16  // napravi levu marginu = 16
         ENDIF
   ENDIF // IF nBMP > 100 // samo ako je veće od 100
  ENDIF // IF nBMP = NIL
  * Sada Postoji ili ne postoji objekat: nBoxBMP = NIL ili NUMERIC(objekat)
 // Ovaj sistem prihvata samo BMP kao ID broj = numerik,
 // koji se šalje u AlertBox() na obradu

 // (nBoxICO) PRIKAZ ICO sistemska ili korisnička ikona
 * 11 - informacija
 * 12 - znak pitanja
 * 13 - precrtano
 * 14 - znak uzvika
 * 19 - prozor
 IF nBoxICO=11 .or. nBoxICO=12 .or. nBoxICO=13 .or. nBoxICO=14 .or. ;
    nBoxICO=18 .or. nBoxICO=19 .or. nBoxICO=20 .or. nBoxICO=21 .or. ;
    nBoxICO=22
      tip_ikone := XBPSTATIC_TYPE_SYSICON // SISTEMSKA
 ELSE
      tip_ikone := XBPSTATIC_TYPE_ICON    // KORISNIČKA
 ENDIF
 // (nBoxICO) PRIKAZ ICO sistemska ili korisnička ikona
 // Izbor vrste fonta za ispis teksta
   IF cFont     == "CB"
      TEXT_FONT := "10.Courier Bold"
   ELSEIF cFont == "C"
      TEXT_FONT := "10.Courier"
   ELSEIF cFont == "A"
      TEXT_FONT := "14.Arial Bold"
   ELSEIF cFont == "L"
      TEXT_FONT := "8.Lucida Console"
   ELSEIF cFont == "HB"
      TEXT_FONT := "10.Helv Bold"
   ELSEIF cFont == "H"
      TEXT_FONT := "9.Helv"
   ELSEIF cFont == "V"
      TEXT_FONT := "10.Verdana"
   ELSEIF cFont == "VB"
      TEXT_FONT := "12.Verdana Bold"
   ELSEIF cFont == "VV"
      TEXT_FONT := "16.Courier Bold"
   ELSE
      TEXT_FONT := "8.Helv"
   ENDIF
 // Izbor boje za font
   IF cBoja     = "R"
      TEXT_COLOR := GRA_CLR_DARKRED
   ELSEIF cBoja = "B"
      TEXT_COLOR := GRA_CLR_DARKBLUE
   ELSE
      TEXT_COLOR := GRA_CLR_BLACK
   ENDIF
   oDeskTop         := AppDesktop()
  /*
   * Create the Alert dialog window
   */
   oDlg_alert := XbpDialog():new( oDesktop, oOwner,,{ 100, 100 },,.F. )
   oDlg_alert:taskList := .T.   // prozor sa zaobljenim coskovima i prikaz nSysIcon
   oDlg_alert:title := cTitle   // prikazi naslov prozora
   IF nSysIcon = nil                  // ako je ikona = nil
                                      // ne prikazuj ikonu u SysMeni-ju
    oDlg_alert:SysMenu     := .F.     // off ikonu i Max,Min,Close dugme
   ELSE
    oDlg_alert:icon        := nSysIcon// ikona uSysMeni-ju prozora
    oDlg_alert:MaxButton   := .F.     // nema max...
    oDlg_alert:MinButton   := .F.     // nema Min, ostaje samo Close
   ENDIF
   oDlg_alert:border      := XBPDLG_NO_BORDER
   oDlg_alert:close       := {|mp1,mp2,obj| obj:hide(), lExit := .T. }
   oDlg_alert:create()
   oDlg_alert:drawingArea:SetFontCompoundName( BUTTON_FONT )
   oDlg_alert:drawingArea:paint := {|| Repaint( aText ) }
  /*
   * Create ICO if requested
   */
   aIconSize      := {0,0}      // ako nema ICO

   IF nBoxICO <> NIL .AND. nBoxBMP == NIL   // samo ako ima ICO a nema BMP
      oIcon := XbpStatic():new( oDlg_alert:drawingArea, , {2,4}, {32,32} )
      oIcon:caption  := nBoxICO
      oIcon:type := tip_ikone // XBPSTATIC_TYPE_SYSICON
      oIcon:create()
      aIconSize      := oIcon:currentSize()
   ENDIF
  /*
   * Create BMP if requested
   */
   IF nBoxBMP <> NIL   // ako ima BMP, ona poništava ikonu
      oIcon  := XbpStatic():new( oDlg_alert, , {0,0}, {xBMP,yBMP} )
      oIcon:caption  := nBoxBMP
      oIcon:type     := XBPSTATIC_TYPE_BITMAP
      oIcon:create()
      aIconSize      := oIcon:currentSize()
   ENDIF
  /*
   * Create a presentation space with font to calculate pushbutton
   * size from font metrics
   */
   oPS := XbpPresSpace():new():create(oDlg_alert:drawingArea:winDevice())
   oFont := XbpFont():new( oPS ):create( BUTTON_FONT )
   oFont:codepage := 238
   oPS:setFont( oFont )
  /*
   * Find longest button caption
   */
   imax := Min( MAX_BUTTONS, Len( aCaption ) )
    nPos   := 0
    nXSize := 0
   FOR i:=1 TO imax
     // === NA DUGMETU MOŽE DA SE PRIKAŽE BMP SLIKA ===
     xButton := aCaption[i]  // dodao coba - ako je Caption BMP slika

     IF TYPE("xButton")=="C" // dodao coba
                             // proveravaj samo Caption koja nisu BMP
      IF Len( aCaption[i] ) > nXsize
         nXsize := Len( aCaption[i] )
         nPos   := i
      ENDIF

     ELSE // dodao coba - ako Caption jeste BMP slika
        * nXsize :=
        * nPos   :=
     ENDIF // dodao coba - ako Caption jeste BMP slika
   NEXT
  /*
   * Determine size for pushbuttons
   */
   // određuje istu dužinu svakog dugmeta
   aPbSize    := GraQueryTextBox( oPS, aCaption[nPos] )
   aPbSize    := { aPbSize[3,1] - aPbSize[2,1] ;
                 , aPbSize[3,2] - aPbSize[2,2] }
   aPbSize[1] *= 1.5     // dužina dugmeta 43.5 ili slično
   aPbSize[2] *= 2       // širina sugmeta 26
   nPbDist    := aPbSize[1] / nXsize
   nPbWidth   := imax * ( aPbSize[1] + nPbDist )
  /*
   * Prepare the string for display and determine display size
   */
   oFont     := XbpFont():new( oPS ):create( TEXT_FONT )
   oFont:codepage := 238
   oPS:setFont( oFont )
   aTextSize := PrepareText( oPS, @aText, cText )
  /*
   * Calculate frame size for the Alert box (XbpDialog window)
   */
   nXsize := Max( nPbWidth + 20, aTextSize[1] + 20 ) + aIconSize[1] * 1.5
   nYsize := aTextSize[2] + 2 * aPbSize[2] + 10
   aSize  := oDlg_alert:calcFrameRect( { 0, 0, nXsize, nYsize } )

   oDlg_alert:setSize( { aSize[3], aSize[4] } )
   MoveToOwner( oDlg_alert )
   aSize := oDlg_alert:drawingArea:currentSize()
   IF nBoxICO == NIL .AND. nBoxBMP == NIL
     /*
      * No icon - Center text in window
      */
      aPos := CenterPos( aTextSize, aSize )
   ELSE
     /*
      * With icon - Align text next to icon
      */
      aPos    := { 0, 0 }
      aPos[1] := 1.75 * aIconSize[1]
   ENDIF

   aPos[2]    := 2.25 * aPbSize[2]
   AdjustPos( aPos, aTextSize, aText, nBoxICO )

   IF nBoxBMP <> NIL   // ako ima BMP ponistava ICO
   AdjustPos( aPos, aTextSize, aText, nBoxBMP )
   ENDIF
  /*
   * Position the icon to the upper left of the text
   */
   IF oIcon <> NIL
      aPos[1] := aIconSize[1] / 4
      aPos[2] := aSize[2] - aIconSize[2] - 8
      oIcon:setPos( aPos )
   ENDIF

   IF nBoxICO == NIL .AND. nBoxBMP == NIL
     /*
      * No icon - Center pushbutton in window
      */
      aPos    := CenterPos( {nPbWidth, 2 * aPbSize[2]}, aSize )
      aPos[1] += ( nPbDist / 2 )

   ELSEIF nPbWidth < aTextSize[1]
     /*
      * Width of all pushbuttons is less than text width.
      * Center pushbutton below text
      */
      aPos    := CenterPos( {nPbWidth, 2 * aPbSize[2]}, aTextSize )
      aPos[1] += ( 1.5 * aIconSize[1] + ( nPbDist / 2 ) )
   ELSE
     /*
      * Align pushbuttons with text
      */
      aPos[1] := 1.75 * aIconSize[1]
   ENDIF

   aPushBtn   := Array( imax )
   aPos[2]    := aPbSize[2] / 2
   nSelect_alert    := 0
   bSelect := {|mp1 ,mp2,obj| nSelect_alert := obj:cargo, lExit := .T. }
   bKeyBoard  := {|nKey,mp2,obj| KeyHandler( nKey, obj, aPushBtn ) }

  /*
   * Create the pushbuttons
   */
   FOR i:=1 TO imax
     xButton := aCaption[i]  // COBA
     IF TYPE("xButton")=="C" // COBA
      // COBA
      aPushBtn[i] := ;
      XbpPushButton():new( oDlg_alert:drawingArea,, aPos, aPbSize )
      aPushBtn[i]:caption   := aCaption[i]
     ELSE                   // COBA
      // COBA
      aPushBtn[i] := ;
      XbpPushButton():new( oDlg_alert:drawingArea,, aPos, {30,26} )
      aPushBtn[i]:caption   := aCaption[i]
     ENDIF                  // COBA
      aPushBtn[i]:cargo     :=  i
      aPushBtn[i]:tabstop   := .T.
      aPushBtn[i]:preselect := .T.
      aPushBtn[i]:activate  := bSelect
      aPushBtn[i]:keyboard  := bKeyboard

      IF imax > 1
         IF i == 1
            aPushBtn[i]:group := XBP_BEGIN_GROUP
         ELSEIF i == imax
            aPushBtn[i]:group := XBP_END_GROUP
         ELSE
            aPushBtn[i]:group := XBP_WITHIN_GROUP
         ENDIF
      ENDIF

      xx := 0
      aPushBtn[i]:setPointer("BAZNE.DLL",60) // COBA
      aPushBtn[i]:create()
      IF TYPE("xButton")=="C"                // COBA
      aPos[1] += ( aPbSize[1] + nPbDist-xx ) // alaska bez xx
      ELSE                                   // COBA
      aPos[1] += ( 30 + nPbDist-xx )         // COBA
      ENDIF                                  // COBA
   NEXT
   oDlg_alert:setModalState( XBP_DISP_APPMODAL )
   oDlg_alert:show()
   oFocus := SetAppFocus( aPushBtn[1] )
   lExit := .F.
   DO WHILE ! lExit
      nEvent := AppEvent( @mp1, @mp2, @oXbp )
      oXbp:handleEvent( nEvent, mp1, mp2 )
   ENDDO
  /*
   * Cleanup: Reset modality, release graphical segment,
   *          dialog and set focus back.
   */
   oDlg_alert:setModalState( XBP_DISP_MODELESS )
   GraSegDestroy( oPS, aText[2] )
   oDlg_alert:destroy()
   SetAppFocus( oFocus )
RETURN nSelect_alert
/*
 * Key handling for pushbuttons in alert box
 * The array containing the pushbuttons is not used here
 * (but may be useful for others...)
 */
STATIC PROCEDURE KeyHandler( nKey, oButton, aPushButtons )
   DO CASE
   CASE nKey == xbeK_ESC
      PostAppEvent( xbeP_Close,,, oButton:setParent():setParent() )
   CASE nKey == xbeK_RETURN
      PostAppEvent( xbeP_Activate,,, oButton )
   ENDCASE
RETURN
/*
 * Calculate entire display area for text to be displayed
 */
STATIC FUNCTION PrepareText( oPS, aText, cText )
   LOCAL aAttr, aTextBox, nMaxWidth, nMaxHeight, cLine, aLine
   aText         := {}
   nMaxWidth     := 0
   nMaxHeight    := 0
   aAttr         := Array( GRA_AS_COUNT )

   aAttr[ GRA_AS_COLOR ] := TEXT_COLOR // GRA_CLR_BLUE
   oPS:setAttrString( aAttr )

   DO WHILE ! Empty( cText )
      cLine      := CutStr( ";", @cText )

      IF Empty( cLine )
         cLine   := " "
      ENDIF
      aLine      := { {0,0}, cLine, 0, 0 }
      aTextBox   := GraQueryTextBox( oPS, aLine[2] )
      aLine[3]   := aTextBox[3,1] - aTextBox[2,1]  // width of substring
      aLine[4]   := aTextBox[3,2] - aTextBox[2,2]  // height of substring
      nMaxWidth  := Max( nMaxWidth, aLine[3] )
      nMaxHeight += ( 2 + aLine[4] )
      AAdd( aText, aLine )
   ENDDO

   aText         := { oPS, 0, aText, aAttr }

RETURN { nMaxWidth, nMaxheight }
/*
 * Adjust GraStringAt() positions for centered display or left alignment
 */
STATIC PROCEDURE AdjustPos( aPos, aSize, aText, nSysIcon )
   LOCAL aLines  := aText[3]
   LOCAL i, imax := Len( aLines )
   IF nSysIcon == NIL
     /*
      * No Icon - Display text centered
      */
      FOR i := 1 TO imax
         aLines[i,1,1] := aPos[1] + ( (aSize[1] - aLines[i,3]) / 2 )
         aLines[i,1,2] := aPos[2] + aSize[2] - i * ( 2 + aLines[i,4] )
      NEXT
   ELSE
     /*
      * With Icon - Display text left aligned
      */
      FOR i := 1 TO imax
         aLines[i,1,1] := aPos[1]
         aLines[i,1,2] := aPos[2] + aSize[2] - i * ( 2 + aLines[i,4] )
      NEXT
   ENDIF
RETURN
/*
 * Repaint text using a graphical segment
 */
STATIC PROCEDURE Repaint( aText )
   LOCAL oPS    := aText[1]
   LOCAL nID    := aText[2]
   LOCAL aLines := aText[3]
   LOCAL aAttr  := aText[4]

   oPS:setAttrString( aAttr )

   IF nID == 0
      nID := GraSegOpen( oPS )

      // AEval( aLines, {|a| MsgBox( a[2] ) } )  ovo daje YU slova
       AEval( aLines, {|a| GraStringAt( oPS, a[1], a[2] ) } )  // ovo ne

     GraSegClose( oPS )
      aText[2] := nID
   ENDIF

   GraSegDraw( oPS, nID )

RETURN
/*
 * Move a window within its parent according to the origin of
 * its owner window. Default position is centered on the owner.
 */
STATIC PROCEDURE MoveToOwner( oDlg_alert, aPos )
   LOCAL oOwner  := oDlg_alert:setOwner()
   LOCAL oParent := oDlg_alert:setParent()
   LOCAL aPos1, nWidth

   DEFAULT aPos TO ;
   CenterPos( oDlg_alert:currentSize(), oOwner:currentSize() )

   DO WHILE oOwner <> oParent
      aPos1   := oOwner:currentPos()

      aPos[1] += aPos1[1]
      aPos[2] += aPos1[2]

      IF oOwner:isDerivedFrom( "XbpDialog" )
        /*
         * Adjust for thickness of the owner window's frame
         */
         nWidth  := ;
    ( oOwner:currentSize()[1] - oOwner:drawingArea:currentSize()[1] )/4
         aPos[1] += nWidth
         aPos[2] += nWidth
      ENDIF
      oOwner := oOwner:setParent()
   ENDDO

   oDlg_alert:setPos( aPos )
RETURN
/*
 * Cut a string at a given delimiter and remove delimiter from string
 */
STATIC FUNCTION CutStr( cCut, cString )
   LOCAL cLeftPart, i := At( cCut, cString )
   IF i > 0
      cLeftPart := Left( cString, i-1 )
      cString   := SubStr( cString, i+Len(cCut) )
   ELSE
      cLeftPart := cString
      cString   := ""
   ENDIF
RETURN cLeftPart

 * Calculate the center position from size and reference size
STATIC FUNCTION CenterPos( aSize, aRefSize )
RETURN { Int( (aRefSize[1] - aSize[1]) / 2 ) ;
       , Int( (aRefSize[2] - aSize[2]) / 2 ) }

* ALERTBOX * KRAJ MODULA



Korisnička COBA Systems funkcija ec_p() i ec_k() za vremenski progres-bar početka i kraja operacije

Program - Procedure za prikaz progres-bar trake koja radi kao Thread nit i ne zavisi od broja stavki koje se obrađuju već od vremena obrade – uključuje se na startu obrade a isključuje se na kraju obrade (preradio i dopunio COBA Systems):

/*
  Thread Progressbar preuzet iz Roger Donnay eXpress++ i dorađen
  Izbačeni pozivi za eXpress++ funkcije, ostao samo čist Xbase++ kod.
  sintaksa:
  FUNCTION ec_p(cTitle, aMessage, cboja1, cboja2, cfont)
  FUNCTION ec_k()

  DEFAULT cTitle := "SAČEKAJ kraj operacije ... "
  DEFAULT cboja1 := GRA_CLR_RED
  DEFAULT cboja2 := GRA_CLR_WHITE
  DEFAULT cfont  := "8.Helv Bold"

  FUNCTION ShowCursorON(o)
  FUNCTION ShowCursorOFF(o)
  DEFAULT o := SetAppWindow()
*/

#include "appevent.ch"
#Include "Xbp.ch"
#Include "Common.ch"
#include "thread.ch"
#include "Gra.ch"
#include "Font.ch"

#Define XBPSTATIC_SYSICON_NONE   0
#define SM_CYCAPTION 4

/* START ČEKANJA */
FUNCTION ec_p(cTitle, aMessage, cboja1, cboja2, cfont)

 LOCAL nWidth, i, lPrint, oThread, cDevice, aSaveScrn, ;
       nCol, nRow, oDlg, drawingArea, oXbp, nHeight, redovi := .T.
 DEFAULT cTitle TO "SAČEKAJ kraj operacije ... "
 DEFAULT cboja1 TO GRA_CLR_RED
 DEFAULT cboja2 TO GRA_CLR_WHITE
 DEFAULT cfont  TO "8.Helv Bold"
 PUBLIC wait_dialog_box := oDlg   ,;
        wait_boja1      := cboja1 ,;
        wait_boja2      := cboja2 ,;
        wait_focus      := setappfocus()
    ****************
     ShowCursorON()   // uključen-prikaz kursora peščanog sata
    ****************
 nWidth  := 0
 nHeight := 0

 IF VALTYPE(aMessage)=="A"
  // ovo je već Array
 ELSE
   IF EMPTY(aMessage)  // ne sme prazan string zbog pretvaranja u Array
      aMessage := " "
      redovi := .F.    // ako nema ni jednog znaka, samo blanko,
                       // ne ispisuj tekst i smanji prozor
   ELSE
     aMessage := { aMessage } // pretvori u Array
     FOR i := 1 TO LEN(aMessage)
       nWidth := Max(nWidth,LEN(aMessage[i]))
     NEXT
   ENDIF
 ENDIF
 lWorking := .T. // uradi crtanje trake progresbara
 IF redovi = .T.
   nHeight := LEN(aMessage) * 17 + 30 + Get_TitleBarHeight() +;
   IIF( lWorking, 10, 0 )
 ELSE
   nHeight := 10 + Get_TitleBarHeight() + IIF( lWorking, 10, 0 )
 ENDIF
 oParent := AppDeskTop()
 oOwner  := setAppWindow()
 oDlg:= XbpDialog():new( oParent,oOwner,{0,0},{nWidth,nHeight+(10)},,.f.)
 oDlg:visible := .f.
 oDlg:tasklist := .f.
 oDlg:minbutton := .f.
 oDlg:maxbutton := .f.
 oDlg:title := cTitle

 oDlg:create()
 drawingArea := oDlg:drawingArea
 drawingArea:setColorBG( cboja1 )
 drawingArea:setColorFG( cboja2 )
 drawingArea:setFontCompoundName( cfont )

   FOR i := 1 TO ( LEN(aMessage) + IIF( lWorking,1,0 ) )
     IF redovi = .T.
              oXbp := XbpStatic():new( drawingArea, , ;
              { 20, nHeight - ( 30+(i*20)) }, {Max(nWidth*7,200),20} )
     ELSE
              oXbp := XbpStatic():new( drawingArea, , ;
              { 0, 4 }, {Max(nWidth*7,200),20} )
     ENDIF
     IF i <= Len(aMessage)
       oXbp:caption := aMessage[i]
     ELSE
       oXbp:caption := ''
     ENDIF
     oXbp:create()
   NEXT

   oXbp:setSize({oXbp:currentSize()[1],oXbp:currentSize()[2]-10})
   oDlg:setSize({oXbp:currentSize()[1]+50,oDlg:currentSize()[2]})
   nWidth := oDlg:currentSize()[1]
   nCol := (oParent:currentSize()[1]-nWidth)/2
   nRow := (oParent:currentSize()[2]-nHeight)/2
   oDlg:setPos({nCol,nRow})
   oDlg:setModalState(XBP_DISP_APPMODAL)
   oDlg:show()
   oDlg:close := {||oDlg:destroy()}
   IF lWorking
      oThread := Thread():new()
      oDlg:cargo := {oXbp,.t.}
      Sleep(10)
      oThread:Start({||_crtajtraku(@oDlg)})
   ENDIF
 ******************************
 PUBLIC wait_dialog_box := oDlg
 ******************************
RETURN NIL

/* KRAJ ČEKANJA */
FUNCTION ec_k()

wait_dialog_box:destroy()
setappfocus(wait_focus)
RELEASE wait_dialog_box, wait_boja1, wait_boja2, wait_focus
tone(5000)
   ****************
    ShowCursorOFF() // isključen-prikaz kursora peščanog sata
   ****************
RETURN NIL

/* ISCRTAJ PROGRESSBAR - GRAFIKA */
STATIC FUNCTION _crtajtraku(oDlg)
LOCAL nCount := 1, oProgress := oDlg:cargo[1], nMaxCount := 24, ;
      nX, aSize, oPS, aAttr[ GRA_AA_COUNT], lOk := .t., mp1, mp2, ;
      oXbp, nEvent
oPS := oProgress:lockPS()
aSize := oProgress:currentSize()
aSize[1] -= 2
aSize[2] -= 2
SetAppFocus(oDlg)
// oDlg:setModalState(XBP_DISP_APPMODAL)

DO WHILE Valtype(oDlg) = 'O' .AND. oDlg:cargo[2] .AND. oDlg:status() > 0
  Sleep(20) // uspori malo !
  IF oDlg:status() > 0
    IF !(SetAppFocus()==oDlg)
      SetAppFocus(oDlg)
    ENDIF
    nX := aSize[1] * ( 1 / nMaxCount )
    nX := Min( nX, aSize[1] ) // Calculate width for rectangle
    IF nX <= 0
      nX := 1
    ENDIF
    nX := Int(nX)
    IF nCount = 1
      aAttr[ GRA_AA_COLOR ] := wait_boja1 // GRA_CLR_DARKRED
      GraSetAttrArea( oPS, aAttr )
      GraBox( oPS, {1,1}, {aSize[1]+2, aSize[2]+2}, GRA_FILL )
    ENDIF
    aAttr[ GRA_AA_COLOR ] := wait_boja2 // GRA_CLR_WHITE
    GraSetAttrArea( oPS, aAttr )
    GraBox( oPS,{(nCount*nX),1},{(nCount*nX)+nX-3,aSize[2]},GRA_FILL )
  ENDIF
  nCount++
  IF nCount > nMaxCount
    nCount := 1
  ENDIF
ENDDO
oProgress:unLockPS(oPS)
RETURN nil

/* ŠIRINA TITLEBAR-a u pixelima */
FUNCTION Get_TitleBarHeight()
RETURN 22

/* UKLJUČI KURSOR ČEKANJA */
Function ShowCursorON( o )
  DEFAULT o TO SetAppWindow()
  ShowElem(o, "XbpDialog," + ;
  iif(ValType(o:className()) = "C",o:className(),""),;
  XBPSTATIC_SYSICON_WAIT)
Return NIL

/* ISKLJUČI KURSOR ČEKANJA */
Function ShowCursorOFF( o )
  DEFAULT o TO SetAppWindow()
  ShowElem(o, "XbpDialog," + ;
  iif(ValType(o:className()) = "C",o:className(),""),;
  XBPSTATIC_SYSICON_NONE)
Return NIL

/* FUNKCIJA ZA ON/OFF KURSOR ČEKANJA */
Static Function  ShowElem(o, cInclusions, nCursorType)
  Local aChildList := {}
       o:SetPointer(,nCursorType,XBPWINDOW_POINTERTYPE_SYSPOINTER )
  aChildList := iif( o:status() = XBP_STAT_CREATE, o:childList(),{})
    If o:className()$cInclusions
       o:Setpointer(,nCursorType,XBPWINDOW_POINTERTYPE_SYSPOINTER )
      aChildList := iif( o:status() = XBP_STAT_CREATE, o:childList(),{})
    EndIF
  AEVAL(aChildList, {|o| ShowElem(o, cInclusions, nCursorType) } )
Return NIL




Procedure i funkcije koje obavljaju posao čitanja lokacije programa:
Korisničke COBA Systems funkcije Gde_Exe(),GdeExe(),Gde_Sam()

FUNCTION Gde_Exe()
 LOCAL cApp_Folder_Exe, nPoz
 // AppName(.T.) pun put do EXE fajla "C:\CSYSTEMS\TEST.EXE"
 nPoz := RAt("\",AppName(.T.))
 // Aplikacioni folder sa EXE fajlom aplikacije  "C:\CSYSTEMS"
 cApp_Folder_Exe := SUBSTR(AppName(.T.),1,nPoz-1)
RETURN( cApp_Folder_Exe )

FUNCTION GdeExe() // Folder u kome je locirana EXE aplikacija
LOCAL cAdresa, nn
   cAdresa := STRTRAN(AppName(.T.),"\"+AppName(),"")
RETURN(cAdresa)

FUNCTION GdeSam()
IF AT("\\",CURDIR())>0
 // COMPUTERNAME - NETNAME
 // \\SERVER\CSYSTEMS\FIRME\FIRMA-01\2001
   RETURN CURDIR()
ELSE
   RETURN CURDRIVE()+":\"+CURDIR()
 // C:\CSYSTEMS\FIRME\FIRMA-01\2001
ENDIF
RETURN CURDIR()




Procedure i funkcije koje obavljaju posao DOS i WINDOWS štampanja
Korisnička COBA Systems funkcija etxt2lpt()
DOS štampa na matrični printer i LPT1 port :

FUNCTION etxt2lpt(TXTfajl)
 LOCAL cTxt, fajlzastampu
 DEFAULT TXTfajl TO "t.txt"
 IF FILE(TXTfajl)=.F.
    ConfirmBox(,TXTfajl,"Nema fajla",XBPMB_OK,XBPMB_CRITICAL)
    RETURN NIL
 ENDIF
 IF FILE(GDE_EXE()+"\CSYSTEMS.CFG")
    cTxt := ALLTRIM(MemoRead(GDE_EXE()+"\CSYSTEMS.CFG"))
    IF AT("DOS",cTxt) = 0 // ako NE postoji tekst "DOS"
       c_greska("Nedozvoljena upotreba DOS printera","STOP MATRIČNI PRINTER")
       RETURN NIL
    ENDIF
 ENDIF

 IF FILE(TXTfajl) // ako postoji fajl za stampu
   //fajlzastampu := "/C COPY "+TXTfajl+" TXT.TXT /B" // za test
     fajlzastampu := "/C COPY "+TXTfajl+" LPT1/B"
     Q = RunShell( fajlzastampu )
     confirmbox(,"Poslato na LPT1 printer","O d š t a m p a n o",XBPMB_OK,;
     XBPMB_INFORMATION+XBPMB_APPMODAL+XBPMB_MOVEABLE)
 ELSE // ako NE postoji fajl za stampu
      confirmbox(,TXTfajl,"Nema dokumenta",XBPMB_OK,;
      XBPMB_CRITICAL+XBPMB_APPMODAL+XBPMB_MOVEABLE)
 ENDIF
RETURN NIL