Alaska Xbase++

Alaska Xbase++
Programiranje u Xbase++

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