dataenvironment kayırlarını saklama programı

* yazılım: KONUK A

*  ilham :Ç.Başöz (form.scx in aslında bir dbf olduğu)

*         Ramani (Projenizdeki Tabloların Yapısını Text Dosyaya alma)

*  çalışılan proje içerisinden DO komutu ile çalıştırılır....

*

IF ! 6=MESSAGEBOX("AÇIK FORM OLMAMALI"+CHR(13)+"DEVAM EDİLSİN Mİ ?",292,application.ActiveProject.NAME)

  RETURN

ENDI

WAIT "işlem süresince"+CHR(13)+ "projeden form açmayın" WINDOW NOWAIT NOCLEAR  

 

PUBLIC oForm

oForm=NEWOBJECT("MyForm")

oForm.Show(1)  && enfeksiyonlara kapalı

 

DEFINE CLASS MyForm AS Form

  ADD OBJECT Label1 AS Label WITH Caption="değişecek dizin bölümünü girin", Top=3, Left=180, Width=200,;

                                  BackStyle=0, FontUnderline=.t., ForeColor=RGB(200,100,100),;

                                  ToolTipText="tıklayarak dizin yardımı alın"

  ADD OBJECT Label2 AS Label WITH Caption="yerine gelecek dizin adını yazın", Top=3, Left=390, Width=200,;

                                  BackStyle=0, FontUnderline=.t., ForeColor=RGB(220,100,100),;

                                  ToolTipText="tıklayarak dizin yardımı alın"

  ADD OBJECT Text1 AS TextBox WITH Left=180, Top=20, Height=25, Width=200

  ADD OBJECT Text2 AS TextBox WITH Left=390, Top=20, Height=25, Width=200

  ADD OBJECT Button2 AS CommandButton WITH Left=600, Top=20, Height=25,Width=60, Caption="değiştir",;

                                  ToolTipText="dizin değişiklikleri yapılır"

  ADD OBJECT Grid1 AS Grid WITH ColumnCount=5, DeleteMark=.f., FontName="Tahoma", ;

                                ReadOnly=.t., ;

                                Height=200, Left=3, Top=50, Width=660

 

  PROCEDURE Load

    SET MEMOWIDTH TO 1000 && properties alanının tamamını alsın

 

  PROCEDURE Destroy

    CLOSE TABLES

    WAIT CLEAR 

    oForm=.f.

 

  PROCEDURE Init

    CLOSE TABLES

    CREATE CURSOR dform (fad C(40),cursAd C(50),cursAdYeni C(50),fsira I,UnikAd C(20), propertiler M) 

 

    WITH This

    .WindowType=0

    .ShowTips=.t.

    .Width=670

    .Caption="Dosya dizin düzeltme: "+application.ActiveProject.NAME 

    ENDWITH

 

    WITH ThisForm.Grid1

    .FontName="Tahoma"

    .FontSize=8

    .RecordSource="dForm"

    .Column1.Header1.Caption="form adı"

    .Column2.Header1.Caption="cursor dizini"

    .Column3.Header1.Caption="yeni cursor dizini"

    .Column4.Header1.Caption="form sıra"

    .Column5.Header1.Caption="kontrol"

    .Column1.Width=160

    .Column2.Width=210

    .Column3.Width=210

    .Column4.Width=50

    ENDWITH

 

    ThisForm.FormdanDosyaYükle

    * SELE 3

    * SELECT * FROM dForm INTO TABLE "c:\_"+CHRTRAN(TTOC(DATETIME()),". :","") 

    * hata olursa ilk kayıtlar propertiler alanından geri alınır

    * istenirse gerialma ile ilgili kod ayrıca yazılır..

     SELE 1

 

*------------------------        

 

  PROCEDURE Button2.Click

    IF 6=MESSAGEBOX("Proje içerisindeki formların"+CHR(13)+"dosyaların dizinini değiştiriyorsunuz",292,"DİKKAT")

      ThisForm.DizinDeğiştir

    ENDI

 

  PROCEDURE Text1.InterActiveChange 

    REPLACE ALL dform.cursAdYeni WITH STRTRAN(dform.cursAd,ALLTRIM(ThisForm.Text1.Value),ALLTRIM(ThisForm.Text2.Value))

    GO TOP

    ThisForm.Refresh

 

  PROCEDURE Label1.Click 

    ThisForm.Text1.Value=ADDBS(JUSTPATH(cursAd))  && backslash ekle

                                                 && veya aşağıdaki var

    ThisForm.Text2.Value=ThisForm.Text1.Value

    Thisform.Text1.InterActiveChange

 

  PROCEDURE Label2.Click 

    ThisForm.Text2.Value=GETDIR()

    *ThisForm.Text2.Value=LEFT(ThisForm.Text2.Value,LEN(ThisForm.Text2.Value)-1) && son backslash olmasın

                                                                                 && veya yukarıdaki addbs()

    Thisform.Text1.InterActiveChange

 

  PROCEDURE Text2.InterActiveChange 

    Thisform.Text1.InterActiveChange 

 

  PROCEDURE FormdanDosyaYükle

    SELECT 2

    FOR Xfsira= 1 TO application.ActiveProject.Files.Count

      Xform = application.ActiveProject.Files(Xfsira).NAME 

      IF UPPER(JUSTEXT(Xform))== "SCX"

        USE (M.Xform)

        SCAN

          IF UPPER(MLINE(BaseClass,1))="CURSOR"

            SCATTER MEMVAR MEMO FIELDS properties,uniqueid

            Xcursor=STRTRAN(MLINE(M.properties,ATLINE("CursorSource = ",M.properties)),"CursorSource = ","" )

            INSERT INTO dform VALUES(M.Xform,Xcursor,Xcursor,Xfsira,M.uniqueid,M.properties)

          ENDIF

        ENDSCAN

      ENDI

    ENDF

    USE

    SELECT 1

    GO TOP

    This.Refresh

 

  PROCEDURE DizinDeğiştir

    *dform (fad C(40),cursAd C(50),cursAdYeni C(50),fsira I,UnikAd C(20), propertiler M) 

    SELECT 1

    SELECT dForm

    SCAN    

      IF ! ALLTRIM(dForm.cursAd) == ALLTRIM(dForm.cursAdYeni)

        SCATTER MEMVAR FIEL fad, cursAd, cursAdYeni, fsira, UnikAd 

        SELECT 2

        *USE (application.ActiveProject.Files(M.fsira).NAME)

        USE (M.fad)

        LOCATE FOR ALLTRIM(uniqueid)=ALLTRIM(M.UnikAd)

        IF FOUND()

          REPLACE properties WITH STRTRAN(properties,ALLTRIM(dForm.cursAd),ALLTRIM(dForm.cursAdYeni))

        ENDIF

        USE

        SELECT 1

      ENDI

    ENDS

 

    SET SAFETY OFF

    SELECT dform

    ZAP

    SET SAFETY ON

    ThisForm.Text1.Value=""

    ThisForm.Text2.Value=""

 

    ThisForm.FormdanDosyaYükle

 

ENDDEFINE