OT: new FWH ECR released

OT: new FWH ECR released

Postby Otto » Sat May 22, 2010 6:59 pm

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.
viewtopic.php?f=4&t=18877

With best regards,

Otto



Image

Image

Image

Image

Image
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6346
Joined: Fri Oct 07, 2005 7:07 pm

Re: OT: new FWH ECR released

Postby Armando » Sat May 22, 2010 7:46 pm

Otto:

Great job !, Congratulations.

It's looks so professional.

Regards
SOI, s.a. de c.v.
estbucarm@gmail.com
http://www.soisa.mex.tl/
http://sqlcmd.blogspot.com/
Tel. (722) 174 44 45
Carpe diem quam minimum credula postero
User avatar
Armando
 
Posts: 3231
Joined: Fri Oct 07, 2005 8:20 pm
Location: Toluca, México

Re: OT: new FWH ECR released

Postby Ruben Fernandez » Sat May 22, 2010 8:23 pm

Otto: Great, Great, Great.

Congratulations.

Ruben Fernandez
Ruben Fernandez
 
Posts: 366
Joined: Wed Aug 30, 2006 5:25 pm
Location: Uruguay

Re: OT: new FWH ECR released

Postby James Bott » Sat May 22, 2010 9:19 pm

Very impressive Otto. Nice work!

James
User avatar
James Bott
 
Posts: 4840
Joined: Fri Nov 18, 2005 4:52 pm
Location: San Diego, California, USA

Re: OT: new FWH ECR released

Postby HunterEC » Sat May 22, 2010 10:03 pm

Otto:

Great job ! I must say: impressive & very professional.
HunterEC
 
Posts: 723
Joined: Tue Sep 04, 2007 8:45 am

Re: OT: new FWH ECR released

Postby hag » Sun May 23, 2010 1:43 am

Otto: great stuff
Thank you
Harvey
hag
 
Posts: 598
Joined: Tue Apr 15, 2008 4:51 pm
Location: LOs Angeles, California

Re: OT: new FWH ECR released

Postby ukoenig » Sun May 23, 2010 5:39 pm

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:
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
User avatar
ukoenig
 
Posts: 4043
Joined: Wed Dec 19, 2007 6:40 pm
Location: Germany

Re: OT: new FWH ECR released

Postby Otto » Sun May 23, 2010 6:32 pm

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
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6346
Joined: Fri Oct 07, 2005 7:07 pm

Re: OT: new FWH ECR released

Postby dutch » Mon May 24, 2010 11:11 am

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
Regards,
Dutch

FWH 19.01 / xHarbour Simplex 1.2.3 / BCC73 / Pelles C / UEStudio
FWPPC 10.02 / Harbour for PPC (FTDN)
ADS V.9 / MySql / MariaDB
R&R 12 Infinity / Crystal Report XI R2
(Thailand)
User avatar
dutch
 
Posts: 1545
Joined: Fri Oct 07, 2005 5:56 pm
Location: Thailand

Re: OT: new FWH ECR released

Postby Otto » Mon May 24, 2010 5:23 pm

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
********************************************************************
mod harbour - Vamos a la conquista de la Web
modharbour.org
https://www.facebook.com/groups/modharbour.club
********************************************************************
User avatar
Otto
 
Posts: 6346
Joined: Fri Oct 07, 2005 7:07 pm

Re: OT: new FWH ECR released

Postby vensanto » Mon May 24, 2010 10:03 pm

hello dutch
i like your room planner
i'm interesting

it's possible get the source or the class

regards

Santo Venezia
User avatar
vensanto
 
Posts: 58
Joined: Thu Oct 13, 2005 1:26 pm
Location: ITALIA

Re: OT: new FWH ECR released

Postby ukoenig » Mon May 24, 2010 10:12 pm

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 :?:
Last edited by ukoenig on Tue May 25, 2010 9:30 am, edited 2 times in total.
Since 1995 ( the first release of FW 1.9 )
i work with FW.
If you have any questions about special functions, maybe i can help.
User avatar
ukoenig
 
Posts: 4043
Joined: Wed Dec 19, 2007 6:40 pm
Location: Germany

Re: OT: new FWH ECR released

Postby frose » Tue May 25, 2010 5:59 am

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
Windows 11 Pro 22H2 22621.1848
Microsoft (R) Windows (R) Resource Compiler Version 10.0.10011.16384
Harbour 3.2.0dev (r2008190002)
FWH 23.10 x86
User avatar
frose
 
Posts: 392
Joined: Tue Mar 10, 2009 11:54 am
Location: Germany, Rietberg

Re: OT: new FWH ECR released

Postby dutch » Tue May 25, 2010 8:49 am

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  Expand view  RUN
#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
Regards,
Dutch

FWH 19.01 / xHarbour Simplex 1.2.3 / BCC73 / Pelles C / UEStudio
FWPPC 10.02 / Harbour for PPC (FTDN)
ADS V.9 / MySql / MariaDB
R&R 12 Infinity / Crystal Report XI R2
(Thailand)
User avatar
dutch
 
Posts: 1545
Joined: Fri Oct 07, 2005 5:56 pm
Location: Thailand

Re: OT: new FWH ECR released

Postby frose » Tue May 25, 2010 2:43 pm

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?
Windows 11 Pro 22H2 22621.1848
Microsoft (R) Windows (R) Resource Compiler Version 10.0.10011.16384
Harbour 3.2.0dev (r2008190002)
FWH 23.10 x86
User avatar
frose
 
Posts: 392
Joined: Tue Mar 10, 2009 11:54 am
Location: Germany, Rietberg

Next

Return to FiveWin for Harbour/xHarbour

Who is online

Users browsing this forum: No registered users and 38 guests