小编Bil*_*ill的帖子

使用Delphi 2010,您可以获得jpg文件的pixelformat

TJPEGImage ( Image.Picture.Graphic ).PixelFormat  

有没有办法获得TPNGImage的pixelformat或bitdepth？

我试过这个,但它返回错误的bitdepth:

 if Lowercase ( ExtractFileExt ( FPath ) ) = '.png' then
   StatusBar1.Panels [ 4 ].Text := ' Color Depth: ' + IntToStr( TPNGImage ( Image.Picture.Graphic ).Header.ColorType ) + '-bit';

procedure TGridThread.Execute;
var
  i: integer;
  iIEBitmap: TIEBitmap;
  iWidth: integer;
  iHeight: integer;
  iImageCount: integer;
  iArrayOfBitmaps: array of TBitmap;
begin
  inherited;
  { Free the thread onTerminate }
  FreeOnTerminate := True;
  if not Terminated then
    begin    
      if not Terminated then
      begin
        Synchronize(
         procedure
           begin
              iIEBitmap := TIEBitmap.Create(Form1.ImageEnView1.IEBitmap);
              iWidth := Form1.ImageEnMView1.ImageOriginalWidth[0];
              iHeight := (Form1.ImageEnMView1.ImageOriginalHeight[0] + iSpaceBetweenImages) *
              Form1.ImageEnMView1.ImageCount;
              iImageCount := Form1.ImageEnMView1.ImageCount;
            end);

           SetLength(iArrayOfBitmaps, iImageCount);

           Synchronize(
            procedure
            begin
              for i := 0 to iImageCount - 1 do // [DCC Error] Unit1.pas(334): E1019 For loop control …

我正在尝试编写两个添加和删除文件夹的函数IShellLibrary.我从这开始,但该函数在System._IntfClear以下方面产生异常:

$ 000007FEFE 168BC4的首次机会异常.消息'c0000005 ACCESS_VIOLATION'的异常类$ C0000005.

该SHAddFolderPathToLibrary是导致异常的行.

我想我需要将库名添加到函数中？

function AddFolderToLibrary(AFolder: string): HRESULT;
{ Add AFolder to Windows 7 library. }
var
  plib: IShellLibrary;
begin
  Result := CoCreateInstance(CLSID_ShellLibrary, nil, CLSCTX_INPROC_SERVER,
    IID_IShellLibrary, plib);
  if SUCCEEDED(Result) then
  begin
    Result := SHAddFolderPathToLibrary(plib, PWideChar(AFolder));
  end;
end;

function RemoveFolderFromLibrary(AFolder: string): HRESULT;
{ Remove AFolder from Windows 7 library. }
var
  plib: IShellLibrary;
begin
  Result := CoCreateInstance(CLSID_ShellLibrary, nil, CLSCTX_INPROC_SERVER,
    IID_IShellLibrary, plib);
  if SUCCEEDED(Result) then
  begin
    Result := SHRemoveFolderPathFromLibrary(plib, PWideChar(AFolder));
  end;
end;

如何使用FiremonkeyFM³获得屏幕尺寸？以下代码:

var
  Size: TPointF;
begin
  Size := FMX.Platform.IFMXScreenService.GetScreenSize;
  ...
end;

导致此编译器错误:

[dcc32 Error] Unit1.pas(46): E2018 Record, object or class type required

我该如何使用IFMXScreenService界面来获取屏幕尺寸？

// experimental code
procedure TFormMain.MyThumbnailProvider( const Path: Unicodestring; Width,
 Height: Integer; out Bitmap: TBitmap );
var
   AExtension: string;
   ARect: TRect;
begin
  AExtension := LowerCase( ExtractFileExt( Path ) );
  if AExtension = '.wmf' then
  begin
    ARect.Left := 0;
    ARect.Top := 0;
    ARect.Right := Width;
    ARect.Bottom := Height;
    Image1.Picture.LoadFromFile( Path ); // added at design time to form
    Bitmap := TBitmap.Create;
    Bitmap.Width := Width;
    Bitmap.Height := Height;
    Bitmap.Canvas.StretchDraw( ARect, Image1.Picture.Graphic );
  end;
end;

编辑

procedure TFormMain.MyThumbnailProvider( const Path: Unicodestring; Width, Height: Integer; …

下面显示的是IOUtils用于计算文件夹和文件的两个函数.如何添加一个开关(CountHidden)来切换计数文件或文件夹faHidden TFileAttribute？

function SubDirectoryCount( const Path: string; const CountHidden: boolean; const Recurse: boolean ): Cardinal;
    { Counts all the sub-directories of a specified directory. If Recurse is true
      all sub-directories are counted recursively, otherwise only immediate
      sub-directories are counted. Count Hidden toggles counting hidden files (faHidden). }
    var
      StrArray: Types.TStringDynArray; // array of subdirectories
      SearchOption: IOUtils.TSearchOption; // directory search option
    begin
      if Recurse then
        SearchOption := IOUtils.TSearchOption.soAllDirectories
      else
        SearchOption := IOUtils.TSearchOption.soTopDirectoryOnly;
      StrArray := IOUtils.TDirectory.GetDirectories( …

此代码用于设置组件,生成编译器警告:

[DCC Warning] Unit1.pas(742): W1024 Combining signed and unsigned types 
                            - widened both operands

var
  iPrecision: cardinal;
  iRadius: cardinal;
  iActive: boolean;
  iInProximity: boolean;

iPrecision := Max(50, 100 - (3 + 2 * ord(iActive and iInProximity)) * iRadius);

这可以以某种方式进行类型转换以防止编译器警告吗？

我正在使用Indy IDFTP来创建目录.我需要找到一种可靠的方法来确定目录是否存在以及它是否存在,以便调用MakeDir.我尝试了以下代码,但是在调用List时没有发生异常,因此即使当时目录不存在,MakeDir也没有执行.如何确定目录是否存在并创建目录(如果该目录不存在)？

{ Check to see if the '/public_html/XXX/' + iDomain + 'Thumbnails' directory exists }
    try
      IdFTP1.List(nil, '/public_html/XXX/' + iDomain + 'Thumbnails', False);
    except
      on e: EIdReplyRFCError do
      begin
        { '/public_html/XXX/' + iDomain + 'Thumbnails' directory does not exist }
        StatusBar1.SimpleText := 'Making thumbnail directory...';
        StatusBar1.Update;
        iFolder := '/public_html/XXX/' + iDomain;
        { Change directory to /public_html/XXX/iDomain }
        IdFTP1.ChangeDir(iFolder);
        iFolder := 'Thumbnails';
        { Create FTP Directory for Thumbnails }
        IdFTP1.MakeDir(iFolder);
      end;
    end;

在我测试期间,目录不存在,但在运行时e是零？我的方法是否正确？

我找到了VB函数ShowPhotoPrintingWizard:

CommonDialog.ShowPhotoPrintingWizard( _
  ByVal Files As VARIANT _
) As HRESULT

如何在Delphi中调用它或获得相同的功能？我正在使用Delphi 2010.

procedure TForm1.ExtractLinks(const URL: String; const StringList: TStringList);
{ Extract "href" attribute from A tags from an URL and add to a stringlist. }
var
  i: Integer;
  iDoc: IHTMLDocument2;
  iHTML: String;
  iv: Variant;
  iLinks: OleVariant;
  iDocURL: String;
  iURI: TidURI;
  iHref: String;
  iIdHTTP: TidHTTP;
  iListItem: TListItem;
begin
  StringList.Clear;
  ListView1.Clear;
  iURI := TidURI.Create(URL);
  try
    iDocURL := 'http://' + iURI.Host;
    if iURI.Path <> '/' then
      iDocURL := iDocURL + iURI.Path;
  finally
    iURI.Free;
  end;
  iDoc := CreateComObject(Class_HTMLDOcument) as IHTMLDocument2;
  try
    iDoc.DesignMode := 'on';
    while iDoc.ReadyState …