KGF_dll - nouvelles versions

SUB PrintProjectSources()
' -- Impression des fichiers source
   dim_local n%,t$,num%,a$,i%,sep%,nl%
   if checked(FP_Check%(1))=1:n%=n%+1:t$=t$+"1,":end_if
   if checked(FP_Check%(2))=1:n%=n%+1:t$=t$+"2,":end_if
   if checked(FP_Check%(3))=1:n%=n%+1:t$=t$+"3,":end_if
   if checked(FP_Check%(4))=1:n%=n%+1:t$=t$+"4,":end_if
   if checked(FP_Check%(5))=1:n%=n%+1:t$=t$+"5,":end_if
  
   for i%=1 to n%
      sep%=instr(t$,",")
      num%=val(left$(t$,sep%-1)):t$=right$(t$,len(t$)-sep%) : ' recup du synedit à imprimer
      Syn_res% = dll_call3("SyneditFunction",Syn%(num%),2,0) : ' activation du dit synedit
      Syn_hnd% = dll_call3("SyneditFunction",Syn%(num%),20,0) : ' recup de son handle
      Clav_res% = dll_call5("SendSingleKey",Syn_hnd%,65,1,0,0) : ' simulation clavier pour selectionner tout le texte
      pause 100
      clipboard_string_copy "" : ' nettoyage du presse papier
      Syn_res% = dll_call3("SyneditFunction",Syn%(num%),22,0) : ' copie du texte dans le presse papier
      pause 1000 : ' pause indispensable pour laisser le temps à la machine de faire le job
      nl% = dll_call3("SyneditFunction",Syn%(num%),28,0) : ' recup de la derniere ligne
      Syn_res% = dll_call3("SyneditFunction",Syn%(num%),18,nl%) : ' aller à la derniere ligne, pour éviter que tout reste sélectionné et faire une gaffe
      a$=clipboard_string_paste$ : ' récupération du texte dans une variable depuis le presse papier
      Syn_res% = dll_call3("SyneditFunction",Syn%(num%),27,adr(a$)) : ' envoie vers l' imprimante
      wait 10000 : delai pour laisser le temps à la machine de faire le job, indispensable sinon 1 page sur 2
   next i%
END_SUB

  for i%=1 to n%
      sep%=instr(t$,",")
      num%=val(left$(t$,sep%-1)):t$=right$(t$,len(t$)-sep%)
      Syn_res% = dll_call3("SyneditFunction",Syn%(num%),2,0)
      a$ = "Page "+str$(num%) : ' ou n'importe quel titre décrivant le contenu de l'édition...
message "on imprime la page "+str$(num%)
      Syn_res% = dll_call3("SyneditFunction",Syn%(num%),27,adr(a$))
'      wait 10000 : ' inutile...
  next i%

dim kgf$,no%,clic%,WB1%

dim b1%                :no%=no%+1 : B1%                =no%
dim FormPanoramicHelp% :no%=no%+1 : FormPanoramicHelp% =no%
dim HP1_button%        :no%=no%+1 : HP1_button%        =no%
dim HP2_button%        :no%=no%+1 : HP2_button%        =no%
dim HP3_button%        :no%=no%+1 : HP3_button%        =no%

label clic

kgf$="C:\Users\Yannick\Desktop\PPE_Vs2_Travail\dll\KGF.dll"
dll_on kgf$


button B1%
on_click B1%,clic

end
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

clic:
  clic%=number_click
  if clic%=B1%          : FormPanoramicHelp():end_if
  if clic%=HP1_button%  : Preced_page()      :end_if
  if clic%=HP2_button%  : Home_Page()        :end_if
  if clic%=HP3_button%  : Next_Page()        :end_if
return

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB FormPanoramicHelp()
' -- Fenêtre d' aide Panoramic
  dim_local hnd%,res%,url$
  url$="http://panoramic-language.pagesperso-orange.fr/French/DOCUMENTS.htm"
  if Object_exists(FormPanoramicHelp%)=1
      show FormPanoramicHelp%
  else
      O_Form(FormPanoramicHelp%,0,1,0,0,480,740,"Aide Panoramic")
      hnd%=handle(FormPanoramicHelp%)
      res% = DLL_call2("SetMinimizeMaximize",hnd%,0)
      O_Button(HP1_button%,FormPanoramicHelp%,1,5,5,20,20,"",1)
      font_name HP1_button%,"Webdings":caption HP1_button%,"3":font_size HP1_button%,12
      O_Button(HP2_button%,FormPanoramicHelp%,1,5,30,20,20,"",1)
      font_name HP2_button%,"Webdings":caption HP2_button%,"H":font_size HP2_button%,12
      O_Button(HP3_button%,FormPanoramicHelp%,1,5,55,20,20,"",1)
      font_name HP3_button%,"Webdings":caption HP3_button%,"4":font_size HP3_button%,12
      WB1% = dll_call1("WB_Create",hnd%)
      res% = dll_call5("WB_Locate",WB1%,5,30,width(FormPanoramicHelp%)-30,height(FormPanoramicHelp%)-80)
  end_if
  res% = dll_call2("WB_Url",WB1%,adr(url$))
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Preced_page()
  dim_local res%
  res% = dll_call2("WB_Function",WB1%,1)
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Next_Page()
  dim_local res%
  res% = dll_call2("WB_Function",WB1%,2)
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB Home_Page()
  dim_local res%,url$
  url$="http://panoramic-language.pagesperso-orange.fr/French/DOCUMENTS.htm"
  res% = dll_call2("WB_Url",WB1%,adr(url$))
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB O_Form(Obj%,P%,V%,T%,L%,H%,W%,C$)
' --Ajout d' un form
  if Obj%> 0 then FORM Obj%
  if P% > 0 then Parent Obj%,P%
  if V% = 0 then hide Obj%
  if H% > 0 then Height Obj%,H%
  if W% > 0 then Width Obj%,W%
  if T% > 0
      Top Obj%,T%
  else
      Top Obj%,(Screen_y-H%)/2
  end_If
  if L% > 0
      Left Obj%,L%
  else
      Left Obj%,(Screen_x-W%)/2
  end_If
  if C$<>"" then Caption Obj%,C$
END_SUB

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

SUB O_Button(Obj%,P%,V%,T%,L%,H%,W%,C$,Cl%)
  BUTTON Obj%
  if P% > 0 then Parent Obj%,P%
  if V% = 0 then hide Obj%
  if H% > 0 then Height Obj%,H%
  if W% > 0 then Width Obj%,W%
  if T% > 0 then Top Obj%,T%
  if L% > 0 then Left Obj%,L%
  if C$<>"" then Caption Obj%,C$
  if Cl%> 0 then on_click Obj%,Clic
  cursor_point Obj%
END_SUB

' test_SetFormProperties.bas

label avec, sans, cercle, touche

dim i%, f%, c%, prop%
width 0,620 : height 0,500 : color 0,0,0,255
caption 0,"A=avec blocage  S=sans blocage"
on_key_down 0,touche

picture 1 : width 1,500 : height 1,400
  2d_target_is 1

dll_on "KGF.dll"
f% = 1
dessiner()

end

sub dessiner()
  color 1,255,0,0
  2d_fill_color 255,255,255
  2d_rectangle 20,20,50,80
  2d_rectangle 100,20,350,350
  2d_fill_color 255,255,0
  2d_circle 200,200,80
  for i%=1 to 20
    gosub cercle
    top 0,top(0) + f%
    left 0,left(0) + 2*f%
  next i%
  if f%=1
    f% = -1
  else
    f% = 1
  end_if
end_sub

touche:
  c% = scancode
  if c%=65 then gosub avec
  if c%=83 then gosub sans
  return
  
avec:
  prop% = dll_call3("SetFormProperties",object_internal(0),0,0)
  i% = dll_call3("SetFormProperties",object_internal(0),1,1+2+4)
  dessiner()
  i% = dll_call3("SetFormProperties",object_internal(0),1,prop%)
  return

sans:
  dessiner()
  return
  
cercle:
  2d_circle int(rnd(50.99)*10),int(rnd(40.99)*10),int(rnd(20.99)*5)
  return

 if f%=1
    f% = -1
  else
    f% = 1
  end_if

 f% = 0-f%

function SetFormProperties(obj: TWinControl; act,opt: integer):integer; stdcall; export;

  function IsWindowUpdateLocked(hwd: THandle; bKeepLocked: Boolean): Boolean;
  begin
    Result := LockWindowUpdate(hwd); //try to lock and compare result
    if (not Result) and (not bKeepLocked) then LockWindowUpdate(0); //then unlock if you want
  end;

begin
  result := -1;
  case act of
    0: begin
        result := 0;
        if IsWindowUpdateLocked(obj.Handle,false) then result := result + 1;
        if obj.DoubleBuffered                    then result := result + 2;
        if csOpaque in obj.ControlStyle          then result := result + 4;
      end;
    1: begin
        if (opt and 1)>0 then LockWindowUpdate(obj.Handle)
                          else LockWindowUpdate(0);
        if (opt and 2)>0 then obj.DoubleBuffered := true
                          else obj.DoubleBuffered := false;
        if (opt and 4)>0 then obj.ControlStyle := obj.ControlStyle + [csOpaque]
                          else obj.ControlStyle := obj.ControlStyle - [csOpaque];
        result := opt;
        end;
  end;
end;

' quelle_version.bas
dim version%, kversion$, pversion$
width 0,270 : height 0,90
top 0,(screen_y-height(0))/2
left 0,(screen_x-width(0))/2
memo 1 :width 1,150 : full_space 1
dll_on "c:\users\acer\desktop/kgf.dll"
kversion$ = string$(25," ")
version% = DLL_call1("KGFdllVersion",adr(kversion$))

pversion$ = string$(25," ")
version% = DLL_call1("PanoramicVersion",adr(pversion$))

item_add 1,kversion$
item_add 1,pversion$
end