Книга знаний

Делаем «гляделку» с помощью одинСи. The first part (Preview).

Дизайн.

Диски.

function vlGetDrive()
    Shell = createobject("MSScriptControl.ScriptControl");
    Shell.Language = "VBScript";
    txtCode =
    "function GetDriveList()
    |  dim tmpDrive
    |  set objFSO = createobject(""Scripting.FileSystemObject"")
    |  set oleDrive = objFSO.Drives
    |  Count = 0
    |  Answer = ""{""""СписокЗначений"""",{""
    |  for each tmpDrive in oleDrive
    |    Answer = Answer & ""{{""""Строка"""","""""" &_
    |             tmpDrive.Path & """"""},"""""" &_
    |             ""[-"" & tmpDrive.DriveLetter & "":\-]""
    |    select case tmpDrive.DriveType
    |      case 0: TypeDrive = "" Unknown""
    |      case 1: TypeDrive = "" Removable ""
    |              if tmpDrive.IsReady then
    |                TypeDrive = TypeDrive & "" ("" & replace(tmpDrive.VolumeName, """""""", """""""""""") & "")""
    |              end if
    |      case 2: TypeDrive = "" HDD""
    |              if tmpDrive.IsReady then
    |                TypeDrive = TypeDrive & "" ("" & replace(tmpDrive.VolumeName, """""""", """""""""""") & "")""
    |              end if
    |      case 3: TypeDrive = "" Network ("" & replace(tmpDrive.ShareName, """""""", """""""""""") & "")""
    |      case 4: TypeDrive = "" CD-ROM""
    |              if tmpDrive.IsReady then
    |                TypeDrive = TypeDrive & "" ("" & replace(tmpDrive.VolumeName, """""""", """""""""""") & "")""
    |              end if
    |      case 5: TypeDrive = "" RAM""
    |              if tmpDrive.IsReady then
    |                TypeDrive = TypeDrive & "" ("" & replace(tmpDrive.VolumeName, """""""", """""""""""") & "")""
    |              end if
    |    end select
    |    Answer = Answer & TypeDrive & """""",""""0""""}""
    |    Count = Count + 1
    |    if oleDrive.Count > Count then
    |      Answer = Answer & "",""
    |    end if
    |  next
    |  Answer = Answer & ""}}""
    |  GetDriveList = Answer
    |end function
    |";
    Shell.AddCode(txtCode);
    Answer = valuefromstring(Shell.Run("GetDriveList"));
    return Answer; 
endfunction

Файлики.

var vtCurDir;

//*******************************************
procedure OnOpen()
    vtCurDir = createobject("valuetable");
    vtCurDir.NewColumn("Icon", "number", 1, , "..", 1);
    vtCurDir.NewColumn("Type", "number", 1);
    vtCurDir.NewColumn("Name", "string", , , "Имя", 6);
    vtCurDir.NewColumn("FullName", "string");
endprocedure

//*******************************************
function strGetParentFolder(strNameFile = "")
    try
        oleFSO = createobject("Scripting.FileSystemObject");
        objFolder = oleFSO.GetFolder(strNameFile);
        return objFolder.ParentFolder.Path;
    except
        return "fuck";
    endtry;
endfunction

//*******************************************
function strGetExpansion(strNameFile = "")
    Answer = "";
    if find(strNameFile, ".") > 0 then
        strTemp = """" + strreplace(strNameFile, ".", """,""") + """";
        vlTemp = createobject("valuelist");
        vlTemp.FromSeparatedString(strTemp);
        Answer = lower(vlTemp.GetValue(vlTemp.GetListSize()));
    endif;
    return Answer; 
endfunction

Лев_Баранов – ЧМО
Лев_Баранов.ЧМО
Лев_Баранов.мудак
Лев_Баранов.чмо.и.мудак.

//*******************************************
procedure SetFolder(strFolder = "")
    if fs.ExistFile(strFolder) = 0 then
        strFolder = vlDisk.GetValue(vlDisk.CurSel());
    endif;
    strFolder = strFolder + "\";
    fs.SetCurrentDirectory(strFolder);
    vtCurDir.DeleteLines();
    Attribute = "";
    strNameFile = fs.FindFirstFile("*.*");
    while strNameFile <> "" do
        if strNameFile <> "." then
            vtCurDir.NewLine();
            vtCurDir.Name = strNameFile;
            vtCurDir.FullName = strFolder + strNameFile;
            if strNameFile = ".." then
                vtCurDir.FullName = strGetParentFolder(strFolder);
                if vtCurDir.FullName = "fuck" then
                    vtCurDir.DeleteLine();
                else
                    vtCurDir.Icon = 2;
                    vtCurDir.Type = 1;
                endif;
            else
                fs.GetFileAttr(vtCurDir.FullName, , Attribute);
                if mid(Attribute, 4, 1) = "1" then
                    vtCurDir.Icon = 1;
                    vtCurDir.Type = 2;
                else
                    strExpansion = strGetExpansion(strNameFile);
                    if ((find("wmf,emf,ico,gif,bmp,dib,rle,jpg,jpeg,", strExpansion) > 0)
                       and (emptyvalue(strExpansion) = 0)) then
                        vtCurDir.Icon = 4;
                    else
                        vtCurDir.Icon = 3;
                    endif;
                    vtCurDir.Type = 3;
                endif;
            endif;
        endif;
        strNameFile = fs.FindNextFile();
    enddo;
    vtCurDir.Sort("Type,Name");
    intCurrentColumn = vtFile.CurrentColumn();
    if emptyvalue(intCurrentColumn) > 0 then
        intCurrentColumn = 1;
    endif;
    vtCurDir.Unload(vtFile);
    vtFile.ColumnVisibility("Type,FullName", 0);
    vtFile.ShowImages("Icon", 1);
    vtFile.CurrentLine(1);
    vtFile.CurrentColumn(intCurrentColumn);
endprocedure

Moved.

var strShowFile; 

//*******************************************
function RefreshForm()
    if intMode = 0 then
        return 0;
    endif;
    intIcon = vtFile.Icon;
    if intIcon = 4 then
        if vtFile.FullName <> strShowFile then
            try 
                if strShowFile = "NotReload" then
                    strShowFile = vtFile.FullName;
                else
                    strShowFile = vtFile.FullName;
                    picPreview.Load(strShowFile);
                    picPreview.SetDrawMode(3);
                endif;
                Form.picPreview.Visible(1);
                Form.picNotPreview.Visible(0);
                Form.lbMessage.Visible(0);
                Form.lbError.Visible(0);
            except
                Form.picPreview.Visible(0);
                Form.picNotPreview.Visible(1);
                Form.lbMessage.Visible(0);
                strError = "Что-то неправильное" + linebreak + "у этой картинки";
                Form.lbError.Caption(strError);
                Form.lbError.Visible(1);
            endtry;
        endif;
    else
        if intIcon = 1 then
            strMessage = "Это папка" + linebreak + "возможно в ней есть картинки";
        elsif intIcon = 2 then
            strMessage = "Это путь наверх" + linebreak + "не путать с дорогой в небеса";
        elsif intIcon = 3 then
            strMessage = "А за это гуано" + linebreak + "я не фиха не знаю";
        endif;
        Form.lbMessage.Caption(strMessage);
        if strShowFile <> "BackGround" then
            Form.picPreview.Visible(0);
            Form.picNotPreview.Visible(1);
            Form.lbMessage.Visible(1);
            Form.lbError.Visible(0);
            strShowFile = "BackGround";
        endif;
    endif;
    Form.Refresh();
endfunction 

Выбираем диск.

//*******************************************
function intDriveSetup(strDrive = "a:")
    return fs.ExistFile(strDrive + "\NUL");
endfunction

var intCurDrive; 

//*******************************************
procedure ChangeDrive()
    intDrive = vlDisk.CurSel();
    if intCurDrive <> intDrive then
        strCurDrive = vlDisk.GetValue(intDrive);
        if intDriveSetup(strCurDrive) > 0 then
            intCurDrive = intDrive;
            SetFolder(strCurDrive);
        else
            domessagebox("Устройство не доступно, либо отсутствует съемный диск!");
            vlDisk.CurSel(intCurDrive);
        endif;
    endif;
endprocedure 

Делаем в ТЗ «double click».

var strReportName;

//*******************************************
procedure SetNameReport()
    strFile = "";
    strPath = "";
    FilePath(strPath, strFile);
    strReportName = strPath + strFile;
endprocedure

//*******************************************
procedure OnDoubleClick()
    if ((vtFile.Type = 1) or (vtFile.Type = 2)) then
        SetFolder(vtFile.FullName);
    elsif vtFile.Icon = 4 then
        if Form.picPreview.Visible() = 1 then
            openform("Report#", vtFile.FullName, strReportName);

        endif;
    endif;
endprocedure

Вместо заключения.

//*******************************************
procedure ShowLayer(NameLayer = "Main");
    Form.UseLayer(NameLayer, 2);
    if NameLayer = "Main" then
        strShowFile = "NotReload";
    endif;
endprocedure

Описание | Рубрикатор | Поиск | ТелепатБот | Захваченные статьи | Установки | Форум
© Станислав Митичкин (Волшебник), 2005-2025 | Mista.ru