Процедура выбора каталога с функцией создания директории
function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall; begin if (uMsg = BFFM_INITIALIZED) and (lpData <> 0) then SendMessage(Wnd, BFFM_SETSELECTION, Integer(True), lpdata); result := 0; end;
function SelectDirectory(wnd:HWND; const Caption: string; SelRoot: string=''; const Root: WideString=''; cFlags:cardinal=BIF_RETURNONLYFSDIRS): string; var WindowList: Pointer; BrowseInfo: TBrowseInfo; Buffer: PChar; OldErrorMode: Cardinal; RootItemIDList, ItemIDList: PItemIDList; ShellMalloc: IMalloc; IDesktopFolder: IShellFolder; Eaten, Flags: LongWord; begin Result := ''; if not DirectoryExists(SelRoot) then SelRoot := ''; FillChar(BrowseInfo, SizeOf(BrowseInfo), 0); if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then begin Buffer := ShellMalloc.Alloc(MAX_PATH); try RootItemIDList := nil; if Root <> '' then begin SHGetDesktopFolder(IDesktopFolder); IDesktopFolder.ParseDisplayName(Application.Handle, nil, POleStr(Root), Eaten, RootItemIDList, Flags); end; with BrowseInfo do begin hwndOwner := Application.Handle; pidlRoot := RootItemIDList; pszDisplayName := Buffer; lpszTitle := PChar(Caption); ulFlags :=cFlags; if SelRoot <> '' then begin lpfn := SelectDirCB; lParam := Integer(PChar(SelRoot)); end; end; WindowList := DisableTaskWindows(0); OldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS); try ItemIDList := ShBrowseForFolder(BrowseInfo); finally SetErrorMode(OldErrorMode); EnableTaskWindows(WindowList); end; if ItemIDList <> nil then begin ShGetPathFromIDList(ItemIDList, Buffer); ShellMalloc.Free(ItemIDList); SetString(Result,Buffer,lstrlen(Buffer)); end; finally ShellMalloc.Free(Buffer); end; end; end;
и собственно сама функция конвертации
Procedure EnableControl(EditParam:boolean); var Editmode2,Editmode:boolean; begin if not EditParam then Editmode:=false else Editmode:=true; if Editmode then Editmode2:=false else Editmode2:=true; form1.Edit1.Enabled:=Editmode; form1.Edit2.Enabled:=Editmode; form1.Button1.Enabled:=Editmode; form1.Button2.Enabled:=Editmode; form1.Button3.Enabled:=Editmode; form1.Button4.Enabled:=Editmode2; end;
// Fln1 файл PNG // Fln2 файл BMP
Procedure ConvertFile(Fln1,fln2:string); var PngImage:TPNGObject; BMP:TBitMap; begin try PngImage:=TPNGObject.create; PngImage.LoadFromFile(Fln1); BMP:=TBitMap.Create; BMP.Width:=PngImage.Width; BMP.Height:=PngImage.Height; BMP.Canvas.Draw(0,0,PngImage); BMP.SaveToFile(fln2); BMP.Free; PngImage.Free; except end; end;
Procedure myConvertFile(Filename1:string); var dir2:string; Filename2:string; begin
if ExtractFileExt(Filename1)<>'' then begin Filename2:=copy(Filename1,1,pos(ExtractFileExt(Filename1),Filename1)-1); end;
dir2:=form1.edit2.text; if dir2<>'' then if dir2[length(dir2)]<>'\' then dir2:=dir2+'\'; ConvertFile(Filename1,dir2+ExtractFileName(Filename2)+'.bmp'); end;
Программа + исходник пример на Дельфи как конвертировать все файл PNG в BMP в директории
