⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 dibcompressoreditor.pas

📁 Delphi控件
💻 PAS
字号:
unit DIBCompressorEditor;

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: DIBCompressorEditor.PAS, released September 04, 2000.

The Initial Developer of the Original Code is Peter Morris (pete@droopyeyes.com),
Portions created by Peter Morris are Copyright (C) 2000 Peter Morris.
All Rights Reserved.

Purpose of file:
To allow selection of compressors at design time.

Contributor(s):
None as yet


Last Modified: September 04, 2000

You may retrieve the latest version of this file at the Project JEDI home page,
located at http://www.delphi-jedi.org
or at http://www.stuckindoors.com/dib


Known Issues:
-----------------------------------------------------------------------------}


interface

{$i OpenSource/dfs.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, cDIBCompressor,
  {$IFDEF DFS_NO_DSGNINTF}
  DesignEditors, DesignIntf,
  {$ELSE}
  DsgnIntf,
  {$ENDIF}
  cDIBSettings, StdCtrls, ExtCtrls, DIBOpenTools;

type
  TDIBCompressorProperty = class(TStringProperty)
  private
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
  published
    { Published declarations }
  end;


  TfmSelectCompressor = class(TForm)
    lbCompressors: TListBox;
    Panel1: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    Panel2: TPanel;
    Label1: TLabel;
    memAbout: TMemo;
    Label2: TLabel;
    lblEmail: TLabel;
    Homepage: TLabel;
    lblHomepage: TLabel;
    lblAuthor: TLabel;
    procedure lbCompressorsClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

implementation

uses
  COMObj;

{$R *.DFM}

{ TDIBCompressorProperty }

procedure TDIBCompressorProperty.Edit;
var
  OrigCompressor: TAbstractDIBCompressor;
  I: Integer;
begin
  OrigCompressor := DefaultCompressor;
  with TfmSelectCompressor.Create(Application) do
    try
      lbCompressors.Clear;
      lbCompressors.Items.Add('(none)');
      lbCompressors.ItemIndex := 0;
      for I := 0 to CompressorCount - 1 do 
      begin
        lbCompressors.Items.Add(Compressor(I).GetDisplayName);
        if Compressor(I) = DefaultCompressor then
          lbCompressors.ItemIndex := I + 1;
      end;
      lbCompressorsClick(nil);

      ShowModal;
      if ModalResult = mrOk then 
      begin
        if DefaultCompressor = nil then
          TDIBSettings(GetComponent(0)).DIBCompressor := ''
        else 
        begin
          TDIBSettings(GetComponent(0)).DIBCompressor :=
            GUIDToString(DefaultCompressor.GetGUID);
          LinkUnitToClass(GetComponent(0), DefaultCompressor.ClassType);
        end;
        
        Self.Designer.Modified;
      end 
      else
        DefaultCompressor := OrigCompressor;
    finally
      Free;
    end;
end;

function TDIBCompressorProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paReadOnly];
end;

function TDIBCompressorProperty.GetValue: string;
begin
  if DefaultCompressor <> nil then
    Result := DefaultCompressor.GetDisplayName
  else
    Result := '(none)';
end;


procedure TfmSelectCompressor.lbCompressorsClick(Sender: TObject);
begin
  if lbCompressors.ItemIndex <= 0 then 
  begin
    DefaultCompressor := nil;
    lblAuthor.Caption := '';
    lblEmail.Caption := '';
    lblHomepage.Caption := '';
    memAbout.Lines.Text := '';
  end 
  else 
  begin
    DefaultCompressor := Compressor(lbCompressors.ItemIndex - 1);
    with DefaultCompressor do 
    begin
      lblAuthor.Caption := GetAuthor;
      lblEmail.Caption := GetEmail;
      lblHomepage.Caption := GetURL;
      memAbout.Lines.Text := GetAboutText;
    end;
  end;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -