mmbmpdlg.pas

一套及时通讯的原码

{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: [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: 08.04.98 - 05:23:31 $                                        =}
{========================================================================}
unit MMBmpDlg;

{$I COMPILER.INC}

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  StdCtrls,
  ExtCtrls,
  Clipbrd,
  Menus,
  MMObj,
  MMUtils,
  MMBmpLst,
  MMFill,
  MMCstDlg,
  MMBmpBtn;

type
  TWMSizing = record
     Msg   : Cardinal;
     fwSide: Longint;
     lpRect: PRect;
     Result: Longint;
  end;

  TMMUpdateMode = (umUp,umDown,umDelete);

type
  TMMBitmapListEditor = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Edit1: TMenuItem;
    About1: TMenuItem;
    Bevel1: TBevel;
    Panel1: TPanel;
    Bevel2: TBevel;
    Panel2: TPanel;
    ClientPanel: TPanel;
    ListHeader: THeader;
    Bevel3: TBevel;
    Panel4: TPanel;
    ListBox: TListBox;
    Bevel4: TBevel;
    menLoad: TMenuItem;
    menSave: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    PicOpenDialog: TMMPictureOpenDialog;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    menCut: TMenuItem;
    menCopy: TMenuItem;
    menPaste: TMenuItem;
    menDelete: TMenuItem;
    N2: TMenuItem;
    menUp: TMenuItem;
    menDown: TMenuItem;
    N3: TMenuItem;
    menClear: TMenuItem;
    N4: TMenuItem;
    menAddList: TMenuItem;
    N5: TMenuItem;
    menSaveBMP: TMenuItem;
    PicSaveDialog: TMMPictureSaveDialog;
    MMBitmapList1: TMMBitmapList;
    btnAdd: TMMBitmapButton;
    btnAddMultiple: TMMBitmapButton;
    btnDelete: TMMBitmapButton;
    btnClear: TMMBitmapButton;
    btnUp: TMMBitmapButton;
    btnDown: TMMBitmapButton;
    btnLoad: TMMBitmapButton;
    btnSave: TMMBitmapButton;
    btnCut: TMMBitmapButton;
    btnCopy: TMMBitmapButton;
    btnPaste: TMMBitmapButton;
    btnHelp: TMMBitmapButton;
    bnOK: TMMBitmapButton;
    btnReplace: TMMBitmapButton;
    menReplace: TMenuItem;
    ButtonTimer: TTimer;
    procedure btnOKClick(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure menLoadClick(Sender: TObject);
    procedure menSaveClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
                              Rect: TRect; State: TOwnerDrawState);
    procedure ListHeaderSized(Sender: TObject; ASection, AWidth: Integer);
    procedure btnClearClick(Sender: TObject);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnAddClick(Sender: TObject);
    procedure btnAddMultiClick(Sender: TObject);
    procedure btnUpClick(Sender: TObject);
    procedure btnDownClick(Sender: TObject);
    procedure btnCutClick(Sender: TObject);
    procedure btnCopyClick(Sender: TObject);
    procedure btnPasteClick(Sender: TObject);
    procedure menAddListClick(Sender: TObject);
    procedure ListBoxDblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure menSaveBMPClick(Sender: TObject);
    procedure PreviewKeyPress(Sender: TObject; var Key: Char);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure btnReplaceClick(Sender: TObject);
    procedure ButtonTimerTimer(Sender: TObject);
    procedure btnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure btnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  private
    FBitmaplist: TMMBitmapList;
    FOrigList  : TMMBitmapList;
    FUpdateIDs : Boolean;

    procedure BitmapListChanged(Sender: TObject);
    procedure SetBitmapList(List: TMMBitmapList);
    procedure UpdateListBox(Index: integer);
    procedure UpdateControls;
    procedure WMSizing(var Msg: TWMSizing); message WM_SIZING;
    procedure WMGetMinMaxInfo(Var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;

    procedure UpdateBitmapIDs(Index: integer; Mode: TMMUpdateMode);
  public
    property BitmapList: TMMBitmapList read FBitmapList write SetBitmapList;
  end;

var
  MMBitmapListEditor: TMMBitmapListEditor;

implementation

{$R *.DFM}

uses
    TypInfo,
    MMAbout;

{== TMMBitmapListEditor =======================================================}
procedure TMMBitmapListEditor.FormCreate(Sender: TObject);
begin
   {$IFDEF BUILD_ACTIVEX}
   MMBitmapList1.Left := -50;
   SetDesigning(False);
   {$ENDIF}

   FUpdateIDs  := False;

   Icon.Handle := LoadResIcon(icoMMTools);
   FBitmapList := TMMBitmapList.Create(Self);
   FBitmapList.OnChange := BitmapListChanged;
   UpdateControls;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.FormDestroy(Sender: TObject);
begin
   FBitmapList.Free;
end;


{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.FormClose(Sender: TObject; var Action: TCloseAction);
begin
   if (ModalResult = mrOK) and (FOrigList <> nil) then
   begin
      FOrigList.Assign(FBitmapList)
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.SetBitmapList(List: TMMBitmapList);
begin
   FOrigList := List;
   FBitmapList.Assign(List);
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.UpdateBitmapIDs(Index: integer; Mode: TMMUpdateMode);
var
   Comps: TStringList;
   Form: TCustomForm;
   i,idx,Value: integer;
   PropInfo: PPropInfo;
   nGlyphs: integer;
begin
   if FUpdateIDs then
   begin
      Form := TCustomForm(FOrigList.Owner);
      if (Form <> nil) then
      begin
         Comps := TStringList.Create;
         for i := 0 to Form.ComponentCount-1 do
         begin
            PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'NumGlyphs');
            if (PropInfo <> nil) then
            begin
               Value := GetOrdProp(Form.Components[i], PropInfo);
               Comps.AddObject(Form.Components[i].Name+' NumGlyphs',Pointer(Value));
            end;
            PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'NumThumbGlyphs');
            if (PropInfo <> nil) then
            begin
               Value := GetOrdProp(Form.Components[i], PropInfo);
               Comps.AddObject(Form.Components[i].Name+' NumThumbGlyphs',Pointer(Value));
            end;
         end;
         //FOrigList.Assign(FBitmapList);
         case Mode of
              umUp: begin
                       for i := 0 to Form.ComponentCount-1 do
                       begin
                          PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapList');
                          if (PropInfo <> nil) then
                          begin
                             if Pointer(GetOrdProp(Form.Components[i], PropInfo)) = Pointer(FOrigList) then
                             begin
                                PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapIndex');
                                if (PropInfo <> nil) then
                                begin
                                   Value := GetOrdProp(Form.Components[i], PropInfo);
                                   if (Value = Index) then
                                      SetOrdProp(Form.Components[i],PropInfo,Index-1)
                                   else if (Value = Index-1) then
                                       SetOrdProp(Form.Components[i],PropInfo,Index);
                                end;
                                PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapThumbIndex');
                                if (PropInfo <> nil) then
                                begin
                                   Value := GetOrdProp(Form.Components[i], PropInfo);
                                   if (Value = Index) then
                                      SetOrdProp(Form.Components[i],PropInfo,Index-1)
                                   else if (Value = Index-1) then
                                       SetOrdProp(Form.Components[i],PropInfo,Index);
                                end;
                                PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapBackIndex');
                                if (PropInfo <> nil) then
                                begin
                                   Value := GetOrdProp(Form.Components[i], PropInfo);
                                   if (Value = Index) then
                                      SetOrdProp(Form.Components[i],PropInfo,Index-1)
                                   else if (Value = Index-1) then
                                       SetOrdProp(Form.Components[i],PropInfo,Index);
                                end;
                             end;
                          end;
                       end;
                    end;
            umDown: begin
                       for i := 0 to Form.ComponentCount-1 do
                       begin
                          PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapList');
                          if (PropInfo <> nil) then
                          begin
                             if Pointer(GetOrdProp(Form.Components[i], PropInfo)) = Pointer(FOrigList) then
                             begin
                                PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapIndex');
                                if (PropInfo <> nil) then
                                begin
                                   Value := GetOrdProp(Form.Components[i], PropInfo);
                                   if (Value = Index) then
                                       SetOrdProp(Form.Components[i],PropInfo,Index+1)
                                   else if (Value = Index+1) then
                                       SetOrdProp(Form.Components[i],PropInfo,Index);
                                end;