fselectcodecs.pas

很好的源代码

unit FSelectCodecs;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, CheckLst, ExtCtrls, EvBGraphics;

type
  TFrmSelectCodecs = class(TForm)
    PnlTop: TPanel;
    LblCodecs: TLabel;
    PnlBottom: TPanel;
    PnlClient: TPanel;
    CLBCodecs: TCheckListBox;
    BtnOK: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  private
    { Private declarations }
    FCheckedCodecCount: Integer;
    function GetCheckedCodec(
      const Index: Integer): TEvBBitmapFileFormatInfo;
  public
    { Public declarations }
    property CheckedCodecCount: Integer read FCheckedCodecCount;
    property CheckedCodecs[const Index: Integer]: TEvBBitmapFileFormatInfo read GetCheckedCodec; default;
  end;

implementation

{$R *.dfm}

procedure TFrmSelectCodecs.FormCreate(Sender: TObject);
var
  I, Padding: Integer;
  Info: TEvBBitmapFileFormatInfo;
begin
  for I := 0 to TEvBBitmap.RegisteredFileFormatCount - 1 do begin
    Info := TEvBBitmap.GetRegisteredFileFormat(I);
    if Info.SupportsQualityLevels then
      CLBCodecs.Items.AddObject(Format('%s (%s)',
        [Info.Description,Info.Extension]),Info)
  end;
  FCheckedCodecCount := CLBCodecs.Count;
  for I := 0 to CLBCodecs.Count - 1 do
    CLBCodecs.Checked[I] := True;
  Padding := ClientHeight - CLBCodecs.ClientHeight;
  ClientHeight := (CLBCodecs.Count * CLBCodecs.ItemHeight) + Padding;
end;

procedure TFrmSelectCodecs.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var
  I: Integer;
begin
  FCheckedCodecCount := 0;
  for I := 0 to CLBCodecs.Count - 1 do
    if CLBCodecs.Checked[I] then
      Inc(FCheckedCodecCount);
  if FCheckedCodecCount = 0 then begin
    ShowMessage('You need to check at least one codec');
    CanClose := False;
  end;
end;

function TFrmSelectCodecs.GetCheckedCodec(
  const Index: Integer): TEvBBitmapFileFormatInfo;
var
  I, J: Integer;
begin
  I := 0;
  for J := 0 to CLBCodecs.Count - 1 do
    if CLBCodecs.Checked[J] then begin
      Result := TEvBBitmapFileFormatInfo(CLBCodecs.Items.Objects[J]);
      if I = Index then
        Exit;
      Inc(I);
    end;
  Result := nil;
end;

end.