Page 1 of 3

OT: new FWH ECR released

Posted: Sat May 22, 2010 6:59 pm
by Otto
Finally we have released our new FWH software “xIceCube”. It would not have been able without your help, especially yours, Antonio.
Many thanks to James for helping me with class design and to Mr. Manuel for TSButton.
“xIceCube” and “xWhBiene” – FWPPC operate on the same data.
Also much of the source code is the same.
http://forums.fivetechsupport.com/viewt ... =4&t=18877

With best regards,

Otto



Image

Image

Image

Image

Image

Re: OT: new FWH ECR released

Posted: Sat May 22, 2010 7:46 pm
by Armando
Otto:

Great job !, Congratulations.

It's looks so professional.

Regards

Re: OT: new FWH ECR released

Posted: Sat May 22, 2010 8:23 pm
by Ruben Fernandez
Otto: Great, Great, Great.

Congratulations.

Ruben Fernandez

Re: OT: new FWH ECR released

Posted: Sat May 22, 2010 9:19 pm
by James Bott
Very impressive Otto. Nice work!

James

Re: OT: new FWH ECR released

Posted: Sat May 22, 2010 10:03 pm
by HunterEC
Otto:

Great job ! I must say: impressive & very professional.

Re: OT: new FWH ECR released

Posted: Sun May 23, 2010 1:43 am
by hag
Otto: great stuff

Re: OT: new FWH ECR released

Posted: Sun May 23, 2010 5:39 pm
by ukoenig
Otto,

it looks very nice.

Just one Question :
In some of my Tests I noticed, that the top Corners ( rounded ) are not painted transparent.
Your Screenshot shows the same Effect.
I think You are using 2 Buttonbars next each other. As well it could be possible
using VTitles ???.

A zoomed part of Your Screenshot shows the Problem.
The bottom-corners are OK.

Image

Maybe I can find a Solution for it.

Best Regards
Uwe :lol:

Re: OT: new FWH ECR released

Posted: Sun May 23, 2010 6:32 pm
by Otto
Thank you all for your kind words.

Uwe:
The main problem of this software is speed. The hardware such a kiosk application runs on is 1GHrz and 512 MB. Therefore you must be very carefully what controls you use.
I don’t use any buttons in this case. These are all bitmaps I paint straight away to the window.
This way you don’t see the painting if you change from one screen to another one – same on PPC.

Best regards,
Otto

Re: OT: new FWH ECR released

Posted: Mon May 24, 2010 11:11 am
by dutch
Dear Otto,

It's very impressive. What kind of button you use in FWH and FWPPC?

My Room Planner is done, Thanks for you help.
Image
Regards,
Dutch

Re: OT: new FWH ECR released

Posted: Mon May 24, 2010 5:23 pm
by Otto
Hello Dutch,

wow, your room planer is good looking.
May I get a new demo of your software?

I don't use buttons for the ECR I paint bitmaps.

Best regards,
Otto

Re: OT: new FWH ECR released

Posted: Mon May 24, 2010 10:03 pm
by vensanto
hello dutch
i like your room planner
i'm interesting

it's possible get the source or the class

regards

Santo Venezia

Re: OT: new FWH ECR released

Posted: Mon May 24, 2010 10:12 pm
by ukoenig
Hello Otto,

I tested a Solution to change from BTNBMP => to BMP.
Like You can see, there is the Problem to show the BMP-Alpha-Channel on Dialog.
As long You don't use round Corners and Shadow, no Problem.
Maybe something to use for a working AlphaChannel like in Vtitles or xBrowse ?
Using a Background-Brush for the Dialog, it works fine.
I'm looking for a Solution, to use a Gradient like the Screenshot shows.

I think, it works only with resizing the BMP and using ABPaint( .... on Dialog PAINT

Image

Best Regards
Uwe :?:

Re: OT: new FWH ECR released

Posted: Tue May 25, 2010 5:59 am
by frose
Dutch,

your room planner is looking very nice.

Do you work with XBrowse?
How do you solve the column merging?

It's possible to get an example?

TIA

Re: OT: new FWH ECR released

Posted: Tue May 25, 2010 8:49 am
by dutch
Dear Santo & TIA,

First of all, Thanks for Otto's idea and very nice Manual's TSButton. I use TXBrwose, DrawLine and TSbutton for my room planner.
- XBrowse for room control (navigator) for Up, Down, PageUp and PageDown.
- Drawline by CreatePen(), LineTo() for drawing a calendar and lines.
- TSbutton for booking over the line, with TSbutton you will be able to use Drag&Drop feature for room move and extend stay also.

I'm not good in Class, this is my code (single file test) before include with the main source code.

Code: Select all

#include "Fivewin.ch"
#include "TSbutton.ch"
#include 'Ads.ch'

#define BRW_STYLE   1
#define ADS_ABORT    .T. 
#define ADS_CONTINUE .F. 

external AdsKeyCount, AdsGetRelKeyPos, AdsSetRelKeyPos

static oDlg, oBrw, oFnt[6], nColor, oSay[1], aRoom, oBtns, nShow

*--------------*
Function Main()
local oDlgs, oGet[3], oSay, oBtn[3]
local dDate
local cRmNo := space(4)
local cRmTy := space(3)
local cPeriod := 'Weekly '
local aPeriod := {'Weekly','Monthly','Quarter'}
local cKeyname

Public comdat, cFoPath, oFont, TopWin, LeftWin

REQUEST ADS

   RddRegister( "ADS", 1 )
   Rddsetdefault( "ADS" )
   AdsSetDeleted(.T.)
   AdsSetServerType( 1 )  // 1,2,4,7
   AdsSetFileType( ADS_CDX )   // 2
   AdsRightsCheck(.F.)

   REQUEST ADSKeyCount, ADSKeyNo, OrdKeyCount, OrdKeyNo, ADSKEYCOUNT, ADSGETRELKEYPOS, ADSSETRELKEYPOS

   SET OPTIMIZE ON 

SET EPOCH TO 1920
SET DATE FORMAT TO 'DD/MM/YY'
SET DATE BRITISH

SET(_SET_DELETED,.T.)

SetHandleCount(200)   

cFoPath := '.\'
TopWin  := 40
LeftWin := 88
aRoom := {}

OPENFILE('HPMCFG','CFG')
   comdat    := CFG->CFG_CDAT
CLOSEFILE('CFG')


dDate := MEMVAR->comdat

DEFINE FONT oFont  NAME "Tahoma" SIZE 0, -12 

DEFINE DIALOG oDlgs FROM  0, 0 TO 100,315 TITLE TE('แผนห้องพัก','Room Planer') ;
         COLOR CLR_BLACK, THEME2007 ;
         PIXEL ;
         FONT MEMVAR->oFont

   oDlgs:lHelpIcon := .F.

   @  7,  7 SAY oSay PROMPT TE('วันที่','Date') OF oDlgs SIZE 40,13 PIXEL
   @ 22,  7 SAY oSay PROMPT TE('เลขห้อง','Room No.') OF oDlgs SIZE 40,13 PIXEL
   @ 37,  7 SAY oSay PROMPT TE('ประเภทห้อง','Room Type') OF oDlgs SIZE 40,13 PIXEL

   @  5, 50 GET oGet[1] VAR dDate ;
            OF oDlgs ;
            SIZE 40,12 PIXEL
/* 
            BITMAP MEMVAR->CalBmp ;
            VALID (dDate >= MEMVAR->comdat) ;
            ACTION (MsgDate2( oGet[1], dDate ) )
*/
   @ 20, 50 GET oGet[2] VAR cRmNo PICTURE '@!' ;
            OF oDlgs ;
            SIZE 32,12 ;
            PIXEL 

   @ 35, 50 GET oGet[3] VAR cRmTy PICTURE '@!' ;
            OF oDlgs ;
            SIZE 32,12 PIXEL
            /*
            BITMAP MEMVAR->ArrBmp 
            VALID  (DataPick(oGet[3],'CCRRMTY',1,{'Code','Description'},{'RMT_CODE','RMT_DESC'},{30,80},cRmTy,'RMT_CODE').and.left(cRmTy,1)<>'H') ;
            ACTION (DataPick(oGet[3],'CCRRMTY',1,{'Code','Description'},{'RMT_CODE','RMT_DESC'},{30,80},cRmTy,'RMT_CODE',.T.), oBtn[1]:SetFocus())
                */
   @  5,100 BTNBMP oBtn[1] PROMPT TE('&1. รายเดือน','&1. Monthly') ;  // TE('&1. รายสัปดาห์','&1. Weekly') ; 
            SIZE 50, 19 ;
            OF oDlgs ;              
            2007 CENTER ;  
            ACTION (PlanTbl(dDate,cRmNo,cRmTy,1), oGet[1]:SetFocus()) 
             
   @ 25,100 BTNBMP oBtn[2] PROMPT TE('&2. ราย 3 เดือน','&2. Quarterly') ;  // TE('&2. รายเดือน','&2. Monthly') ;
            SIZE 50, 19 ;
            2007 CENTER ; 
            OF oDlgs ;
            ACTION (PlanTbl(dDate,cRmNo,cRmTy,2), oGet[1]:SetFocus()) 
 
ACTIVATE DIALOG oDlgs ON INIT (oDlgs:Move(MEMVAR->TopWin,MEMVAR->LeftWin ))

return nil

*----------------------------------------*
Procedure PlanTbl(dStart,cRmNo,cRmTy,nType)
local oBtn[5], oSay[4]
local n

OPENFILE('CCRROOM','ROOM',1)
do while !ROOM->(eof())   // for n := 1 to 100
    if ROOM->RMS_RMTY <> 'HFO'
    aadd( aRoom, { ROOM->RMS_RMNO, ROOM->RMS_RMTY } )
   end
   ROOM->(dbskip())
end
CLOSEFILE('ROOM')

OPENFILE('CCROOO','ROO',3)
OPENFILE('EZFOL','FOL2',1)
OPENFILE('CCRTBL','INQ',2)
Set Relation to INQ->TBL_INTNO into FOL2
INQ->(DbGoTop())

DEFINE FONT oFnt[1]  NAME "Time Roman" SIZE 0, -12 BOLD
DEFINE FONT oFnt[2]  NAME "Time Roman" SIZE 0, -14 BOLD
DEFINE FONT oFnt[4]  NAME "Time Roman" SIZE 0, -9  
DEFINE FONT oFnt[5]  NAME "Time Roman" SIZE 0, -9   BOLD
DEFINE FONT oFnt[6]  NAME "Time Roman" SIZE 0, -11  BOLD
DEFINE FONT oFnt[3]  NAME "Tahoma"      SIZE 0, -11

DEFINE DIALOG oDlg FROM 40, 82 TO 710, 1020 TITLE "Room Planner" PIXEL COLOR CLR_BLACK, CLR_WHITE // THEME2007

    @  0, 0     XBROWSE oBrw ARRAY aRoom ;
                COLUMNS 1, 2 ;
                SIZES 40, 40 ;
                HEADER 'Room', 'RmTy' ;     
                JUSTIFY 2, 2 ;          
                COLOR CLR_BLACK, THEME2007 ;
                SIZE  42, 322 ;
                PIXEL ;
                FONT oFnt[1] ;
                WHEN .F. ;
                OF oDlg

    oBrw:lHScroll               := .F.
    oBrw:lVScroll               := .F.  
    oBrw:lRecordSelector    := .F.
    // oBrw:l2007                   := .F.
    oBrw:nRowHeight             := 20
    oBrw:nHeaderHeight      := 40
    oBrw:nMarqueeStyle      := MARQSTYLE_HIGHLROW
    oBrw:nRowDividerStyle   := LINESTYLE_LIGHTGRAY
    oBrw:nColDividerStyle   := LINESTYLE_LIGHTGRAY
    oBrw:bClrSel                := oBrw:bClrStd
    oBrw:aCols[1]:nHeadStrAlign := AL_CENTER
    oBrw:aCols[2]:nHeadStrAlign := AL_CENTER
    
    oBrw:CreateFromCode()

    ShowBook(nType,1,dStart)

                 
    @ 322,  2 SBUTTON oSay[1] PROMPT 'Reservation' SIZE 50,8 OF oDlg ;
                 PIXEL ;    
                 FONT oFnt[6] ;
                 TEXT POSITION ON_LEFT ;    
                 CRYSTAL ;
                 W97 ;
                 COLOR CLR_BLUE, nRGB( 240,220,110) ;
                 ACTION Msginfo( 'Reservation' )

    @ 322, 54 SBUTTON oSay[2] PROMPT 'Occupied' SIZE 50,8 OF oDlg ;
                 PIXEL ;    
                 FONT oFnt[6] ;
                 TEXT POSITION ON_LEFT ;    
                 CRYSTAL ;
                 W97 ;
                 COLOR CLR_WHITE, CLR_GREEN ;
                 ACTION Msginfo( 'Occupied' )

    @ 322,106 SBUTTON oSay[3] PROMPT 'Deposit Rsvn.' SIZE 50,8 OF oDlg ;
                 PIXEL ;    
                 FONT oFnt[6] ;
                 TEXT POSITION ON_LEFT ;    
                 CRYSTAL ;
                 W97 ;
                 COLOR CLR_WHITE, CLR_BLUE ;
                 ACTION Msginfo( 'Reservation with Deposit' )
                 
    @ 322,158 SBUTTON oSay[3] PROMPT 'OOO/OOS' SIZE 50,8 OF oDlg ;
                 PIXEL ;    
                 FONT oFnt[6] ;
                 TEXT POSITION ON_LEFT ;    
                 CRYSTAL ;
                 W97 ;
                 COLOR CLR_WHITE, CLR_RED ;
                 ACTION Msginfo( 'Out Of Order/Out Of Service' )
                 
    @ 322,210 SBUTTON oSay[3] PROMPT 'Block' SIZE 50,8 OF oDlg ;
                 PIXEL ;    
                 FONT oFnt[6] ;
                 TEXT POSITION ON_LEFT ;    
                 CRYSTAL ;
                 W97 ;
                 COLOR CLR_BLUE, nRGB( 130, 220, 250 ) ;  // CLR_HCYAN ;
                 ACTION Msginfo( 'Room Block' )
                                 
    @ 322,299 SBUTTON oBtn[1] PROMPT 'Up' SIZE 40,12 OF oDlg ;
                 PIXEL ;
                 ACTION (oBrw:Skip(-1), oBrw:Refresh(), ShowBook(nType,2,dStart))  // ClearBook(), 

    @ 322,341 SBUTTON oBtn[2] PROMPT 'Down' SIZE 40,12 OF oDlg ;
                 PIXEL ;
                 ACTION (oBrw:Skip(1), oBrw:Refresh(), ShowBook(nType,2,dStart))
                 
    @ 322,383 SBUTTON oBtn[3] PROMPT 'PgUp' SIZE 40,12 OF oDlg ;
                 PIXEL ;
                 ACTION (oBrw:Skip(-30), oBrw:Refresh(), ShowBook(nType,2,dStart))

    @ 322,425 SBUTTON oBtn[4] PROMPT 'PgDown' SIZE 40,12 OF oDlg ;
                 PIXEL ;
                 ACTION (oBrw:Skip(30), oBrw:Refresh(), ShowBook(nType,2,dStart))

ACTIVATE DIALOG oDlg ON PAINT (DrawCalen(nType,dStart)) ;
          ON RIGHT CLICK (oDlg:End())
          
CLOSEFILE('INQ')
CLOSEFILE('FOL2')
CLOSEFILE('ROO')
          
return


*-------------------------*
Function DrawCalen(nType,dStart)
local n, nHeight, nColumn, oSay, nStart, nBottom, nText1, nText2, nText3, nCol
local nMon, cMon, nCols, aCols

oDlg:GetDc()

if nType = 1        // monthly

    nHeight := 20   
    nColumn := 26
    nStart  := 58
    nBottom := 642
    nMon      := 0
    GradientFill( oDlg:hDC,  0, 83, 20, 1020 , { { 1, nRGB(200,255,230), nRGB(130,255,200) } } )  // , { 1, nRGB(0,200,100), nRGB(130,255,200) }  } )
    SayLine(  0, nStart+5, nBottom, nStart+5, CLR_GRAY )
    SayLine(  0, nStart+6, nBottom, nStart+6, CLR_HGRAY )

    for n := 1 to 33    // day
         do case 
             case dow(dStart+(n-1)) = 6  // Friday
                    GradientFill( oDlg:hDC, 20, nStart+(n*nColumn), nBottom-2, nStart+((n+1)*nColumn), { { 1, nRGB(200,230,255), nRGB(160,200,255) } } )
                oDlg:Say( 22, nStart+5+(n*nColumn), str(day(dStart+(n-1)),2), CLR_BLACK, nRGB(200,230,255), oFnt[2], .T. )
             case dow(dStart+(n-1)) = 7  // Saturday
                    GradientFill( oDlg:hDC, 20, nStart+(n*nColumn), nBottom-2, nStart+((n+1)*nColumn), { { 1, nRGB(225,200,255), nRGB(200,165,255) } } )
                    oDlg:Say( 22, nStart+5+(n*nColumn), str(day(dStart+(n-1)),2), CLR_BLACK, nRGB(225,200,255), oFnt[2], .T. )
             otherwise                       // WeekDay
                    oDlg:Say( 22, nStart+5+(n*nColumn), str(day(dStart+(n-1)),2), CLR_GRAY,, oFnt[1], .T. )
         endcase         
     if day(dStart+(n-1))=1 
    
             nMon++    
             SayLine(  0, nStart+(n*nColumn), nBottom, nStart+(n*nColumn), CLR_BLACK )
             SayLine(  0, nStart+(n*nColumn)+1, nBottom, nStart+(n*nColumn)+1, CLR_HGRAY )
             
             if nMon = 1
                 nText1     := gettextwidth(0, cMonth(dStart) ) 
                 nCols   := iif(n<=2,88,88+((((n-1)*nColumn)-nText1)/2))
                 cMon   := iif(n<=2,left(cMonth(dStart),3),cMonth(dStart))
             if day(dStart) <> 1
                     oDlg:Say( 1, nCols, cMon, CLR_BLUE,nRGB( 165,255,210), oFnt[1], .T. )
                 end
             elseif nMon = 2
                 cMon   := iif(n>=30,left(cMonth(dStart+n),3),cMonth(dStart+n))
                 nText3 := gettextwidth(0, cMonth(dStart+n) ) 
             else
                 nText1     := gettextwidth(0, cMonth(dStart) ) 
                 nCols   := iif(n<=2,88,88+(((n*nColumn)-nText1)/2))
                 cMon   := iif(n<=2,left(cMonth(dStart),3),cMonth(dStart))
                 oDlg:Say( 1, nCols, cMon, CLR_RED,nRGB( 165,255,210), oFnt[1], .T. )
         end

        elseif day(dStart+(n-1))=2
    
         oDlg:Line( 20, nStart+(n*nColumn), nBottom, nStart+(n*nColumn), CLR_GRAY )
             nText2 := gettextwidth(0, cMonth(dStart+(n-1)) ) 
             nCol     := 99+((n-1)*nColumn)+((930-(99+((n)*nColumn))-nText2)/2)
         if nMon >= 1
                 oDlg:Say( 1, nCol, cMonth(dStart+(n-1)), CLR_BLUE,nRGB( 165,255,210), oFnt[1], .T. )
             end
         
        else
         oDlg:Line( 20, nStart+(n*nColumn), nBottom, nStart+(n*nColumn), CLR_GRAY )
        end
    next
    SayLine( 20, 80, 20, 940, CLR_HGRAY )
    for n := 1 to 31  // Room
         SayLine( 21+(n*nHeight), 80, 21+(n*nHeight), 940, CLR_HGRAY )
    next
else        //  Quarterly
    aCols   := {}
    nHeight := 20
    nColumn := 11
    nStart  := 73
    nBottom := 642
    nMon      := 0
    
    GradientFill( oDlg:hDC,  0, 83, 20, 1020 , { { 1, nRGB(200,255,230), nRGB(130,255,200) } } )  // , { 1, nRGB(0,200,100), nRGB(130,255,200) }  } )
    SayLine(  0, nStart+5, nBottom, nStart+5, CLR_BLACK )
    SayLine(  0, nStart+6, nBottom, nStart+6, CLR_GRAY )

    for n := 1 to 78
         do case
             case dow(dStart+(n-1)) = 6
                    GradientFill( oDlg:hDC, 20, nStart+(n*nColumn), nBottom-2, nStart+((n+1)*nColumn), { { 1, nRGB(200,230,255), nRGB(160,200,255) } } )
                oDlg:Say( 22, nStart+(n*nColumn), str(day(dStart+(n-1)),2), CLR_BLACK, nRGB(200,230,255), oFnt[5], .T. )
             case dow(dStart+(n-1)) = 7
                    GradientFill( oDlg:hDC, 20, nStart+(n*nColumn), nBottom-2, nStart+((n+1)*nColumn), { { 1, nRGB(225,200,255), nRGB(200,165,255) } } )
                    oDlg:Say( 22, nStart+(n*nColumn), str(day(dStart+(n-1)),2), CLR_BLACK, nRGB(225,200,255), oFnt[5], .T. )
             otherwise
                    oDlg:Say( 22, nStart+(n*nColumn), str(day(dStart+(n-1)),2), CLR_GRAY,, oFnt[4], .T. )
         endcase         
     if day(dStart+(n-1))=1 
             aadd( aCols, nStart+(n*nColumn) )
             nMon++    
             SayLine(  0, nStart+(n*nColumn), nBottom, nStart+(n*nColumn), CLR_BLACK )
             SayLine(  0, nStart+(n*nColumn)+1, nBottom, nStart+(n*nColumn)+1, CLR_HGRAY )
             
             if nMon = 1
                 nText1     := gettextwidth(0, cMonth(dStart) ) 
                 nCols   := iif(n<=4,85,88+((((n-1)*nColumn)-nText1)/2))
                 cMon   := iif(n<=4,left(cMonth(dStart),3),cMonth(dStart))
             if day(dStart) <> 1
                     oDlg:Say( 1, nCols, cMon, CLR_BLUE,nRGB( 165,255,210), oFnt[6], .T. )
                 end
                 
             elseif nMon = 2
                 nText1     := gettextwidth(0, cMonth(dStart+(n-2)) ) 
                 nCols   := aCols[1]+(((aCols[2]-aCols[1])/2)-nText1)+22
                 cMon   := iif(n<=2,left(cMonth(dStart+(n-2)),3),cMonth(dStart+(n-2)))
                 oDlg:Say( 1, nCols, cMon, CLR_BLUE,nRGB( 165,255,210), oFnt[6], .T. )
                 
             elseif nMon = 3
                 nText1     := gettextwidth(0, cMonth(dStart+(n-2)) ) 
                 nCols   := aCols[2]+(((aCols[3]-aCols[2])/2)-nText1)+22
                 cMon   := iif(n<=2,left(cMonth(dStart+(n-2)),3),cMonth(dStart+(n-2)))
                 oDlg:Say( 1, nCols, cMon, CLR_BLUE,nRGB( 165,255,210), oFnt[6], .T. )
                 if (dStart+(n-1)) < dSTart+77
                     nText1     := gettextwidth(0, cMonth(dStart+(n-1)) ) 
                     nCols   := aCols[3]+(((940-aCols[3])/2)-nText1)+22
                     cMon   := iif((78-n)<=4,left(cMonth(dStart+(n-1)),3),cMonth(dStart+(n-1)))
                     oDlg:Say( 1, nCols, cMon, CLR_BLUE,nRGB( 165,255,210), oFnt[6], .T. )
                 end
         end
             
        elseif day(dStart+(n-1))=2
    
         oDlg:Line( 20, nStart+(n*nColumn), nBottom, nStart+(n*nColumn), CLR_GRAY )
             nText2 := gettextwidth(0, cMonth(dStart+n) ) 
             nCol     := 99+((n-1)*nColumn)+((930-(99+((n)*nColumn))-nText2)/2)
         if nMon >= 1
                 // oDlg:Say( 1, nCol, cMonth(dStart+(n-1)), CLR_BLUE,nRGB( 165,255,210), oFnt[1], .T. )
             end
         
        else
         oDlg:Line( 20, nStart+(n*nColumn), nBottom, nStart+(n*nColumn), CLR_GRAY )
        end
    next
    SayLine( 20, 80, 20, 940, CLR_HGRAY )
    for n := 1 to 31
         SayLine( 21+(n*nHeight), 80, 21+(n*nHeight), 940, CLR_HGRAY )
    next

end
return nil

********************************************************
Function SayLine( nTop, nLeft, nBottom, nRight, nColor )
LOCAL n, hPen, hOldPen

Default nColor := CLR_GRAY

oDlg:GetDc()
hPen := CreatePen( 0, 1, nColor )
hOldPen := SelectObject( oDlg:hDc, hPen )

MoveTo( oDlg:hDC, nLeft, nTop )

if nTop=nBottom
   LineTo( oDlg:hDC, nRight, nTop )
else
   LineTo( oDlg:hDC, nLeft, nBottom )
end

SelectObject( oDlg:hDc, hOldPen )
DeleteObject( hPen )
oDlg:ReleaseDc()
return nil  

*----------------------------------------*
Function ShowBook( nType, nSize, dStart )
local nStart := (oBrw:nArrayAt-oBrw:nRowSel)
local nCol := 6
local n, dDepart, dArr, aName
local aInfo, nDay, nWidth, nLeft, nAdj

nDay  := iif(nType=1,33,78)
nLeft := iif(nType=1,42,39)
aInfo := oDlg:DispBegin()
nWidth:= iif(nType=1,13,5.5)
if nSize = 2
   ClearBook()  
end

oBtns := {}
aName := {}
nShow := 0
nAdj  := 0
for n := 1 to 30   // 30 = rows
     if (n+nStart)  <= len(aRoom)
         if INQ->(DbSeek('O'+aRoom[n+nStart][1]))
             do while INQ->TBL_STATUS+INQ->TBL_RMNO == 'O'+aRoom[n+nStart][1] .and. !INQ->(eof())
                 if INQ->TBL_NUMRM = 1 
                     dDepart := iif(INQ->TBL_DEP>dStart+nDay+1, dStart+nDay+1, INQ->TBL_DEP )
                     dArr       := iif(INQ->TBL_ARR<dStart,dStart,INQ->TBL_ARR)
                     nShow += 1      
                     asize( oBtns, nShow )
                     aadd( aName, { rtrim(INQ->TBL_TITLE), rtrim(INQ->TBL_FIRST), rtrim(INQ->TBL_LAST), INQ->TBL_INTNO, INQ->TBL_RMNO, INQ->TBL_ARR, INQ->TBL_DEP } )
                     
                     MakeBtn( (11+(n*10))*nSize, 43*nSize, nShow, aName, INQ->TBL_STATUS, (int(nWidth/2)+(nWidth*(dDepart-dStart))-1)*nSize, (8*nSize), dDepart-dStart, 0 )
                     
                     exit
                 end
                 INQ->(DbSkip())
             end
         end
         if INQ->(DbSeek('R'+aRoom[n+nStart][1]))
             do while INQ->TBL_STATUS+INQ->TBL_RMNO == 'R'+aRoom[n+nStart][1] .and. ;
                         INQ->TBL_ARR<dStart+nDay .and. !INQ->(eof())
                 if INQ->TBL_NUMRM = 1
                     dDepart := iif(INQ->TBL_DEP>dStart+nDay, dStart+nDay, INQ->TBL_DEP )
                     dArr       := iif(INQ->TBL_ARR<dStart,dStart,INQ->TBL_ARR)
                     if INQ->TBL_ARR=dStart
                         nCol := 6
                     elseif INQ->TBL_ARR < dStart
                        nCol := iif(nType=1,1,4)
                     else
                         nCol := (((dArr-dStart)*nWidth)+6)-iif(dDepart=dArr, 6, 0 )
                         if nType=2 .and. INQ->TBL_DEP=INQ->TBL_ARR
                             nCol += 3.5
                         end
                     end
                     // nCol    := iif(INQ->TBL_ARR=dStart,6,((dArr-dStart)*nWidth)+6)-;
                     //             iif(dDepart=dArr, 6, 0 )
                     nAdj := 0
                     if dDepart=dArr
                         if INQ->TBL_ARR=INQ->TBL_DEP
                            nAdj := nWidth
                         else
                             nAdj := Int(nWidth/2)
                         end 
                     elseif INQ->TBL_ARR < dStart+1
                         nAdj := Int(nWidth/2) 
                     end
                     
                     nShow += 1      
                     asize( oBtns, nShow )
                     aadd( aName, { rtrim(INQ->TBL_TITLE), rtrim(INQ->TBL_FIRST), rtrim(INQ->TBL_LAST), INQ->TBL_INTNO, INQ->TBL_RMNO, INQ->TBL_ARR, INQ->TBL_DEP } )
                     
                     MakeBtn( (11+(n*10))*nSize, (nLeft+nCol)*nSize, nShow, aName, INQ->TBL_STATUS, ((nWidth*(dDepart-dArr))+nAdj-1)*nSize, (8*nSize), dDepart-dArr, FOL2->FOL_PAD1)
                     
                 end
                 INQ->(DbSkip())
             end
         end
         
         if ROO->(DbSeek(aRoom[n+nStart][1]))
         do while ROO->OOO_RMNO = aRoom[n+nStart][1]  .and. !ROO->(eof())
             if ROO->OOO_START <= dStart+nDay+1 .and. ;
                 ROO->OOO_END   >= dStart .and. ;
                !ROO->(Eof())

                     dDepart := iif(ROO->OOO_END>dStart+nDay, dStart+nDay, ROO->OOO_END )
                     dArr       := iif(ROO->OOO_START<dStart,dStart,ROO->OOO_START)
                     if ROO->OOO_START=dStart
                         nCol := 6
                     elseif ROO->OOO_START < dStart
                        nCol := iif(nType=1,1,4)
                     else
                         nCol := (((dArr-dStart)*nWidth)+6)-iif(dDepart=dArr, 6, 0 )
                         if nType=2 .and. ROO->OOO_END=ROO->OOO_START
                             nCol += 3.5
                         end
                     end
                     // nCol    := iif(INQ->TBL_ARR=dStart,6,((dArr-dStart)*nWidth)+6)-;
                     //             iif(dDepart=dArr, 6, 0 )
                     nAdj := 0
                     if dDepart=dArr
                         if ROO->OOO_START=ROO->OOO_END
                            nAdj := nWidth
                         else
                             nAdj := Int(nWidth/2)
                         end 
                     elseif ROO->OOO_START < dStart+1
                         nAdj := Int(nWidth/2) 
                     end
                
                 
                 nShow += 1      
                     asize( oBtns, nShow )
                     aadd( aName, { '', '', rtrim(ROO->OOO_RMK), Str(ROO->(Recno()),10), ROO->OOO_RMNO, ROO->OOO_START, ROO->OOO_END } )
                     
                     MakeBtn( (11+(n*10))*nSize, (nLeft+nCol)*nSize, nShow, aName, 'O'+ROO->OOO_STATUS, ((nWidth*(dDepart-dArr))+nAdj-1)*nSize, (8*nSize), dDepart-dArr, 0)
                     
           end
            ROO->(DbSkip())
         end
     end
     end
next

oDlg:DispEnd( aInfo )
return nil

*-------------------*
Function ClearBook()
local n
for n := 1 to nShow
     oBtns[n]:End()
next
return nil

*------------------------------------------*
Function MakeBtn( nRow, nCol, nShow, aName, cStatus, nWidth, nHeight, nNts, nRsDep )
local cName, cFullName, CLR_FRGD, CLR_BKGD

if nNts <= 2
    cName := left(aName[nShow][3],10)
elseif nNts >= 3 .and. nNts <= 5
    cName := aName[nShow][1]+iif(!empty(aName[nShow][1]),' ','')+aName[nShow][3]
else
    cName := aName[nShow][1]+iif(!empty(aName[nShow][1]),' ','')+aName[nShow][2]+iif(!empty(aName[nShow][2]),' ','')+aName[nShow][3]
end 
cFullName := aName[nShow][1]+iif(!empty(aName[nShow][1]),' ','')+aName[nShow][2]+iif(!empty(aName[nShow][2]),' ','')+aName[nShow][3]+CRLF+;
                 dtoc(aName[nShow][6])+' - '+dtoc(aName[nShow][7])
                 
if cStatus=='O'
    @ nRow, nCol SBUTTON oBtns[nShow] PROMPT cName ;
                     SIZE nWidth, nHeight ;
                     FONT oFnt[3] ;
                     OF oDlg ;
                     TEXT POSITION ON_LEFT ;    
                     CRYSTAL ; 
                     W97 ;
                     TOOLTIP cFullName ;
                     PIXEL COLOR CLR_WHITE, CLR_GREEN ;
                     ACTION RoomInfo( ltrim(aName[nShow][4]), cStatus )
                     // ACTION Msginfo( aName[nShow][1]+iif(!empty(aName[nShow][1]),' ','')+aName[nShow][2]+iif(!empty(aName[nShow][2]),' ','')+aName[nShow][3]+' ('+aName[nShow][4]+')'+CRLF+;
                     //                   dtoc(aName[nShow][6])+' - '+dtoc(aName[nShow][7]) )
elseif cStatus=='R'
    CLR_FRGD := iif(nRsDep<>0,CLR_WHITE,CLR_BLUE)
    CLR_BKGD := iif(nRsDep<>0,CLR_BLUE,nRGB( 240,220,110))
    
    @ nRow, nCol SBUTTON oBtns[nShow] PROMPT cName ;
                     SIZE nWidth, nHeight ;
                     FONT oFnt[3] ;
                     OF oDlg ;
                     TEXT POSITION ON_LEFT ;    
                     CRYSTAL ;
                     W97 ;
                     TOOLTIP cFullName ;
                     PIXEL COLOR CLR_FRGD, CLR_BKGD ;
                     ACTION RoomInfo( ltrim(aName[nShow][4]), cStatus )
                     // ACTION Msginfo( aName[nShow][1]+iif(!empty(aName[nShow][1]),' ','')+aName[nShow][2]+iif(!empty(aName[nShow][2]),' ','')+aName[nShow][3]+' ('+aName[nShow][4]+')'+CRLF+;
                     //                   dtoc(aName[nShow][6])+' - '+dtoc(aName[nShow][7]) )
                     
                     // oBtns[nShow]:lDrag := .T.
                     // oBtns[nShow]:bMoved := {|| Msginfo( oBtns[nShow]:nTop ) }
                     oBtns[nShow]:bRClicked := {|nRow,nCol| Menu_Action( oBtns, nShow, aName, nRow, nCol ) } // [nShow]:nTop ) }
                     
                     
elseif cStatus=='OO' .or. cStatus=='OS'
    @ nRow, nCol SBUTTON oBtns[nShow] PROMPT cName ;
                     SIZE nWidth, nHeight ;
                     FONT oFnt[3] ;
                     OF oDlg ;
                     TEXT POSITION ON_LEFT ;    
                     CRYSTAL ;
                     W97 ;
                     TOOLTIP cFullName ;
                     PIXEL COLOR CLR_WHITE, CLR_RED ;
                     ACTION RoomInfo( ltrim(aName[nShow][4]), cStatus )
                     //ACTION Msginfo( aName[nShow][1]+iif(!empty(aName[nShow][1]),' ','')+aName[nShow][2]+iif(!empty(aName[nShow][2]),' ','')+aName[nShow][3]+' ('+aName[nShow][4]+')'+CRLF+;
                     //                   dtoc(aName[nShow][6])+' - '+dtoc(aName[nShow][7]) )

elseif cStatus=='OB'
    @ nRow, nCol SBUTTON oBtns[nShow] PROMPT cName ;
                     SIZE nWidth, nHeight ;
                     FONT oFnt[3] ;
                     OF oDlg ;
                     TEXT POSITION ON_LEFT ;    
                     CRYSTAL ;
                     W97 ;
                     TOOLTIP cFullName ;
                     PIXEL COLOR CLR_BLUE, nRGB( 130, 220, 250 ) ;
                     ACTION RoomInfo( ltrim(aName[nShow][4]), cStatus )
                     // ACTION Msginfo( aName[nShow][1]+iif(!empty(aName[nShow][1]),' ','')+aName[nShow][2]+iif(!empty(aName[nShow][2]),' ','')+aName[nShow][3]+' ('+aName[nShow][4]+')'+CRLF+;
                     //                   dtoc(aName[nShow][6])+' - '+dtoc(aName[nShow][7]) )

end

return nil

*----------------------*
Function TE(cThai,cEng)
return cEng

*-----------------------------------------*
Function menu_action( oBtns, nShow, aName, nRow, nCol )

local oMenu

MENU oMenu POPUP 2007
MENUITEM "Move Room" action DragOk(oBtns,nShow,aName)
MENUITEM "Extend" action ReSize(oBtns[nShow])
ENDMENU

ACTIVATE MENU oMenu AT nRow, nCol OF oBtns[nShow]

return nil
*-----------------------*
Function DragOk( oBtns, nShow, aName )
local nTop := oBtns[nShow]:nTop
local nArray := ascan( aRoom, {|x| x[1]=aName[nShow][5] } )
oBtns[nShow]:lDrag := .T.
oBtns[nShow]:bMoved := {|| (if(MsgYesNo('Move from : '+aRoom[nArray][1]+' To '+aRoom[nArray-int(round((nTop-oBtns[nShow]:nTop)/20,0))][1]+' ?'),MoveRoom(aRoom[nArray][1],aRoom[nArray-int(round((nTop-oBtns[nShow]:nTop)/20,0))][1]),), oBtns[nShow]:lDrag := .F.) }
return nil

*-----------------------*
Function ReSize( oBtns )
oBtns:lDrag := .T.
oBtns:ShowDots()
oBtns:bMoved := {|| (Msginfo( oBtns:nLeft ), oBtns:lDrag := .F.) }
return nil
*-------------------------------------*
Function MoveRoom( cOldRoom, cNewRoom )
Msginfo('Move From : '+cOldRoom+' -> '+cNewRoom)
return nil

*----------------------*
Function RoomInfo(cIntNo,cStatus)
/*
local old_sel := select()
local aRmSt


if valtype( Eval(bData) ) = 'N'
   aRmSt := subs(ChkOcRs( aColPos[oLbx:nLogicPos][1], dComDat+(nCol-3), nType ),31,41)
else
   aRmSt := Subs(Eval(bData),31,41)
end

if len(cStatus) = 2
   SELECT('ROO')
   ROO->(DbGoTo(val(cIntNo)))
   ViewOOO()
else
   SELECT('INQ') 
   INQ->(SetOrder(1))
   if INQ->(DbSeek(cIntNo))
      OPENFILE('CCRTBL','RSV',1)
      RSV->(DbGoTo( INQ->(RecNo()) ))
      RSV->(GstInfo('RSV'))
      CLOSEFILE('RSV')
   end
   INQ->(SetOrder(13))
end

select(old_sel)
*/
return nil

*---------------*
Procedure ViewOOO()
local oDlg, oBtn, oGets[7]
local cRmNo, cStatus, dStart, dEnd, cRmk, cUser, dDate, ooStatus, ooNumRms
local nTop, nLeft
local aStatus :=  {'Out Of Order  ','Out Of Service','Block         '}

do case
   case ROO->OOO_STATUS='O'
        cStatus := aStatus[1]
   case ROO->OOO_STATUS='S'
        cStatus := aStatus[2]
   case ROO->OOO_STATUS='B'
        cStatus := aStatus[3]
end

DEFINE DIALOG oDlg RESOURCE 'EDITRMOO' TITLE TE('รายละเอียดห้องเสีย','View Out Of Order') ;
         COLOR CLR_BLACK,   THEME2007 ;
         FONT MEMVAR->oFont

    oDlg:lHelpIcon := .F.

   REDEFINE GET oGets[1] VAR ROO->OOO_RMNO  ID 101 OF oDlg PICTURE '!!!!' ;
            WHEN .F. COLOR CLR_BLACK, CLR_WHITE
   REDEFINE GET oGets[2] VAR cStatus        ID 102 OF oDlg ;
            WHEN .F. COLOR CLR_BLACK, CLR_WHITE
   REDEFINE GET oGets[3] VAR ROO->OOO_START ID 103 OF oDlg ;
            WHEN .F. COLOR CLR_BLACK, CLR_WHITE
   REDEFINE GET oGets[4] VAR ROO->OOO_END   ID 104 OF oDlg ;
            WHEN .F. COLOR CLR_BLACK, CLR_WHITE
   REDEFINE GET oGets[5] VAR ROO->OOO_RMK   ID 105 OF oDlg ;
            WHEN .F. COLOR CLR_BLACK, CLR_WHITE
   REDEFINE GET oGets[6] VAR ROO->OOO_USER  ID 106 OF oDlg ;
            WHEN .F. COLOR CLR_BLACK, CLR_WHITE
   REDEFINE GET oGets[7] VAR ROO->OOO_DATE  ID 107 OF oDlg ;
            WHEN .F. COLOR CLR_BLACK, CLR_WHITE
            
    oGets[1]:lDisColors := .F.            
    oGets[2]:lDisColors := .F.            
    oGets[3]:lDisColors := .F.            
    oGets[4]:lDisColors := .F.            
    oGets[5]:lDisColors := .F.            
    oGets[6]:lDisColors := .F.            
    oGets[7]:lDisColors := .F.            
            
   REDEFINE SBUTTON oBtn ID 4 ;
            RESOURCE 'EXIT', 'EXIT', 'EXIT', 'EXIT' ;  //    FONT oFnt ;
            NOBORDER ;
            PROMPT TE('ถอย','E&xit') ;
            ACTION ( oDlg:End() ) ;
            COLOR {|oBtn| If( oBtn:lMouseOver, CLR_YELLOW, CLR_WHITE ) } ;
            TEXT ON_RIGHT

ACTIVATE DIALOG oDlg CENTER RESIZE16
return
Regards,
Dutch

Re: OT: new FWH ECR released

Posted: Tue May 25, 2010 2:43 pm
by frose
Dutch,

thank you very much for the posted code, understanding how you solve it, very impressive.

But I can't compile bpaint.c, so I can't use TSButton and test your app :(
I think it's because I'm compile my app with xCC.exe (xHarbour.com), perhaps someone has a solution?