mmidxprp.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Tel.: [phone]                   =}
{=  Loewenstr.7a                = [e-mail]                     =}
{========================================================================}
{=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
{========================================================================}
{=  This code is for reference purposes only and may not be copied or   =}
{=  distributed in any format electronic or otherwise except one copy   =}
{=  for backup purposes.                                                =}
{=                                                                      =}
{=  No Delphi Component Kit or Component individually or in a collection=}
{=  subclassed or otherwise from the code in this unit, or associated   =}
{=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
{=  without express permission from SwiftSoft.                          =}
{=                                                                      =}
{=  For more licence informations please refer to the associated        =}
{=  HelpFile.                                                           =}
{========================================================================}
{=  $Date: 02.03.98 - 21:26:34 $                                        =}
{========================================================================}
unit MMIdxPrp;

{$I COMPILER.INC}

interface

uses
{$IFDEF DELPHI6}
    DesignIntf,
    DesignEditors,
{$ELSE}
    DsgnIntf,
{$ENDIF}

    Windows,
    Messages,
    SysUtils,
    Classes,
    Graphics,
    Controls,
    Forms,
    Dialogs,
    StdCtrls,
    ExtCtrls,
    MMObj,
    MMUtils,
    MMBmpLst,
    MMFill;

type
  {-- TMMBMPIndexForm ---------------------------------------------------------}
  TMMBMPIndexForm = class(TForm)
    ClientPanel: TPanel;
    ListHeader: THeader;
    Panel4: TPanel;
    ListBox: TListBox;
    btnOK: TButton;
    btnCancel: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
                              Rect: TRect; State: TOwnerDrawState);
    procedure ListHeaderSized(Sender: TObject; ASection, AWidth: Integer);
    procedure ListBoxDblClick(Sender: TObject);
  private
     FBitmapList: TMMBitmapList;
     procedure SetBitmapList(List: TMMBitmapList);
     procedure UpdateListBox;
  public
    property BitmapList: TMMBitmapList read FBitmapList write SetBitmapList;
  end;

  {-- TMMBitmapIndexProperty --------------------------------------------------}
  TMMBitmapIndexProperty = class(TIntegerProperty)
  public
    procedure Edit; override;
    function  GetAttributes: TPropertyAttributes; override;
  end;

  {-- TMMBitmapBackIndexProperty --------------------------------------------}
  TMMBitmapBackIndexProperty = class(TIntegerProperty)
  public
    procedure Edit; override;
    function  GetAttributes: TPropertyAttributes; override;
  end;

var
  MMBMPIndexForm: TMMBMPIndexForm;

function ExecuteBitmapIndexEditor(List: TMMBitmapList; var Idx: integer): Boolean;

implementation

{$R *.DFM}

{------------------------------------------------------------------------------}
function ExecuteBitmapIndexEditor(List: TMMBitmapList; var Idx: integer): Boolean;
begin
   Result := False;
   if (List <> nil) then
   with TMMBMPIndexForm.Create(Application) do
   try
      BitmapList := List;
      if (Idx < ListBox.Items.Count) then
          ListBox.ItemIndex := Idx;

      if (ShowModal = mrOK) then
      begin
         Result := True;
         Idx := ListBox.ItemIndex;
      end;

   finally
      Free;
   end;
end;

{== TMMBitmapIndexProperty ====================================================}
procedure TMMBitmapIndexProperty.Edit;
var
   Idx: integer;
   List: TMMBitmapList;
   Comp: TComponent;

begin
   Comp := (GetComponent(0) as TComponent);

   if (Comp is TMMCustomBitmapListControl) then
   begin
      Idx  := (Comp as TMMCustomBitmapListControl).BitmapIndex;
      List := (Comp as TMMCustomBitmapListControl).BitmapList;
   end
   else if (Comp is TMMFormFill) then
   begin
      Idx  := (Comp as TMMFormFill).BitmapIndex;
      List := (Comp as TMMFormFill).BitmapList;
   end
   else if (Comp is TMMPanelFill) then
   begin
      Idx  := (Comp as TMMPanelFill).BitmapIndex;
      List := (Comp as TMMPanelFill).BitmapList;
   end
   else exit;

   if ExecuteBitmapIndexEditor(List,Idx) then
      SetOrdValue(Idx);
end;

{-- TMMBitmapIndexProperty ----------------------------------------------------}
function TMMBitmapIndexProperty.GetAttributes: TPropertyAttributes;
begin
   Result := [paMultiSelect, paDialog, paRevertable];
end;

{== TMMBitmapBackIndexProperty ================================================}
procedure TMMBitmapBackIndexProperty.Edit;
var
   Idx: integer;
   List: TMMBitmapList;
   Comp: TComponent;

begin
   Comp := (GetComponent(0) as TComponent);

   if (Comp is TMMCustomBitmapListControl) then
   begin
      Idx  := (Comp as TMMCustomBitmapListControl).BitmapBackIndex;
      List := (Comp as TMMCustomBitmapListControl).BitmapList;
   end
   else if (Comp is TMMPanelFill) then
   begin
      Idx  := (Comp as TMMPanelFill).BitmapBackIndex;
      List := (Comp as TMMPanelFill).BitmapList;
   end
   else exit;

   if ExecuteBitmapIndexEditor(List,Idx) then
      SetOrdValue(Idx);
end;

{-- TMMBitmapBackIndexProperty ------------------------------------------------}
function TMMBitmapBackIndexProperty.GetAttributes: TPropertyAttributes;
begin
   Result := [paMultiSelect, paDialog, paRevertable];
end;

{== TMMBMPIndexForm ===========================================================}
procedure TMMBMPIndexForm.FormCreate(Sender: TObject);
begin
   Icon.Handle := LoadResIcon(icoMMTools);
   FBitmapList := nil;
end;

{-- TMMBMPIndexForm -----------------------------------------------------------}
procedure TMMBMPIndexForm.SetBitmapList(List: TMMBitmapList);
begin
   FBitmapList := List;
   UpdateListBox;
end;

{-- TMMBMPIndexForm -----------------------------------------------------------}
procedure TMMBMPIndexForm.UpdateListBox;
var
   i: integer;
begin
   ListBox.Items.BeginUpdate;
   try
      ListBox.Clear;
      if (FBitmapList <> nil) then
      for i := 0 to FBitmapList.Count-1 do
      begin
         ListBox.Items.Add(IntToStr(i));
      end;
   finally
      ListBox.Items.Endupdate;
   end;
end;

{-- TMMBMPIndexForm -----------------------------------------------------------}
procedure TMMBMPIndexForm.ListBoxDrawItem(Control: TWinControl;
                                          Index: Integer; Rect: TRect;
                                          State: TOwnerDrawState);
var
  R: TRect;
  S: string;
  C: array[0..255] of Char;
  X,Y,iWidth,iHeight,W: integer;
  Factor: Double;

begin
   with ListBox.Canvas do
   begin
      FillRect(Rect);

      inc(Rect.Top);
      dec(Rect.Bottom);
      R := Rect;

      { draw the ID }
      S := ListBox.Items[Index];
      R.Right := ListHeader.SectionWidth[0];
      X := (R.Left + ((R.Right-R.Left) div 2)) - TextWidth(S) div 2;
      Y := (R.Top + ((R.Bottom-R.Top) div 2)) - TextHeight(S) div 2;
      ExtTextOut(ListBox.Canvas.Handle, X, Y, ETO_CLIPPED or
                 ETO_OPAQUE, @R, StrPCopy(C, S), Length(S), nil);

      R.Left := R.Right;
      R.Right := Rect.Right;
      inc(R.Top);
      dec(R.Bottom);

      iWidth  := FBitmapList.Items[index].Width;
      iHeight := FBitmapList.Items[index].Height;

      if (iWidth < (R.Right-R.Left)) and
         (iHeight < (R.Bottom-R.Top)) then
      begin
         R.Right := R.Left+iWidth;
         R.Top   := R.Top + (((R.Bottom-R.Top)-iHeight) div 2);
         R.Bottom:= R.Top + iHeight;
      end
      else
      begin
         if (iWidth <= iHeight) then
         begin
            if (iHeight > R.Bottom-R.Top) then
            begin
               Factor  := (R.Bottom - R.Top)/iHeight;
               iWidth  := Trunc(iWidth * Factor);
               iHeight := R.Bottom-R.Top;
            end;
            Factor  := Min(R.Bottom-R.Top,iHeight)/iHeight;
            iWidth  := Trunc(iWidth * Factor);
            if (iWidth > R.Right-R.Left) then
            begin
               Factor  := (R.Right - R.Left)/iWidth;
               iHeight := Trunc(iHeight * Factor);
               iWidth  := R.Right-R.Left;
               R.Top    := R.Top + (((R.Bottom-R.Top)-iHeight) div 2);
               R.Bottom := R.Top + iHeight;
            end;
            R.Right  := R.Left + iWidth;
         end
         else
         begin
            if (iHeight > R.Bottom-R.Top) then
            begin
               Factor  := (R.Bottom - R.Top)/iHeight;
               iWidth  := Trunc(iWidth * Factor);
               iHeight := R.Bottom-R.Top;
            end;
            W := Min(R.Right-R.Left,iWidth);
            Factor   := W/iWidth;
            iHeight  := Trunc(iHeight * Factor);
            R.Top    := R.Top + (((R.Bottom-R.Top)-iHeight) div 2);
            R.Bottom := R.Top + iHeight;
            R.Right := R.Left+W;
         end
      end;

      StretchDraw(R, FBitmapList.Items[index]);
   end;
end;

{-- TMMBMPIndexForm -----------------------------------------------------------}
procedure TMMBMPIndexForm.ListHeaderSized(Sender: TObject; ASection, AWidth: Integer);
begin
   ListBox.Invalidate;
end;

{-- TMMBMPIndexForm -----------------------------------------------------------}
procedure TMMBMPIndexForm.ListBoxDblClick(Sender: TObject);
begin
   ModalResult := mrOK;
end;

end.