'le programme crée un dossier "avibmptst" ; dedans ; tu places tes avi,bmp
'le beuton "open" charge le fichier .tst que tu as au préalable , créé
'le beuton "avib" charge les avi/bmp pour créer le fichier .tst que tu saves 
'si tu click sur la row bloc-notes tu ouvres un rich par col
'pour fermer le rich , un click droit  sur le rich ; pour le popup , un click gauche sur le QSTRINGGRID
'le beuton "swap" affiche le calendar , donc ; l'edit
'le calendar "un calendar perpête"
'un dbclick G sur l'edit pour le popup
'le zoom -> "+" "-" pour les images de l'edit
'le del -> unicquement avec "terminal" et avec la coul papier ,paque c'est un faut del
'sur le popup de l'edit tu as "coul fond char" -> pour remêtre la coul fond à -1 tu click sur "coul fond char" épi sur la fenetre coul "annuler"
'pour fixer une image sur l'edit , un click D 
'n'est pas implanté ; le cut , Le paste , etc de l'edit ??..
'seul LES font.name ="terminal","Arial","Times New Roman" sont alignés en function du size , pour textout
'un click D sur le QFILELISTBOX pour le popup 
'pour les avi sur QFILELISTBOX ,tu click sur le nom de l'avi ,épi tu click sur le beton "M" ,épi sur le beton "O"
'pour l'avi 1/1 ,tu click sur le beton "II"

$TYPECHECK ON

 $INCLUDE "RAPIDQ.INC" 
   CONST CF_BITMAP_BMP=2 
   CONST OBJ_BITMAP_BMP=7

   Const BLACKNESS = &H42
   Const DSINVERT = &H550009
   Const MERGECOPY = &HC000CA
   Const MERGEPAINT = &HBB0226
   Const NOTSRCCOPY = &H330008
   Const NOTSRCERASE = &H1100A6
  ' Const PATCOPY = &HF00021
    Const PATINVERT = &H5A0049
  ' Const PATPAINT = &HFB0A09
    Const WHITENESS = &HFF0062
 
    Const SRCAND = &H8800C6 
    Const SCrcOPY = &HCC0020 
    Const SRCERASE = &H440328
    Const SRCINVERT = &H660046 
    Const SRCPAINT = &HEE0086
    DECLARE FUNCTION NViewLibLoad LIB "NVIEWLIB" ALIAS "NViewLibLoad" (FileName AS STRING, Progress AS INTEGER) AS INTEGER
 
 DECLARE FUNCTION GetWidth LIB "NVIEWLIB" ALIAS "GetWidth" AS INTEGER
 DECLARE FUNCTION GetHeight LIB "NVIEWLIB" ALIAS "GetHeight" AS INTEGER

Declare Function CreateRoundRectRgn Lib "gdi32" Alias "CreateRoundRectRgn" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
'Declare Function DeleteObject Lib "gdi32" alias "DeleteObject" (ByVal hObject As Long) As Long

Declare Function SetWindowRgn Lib "user32" alias "SetWindowRgn" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As long) As Long
 
 
'Declare Function DeleteDC Lib "gdi32" alias "DeleteDC" (ByVal hdc As Long) As Long
    DECLARE Function PlayMedia Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, lpstrReturnString As Long, uReturnLength As Long, hwndCallback As Long) As Long
    DECLARE FUNCTION GetCurrentObjectbmp LIB "gdi32" ALIAS "GetCurrentObject" (hdc AS LONG,uObjectType AS LONG) AS LONG
    DECLARE SUB SetFocus LIB "USER32" ALIAS "SetFocus" (HWnd AS LONG)  
    Declare Function GetDC Lib "user32" alias "GetDC" (ByVal hwnd As Long) As Long
    Declare Function DeleteObject Lib "gdi32" alias "DeleteObject" (ByVal hObject As Long) _
        As Long
    Declare Function DeleteDC Lib "gdi32" alias "DeleteDC" (ByVal hdc As Long) As Long
    Declare Function BitBlt Lib "gdi32" _
        alias "BitBlt" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, _
        ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
        ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
 ''''''''''''''''''''''''''data calendar''''''''''''''''''''''''''''''''''''''''''''''''''''
 TYPE TCHOOSECOLOR
     lStructSize AS LONG
     hWndOwner AS LONG
     hInstance AS LONG
     rgbResult AS LONG
     CustColors(1 TO 16) AS LONG
     Flags AS DWORD
     lCustData AS LONG
     lpfnHook AS LONG
     lpTemplateName AS LONG
 END TYPE
 dim ccr as TCHOOSECOLOR
 
 DECLARE FUNCTION ChooseColorDlg LIB "COMDLG32" ALIAS "ChooseColorA" _
                  (ccr AS TCHOOSECOLOR) AS LONG
 CONST CC_RGBINIT = &H1
 CONST CC_FULLOPEN = &H2
 CONST CC_PREVENTFULLOPEN = &H4
 CONST CC_SHOWHELP = &H8
 CONST CC_ENABLEHOOK = &H10
 CONST CC_ENABLETEMPLATE = &H20
 CONST CC_ENABLETEMPLATEHANDLE = &H40
 CONST CC_SOLIDCOLOR = &H80
 CONST CC_ANYCOLOR = &H100
 $resource skin as "formgrid2.bmp"
        dim bf1 as qbitmap
 bf1.Width =  423
 bf1.Height =  12
 Bf1.Paint(0,0,0,0)
 dim servbmp as qbitmap
 dim rected as qrect
 dim font1 as qfont
 font1.name ="Terminal"
 font1.size = 9
 font1.color = &h9AFF7
 dim font as qfont
 font.name = "terminal"
 font.size = 5
 font.color = 960'&h168b
 
 DIM Popedit AS QPopupMenu
 DIM coulCfond as qmenuitem,couldel as qmenuitem,pagecoul as QMenuItem,del as QMenuItem,Copy AS QMenuItem, Cut AS QMenuItem, Paste AS QMenuItem, SelectAll AS QMenuItem,colo as QMenuItem,fonts as qmenuitem,save as qmenuitem
 popedit.AddItems (Copy,Cut,Paste,SelectAll,save,del,pagecoul,couldel,coulCfond,colo,fonts)
 
 DIM popupcal as qPopupMenu
 DIM delc as QMenuItem,load as QMenuItem,loadst as QMenuItem
 popupcal.AddItems (Delc,load,loadst)
 declare sub clearbmp
 DECLARE SUB Tabjourmoi
 Declare Sub do_Keys(Key As Word,x as word, y as word,Shift As Integer)
 Declare Sub lesmois
 Declare sub fix
 Declare sub imgcenter1
 declare sub swaps
 declare sub timJM
 declare sub upcur
 declare sub okpoped
 declare sub couleur
 declare sub getfont
 declare sub coul_page
 declare sub delcoul
 declare sub savebmp
 declare sub delimtst
 declare sub imload
 declare sub strtch
 declare sub Ccharfond
 declare sub exitex
 delc.caption="&Delimtext":delc.onclick=delimtst
 Copy.Caption = "&Copy"   ': Copy.OnClick = copytxt
 Cut.Caption  = "Cu&t"   ': Cut.OnClick = CutClick
 couldel.caption="Coul Del":couldel.onclick=delcoul
 Paste.Caption = "&Paste" ': Paste.OnClick = PasteClick
 SelectAll.Caption = "&Select All"': SelectAll.OnClick = file
 colo.caption = "coul Char":colo.onclick = couleur
 fonts.caption = "font":fonts.onclick = getfont
 save.caption="&Save":save.onclick=savebmp
 del.caption="Delimtext":del.onclick=clearbmp
 pagecoul.caption="coul page":pagecoul.onclick=coul_page
 load.caption="load imedit":load.onclick=imload
 loadst.caption="load stretch":loadst.onclick=strtch
 coulCfond.caption="Coul fond char":coulCfond.onclick=Ccharfond
 
 dim dpswap as byte
 dim anne as string
 anne=right$(date$,4)
 dim txm(31,12,1) as qbitmap
 dim ane as byte
 dim mois$(12) as byte
 mois$(0) =31
 
 mois$ (1) = 31
 mois$ (2) = 28
 mois$ (3) = 31
 mois$ (4) = 30
 mois$ (5) = 31
 mois$ (6) = 30
 mois$ (7) = 31
 mois$ (8) = 31
 mois$ (9) = 30
 mois$ (10) = 31
 mois$ (11) = 30
 mois$ (12) = 31
 '''''''''''''''''''''''''''''''''''''''''''''''''fin data calendar
 dim  villeList as string
 villeList="PARIS"+chr$(13)+chr$(10)+"ST ETIENNE"+chr$(13)+chr$(10)+"LYON"+chr$(13)+chr$(10)+"Boff"
 dim font12 as qfont 
 font12.name = "ms serif" 
 font12.addstyles(0)
 font12.size =7
 font12.color = 1200 '&h80FF
 dim im as qbitmap
 
 
 im.bmp="telescopz1.bmp"
 dim row_o as qbitmap
 row_o.bmp="row_o7.bmp"
 dim rowx as qbitmap
 rowx.bmp="row_o4.bmp"
 
 DECLARE SUB  cellClick (Col%, Row% , can%)
 DECLARE SUB DrawCell (Col%, Row%, State%, Rect AS QRECT, Sender AS QSTRINGGRID)
 
 DECLARE SUB OpenClick
 DECLARE SUB iddroite
 DECLARE SUB idgauche
 DECLARE SUB saveClick
 DECLARE SUB richdown  (key as integer,X%, Y%, Shift%,sender as qrichedit)
 declare sub print_it
 declare sub copyclick
 declare sub cutclick
 declare sub delrowclick 
 declare sub couleurclick
 declare sub pasteclick
 declare sub selectsallclick 
 declare sub undoclick
 
 declare sub  Pop
 declare sub copyclickrich
 declare sub cutclickrich
 declare sub pasteclickrich
 declare sub selectsallclickrich
 declare sub openfile
 declare sub openavibmp
 declare sub load_avi_txt
 declare sub  saveprog
 declare sub Magnét
 declare sub show
 declare sub plécran
 declare sub move (ky as integer)
 declare sub stopplay
 declare sub delcoltxt
 declare sub Delgridtxt
declare sub indxane
 dim memonumfram as long
 dim mSlide as string * 256
 dim dpstopplay as byte
 dim c as long
 DIM PopupMenurich AS QPopupMenu'le pop des richs
 dim prich as QMenuItem,sp as QMenuItem ,copyrich as QMenuItem,pasterich as QMenuItem,cutrich as QMenuItem,selectsallrich as QMenuItem
 prich.caption="POUR LE RICH"
 sp.Caption = "-"  
 pasterich.caption="&Paste":pasterich.onclick=pasteclickrich
 copyrich.caption="&Copy":copyrich.onclick=copyclickrich
 cutrich.caption = "&Cut":cutrich.onclick= cutclickrich
 selectsallrich.caption="&Select All":selectsallrich.onclick=selectsallclickrich
 popupmenurich.AddItems (prich,sp,copyrich,cutrich,pasterich,selectsallrich)
 DIM Popupgrid AS QPopupMenu'le pop de stringgrid
 dim delcol as QMenuItem,delrow as QMenuItem,delcoltext as QMenuItem,deltgrid as QMenuItem,incol as QMenuItem,inrow as QMenuItem
 delcol.caption="&Delcol":'delcol.onclick=pasteclickrich
 delrow.caption="&Delrow":'delrow.onclick=copyclickrich
 delcoltext.caption = "&Delcoltxt":delcoltext.onclick= delcoltxt
 deltgrid.caption="&Delgridtxt":deltgrid.onclick=Delgridtxt
 Popupgrid.AddItems (delcol,delrow ,delcoltext, deltgrid ,incol ,inrow )
 servbmp.bmphandle=skin
      CREATE FormSTRINGGRID AS QFORM
      borderstyle = bsnone
     center 
    width=641
 height=392

 color = &hC0C0C0
 shapeForm (skin,&hffffff)
 create imagecal as qimage
 cursor=4
 align=5
 bmpHandle=skin
 transparent=1
 end create   
 create imagecal1 as qimage
  
 left=1
width=641
 height=392
 bmphandle=skin
 
 transparent=1
 
 end create   
 
 create edit1 as qedit
  top=4
  left=280
  font=font12
  font.color=&hffff
  color = &h5081E4   
  text="Save file .tst"
  hint="File -> .tst"
  showhint=1
  width=60
  height=16
  end create    
create exite as qcoolbtn
         font=font12
         top=9
         left=39
         width=22
         height=12
         caption="Exit"
         flat=1
         font.color=&hff
        
         onclick=exitex
 
         end create      
    
  
   create cachstring as qpanel
 top=28
 LEFT=20
    BevelOuter = 1
 
 BevelInner = 1
 BevelWidth = 2
 
    Width = 594
       Height = 349

    OnClick = pop
       CREATE StringGrid1  AS QSTRINGGRID
       align=5
     ' Height = FormSTRINGGRID.clientheight
       font=font12
       font.size=7
       FONT.color=&H62FF
       showhint=1
       ScrollBars=0
      BorderStyle=1
         AddOptions(goEditing )
         GridLineWidth=0
         ColCount = 9
         RowCount = 15
         FixedColor= &h225ADD

        Separator="|" 'bofff quetuveux
        Cell(0,1) = "  Nom"
         Cell(0,2) = "  AD :"
         Cell(0,3) = "  DC :"
         Cell(0,4) = "  Date"     
         Cell(0,5) = "  Heure -> Start"
         Cell(0,6) = "  Magn"
         Cell(0,7) = "  Turbulences"
         Cell(0,8) = "  Diamètre apparent"
         Cell(0,9) = "  G -> Capteur au 4/5"
         Cell(0,10) = "  Nb d'images"
         Cell(0,11) = "  Temps de Capture"
         Cell(0,12) = "  Lieux"
         Cell(0,13)= "  Coordonnées"
         cell(0,14)="  Bloc-notes"
         
         'cell(0,StringGrid1.RowCount-1)="   Bloc-notes"
        
         DefaultRowHeight = 16
        DefaultColWidth=110
    ColWidths(0)=141
     RowHeights(0)=112
      Color=&hff
     
      FixedCols=1
         FixedRows = 0
        PopupMenu=Popupgrid
        ondrawcell= DrawCell
        OnSelectCell = cellClick
 
       
       END CREATE
 
 
          create pancolrow0 as qpanel
          BevelInner = 0
   BevelWidth = 0
          left=5
          top=6
      width=140
         height=110
        

        
       
         create imcolrow0 as qimage
         font=font12
         font.size=7
         align=5
         bmp=im.bmp
        transparent=1
        RoundRect(4+15,3+32, 85 ,17+35,8,8,&hff) 
         RoundRect(7+15,4+32, 82 ,16+35,7,7,&hCAFCFF)
         TextOut (22, 38 ,"ASPROcam" , 960, -1)
        onmouseup=move
         onmousemove=move
         end create
      
         create Nbimages as qedit
          font=font12
          font.size=6
          font.color=&H62FF
         top=65
         left=5
         width=95
         height=13
         autosize=0
         MaxLength=13
         visible=0
         end create
  
         create btstgD as qcoolbtn
         font=font12
         top=0
         left=106
         width=16
         height=15
         flat=1
         font.color=&hff
       
         onclick=idgauche
 
         end create
         create btstgG as qcoolbtn
         font=font12
         top=0
         left=122
         width=16
         height=15
         flat=1
         font.color=&hff
        
         onclick=iddroite
         end create
         create swape as qcoolbtn
         font=font12
         top=4
         left=4
         width=29
         height=15
         flat=1
         font.color=&hff
         caption="Swap"
         hint="       Swap"+chr$(13)+chr$(10)+"Edit  & File avi/bmp"
         showhint=1
         onclick=swaps
         end create
         create btopen as qcoolbtn
         font=font12
         top=17
         left=106
         width=31
         height=16
         flat=1
         font.color=960
         caption="Open"
         hint="Load file .tst"
         showhint=1
         onclick=openfile
         end create
        create btavi as qcoolbtn
         font=font12
         top=34
         left=106
         width=31
         height=16
         flat=1
         font.color=960
         caption="AviB"
         hint="Load avi/bmp"
         showhint=1
         onclick=openavibmp
         end create
          create btsave as qcoolbtn
         font=font12
         top=51
         left=106
         width=31
         height=16
         flat=1
         
         font.color=960
         caption="Save"
         hint="Save file .tst"
         showhint=1
         onclick=saveprog
         end create
         create magn as qcoolbtn
         font=font12
         top=85
         left=121
         width=15
         height=17
         flat=1
         font.color=960
         caption="M "
         hint="Magnéto on/off"
         showhint=1
         onclick=Magnét
         end create
         create prt as qcoolbtn
         font=font12
         top=68
         left=104
         width=16
         height=10
         flat=1
         font.color=&hff
         caption="P "
         hint="Print STRINGGRID"
         showhint=1
         onclick=print_it
         end create
         create plécr as qcoolbtn
         font=font12
         top=68
         left=121
         width=16
         height=10
        flat=1
         font.color=&hff
         caption=chr$(33)+chr$(33)
         hint="Video 1/1"
         showhint=1        
         onclick=plécran
         end create
         create stopm as qcoolbtn
         font=font12
         top=89
         left=55
         width=12
         height=13
        flat=1
         font.color=&hff
         caption="O "
        hint="Stop/Play"
        showhint=1
        onclick=stopplay
         end create
         
       create curavi as qpanel
        BevelInner = 2
         BevelWidth = 1
  
        top=103
        left=56
        width=10
        height=7
        color=&hff'&h8CD4FE
        visible=0
        onmouseup=move
        onmousemove=move
        end create
      
 
        create edit as qedit
  top=85
  left=8
  font=font12
  font.color=&hffff
  color = &h5081E4   
  text="Save file .tst"
  hint="File -> .tst"
  showhint=1
  width=104
  height=16
  end create
  
'color = &hA5BDF1  

 color = &h8BABED
' color = &h9BB7F0
' color = &h779CEA   
 'color = &h0080FF
  'color = &hE8E8E8
 'color = &h00E6E6
     end create
            color= 0

       END CREATE
   onshow=show
      END CREATE'''''''''''''''''''fin FormSTRINGGRID
             create split as qpanel'''''''''''''''''''''''''''''''''''''''split'''''file
  parent=cachstring
  
  Top = 119
  Left =6
   Width = 140
   HEIGHT=223  
   
    BevelOuter = 1
        BevelWidth = 2
    visible =0 
    CREATE Fil AS QFILELISTBOX
    font = font12
    font.color =&hffffff  
    font.addstyles(0)
   align =5                  
                Color =160'&H1C4EB7 '&h8EADC0
                 Drive =CURDIR$
                 ShowIcons = 1
                ExtendedSelect = 1
                
                 ItemHeight = 14
                TabOrder = 2   
                     
                showhint=1  
                PopupMenu=popupcal
                   OnClick = load_avi_txt            
            END CREATE
 
          end create''''''''''''''''''''''''''''''fin''''box  
      ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''calendar
      CREATE Panel177 AS QPANEL
 
 parent=cachstring
 color=&H32EC'&h2D50A2
 
 BevelOuter = 1
 
 BevelInner = 1
 BevelWidth = 1
 align=4
 Width = 440'438
 
 Height = 293
 visible=0
 
 create  pi as qpanel''''''''''''''''''''''''''''''''''panel des jours D L M M J V S
 BevelInner = 1
 BevelWidth = 1
 Left = 5
 Top = 7  '54
 Width =398 '423
 Height = 16
 color=0
 CREATE Images AS QIMAGE
 align=5
 bmp =bf1.bmp
 
 END CREATE
 end create
 
 CREATE tab AS QTABCONTROL  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''tab jours
 left=5
 top=24
 width=panel177.clientwidth-9
 height=panel177.CLIENTheight+18
 CREATE Pan AS Qpanel'''''''''''''''''''''''''la panel cache les jours 29 30 31
 BevelInner = 0
 BevelWidth = 0
   font = font12
 font.size = 6
 font.color = &hf5ff
 
 Left = 350
 Top = 1
 color =&H32EC'&h2D50A2
 
 
 Width = 38
 height =15
 
 end create 
 
  
 font = font
 font.size = 6
 
 font.color=&hff
 tabinactivefont = font
 
 color =&H32EC
 tabwidth = 12
 tabinactivecolor =&hD3FFFF
 font.color =&hf5ff
 addTabs "*","1 ","2 ","3 ","4 ","5 ","6 ","7 ","8 ","9 ","10 ","11 ","12","13","14","15","16","17","18","19","20","21","22","23","24","25","26","27","28","29","30","31"
 
 FocusButtons=0
 tabindex = 0
 OnChange= Tabjourmoi
 create seljour as qpanel
 top=12
 'left=15
 width=13
 height=5
 color=&hff
 end create
 
 CREATE tab1 AS QTABCONTROL''''''''''''''''''''''''''''''''''tab1 les mois
 font = font12
 font.size = 7
 tabinactivefont = font12
 font.color = &hf5ff
 left = tab.ClientWidth - 35
 top = 17
 verticaltabs =1
 tabposition =1
 color =&H32EC
 tabwidth = 22
 tabheight = 30
 Width = 35
 Height = Panel177.HEIGHT
 tabinactivecolor = &hD3FFFF'&hbecde7
 addTabs anne," janv"," févr"," mars"," avri"," mai"," juin"," juil"," aout"," sept"," octo"," nove"," déce"
 
 FocusButtons=0
 tabindex = 0
 OnChange= tabjourmoi'lesmois
 create selmois as qpanel
 top=1
 left=0
 width=5
 height=24
 color=&hff
 end create
 create edit2 as qedit
font.color=0
 left = 2'70
 top = 4
width = 28
height = 31
MaxLength=4
visible=0

onchange=indxane
end create
 end create '''''
 
 CREATE panel111 AS QPanel''''''''''''''''''''''''''''''''''''''''''panel de l'edit
 parent=tab
 Top = 25
 Left = 10
 Width = tab.ClientWidth -52
 Height = Tab.ClientHeight-35
 
 BevelInner = 1
 BevelWidth = 2
 visible=0
 
 CREATE Pa111 AS QPanel
 align = 5
 
 color=&heeeeee
 BevelInner = 0
 BevelWidth = 0
 
 create Tx As Qrichedit
 OnkeyPRESS= do_keys
 OnKeyUp=upcur
 VISIBLE=0
 End Create
 CREATE imtext AS Qimage 'l'edit
 
 font = font1
 
 align = 5
 
 ondblclick=okpoped
 
 onmousedown = do_keys
 
 end create
 
 CREATE Panel1 AS QPANEL 'le cur de l'edit
 top = 0
 left =0
 
 
 Width = 14
 Height = 1
 Color = 960
 enabled=0
 
 END CREATE
 CREATE Panel2 AS QPANEL 'le cur de l'edit
 top = 12
 left =0
 Width = 14
 Height = 1
 Color = 960
 enabled=0
 
 END CREATE
 CREATE Panel3 AS QPANEL 'le cur de l'edit
 
 top = 0
 left =0
 
 Width = 1
 Height = 14
 Color = 960
 enabled=0
 
 END CREATE
 CREATE Panel4 AS QPANEL 'le cur de l'edit
 top = 0
 left =12
 Width = 1
 Height = 14
 Color = 960
 enabled=0
 
 END CREATE
 CREATE Panel5 AS QPANEL 'le cur de l'edit
 top = 14
 left =2
 Width = 10
 Height = 1
 Color = 960
 enabled=0
 
 END CREATE
 
 CREATE imt AS Qimage'''''''''''''''''''''''''''''''''''''''''''''''''''imt pour visualiser l'image dans l'edit
 
 enabled=0
 
 
 visible=0
 end create
 CREATE panel100 AS QPanel''''''''''''''''''''''''''''''''''''''''''panel n2
 parent=tab
 BevelInner = 1
 BevelWidth = 1
 Top = (Tab.ClientHeight+20-200)/2'25
 Left =(tab.ClientWidth-30 -300)/2' 10
 Width = 300
 Height =200 
 color = &h0080FF
 create tig as qimage
 align=5
 stretch=1
 BMP="tigre1.bmp"

 end create

 
 end create
 end create''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''?
 
 END CREATE'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 end create''''''''''''''''''''''''''''''''''''''fin pan calendar
 create cabtal as qpanel''''''''''''''''''''''''''''''''''''''''''''''''''
 Left = panel177.Clientwidth-35
 Top = 7
 Width = 30
         Height = 30
         BevelInner = 1
color = &h0080FF
 CREATE imbtal as qimage
 ALIGN=5
' TOP=2
'LEFT=2
'Width = 26
'         Height = 26
 BMP="BTONCAL.bmp"
 stretch=1

 
end create
 CREATE Button181 AS QCoolbtn
 
 font = font12
 font.addstyles(0)
 font.color=&hff
 TOP=2
 LEFT=2
 Width = 25
         Height = 25
 hint="Alarme"
 showhint=1
 flat=1
 
 
 END CREATE
 
 
 end create''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
 end create
 
      dim i as byte
      dim ii as byte
      dim stop as byte
      dim dppop as byte
      dim dprichv as byte
      dim memorow as long
      dim memocol as long
      dim okrich as byte
      dim dpavibmp as byte
      dim memoname as string
      dim counte as byte
      dim dpmagn as byte
     
      dim dpscanavibmpcran as byte
      dim dpcol as byte
      dim dpmove as byte
      dim imprint(StringGrid1.COLCount-1) as qbitmap'--------------le bitmap pour print
 dim rich (StringGrid1.COLCount-1) as qrichedit'-------- à supprimer si pas de bloc-note
 '
 StringGrid1.col=0
 StringGrid1.row=0
    dim PLAYhandle as long
    DIM okplay as long
    dim indexcol as byte
    dim codestringg as string
    dim hmap as long
    dim indexmap as long
   ' dim dpchange as byte  
    dim index as word
    dim memopos as word
    dim  FileName as string
    dim  FileNames as string
    dim dpaddavibmp as byte
    dim dptst as byte
    dim dpsave as byte
    dim path as string
    dim memoavi as string
    Dim lens as byte
     dim mLength as string * 256
     DIM dpscanavibmp AS BYTE
     dim croun as integer
     croun=&H1C4EB7
     dim fcoul as long
     dim elip as long
  doevents  
   MKDIR "avibmptst" 'crée un dossier
 


 fil.Directory ="avibmptst"'"C:\rapidq\avibmptst"'pointe sur le dossier
 SetFocus(StringGrid1.handle)
 okrich=0 
'  elip= CreateRoundRectRgn (0,0,641,392,12,12) : SetWindowRgn (FormSTRINGGRID.handle,elip,1)
'DeleteObject (elip)
 sub show
 for i=1 to StringGrid1.COLCount-1'les riches dans la sub onshow paqueu les richs ne sont pas inisialises avec SHOWMODAL
 
       rich(i).parent=cachstring
 rich(i).FONT=font12 
 rich(i).FONT.color=&H62FF
 rich(i).color=&HD3F1FF
 rich(i).width=110
 rich(i).height=192
 rich(i).tag=i
 rich(i).Wordwrap=0 
 rich(i).visible=0
 rich(i).OnMouseup=richdown
 next
 end sub
 
 sub pop
 PopupMenurich.Popup (screen.mousex,screen.mousey)
  
 end sub
 sub richdown (key,X%, Y%, Shift%,sender as qrichedit)'pour fermer les richs de bloc-note
 
 if key=1 then 
 rich(sender.tag).visible=0
 StringGrid1.enabled=1'pour redonner la main à QSTRINGGRID 
 if rich(sender.tag).text > "" then
  StringGrid1.cell(StringGrid1.col,StringGrid1.RowCount-1)="               X"'le cache des richs
 If dpsave=1 then btsave.font.color=960:dpsave=0
 else
 StringGrid1.cell(StringGrid1.col,StringGrid1.RowCount-1)=""
 end if
 okrich=0
 StringGrid1.row=1
  btstgD.enabled= 1
  btstgG.enabled=1
  swape.enabled=1
 end if
  
 end sub
    SUB cellClick (Col%, Row% ,can%)
    
      StringGrid1.ColumnStyle(col%)=2
      if row% = 0   and col% > 0 then'   
      curavi.left=10
      memoavi=StringGrid1.Cell(col%,0)
      PlayMedia("status " + memoavi + " length",varptr(mLength),256,0)
      lens=val(LEFT$(mLength,7))
      Nbimages.text = "Len Im : "+str$(lens)    
      end if
      
      if row%=4 then     
      StringGrid1.Cell(col%,4) = "        "+insert$(left$(date$,3),right$(date$,7),4)'pour la rigol
      end if     
      
      if row%=5 then   StringGrid1.Cell(col%,5) = "          "+time$'pour la rigol
      
      if col% > 0 and row%=StringGrid1.RowCount-1 then'pour  positionner les richs (la row max)
      okrich=1
      StringGrid1.enabled=0  '  
      SetFocus(rich(col%).handle)
     btstgD.enabled=0  
     btstgG.enabled=0  
     swape.enabled=0 
      index=col%'----------index pour la select des richs en cut,copy,etc..     
      end if
  
    
     
 END SUB
  
     Sub DrawCell (Col%, Row%, State%, Rect AS QRECT, Sender AS QSTRINGGRID)
       
        
        if col% = 0  and row% > 0  then '--la colo de la col=0 
       sender.draw(Rect.left+1,Rect.Top+1,row_o.bmp)
      Sender.TextOut (Rect.left+2, Rect.Top+4 ,Sender.Cell(Col%, Row%),0, -1)
        Sender.TextOut (Rect.left, Rect.Top+2 ,Sender.Cell(Col%, Row%),&hffff, -1)
       
        end if
  
 
 
        if col% > 0   then'--la colo des autres cases que col=0 
       
        if row% > 0 then
       sender.draw(Rect.left+1,Rect.Top+1,rowx.bmp)
        else
        c=rgb(136,23,11)      
       Sender.fillrect(Rect.left+1, Rect.Top+1, Rect.right, Rect.bottom, c) 
       end if
          Sender.TextOut (Rect.left+7, Rect.Top+4 ,Sender.Cell(Col%, Row%),0, -1) 
        Sender.TextOut (Rect.left+5, Rect.Top+2 ,Sender.Cell(Col%, Row%),&haaffff, -1)
         
        END IF
 
        
         IF sender.col=col% AND sender.row=row%  THEN 'la colo , pour la sélec de la case     
       if sender.row > 0 then
        Sender.fillrect(Rect.left+3, Rect.Top+3, Rect.right-2, Rect.bottom-3, &hef)
        Sender.TextOut (Rect.left+5, Rect.Top+2 ,Sender.Cell(Col%, Row%), &heeeeee, -1)
       end if
        if sender.row = 0 THEN croun=&hff
        else 
        
        if row% = 0 THEN croun=&h779CEA
        end if
        
    
    if col% > 0 and row%=0  then
           sender.RoundRect(Rect.left+2,Rect.Top+1, Rect.right-1 ,Rect.Top+17,8,8,&hffff) 'pour le dessus de l'image ; le RoundRect
        sender.RoundRect(Rect.left+4,Rect.Top+2, Rect.right-3 ,Rect.Top+16,7,7,croun)

              Sender.TextOut (Rect.left+7, Rect.Top+5 ,Sender.Cell(Col%, Row%),0, -1) 
        Sender.TextOut (Rect.left+5, Rect.Top+3 ,Sender.Cell(Col%, Row%),&hFFFFFF, -1)
           
         
           if dpaddavibmp = 1 and sender.col=col%  then 'pour ajouter des avi et bmp 
         
           memopos=rinstr(len(fil.FileName),fil.FileName,"\")
           FileNames=right$(fil.FileName,len(fil.FileName)-memopos)
                   if instr(lcase$(sender.cell(col%,0)),".avi") > 0 then PlayMedia("close "+ sender.cell(col%,0),0,0,0) 
              if len(FileNames) > 0 then
              sender.cell(col%,0)=FileNames
             
              dpaddavibmp=0
              end if
         end if
         
        if sender.cell(col%,0) > ""  then 'pour l'affichage des avi et bmp
         
        if  instr(lcase$(sender.cell(col%,0)),".avi") and dpscanavibmp=0  then  'avi
        
        playMedia("open " + sender.cell(col%,0) + " parent " + STR$(sender.handle) + " style child",0,0,0)
        PlayMedia("put " + sender.cell(col%,0) + " window at "+str$(Rect.left+3)+" "+str$(Rect.Top+19)+" " + str$(Rect.right-3-Rect.left-3) + " " + str$(Rect.bottom-2-19),0,0,0)
        
        PlayMedia("status " + sender.cell(col%,0) + " length",varptr(mLength),256,0)
        lens=val(LEFT$(mLength,7))
       PlayMedia("play " + sender.cell(col%,0) + " from "+str$(lens),0,0,0) 
      
       PlayMedia("pause "+ sender.cell(col%,0),0,0,0)    
       doevents
        elseif instr(lcase$( sender.cell(col%,0)),".bmp") then 
     
       imprint(col%).LoadFromFile(sender.cell(col%,0)) 'sender.cell(col%,0) 
        
       rect.left=rect.left+3:Rect.Top=Rect.Top+19:Rect.right=Rect.right-3:Rect.bottom=Rect.bottom-2
       sender.StretchDraw(rect,imprint(col%).bmp)
       rect.left=rect.left-3:Rect.Top=Rect.Top-19:Rect.right=Rect.right+3:Rect.bottom=Rect.bottom+2

       end if
      
       end if
 
    end if
        
        IF sender.col= col% AND sender.row=row% and okrich=1 and sender.row=sender.RowCount-1 THEN 'pour la select des rich
      
       sender.draw(Rect.left+1,Rect.Top+1,rowx.bmp)
       Sender.TextOut (Rect.left+42, Rect.Top+4 ,"notes",0, -1) 
        Sender.TextOut (Rect.left+40,Rect.top+2 ,"notes", &hffFF, -1)
        rich(col%).left=rect.left+6:rich(col%).top=Rect.Top-186
       rich(col%).visible=1
      
      end if 
       
        IF  row%=12 and sender.row=row% THEN       
        sender.ColumnStyle(col%)=0
        sender.ColumnList(col%) = villeList
        end if
      END SUB 
 
 sub openfile
 if dptst=0 THEN
 btopen.font.color=&hff
 btavi.font.color=960
 split.visible=1
 fil.mask = "*.tst"'-----------------> le .tst ou autres pour éviter le .txt et autres ; paque si non merdiqueueu !
 dpaddavibmp = 0
 dpavibmp=0
 fil.update
 dpscanavibmp=0
 dptst=1
 else
 dptst=0
 split.visible=0
 btopen.font.color=960
 end if
 end sub
 sub openavibmp
 
 if dpavibmp=0 then
 dpavibmp=1
 dptst=0
 btopen.font.color=960
 split.visible=1
 fil.mask = "*.avi;*.bmp"
 load_avi_txt
 btavi.font.color=&hff
 else
 dpavibmp=0
 btavi.font.color=960
 split.visible=0
 end if
 end sub
 sub saveprog
 if dpsave=0 then
 dpsave=1
 btsave.font.color=&hff
 'btavi.font.color=960
 'btopen.font.color=960
 magn.font.color=960
 edit.visible=1
 dpmagn=0
 'dpavibmp=0
 'dptst=0
 
 setfocus(edit.handle)
 else
 dpsave=0
 edit.font.color=&hffff
 if dpswap=0 AND len(edit.text) > 0 THEN
 Saveclick
 end if
 setfocus(StringGrid1.handle)
 end if 
 end sub
 sub Magnét
 if dpmagn=0 then
 dpmagn=1
 magn.font.color=&hff
 edit.visible=0
 curavi.visible=1
 Nbimages.visible=1
 else
 magn.font.color=960
 edit.visible=1
 curavi.visible=0
 Nbimages.visible=0
 dpmagn=0
 end if 
 end sub
 
 
 sub plécran 
 StringGrid1.row=0
 dim memonumframpl as long
 dpscanavibmp=1
 PlayMedia("close "+ memoavi,0,0,0)
 PLAYhandle = playMedia("open " + memoavi + " parent " + STR$(0) + " style child",0,0,0)
  PlayMedia("put " + memoavi + " window at "+str$(0)+" "+str$(0)+" " + str$(0) + " " + str$(0),0,0,0)     
  PlayMedia("play " + memoavi+ " from "+str$(0),0,0,0)
  do
 DOEVENTS 
  PlayMedia("status " + memoavi + " position",varptr(mSlide),256,0)
 memonumframpl= val(LEFT$(mSlide,7))
  loop until memonumframpl = lens
  dpscanavibmp=0
 PlayMedia("close "+ memoavi,0,0,0)
 
 StringGrid1.row=0
 setfocus(StringGrid1.handle)
 end sub
 
 sub stopplay
 StringGrid1.row=0
 doevents
 if memoavi = "" or dpscanavibmp=1 then exit sub
 if dpstopplay=0 then
 dpstopplay=1
 PlayMedia("play " + memoavi+ " from "+str$(memonumfram),0,0,0)
 else
 dpstopplay=0
 PlayMedia("stop "+ memoavi,0,0,0)
 PlayMedia("pause "+ memoavi,0,0,0)
 end if
 do
 doevents
 PlayMedia("status " + memoavi + " position",varptr(mSlide),256,0)
 memonumfram= val(LEFT$(mSlide,7))
 Nbimages.text="Nb Im: "+str$(memonumfram)
 if memonumfram=lens then doevents:dpstopplay=0:memonumfram=0:exit do
 loop
 
 end sub
 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 sub move (ky)
 dim mx as byte
 
 if mousex < 2 then ky=2
 mx=mousex
 if mx < 10 then mx=10
 if mx >108 then mx=108
 if ky=0 xor dpmove=1 then
 
 curavi.left=mx-4
 curavi.enabled=0
' imcolrow0.enabled=0
 dpmove=1
 else
 dpmove=0
 curavi.enabled=1
' imcolrow0.enabled=1
 
 end if
 
 end sub
 
 SUB OpenClick
 doevents
 PlayMedia("close all",0,0,0) 
 
 
 for i= 0 to StringGrid1.colcount-1
 for ii = 0 to StringGrid1.rowcount-1
 StringGrid1.CELL(i,ii)=""
 next
 rich(i).text=""
 next
 
 
    StringGrid1.LoadFromFile  (fil.FileName,0, 0,StringGrid1.rowcount-1)
    memopos=rinstr(len(fil.FileName),fil.FileName,"\")
    path=left$(fil.FileName,memopos)
         FileName=right$(fil.FileName,len(fil.FileName)-memopos)
    edit.text=FileName     
 doevents
   for i = 1 to StringGrid1.colCount-1
 if StringGrid1.cell(i,StringGrid1.rowcount-1) > "" then
 codestringg=StringGrid1.cell(i,StringGrid1.rowcount-1)'décode le StringGrid1.cell pour le rich
 'paque: le StringGrid1.cell sur une ligne ; sans CHR$(13) , CHR$(10) 
 
 rich(i).text=REPLACESUBSTR$ (codestringg,"$", CHR$(13)+CHR$(10))
 
 StringGrid1.cell(i,StringGrid1.rowcount-1)="               X"
 else
 rich(i).text=""
 end if
 
 next
 doevents
 
 
 END SUB
 SUB Saveclick
 
 
 
 for i=1 to StringGrid1.colCount-1
 if StringGrid1.cell(i,StringGrid1.rowCount-1) = "               X" then
 
 codestringg=REPLACESUBSTR$(rich(i).text, CHR$(13)+CHR$(10), "$")'remplace les CHR$(13)+CHR$(10) par "$" ; donc une seul ligne
 StringGrid1.cell(i,StringGrid1.rowcount-1)=codestringg'le save des richs
 end if
 next
  FileName=path+edit.text
  StringGrid1.SaveToFile (FileName, 0, 0,StringGrid1.RowCount-1) 
 
 for i=1 to StringGrid1.colCount-1
 if StringGrid1.cell(i,StringGrid1.rowcount-1) > "" then
 StringGrid1.cell(i,StringGrid1.rowcount-1)="               X" 'le cache des richs
 end if
 next
 fil.Update
 
 btsave.font.color=960
 END SUB
 
 
 sub print_it
 dim stringdc as long
 
 stringdc=getdc(FormSTRINGGRID.handle)'la un vrai handle
 imprint(0).width=FormSTRINGGRID.width
 imprint(0).height=FormSTRINGGRID.height
 panel1.visible=0:panel2.visible=0:panel3.visible=0:panel4.visible=0:panel5.visible=0
 doevents 'pour laisser le temps à rq de rendre invisible le cur de l'edit
 
 'imprint.CopyMode =DSINVERT
 'BitBlt est une api gdi32 et imprint.handle , un dc ????? du bitmap -> dim imprint as qbitmap
 BitBlt (imprint(0).handle,0,0,FormSTRINGGRID.width,FormSTRINGGRID.height,stringdc,0,0,SCrcOPY)
 'BitBlt (getdc(0),0,0,StringGrid1.width,StringGrid1.height,stringdc,0,0,SCrcOPY)  -->écran
 'imprint.PixelFormat=2 '-- là ; il faut tester ; pasque, bonjour les cartouches d'encres (moi pas d'imprim)
 'imprint.draw(0,0,imprint.bmp)
 panel1.visible=1:panel2.visible=1:panel3.visible=1:panel4.visible=1:panel5.visible=1
 
 'imprint.Monochrome=1
 'imprint.draw(0,0,imprint.bmp)
 imprint(0).SaveToFile  path+"print_it.bmp"  'le file bmp
 hmap=GetCurrentObjectBmp(imprint(0).handle,OBJ_BITMAP_BMP)'dans le clipboardeu
        clipboard.open
        clipboard.clear
        clipboard.SetAsHandle(CF_BITMAP_BMP,hmap)
        clipboard.close
 
        end sub
 SUB CopyClickrich:  Rich(index).CopyToClipBoard:clipboard.setastext clipboard.text:    END SUB   
 SUB CutClickrich:   Rich(index).CutToClipBoard:     END SUB
 SUB PasteClickrich: Rich(index).PasteFromClipBoard: END SUB
 SUB SelectsAllClickrich: Rich(index).SelectAll:      END SUB
 sub clearbmp
 clipboard.open
        clipboard.clear      
  clipboard.close
  imt.HANDLE=""
  doevents
 txm(Tab.tabindex,Tab1.tabindex,ane).paint(0,0,Fcoul,-1)
  imtext.bmp=txm(Tab.tabindex,Tab1.tabindex,ane).bmp
 imtext.repaint
  end sub
 sub load_avi_txt
 if dptst=1 and len(fil.filename)>0 then
 
 OpenClick
 
 elseif dptst=0 and len(fil.filename)>0 then
 dpaddavibmp=1
 
 end if 
 'PlayMedia("close all",0,0,0)
 'playMedia("open " + fil.FileName + " parent " + STR$(StringGrid1.handle) + " style child",0,0,0)
 'PlayMedia("play " + FileNames + " from " + str$(0),0,0,0) 
 'PlayMedia("close "+ fil.FileName,0,0,0)
 'PlayMedia("status " + fil.FileName + " length",VARPTR(mLength),256,0)
 'PlayMedia("set " + FileName + " audio all " + audio$, 0, 0, 0)
 'PlayMedia("status " + FileName + " mode",VARPTR(mAudio),256,0)
 'PlayMedia("status " + FileName + " position",VARPTR(mSlide),256,0)
 'PlayMedia("Where " + FileName + " destination", VARPTR(mValue), LEN(mValue) - 1, 0)
 'PlayMedia("put " + sender.cell(col%,1) + " window at "+str$(Rect.left+3)+" "+str$(Rect.Top+19)+" " + str$(Rect.right-3-Rect.left-3) + " " + str$(Rect.bottom-2-19),0,0,0)
 'PlayMedia("pause "+ FileName,0,0,0)
 'PlayMedia("open " + FileName + " type MpegVideo",0,0,0) 
 'PlayMedia("stop "+ FileName,0,0,0)     
 end sub
 SUB iddroite
 dprichv=1
 dpscanavibmp=1
 doevents
 PlayMedia("close all",0,0,0)
 StringGrid1.LeftCol=5
 dpscanavibmp=0
 doevents
 END SUB
 SUB idgauche
 dprichv=0
 dpscanavibmp=1
 doevents
 PlayMedia("close all",0,0,0)
 StringGrid1.LeftCol=1
 dpscanavibmp=0
 doevents
 end sub
 sub delcoltxt
 doevents
 PlayMedia("close all",0,0,0)
 IF StringGrid1.col > 0 THEN
 for ii = 0 to StringGrid1.rowcount-1
 StringGrid1.CELL(StringGrid1.col,ii)=""
 next
 rich(StringGrid1.col).text=""
 END IF
 end sub
 sub Delgridtxt
 doevents
 PlayMedia("close all",0,0,0)
 for i= 1 to StringGrid1.colcount-1
 for ii = 0 to StringGrid1.rowcount-1
 StringGrid1.CELL(i,ii)=""
 next
 rich(i).text=""
 next
 
 end sub
 '''''''''''''''''''''''''''''''''''''''''sub calendar''''''''''''''''''''' 
 DIM FontDialog AS QFontDialog
 dim x as long
 dim y as long
 dim rx as long
 dim ry as long
 dim ratio as single
 dim act_w as long
 dim ACT_H as long
 dim a as byte
 dim pl as long
 dim pa1 as long
 dim pa as long
 dim pax as long
 dim pay as long
 dim tx1 as long
 dim ty1 as long
 dim la1 as long
 dim lb1 as long
 dim car as byte
 dim spcoul as integer
 dim poin1 'as byte
 dim sex 'as byte
 dim da$ 's string
 dim bi1 'as byte
 dim n1 'as long
 dim n2 'as long
 dim moi 'as byte
 dim j18 'as byte
 dim j 'as single
 dim sem 'as long
 dim m 'as byte
 dim n 'as long
 dim ccoul as long
 dim memocoul as integer
 dim mydate as string
 dim dpviscur as byte
 dim ct as long
 DIM koef as integer
 fcoul=&hffffff
 ccoul=0'&h9AFF7
 ct=-1
 dim imv as byte
 car=0
 dim  b$(tx1,ty1,car) as string
 dim rec as qrect
 dim r as long
 dim t as long
 dim pointag as long
 dim dif as integer
 dim memodif as double
 dim memoref as double
 dim dxane as string
 DIM DXTi AS QTimer
dim date$L as string
date$L=date$
dim memodate as string
dim dpdate as byte
 DXTi.Enabled = 1
 DXTi.Interval =1
 DXTi.OnTimer = timJM
 FormSTRINGGRID.font=font12
 FormSTRINGGRID.SHOWMODAL'''''
 sub okpoped
 popedit.Popup(screen.mousex,screen.mousey)
 end sub
 sub swaps
 if dpswap=0 then
 dpswap=1
 doevents
 Panel177.visible=1
 else
 dpswap=0
 dpaddavibmp=0
 Panel177.visible=0
 
 end if
 end sub
 sub upcur
 
 panel1.width = pa+1
 panel2.width = pa+1
 panel3.height = pl+1+dif
 panel4.height= pl+1+dif
 panel2.Left = la1-1
 panel2.Top = lb1-dif
 panel1.Left =la1-1
 panel1.Top = lb1+pl
 panel4.Left =la1+pa-1
 panel4.Top = lb1-dif
 panel3.Left = la1-1
 panel3.Top = lb1-dif
 panel5.Left = la1-1
 panel5.Top = lb1+pl-2
 panel5.width = pa+1
 end sub
 sub  Do_Keys (Key ,x,y,Shift)
 doevents
 
 setfocus (tx.handle)
 dim ratio as double
 if a=0 then
 a=1
 imtext.font = font1
 pl=imtext.textheight("A")
 pa1=imtext.textwidth("A")
 tx1=imtext.width\pa1
 ty1=imtext.height\pl
 redim b$(tx1,ty1,car) as string
 for r = 0 to ty1-1
 for t = 0 to tx1-1
 b$(t,r,0)=" "
 next
 next
 
 end if
 
 if dpswap=1 and dpavibmp=1 and fil.filename > ""  then
 imt.handle=NViewLibLoad (fil.filename,0)
 imt.width =getwidth
 imt.height =getheight
 act_w = imt.width: act_H = imt.height
 imt.visible=1
 fil.ItemIndex=-1
 fil.Update
 
 end if
 with imt
 
 select case key
 case 0
 
 .left= x : .top= y 
 doevents
 la1 =(x\pa1)*pa1
 lb1 =(y\pl)*pl
 
 case 1 
 if dpavibmp=1 then fix:exit sub
 case 45       ' ---
 if  .width/act_w < 0.05 then exit sub
 ratio = 0.9
 doevents
 .height = .height * ratio
 .width = .width * ratio
 .stretch = 1
 
 case 43      ' +++
 if .width/ act_w > 4 then exit sub
 ratio = 1.1
 doevents
 .height = .height * ratio
 .width = .width * ratio
 .stretch = 1
 
 end select
 end with
 pa=imtext.textwidth(chr$(key))
 
 memodif= (imtext.textheight("A")-font1.SIZE)\2+font1.SIZE
 memoref=memodif
 if font1.name="Arial" then
 if font1.SIZE > 14 then memoref=memodif-1
 if font1.SIZE > 18 then memoref=memodif
 if font1.SIZE > 22 then memoref=memodif-1
 if font1.SIZE > 28 then memoref=memodif
 if font1.SIZE > 36 then memoref=memodif-2
 if font1.SIZE > 48 then memoref=memodif-1
 end if
 if font1.name="Times New Roman" then
 if font1.SIZE > 10 then memoref=memodif-1
 if font1.SIZE > 11 then memoref=memodif
 if font1.SIZE > 12 then memoref=memodif-1
 if font1.SIZE > 22 then memoref=memodif-2
 if font1.SIZE > 24 then memoref=memodif-1
 if font1.SIZE > 26 then memoref=memodif-2
 if font1.SIZE > 48 then memoref=memodif-4
 end if
 dif=(imtext.textheight("A")-pl)
 if key = 13 then inc lb1,pl:la1=0:key=""
 if key = 8  then imtext.textout(la1,lb1-memoref+pl-2," ",Fcoul,Fcoul):dec la1,pa:doevents
 
 panel1.width = pa+1
 panel2.width = pa+1
 panel3.height = pl+1+dif
 panel4.height= pl+1+dif
 panel2.Left = la1-1
 panel2.Top = lb1-dif
 panel1.Left =la1-1
 panel1.Top = lb1+pl
 panel4.Left =la1+pa-1
 panel4.Top = lb1-dif
 panel3.Left = la1-1
 panel3.Top = lb1-dif
 panel5.Left = la1-1
 panel5.Top = lb1+pl-2
 panel5.width = pa+1
 
 if   KEY > 31 and key <> 43 and key <> 45 AND key <>"" then
 doevents
 imtext.textout(la1,lb1-memoref+pl-2,chr$(key),Ccoul,CT)'
 b$(la1\pa1,lb1\pl,0)=chr$(key)
 
 inc la1,pa
 if la1 > (imtext.width-pa) then  inc lb1,pl:la1=0
 
 key=""
 
 end if
 
  txm(Tab.tabindex,Tab1.tabindex,ane).bmp=imtext.bmp
 
 end sub
 SUB  tabjourmoi
 dim index as byte
 dim ini as byte
 
 select case Tab.tabindex
 
 case 0
 panel111.Visible = 0
 
 panel100.visible=1
 
 case 0 to 31
 if Tab1.tabindex=0 then exit sub
 setfocus(tx.handle)
 
 Panel100.Visible = 0
 
 redim b$(0,0,0) as string
 
 ane=val(right$(date$L,2))
 doevents
 txm(Tab.tabindex,Tab1.tabindex,ane).Width = imtext.width
 txm(Tab.tabindex,Tab1.tabindex,ane).Height = imtext.height
 
 imtext.bmp=txm(Tab.tabindex,Tab1.tabindex,ane).bmp
 
 
 panel111.Visible = 1
 
 
 
 poin1=0
 
 
 end select
 end sub
 
 
 sub fix
 
 with rec
 .top =imt.top ''ry
 .left=imt.left 'rx
 .right =imt.left+imt.width
 .bottom =imt.top+imt.height
 end with
 doevents
 imtext.stretchdraw (rec,imt.bmp)
 imt.visible=0
 imt.handle=""
 end sub
 
 sub timJM
 
 FormSTRINGGRID.textout(581,14," "+left$ (TIME$,5)+" ",&hffff,0)
 if dpviscur=0 then
 dpviscur=1
 panel5.COLOR=&hff
 else
 dpviscur=0
 panel5.color=&hffffff
 end if
 
 dim jan as string
 dim mois as string
 sex=1
if dpdate =0 then memodate=date$L:dpdate=1
 if (date$L <> da$) then
 
 da$ = date$L
 bi1 = val(right$ (da$,4))
 sex =bi1 mod 4
 
 n1=int((bi1-1)/4):  n2=(bi1+n1-1) mod 7
 
 
 moi = val (left$(da$,2))
 if sex = 0 and moi = 2 then mois$(2)=29 else mois$(2)=28
 if sex = 0 and moi<>1 and moi <>2 then n2=n2+1
 j18=mois$(moi)
 for m = 1 to moi -1
 j = j + mois$(m)
 next
 sem = (j+n2) mod 7
 
 j=0 :n2=0
 
 font.size = 6
 
 images.font =font'4
 
 mydate=insert$(left$(date$L,3),right$(date$L,7),4)
 
 
 m =sem*12
 images.textout (4-m-74,3,"D L M M J V S D L M M J V S D L M M J V S D L M M J V S D L M M J V S D L M M J V S D L M M J V   ",&hffff,0)
 
 for r = 0 to 582 step 84
 images.textout(4+r-m-74,3,"D",&hff,0)
 next
 
 if j18 = 31 then pan.left =386
 if j18 = 30 then pan.left =374
 if j18 = 29 then pan.left =362
 if j18 = 28 then pan.left =350
 seljour.left=1+(val(left$(mydate,2))*12)'
 selmois.top=1+(val(left$(date$L,2))*22)
 tab1.tabindex=val(left$(date$l,2))
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 end if
if tab1.tabindex = 0 then

edit2.visible=1
setfocus(edit2.handle)
 
else
edit2.visible=0

DATE$L=right$ (daTE$L,8)
if tab1.tabindex < 10 then date$L="0"+str$(tab1.tabindex)+DATE$L else date$L=str$(tab1.tabindex)+DATE$L
if  dpswap=1 and panel100.visible = 0 then
if tab.tabindex < 10 then
date$L=left$(date$L,3)+"0"+str$(tab.tabindex)+right$(date$L,5)
else
date$L=left$(date$L,3)+str$(tab.tabindex)+right$(date$L,5)
end if
end if
if  dpswap=0 then tab1.DelTabs (0):tab1.InsertTab (0,right$(memodate,4)):date$L=memodate
end if
edit1.text=insert$(left$(date$L,3),right$(date$L,7),4)
' ane=val(right$(date$L,2))-val(right$(da$,2))

' if ane > 0 then ane=1
 
 DXTi.Interval =500
 end sub
 sub couleur
 
 DIM ReturnVal AS LONG
     CCr.lStructSize = SIZEOF(CCr)
     CCr.hWndOwner = 0
     CCr.Flags = CC_RGBINIT + CC_FULLOPEN
   CCr.rgbResult = imtext.font.color
   
      
 ReturnVal=ChooseColorDlg(CCr)
    
  
    IF ReturnVal <> 0 THEn
 
  ccoul=CCr.rgbResult
     end if
 
 end sub
 sub getfont
 FontDialog.GetFont(Font1)
 IF FontDialog.Execute THEN
    
     FontDialog.SetFont(Font1)
     imtext.FONT=font1
   
     
   END IF
 
 end sub
 sub coul_page
 DIM ReturnVal AS LONG
     CCr.lStructSize = SIZEOF(CCr)
     CCr.hWndOwner = 0
     CCr.Flags = CC_RGBINIT + CC_FULLOPEN
 CCr.rgbResult=fcoul
 ReturnVal=ChooseColorDlg(CCr)
    IF ReturnVal <> 0 THEn
  Fcoul=CCr.rgbResult
  txm(Tab.tabindex,Tab1.tabindex,ane).Paint(0,0,CCr.rgbResult,-1)
  imtext.bmp=txm(Tab.tabindex,Tab1.tabindex,ane).bmp
  memocoul=Fcoul
     end if
 
 end sub
 sub Ccharfond
 
 DIM ReturnVal AS LONG
     CCr.lStructSize = SIZEOF(CCr)
     CCr.hWndOwner = 0
     CCr.Flags = CC_RGBINIT + CC_FULLOPEN  
     CCr.rgbResult = ct   
 ReturnVal=ChooseColorDlg(CCr)
    IF ReturnVal <> 0 THEn
  ct = CCr.rgbResult
   
     else
  ct=-1
     end if

 end sub
 sub delcoul
 
 DIM ReturnVal AS LONG
     CCr.lStructSize = SIZEOF(CCr)
     CCr.hWndOwner = 0
     CCr.Flags = CC_RGBINIT + CC_FULLOPEN  
     CCr.rgbResult=fcoul   
 ReturnVal=ChooseColorDlg(CCr)
    IF ReturnVal <> 0 THEn
  Fcoul=CCr.rgbResult
     else
 Fcoul=memocoul
     end if
 end sub
 sub savebmp
 chdir curdir$
 doevents
 txm(Tab.tabindex,Tab1.tabindex,ane).SaveToFile str$(Tab.tabindex)+"-"+str$(Tab1.tabindex)+"-"+right$(date$L,2)+"#"+left$(time$,5)-":" +".bmp"
 fil.Update
 end sub
 sub delimtst
 kill fil.filename
 fil.Update
 end sub
 sub imload
 
 txm(Tab.tabindex,Tab1.tabindex,ane).LoadFromFile fil.filename
 imtext.bmp=txm(Tab.tabindex,Tab1.tabindex,ane).bmp
 fil.Update
 imt.handle=""
 end sub
 sub strtch
 doevents
 rected.right=imtext.width
 rected.bottom=imtext.height
 txm(Tab.tabindex,Tab1.tabindex,ane).LoadFromFile fil.filename
 txm(Tab.tabindex,Tab1.tabindex,ane).StretchDraw(rected,txm(Tab.tabindex,Tab1.tabindex,ane).bmp)
 imtext.bmp=txm(Tab.tabindex,Tab1.tabindex,ane).bmp
 fil.Update
 imt.handle=""
 end sub
 '''''''''''''''''''''''''''''''''''''fin sub calendar''''''''''''''''''''''
sub exitex
application.Terminate
end sub
sub indxane
tab1.DelTabs (0)
if  len(edit2.text)=4 then date$l=left$(date$l,6)+edit2.text
tab1.InsertTab (0,edit2.text)
end sub