开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MMBmpDlg.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：33k
源码类别：

Delphi控件源码

开发平台：

Delphi

MMBmpDlg.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49 (0)351-8037944              =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 08.04.98 - 05:23:31 $                                        =}
  24. {========================================================================}
  25. unit MMBmpDlg;
  27. {$I COMPILER.INC}
  29. interface
  31. uses
  32.   Windows,
  33.   Messages,
  34.   SysUtils,
  35.   Classes,
  36.   Graphics,
  37.   Controls,
  38.   Forms,
  39.   Dialogs,
  40.   StdCtrls,
  41.   ExtCtrls,
  42.   Clipbrd,
  43.   Menus,
  44.   MMObj,
  45.   MMUtils,
  46.   MMBmpLst,
  47.   MMFill,
  48.   MMCstDlg,
  49.   MMBmpBtn;
  51. type
  52.   TWMSizing = record
  53.      Msg   : Cardinal;
  54.      fwSide: Longint;
  55.      lpRect: PRect;
  56.      Result: Longint;
  57.   end;
  59.   TMMUpdateMode = (umUp,umDown,umDelete);
  61. type
  62.   TMMBitmapListEditor = class(TForm)
  63.     MainMenu1: TMainMenu;
  64.     File1: TMenuItem;
  65.     Edit1: TMenuItem;
  66.     About1: TMenuItem;
  67.     Bevel1: TBevel;
  68.     Panel1: TPanel;
  69.     Bevel2: TBevel;
  70.     Panel2: TPanel;
  71.     ClientPanel: TPanel;
  72.     ListHeader: THeader;
  73.     Bevel3: TBevel;
  74.     Panel4: TPanel;
  75.     ListBox: TListBox;
  76.     Bevel4: TBevel;
  77.     menLoad: TMenuItem;
  78.     menSave: TMenuItem;
  79.     N1: TMenuItem;
  80.     Exit1: TMenuItem;
  81.     PicOpenDialog: TMMPictureOpenDialog;
  82.     OpenDialog: TOpenDialog;
  83.     SaveDialog: TSaveDialog;
  84.     menCut: TMenuItem;
  85.     menCopy: TMenuItem;
  86.     menPaste: TMenuItem;
  87.     menDelete: TMenuItem;
  88.     N2: TMenuItem;
  89.     menUp: TMenuItem;
  90.     menDown: TMenuItem;
  91.     N3: TMenuItem;
  92.     menClear: TMenuItem;
  93.     N4: TMenuItem;
  94.     menAddList: TMenuItem;
  95.     N5: TMenuItem;
  96.     menSaveBMP: TMenuItem;
  97.     PicSaveDialog: TMMPictureSaveDialog;
  98.     MMBitmapList1: TMMBitmapList;
  99.     btnAdd: TMMBitmapButton;
  100.     btnAddMultiple: TMMBitmapButton;
  101.     btnDelete: TMMBitmapButton;
  102.     btnClear: TMMBitmapButton;
  103.     btnUp: TMMBitmapButton;
  104.     btnDown: TMMBitmapButton;
  105.     btnLoad: TMMBitmapButton;
  106.     btnSave: TMMBitmapButton;
  107.     btnCut: TMMBitmapButton;
  108.     btnCopy: TMMBitmapButton;
  109.     btnPaste: TMMBitmapButton;
  110.     btnHelp: TMMBitmapButton;
  111.     bnOK: TMMBitmapButton;
  112.     btnReplace: TMMBitmapButton;
  113.     menReplace: TMenuItem;
  114.     ButtonTimer: TTimer;
  115.     procedure btnOKClick(Sender: TObject);
  116.     procedure About1Click(Sender: TObject);
  117.     procedure menLoadClick(Sender: TObject);
  118.     procedure menSaveClick(Sender: TObject);
  119.     procedure FormCreate(Sender: TObject);
  120.     procedure FormDestroy(Sender: TObject);
  121.     procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
  122.                               Rect: TRect; State: TOwnerDrawState);
  123.     procedure ListHeaderSized(Sender: TObject; ASection, AWidth: Integer);
  124.     procedure btnClearClick(Sender: TObject);
  125.     procedure btnDeleteClick(Sender: TObject);
  126.     procedure btnAddClick(Sender: TObject);
  127.     procedure btnAddMultiClick(Sender: TObject);
  128.     procedure btnUpClick(Sender: TObject);
  129.     procedure btnDownClick(Sender: TObject);
  130.     procedure btnCutClick(Sender: TObject);
  131.     procedure btnCopyClick(Sender: TObject);
  132.     procedure btnPasteClick(Sender: TObject);
  133.     procedure menAddListClick(Sender: TObject);
  134.     procedure ListBoxDblClick(Sender: TObject);
  135.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  136.     procedure menSaveBMPClick(Sender: TObject);
  137.     procedure PreviewKeyPress(Sender: TObject; var Key: Char);
  138.     procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  139.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  140.     procedure FormResize(Sender: TObject);
  141.     procedure btnReplaceClick(Sender: TObject);
  142.     procedure ButtonTimerTimer(Sender: TObject);
  143.     procedure btnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  144.     procedure btnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  145.   private
  146.     FBitmaplist: TMMBitmapList;
  147.     FOrigList  : TMMBitmapList;
  148.     FUpdateIDs : Boolean;
  150.     procedure BitmapListChanged(Sender: TObject);
  151.     procedure SetBitmapList(List: TMMBitmapList);
  152.     procedure UpdateListBox(Index: integer);
  153.     procedure UpdateControls;
  154.     procedure WMSizing(var Msg: TWMSizing); message WM_SIZING;
  155.     procedure WMGetMinMaxInfo(Var Msg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
  157.     procedure UpdateBitmapIDs(Index: integer; Mode: TMMUpdateMode);
  158.   public
  159.     property BitmapList: TMMBitmapList read FBitmapList write SetBitmapList;
  160.   end;
  162. var
  163.   MMBitmapListEditor: TMMBitmapListEditor;
  165. implementation
  167. {$R *.DFM}
  169. uses
  170.     TypInfo,
  171.     MMAbout;
  173. {== TMMBitmapListEditor =======================================================}
  174. procedure TMMBitmapListEditor.FormCreate(Sender: TObject);
  175. begin
  176.    {$IFDEF BUILD_ACTIVEX}
  177.    MMBitmapList1.Left := -50;
  178.    SetDesigning(False);
  179.    {$ENDIF}
  181.    FUpdateIDs  := False;
  183.    Icon.Handle := LoadResIcon(icoMMTools);
  184.    FBitmapList := TMMBitmapList.Create(Self);
  185.    FBitmapList.OnChange := BitmapListChanged;
  186.    UpdateControls;
  187. end;
  189. {-- TMMBitmapListEditor -------------------------------------------------------}
  190. procedure TMMBitmapListEditor.FormDestroy(Sender: TObject);
  191. begin
  192.    FBitmapList.Free;
  193. end;
  196. {-- TMMBitmapListEditor -------------------------------------------------------}
  197. procedure TMMBitmapListEditor.FormClose(Sender: TObject; var Action: TCloseAction);
  198. begin
  199.    if (ModalResult = mrOK) and (FOrigList <> nil) then
  200.    begin
  201.       FOrigList.Assign(FBitmapList)
  202.    end;
  203. end;
  205. {-- TMMBitmapListEditor -------------------------------------------------------}
  206. procedure TMMBitmapListEditor.SetBitmapList(List: TMMBitmapList);
  207. begin
  208.    FOrigList := List;
  209.    FBitmapList.Assign(List);
  210. end;
  212. {-- TMMBitmapListEditor -------------------------------------------------------}
  213. procedure TMMBitmapListEditor.UpdateBitmapIDs(Index: integer; Mode: TMMUpdateMode);
  214. var
  215.    Comps: TStringList;
  216.    Form: TCustomForm;
  217.    i,idx,Value: integer;
  218.    PropInfo: PPropInfo;
  219.    nGlyphs: integer;
  220. begin
  221.    if FUpdateIDs then
  222.    begin
  223.       Form := TCustomForm(FOrigList.Owner);
  224.       if (Form <> nil) then
  225.       begin
  226.          Comps := TStringList.Create;
  227.          for i := 0 to Form.ComponentCount-1 do
  228.          begin
  229.             PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'NumGlyphs');
  230.             if (PropInfo <> nil) then
  231.             begin
  232.                Value := GetOrdProp(Form.Components[i], PropInfo);
  233.                Comps.AddObject(Form.Components[i].Name+' NumGlyphs',Pointer(Value));
  234.             end;
  235.             PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'NumThumbGlyphs');
  236.             if (PropInfo <> nil) then
  237.             begin
  238.                Value := GetOrdProp(Form.Components[i], PropInfo);
  239.                Comps.AddObject(Form.Components[i].Name+' NumThumbGlyphs',Pointer(Value));
  240.             end;
  241.          end;
  242.          //FOrigList.Assign(FBitmapList);
  243.          case Mode of
  244.               umUp: begin
  245.                        for i := 0 to Form.ComponentCount-1 do
  246.                        begin
  247.                           PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapList');
  248.                           if (PropInfo <> nil) then
  249.                           begin
  250.                              if Pointer(GetOrdProp(Form.Components[i], PropInfo)) = Pointer(FOrigList) then
  251.                              begin
  252.                                 PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapIndex');
  253.                                 if (PropInfo <> nil) then
  254.                                 begin
  255.                                    Value := GetOrdProp(Form.Components[i], PropInfo);
  256.                                    if (Value = Index) then
  257.                                       SetOrdProp(Form.Components[i],PropInfo,Index-1)
  258.                                    else if (Value = Index-1) then
  259.                                        SetOrdProp(Form.Components[i],PropInfo,Index);
  260.                                 end;
  261.                                 PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapThumbIndex');
  262.                                 if (PropInfo <> nil) then
  263.                                 begin
  264.                                    Value := GetOrdProp(Form.Components[i], PropInfo);
  265.                                    if (Value = Index) then
  266.                                       SetOrdProp(Form.Components[i],PropInfo,Index-1)
  267.                                    else if (Value = Index-1) then
  268.                                        SetOrdProp(Form.Components[i],PropInfo,Index);
  269.                                 end;
  270.                                 PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapBackIndex');
  271.                                 if (PropInfo <> nil) then
  272.                                 begin
  273.                                    Value := GetOrdProp(Form.Components[i], PropInfo);
  274.                                    if (Value = Index) then
  275.                                       SetOrdProp(Form.Components[i],PropInfo,Index-1)
  276.                                    else if (Value = Index-1) then
  277.                                        SetOrdProp(Form.Components[i],PropInfo,Index);
  278.                                 end;
  279.                              end;
  280.                           end;
  281.                        end;
  282.                     end;
  283.             umDown: begin
  284.                        for i := 0 to Form.ComponentCount-1 do
  285.                        begin
  286.                           PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapList');
  287.                           if (PropInfo <> nil) then
  288.                           begin
  289.                              if Pointer(GetOrdProp(Form.Components[i], PropInfo)) = Pointer(FOrigList) then
  290.                              begin
  291.                                 PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapIndex');
  292.                                 if (PropInfo <> nil) then
  293.                                 begin
  294.                                    Value := GetOrdProp(Form.Components[i], PropInfo);
  295.                                    if (Value = Index) then
  296.                                        SetOrdProp(Form.Components[i],PropInfo,Index+1)
  297.                                    else if (Value = Index+1) then
  298.                                        SetOrdProp(Form.Components[i],PropInfo,Index);
  299.                                 end;
  300.                                 PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapThumbIndex');
  301.                                 if (PropInfo <> nil) then
  302.                                 begin
  303.                                    Value := GetOrdProp(Form.Components[i], PropInfo);
  304.                                    if (Value = Index) then
  305.                                        SetOrdProp(Form.Components[i],PropInfo,Index+1)
  306.                                    else if (Value = Index+1) then
  307.                                        SetOrdProp(Form.Components[i],PropInfo,Index);
  308.                                 end;
  309.                                 PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapBackIndex');
  310.                                 if (PropInfo <> nil) then
  311.                                 begin
  312.                                    Value := GetOrdProp(Form.Components[i], PropInfo);
  313.                                    if (Value = Index) then
  314.                                        SetOrdProp(Form.Components[i],PropInfo,Index+1)
  315.                                    else if (Value = Index+1) then
  316.                                        SetOrdProp(Form.Components[i],PropInfo,Index);
  317.                                 end;
  318.                              end;
  319.                           end;
  320.                        end;
  321.                     end;
  322.           umDelete: begin
  323.                        for i := 0 to Form.ComponentCount-1 do
  324.                        begin
  325.                           PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapList');
  326.                           if (PropInfo <> nil) then
  327.                           begin
  328.                              if Pointer(GetOrdProp(Form.Components[i], PropInfo)) = Pointer(FOrigList) then
  329.                              begin
  330.                                 PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapIndex');
  331.                                 if (PropInfo <> nil) then
  332.                                 begin
  333.                                    Value := GetOrdProp(Form.Components[i], PropInfo);
  334.                                    if (Value > Index) then
  335.                                        SetOrdProp(Form.Components[i],PropInfo,Value-1);
  336.                                 end;
  337.                                 PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapThumbIndex');
  338.                                 if (PropInfo <> nil) then
  339.                                 begin
  340.                                    Value := GetOrdProp(Form.Components[i], PropInfo);
  341.                                    if (Value > Index) then
  342.                                        SetOrdProp(Form.Components[i],PropInfo,Value-1);
  343.                                 end;
  344.                                 PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapBackIndex');
  345.                                 if (PropInfo <> nil) then
  346.                                 begin
  347.                                    Value := GetOrdProp(Form.Components[i], PropInfo);
  348.                                    if (Value > Index) then
  349.                                        SetOrdProp(Form.Components[i],PropInfo,Value-1);
  350.                                 end;
  351.                              end;
  352.                           end;
  353.                        end;
  354.                     end;
  355.          end;
  356.          for i := 0 to Form.ComponentCount-1 do
  357.          begin
  358.             PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'NumGlyphs');
  359.             if (PropInfo <> nil) then
  360.             begin
  361.                idx := Comps.IndexOf(Form.Components[i].Name+' NumGlyphs');
  362.                if (idx >= 0) then
  363.                begin
  364.                   SetOrdProp(Form.Components[i], PropInfo, integer(Comps.Objects[idx]));
  365.                end;
  366.             end;
  367.             PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'NumThumbGlyphs');
  368.             if (PropInfo <> nil) then
  369.             begin
  370.                idx := Comps.IndexOf(Form.Components[i].Name+' NumThumbGlyphs');
  371.                if (idx >= 0) then
  372.                begin
  373.                   SetOrdProp(Form.Components[i], PropInfo, integer(Comps.Objects[idx]));
  374.                end;
  375.             end;
  376.          end;
  377.          Comps.Free;
  378.       end;
  379.    end;
  380. end;
  382. {-- TMMBitmapListEditor -------------------------------------------------------}
  383. procedure TMMBitmapListEditor.BitmapListChanged(Sender: TObject);
  384. begin
  385.    UpdateListBox(ListBox.ItemIndex);
  386. end;
  388. {-- TMMBitmapListEditor -------------------------------------------------------}
  389. procedure TMMBitmapListEditor.UpdateListBox(Index: integer);
  390. var
  391.    i: integer;
  393.    function GetRefCount(idx: integer): integer;
  394.    var
  395.       Form: TCustomForm;
  396.       i: integer;
  397.       PropInfo: PPropInfo;
  399.    begin
  400.       Result := 0;
  401.       if FUpdateIDs then
  402.       begin
  403.          Form := TCustomForm(FOrigList.Owner);
  404.          if (Form <> nil) then
  405.          begin
  406.             for i := 0 to Form.ComponentCount-1 do
  407.             begin
  408.                PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapList');
  409.                if (PropInfo <> nil) then
  410.                begin
  411.                   if Pointer(GetOrdProp(Form.Components[i], PropInfo)) = Pointer(FOrigList) then
  412.                   begin
  413.                      PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapIndex');
  414.                      if (PropInfo <> nil) then
  415.                      begin
  416.                         if (GetOrdProp(Form.Components[i], PropInfo) = Idx) then inc(Result);
  417.                      end;
  418.                      PropInfo := GetPropInfo(Form.Components[i].ClassInfo,'BitmapThumbIndex');
  419.                      if (PropInfo <> nil) then
  420.                      begin
  421.                         if (GetOrdProp(Form.Components[i], PropInfo) = Idx) then inc(Result);
  422.                      end;
  423.                   end;
  424.                end;
  425.             end;
  426.          end;
  427.       end;
  428.    end;
  430. begin
  431.    ListBox.Items.BeginUpdate;
  432.    try
  433.       ListBox.Clear;
  434.       for i := 0 to FBitmapList.Count-1 do
  435.       begin
  436.          ListBox.Items.AddObject(IntToStr(i),Pointer(GetRefCount(i)));
  437.       end;
  439.       if (Index < 0) then
  440.           Index := 0;
  442.       if (Index >= ListBox.Items.Count) then
  443.           Index := ListBox.Items.Count-1;
  445.       if (Index < ListBox.Items.Count) then
  446.           ListBox.ItemIndex := Index;
  448.       UpdateControls;
  450.    finally
  451.       ListBox.Items.EndUpdate;
  452.    end;
  453. end;
  455. {-- TFindMarkerForm -----------------------------------------------------}
  456. procedure TMMBitmapListEditor.ListBoxDrawItem(Control: TWinControl;
  457.                                               Index: Integer; Rect: TRect;
  458.                                               State: TOwnerDrawState);
  459. var
  460.   R: TRect;
  461.   S: string;
  462.   C: array[0..255] of Char;
  463.   X,Y,iWidth,iHeight,W: integer;
  464.   Factor: Double;
  466. begin
  467.    with ListBox.Canvas do
  468.    begin
  469.       FillRect(Rect);
  471.       inc(Rect.Top);
  472.       dec(Rect.Bottom);
  473.       R := Rect;
  475.       { draw the ID }
  476.       S := ListBox.Items[Index];
  477.       R.Right := ListHeader.SectionWidth[0];
  478.       X := (R.Left + ((R.Right-R.Left) div 2)) - TextWidth(S) div 2;
  479.       Y := (R.Top + ((R.Bottom-R.Top) div 2)) - TextHeight(S) div 2;
  480.       ExtTextOut(ListBox.Canvas.Handle, X, Y, ETO_CLIPPED or
  481.                  ETO_OPAQUE, @R, StrPCopy(C, S), Length(S), nil);
  483.       R.Left := R.Right;
  484.       R.Right := Rect.Right;
  486.       { draw the RefCount }
  487.       S := IntToStr(integer(ListBox.Items.Objects[Index]));
  488.       R.Right := ListHeader.SectionWidth[0]+ListHeader.SectionWidth[1];
  489.       X := (R.Left + ((R.Right-R.Left) div 2)) - TextWidth(S) div 2;
  490.       Y := (R.Top + ((R.Bottom-R.Top) div 2)) - TextHeight(S) div 2;
  491.       ExtTextOut(ListBox.Canvas.Handle, X, Y, ETO_CLIPPED or
  492.                  ETO_OPAQUE, @R, StrPCopy(C, S), Length(S), nil);
  494.       R.Left := R.Right;
  495.       R.Right := Rect.Right;
  496.       inc(R.Top);
  497.       dec(R.Bottom);
  499.       iWidth  := FBitmapList.Items[index].Width;
  500.       iHeight := FBitmapList.Items[index].Height;
  502.       if (iWidth < (R.Right-R.Left)) and
  503.          (iHeight < (R.Bottom-R.Top)) then
  504.       begin
  505.          R.Right := R.Left+iWidth;
  506.          R.Top   := R.Top + (((R.Bottom-R.Top)-iHeight) div 2);
  507.          R.Bottom:= R.Top + iHeight;
  508.       end
  509.       else
  510.       begin
  511.          if (iWidth <= iHeight) then
  512.          begin
  513.             if (iHeight > R.Bottom-R.Top) then
  514.             begin
  515.                Factor  := (R.Bottom - R.Top)/iHeight;
  516.                iWidth  := Trunc(iWidth * Factor);
  517.                iHeight := R.Bottom-R.Top;
  518.             end;
  519.             Factor  := Min(R.Bottom-R.Top,iHeight)/iHeight;
  520.             iWidth  := Trunc(iWidth * Factor);
  521.             if (iWidth > R.Right-R.Left) then
  522.             begin
  523.                Factor  := (R.Right - R.Left)/iWidth;
  524.                iHeight := Trunc(iHeight * Factor);
  525.                iWidth  := R.Right-R.Left;
  526.                R.Top    := R.Top + (((R.Bottom-R.Top)-iHeight) div 2);
  527.                R.Bottom := R.Top + iHeight;
  528.             end;
  529.             R.Right  := R.Left + iWidth;
  530.          end
  531.          else
  532.          begin
  533.             if (iHeight > R.Bottom-R.Top) then
  534.             begin
  535.                Factor  := (R.Bottom - R.Top)/iHeight;
  536.                iWidth  := Trunc(iWidth * Factor);
  537.                iHeight := R.Bottom-R.Top;
  538.             end;
  539.             W := Min(R.Right-R.Left,iWidth);
  540.             Factor   := W/iWidth;
  541.             iHeight  := Trunc(iHeight * Factor);
  542.             R.Top    := R.Top + (((R.Bottom-R.Top)-iHeight) div 2);
  543.             R.Bottom := R.Top + iHeight;
  544.             R.Right := R.Left+W;
  545.          end
  546.       end;
  548.       StretchDraw(R, FBitmapList.Items[index]);
  550.       UpdateControls;
  551.    end;
  552. end;
  554. {-- TMMBitmapListEditor -------------------------------------------------------}
  555. procedure TMMBitmapListEditor.ListHeaderSized(Sender: TObject; ASection, AWidth: Integer);
  556. begin
  557.    ListBox.Invalidate;
  558. end;
  560. {-- TMMBitmapListEditor -------------------------------------------------------}
  561. procedure TMMBitmapListEditor.UpdateControls;
  562. begin
  563.    with ListBox do
  564.    begin
  565.       btnDelete.Enabled := (FBitmapList.Count > 0) and (ListBox.ItemIndex >= 0);
  566.       menDelete.Enabled := btnDelete.Enabled;
  567.       btnClear.Enabled  := (FBitmapList.Count > 0);
  568.       menClear.Enabled  := btnClear.Enabled;
  569.       btnSave.Enabled   := btnClear.Enabled;
  570.       menSave.Enabled   := btnSave.Enabled;
  571.       btnUp.Enabled     := (Items.Count > 0) and (ItemIndex > 0);
  572.       menUp.Enabled     := btnUp.Enabled;
  573.       btnDown.Enabled   := (Items.Count > 0) and (ItemIndex < Items.Count-1);
  574.       menDown.Enabled   := btnDown.Enabled;
  575.       btnCut.Enabled    := btnDelete.Enabled;
  576.       menCut.Enabled    := btnCut.Enabled;
  577.       btnCopy.Enabled   := btnDelete.Enabled;
  578.       menCopy.Enabled   := btnCopy.Enabled;
  579.       menSaveBMP.Enabled:= btnCopy.Enabled;
  580.       btnPaste.Enabled  := Clipboard.HasFormat(CF_BITMAP);
  581.       menPaste.Enabled  := btnPaste.Enabled;
  582.       btnReplace.Enabled:= btnPaste.Enabled and (ListBox.ItemIndex >= 0) and (ListBox.Items.Count > 0);
  583.       menReplace.Enabled:= btnReplace.Enabled;
  584.    end;
  585. end;
  587. {-- TMMBitmapListEditor -------------------------------------------------------}
  588. procedure TMMBitmapListEditor.btnOKClick(Sender: TObject);
  589. begin
  590.    ModalResult := mrOK;
  591. end;
  593. {-- TMMBitmapListEditor -------------------------------------------------------}
  594. procedure TMMBitmapListEditor.About1Click(Sender: TObject);
  595. begin
  596.    Show_AboutBox(0);
  597. end;
  599. {-- TMMBitmapListEditor -------------------------------------------------------}
  600. procedure TMMBitmapListEditor.menLoadClick(Sender: TObject);
  601. begin
  602.    if OpenDialog.Execute then
  603.       FBitmapList.LoadFromFile(OpenDialog.FileName);
  604. end;
  606. {-- TMMBitmapListEditor -------------------------------------------------------}
  607. procedure TMMBitmapListEditor.menSaveClick(Sender: TObject);
  608. var
  609.    S: string;
  610. begin
  611.    if SaveDialog.Execute then
  612.    begin
  613.       S := ChangeFileExt(SaveDialog.FileName,'.~bm');
  614.       DeleteFile(S);
  615.       RenameFile(SaveDialog.FileName,S);
  616.       FBitmapList.SaveToFile(SaveDialog.FileName);
  617.    end;
  618. end;
  620. {-- TMMBitmapListEditor -------------------------------------------------------}
  621. procedure TMMBitmapListEditor.menAddListClick(Sender: TObject);
  622. begin
  623.    if OpenDialog.Execute then
  624.       FBitmapList.AddListFromFile(OpenDialog.FileName);
  625. end;
  627. {-- TMMBitmapListEditor -------------------------------------------------------}
  628. procedure TMMBitmapListEditor.menSaveBMPClick(Sender: TObject);
  629. begin
  630.    if PicSaveDialog.Execute then
  631.    begin
  632.       FBitmapList[ListBox.ItemIndex].SaveToFile(PicSaveDialog.FileName);
  633.    end;
  634. end;
  636. {-- TMMBitmapListEditor -------------------------------------------------------}
  637. procedure TMMBitmapListEditor.btnAddClick(Sender: TObject);
  638. begin
  639.    PicOpenDialog.Options := PicOpenDialog.Options - [ofAllowMultiSelect];
  640.    if PicOpenDialog.Execute then
  641.    begin
  642.       FBitmapList.AddFromFile(PicOpenDialog.FileName);
  643.    end;
  644. end;
  646. {-- TMMBitmapListEditor -------------------------------------------------------}
  647. procedure TMMBitmapListEditor.btnAddMultiClick(Sender: TObject);
  648. var
  649.    i: integer;
  650. begin
  651.    PicOpenDialog.Options := PicOpenDialog.Options + [ofAllowMultiSelect];
  652.    if PicOpenDialog.Execute then
  653.    begin
  654.       ListBox.Items.BeginUpdate;
  655.       try
  656.          for i := 0 to PicOpenDialog.Files.Count-1 do
  657.              FBitmapList.AddFromFile(PicOpenDialog.Files[i]);
  658.       finally
  659.          ListBox.Items.EndUpdate;
  660.       end;
  661.    end;
  662. end;
  664. {-- TMMBitmapListEditor -------------------------------------------------------}
  665. procedure TMMBitmapListEditor.btnClearClick(Sender: TObject);
  666. begin
  667.    FBitmapList.Clear;
  668. end;
  670. {-- TMMBitmapListEditor -------------------------------------------------------}
  671. procedure TMMBitmapListEditor.btnDeleteClick(Sender: TObject);
  672. begin
  673.    if btnDelete.Enabled then
  674.    begin
  675.       FBitmapList.Delete(ListBox.ItemIndex);
  676.       UpdateBitmapIDs(ListBox.ItemIndex,umDelete);
  677.    end;
  678. end;
  680. {-- TMMBitmapListEditor -------------------------------------------------------}
  681. procedure TMMBitmapListEditor.btnUpClick(Sender: TObject);
  682. begin
  683.    if (ListBox.ItemIndex > 0) then
  684.    begin
  685.       FBitmapList.Move(ListBox.ItemIndex,ListBox.ItemIndex-1);
  686.       UpdateBitmapIDs(ListBox.ItemIndex,umUp);
  687.       ListBox.ItemIndex := ListBox.ItemIndex-1;
  688.    end
  689.    else ButtonTimer.Enabled := False;
  690. end;
  692. {-- TMMBitmapListEditor -------------------------------------------------------}
  693. procedure TMMBitmapListEditor.btnDownClick(Sender: TObject);
  694. begin
  695.    if (ListBox.ItemIndex < ListBox.Items.Count-1) then
  696.    begin
  697.       FBitmapList.Move(ListBox.ItemIndex,ListBox.ItemIndex+1);
  698.       UpdateBitmapIDs(ListBox.ItemIndex,umDown);
  699.       ListBox.ItemIndex := ListBox.ItemIndex+1;
  700.    end
  701.    else ButtonTimer.Enabled := False;
  702. end;
  704. {-- TMMBitmapListEditor -------------------------------------------------------}
  705. procedure TMMBitmapListEditor.btnCutClick(Sender: TObject);
  706. begin
  707.    btnCopyClick(nil);
  708.    btnDeleteClick(nil);
  709. end;
  711. {-- TMMBitmapListEditor -------------------------------------------------------}
  712. procedure TMMBitmapListEditor.btnCopyClick(Sender: TObject);
  713. begin
  714.    Clipboard.Assign(FBitmapList.Items[ListBox.ItemIndex]);
  715. end;
  717. {-- TMMBitmapListEditor -------------------------------------------------------}
  718. procedure TMMBitmapListEditor.btnPasteClick(Sender: TObject);
  719. var
  720.    BMP: TBitmap;
  721.    idx: integer;
  722. begin
  723.    BMP := TBitmap.Create;
  724.    try
  725.       idx := ListBox.ItemIndex;
  726.       BMP.Assign(Clipboard);
  727.       FBitmapList.Insert(idx,BMP)
  728.    finally
  729.       BMP.Free;
  730.    end;
  731. end;
  733. {-- TMMBitmapListEditor -------------------------------------------------------}
  734. procedure TMMBitmapListEditor.btnReplaceClick(Sender: TObject);
  735. var
  736.    BMP: TBitmap;
  737.    idx: integer;
  738. begin
  739.    BMP := TBitmap.Create;
  740.    try
  741.       idx := ListBox.ItemIndex;
  742.       BMP.Assign(Clipboard);
  743.       FBitmapList.Delete(idx);
  744.       FBitmapList.Insert(idx,BMP)
  745.    finally
  746.       BMP.Free;
  747.    end;
  748. end;
  750. {-- TMMBitmapListEditor -------------------------------------------------------}
  751. procedure TMMBitmapListEditor.ListBoxDblClick(Sender: TObject);
  752. var
  753.    Form: TForm;
  754.    Panel: TPanel;
  755.    Image: TImage;
  756. begin
  757.    Panel := nil;
  758.    Image := nil;
  759.    Form  := TForm.Create(Self);
  760.    with Form do
  761.    try
  762.       BorderStyle   := bsSizeToolWin;
  763.       Caption       := 'Preview';
  764.       Position      := poScreenCenter;
  765.       PixelsPerInch := 96;
  766.       ClientWidth   := FBitmapList.Items[ListBox.ItemIndex].Width+10;
  767.       ClientHeight  := FBitmapList.Items[ListBox.ItemIndex].Height+10;
  768.       OnKeyPress    := PreviewKeyPress;
  769.       Panel := TPanel.Create(Form);
  770.       Panel.Parent      := Form;
  771.       Panel.Align       := alClient;
  772.       Panel.BevelOuter  := bvNone;
  773.       Panel.BorderWidth := 5;
  774.       Panel.Color       := clWindow;
  775.       Image := TImage.Create(Panel);
  776.       Image.Parent         := Panel;
  777.       Image.Align          := alClient;
  778.       Image.AutoSize       := True;
  779.       Image.Center         := True;
  780.       Image.Stretch        := True;
  781.       Image.Picture.Bitmap := FBitmapList.Items[ListBox.ItemIndex];
  783.       ShowModal;
  785.    finally
  786.       Image.Free;
  787.       Panel.Free;
  788.       Form.Free;
  789.    end;
  790. end;
  792. {-- TMMBitmapListEditor -------------------------------------------------------}
  793. procedure TMMBitmapListEditor.PreviewKeyPress(Sender: TObject; var Key: Char);
  794. begin
  795.   if Key = #27 then TForm(Sender).Close;
  796. end;
  798. {-- TMMBitmapListEditor -------------------------------------------------------}
  799. procedure TMMBitmapListEditor.WMSizing(var Msg: TWMSizing);
  801.    function CalcMaxItems(aHeight: integer): integer;
  802.    begin
  803.       // liefert die f黵 aHeight maximal m鰃lichen Tracks
  804.       Result := Max((aHeight-NonClientHeight-MenuHeight-ClientPanel.Top-ListHeader.Height-2) div ListBox.ItemHeight,1);
  805.    end;
  807.    function CalcClientHeight(NumItems: integer): integer;
  808.    begin
  809.       // liefert die ben鰐igte ClientH鰄e f黵 NumTracks
  810.       Result := ((NumItems*ListBox.ItemHeight)+NonClientHeight+MenuHeight+ClientPanel.Top+ListHeader.Height+2);
  811.    end;
  813. begin
  814.    // The WM_SIZING message is sent to a window that the user is resizing.
  815.    // By processing this message, an application can monitor the size and
  816.    // position of the drag rectangle and, if needed, change its size or
  817.    // position.
  819.    with Msg.lpRect^ do
  820.    case Msg.fwSide of
  821.       WMSZ_BOTTOM,              // Bottom edge
  822.       WMSZ_BOTTOMLEFT,         // Bottom-left corner
  823.       WMSZ_BOTTOMRIGHT:         // Bottom-right corner
  824.         Bottom := Top + CalcClientHeight(CalcMaxItems(Bottom-Top));
  826.       WMSZ_TOP,                 // Top edge
  827.       WMSZ_TOPLEFT,             // Top-left corner
  828.       WMSZ_TOPRIGHT:         // Top-right corner
  829.         Top := Bottom - CalcClientHeight(CalcMaxItems(Bottom-Top));
  830.    end;
  831.    Msg.Result := 1;       // Tell windows you have changed sizing
  833.    inherited;
  834. end;
  836. {-- TMMBitmapListEditor -------------------------------------------------------}
  837. procedure TMMBitmapListEditor.WMGetMinMaxInfo(Var Msg: TWMGetMinMaxInfo);
  838. begin
  839.    // Steuert die Maximal und Minimal H鰄e/Breite des Formulars
  840.    if not (csLoading in ComponentState) then
  841.    with Msg.MinMaxInfo^ do
  842.    begin
  843.       // Minimum width
  844.       ptMinTrackSize.X := 290;
  845.    end;
  846.    Msg.Result := 0;       // Tell windows you have changed minmaxinfo
  848.    inherited;
  849. end;
  851. {-- TMMBitmapListEditor -------------------------------------------------------}
  852. procedure TMMBitmapListEditor.FormResize(Sender: TObject);
  853. begin
  854.    ListBox.Invalidate;
  855. end;
  857. {-- TMMBitmapListEditor -------------------------------------------------------}
  858. procedure TMMBitmapListEditor.FormMouseMove(Sender: TObject;  Shift: TShiftState; X, Y: Integer);
  859. begin
  860.    if (ListBox.ItemIndex <= 0) then
  861.    begin
  862.       btnPaste.Enabled  := Clipboard.HasFormat(CF_BITMAP);
  863.       menPaste.Enabled  := btnPaste.Enabled;
  864.       btnReplace.Enabled:= btnPaste.Enabled and (ListBox.ItemIndex >= 0) and (ListBox.Items.Count > 0);
  865.       menReplace.Enabled:= btnReplace.Enabled;
  866.    end;
  867. end;
  869. {-- TMMBitmapListEditor -------------------------------------------------------}
  870. procedure TMMBitmapListEditor.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  871. begin
  872.    if (Key = VK_DELETE) then btnDeleteClick(nil);
  873. end;
  875. {-- TMMBitmapListEditor -------------------------------------------------------}
  876. procedure TMMBitmapListEditor.ButtonTimerTimer(Sender: TObject);
  877. begin
  878.    ButtonTimer.Interval := 50;
  879.    TMMBitmapButton(ButtonTimer.Tag).OnClick(nil);
  880. end;
  882. {-- TMMBitmapListEditor -------------------------------------------------------}
  883. procedure TMMBitmapListEditor.btnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  884. begin
  885.    ButtonTimer.Tag := integer(Sender);
  886.    ButtonTimer.Interval := 400;
  887.    ButtonTimer.Enabled := True;
  888. end;
  890. {-- TMMBitmapListEditor -------------------------------------------------------}
  891. procedure TMMBitmapListEditor.btnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  892. begin
  893.    ButtonTimer.Enabled := False;
  894. end;
  896. end.