mmbmpdlg.pas

一套及时通讯的原码

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.menLoadClick(Sender: TObject);
begin
   if OpenDialog.Execute then
      FBitmapList.LoadFromFile(OpenDialog.FileName);
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.menSaveClick(Sender: TObject);
var
   S: string;
begin
   if SaveDialog.Execute then
   begin
      S := ChangeFileExt(SaveDialog.FileName,'.~bm');
      DeleteFile(S);
      RenameFile(SaveDialog.FileName,S);
      FBitmapList.SaveToFile(SaveDialog.FileName);
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.menAddListClick(Sender: TObject);
begin
   if OpenDialog.Execute then
      FBitmapList.AddListFromFile(OpenDialog.FileName);
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.menSaveBMPClick(Sender: TObject);
begin
   if PicSaveDialog.Execute then
   begin
      FBitmapList[ListBox.ItemIndex].SaveToFile(PicSaveDialog.FileName);
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnAddClick(Sender: TObject);
begin
   PicOpenDialog.Options := PicOpenDialog.Options - [ofAllowMultiSelect];
   if PicOpenDialog.Execute then
   begin
      FBitmapList.AddFromFile(PicOpenDialog.FileName);
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnAddMultiClick(Sender: TObject);
var
   i: integer;
begin
   PicOpenDialog.Options := PicOpenDialog.Options + [ofAllowMultiSelect];
   if PicOpenDialog.Execute then
   begin
      ListBox.Items.BeginUpdate;
      try
         for i := 0 to PicOpenDialog.Files.Count-1 do
             FBitmapList.AddFromFile(PicOpenDialog.Files[i]);
      finally
         ListBox.Items.EndUpdate;
      end;
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnClearClick(Sender: TObject);
begin
   FBitmapList.Clear;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnDeleteClick(Sender: TObject);
begin
   if btnDelete.Enabled then
   begin
      FBitmapList.Delete(ListBox.ItemIndex);
      UpdateBitmapIDs(ListBox.ItemIndex,umDelete);
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnUpClick(Sender: TObject);
begin
   if (ListBox.ItemIndex > 0) then
   begin
      FBitmapList.Move(ListBox.ItemIndex,ListBox.ItemIndex-1);
      UpdateBitmapIDs(ListBox.ItemIndex,umUp);
      ListBox.ItemIndex := ListBox.ItemIndex-1;
   end
   else ButtonTimer.Enabled := False;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnDownClick(Sender: TObject);
begin
   if (ListBox.ItemIndex < ListBox.Items.Count-1) then
   begin
      FBitmapList.Move(ListBox.ItemIndex,ListBox.ItemIndex+1);
      UpdateBitmapIDs(ListBox.ItemIndex,umDown);
      ListBox.ItemIndex := ListBox.ItemIndex+1;
   end
   else ButtonTimer.Enabled := False;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnCutClick(Sender: TObject);
begin
   btnCopyClick(nil);
   btnDeleteClick(nil);
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnCopyClick(Sender: TObject);
begin
   Clipboard.Assign(FBitmapList.Items[ListBox.ItemIndex]);
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnPasteClick(Sender: TObject);
var
   BMP: TBitmap;
   idx: integer;
begin
   BMP := TBitmap.Create;
   try
      idx := ListBox.ItemIndex;
      BMP.Assign(Clipboard);
      FBitmapList.Insert(idx,BMP)
   finally
      BMP.Free;
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnReplaceClick(Sender: TObject);
var
   BMP: TBitmap;
   idx: integer;
begin
   BMP := TBitmap.Create;
   try
      idx := ListBox.ItemIndex;
      BMP.Assign(Clipboard);
      FBitmapList.Delete(idx);
      FBitmapList.Insert(idx,BMP)
   finally
      BMP.Free;
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.ListBoxDblClick(Sender: TObject);
var
   Form: TForm;
   Panel: TPanel;
   Image: TImage;
begin
   Panel := nil;
   Image := nil;
   Form  := TForm.Create(Self);
   with Form do
   try
      BorderStyle   := bsSizeToolWin;
      Caption       := 'Preview';
      Position      := poScreenCenter;
      PixelsPerInch := 96;
      ClientWidth   := FBitmapList.Items[ListBox.ItemIndex].Width+10;
      ClientHeight  := FBitmapList.Items[ListBox.ItemIndex].Height+10;
      OnKeyPress    := PreviewKeyPress;
      Panel := TPanel.Create(Form);
      Panel.Parent      := Form;
      Panel.Align       := alClient;
      Panel.BevelOuter  := bvNone;
      Panel.BorderWidth := 5;
      Panel.Color       := clWindow;
      Image := TImage.Create(Panel);
      Image.Parent         := Panel;
      Image.Align          := alClient;
      Image.AutoSize       := True;
      Image.Center         := True;
      Image.Stretch        := True;
      Image.Picture.Bitmap := FBitmapList.Items[ListBox.ItemIndex];

      ShowModal;

   finally
      Image.Free;
      Panel.Free;
      Form.Free;
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.PreviewKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #27 then TForm(Sender).Close;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.WMSizing(var Msg: TWMSizing);

   function CalcMaxItems(aHeight: integer): integer;
   begin
      // liefert die f黵 aHeight maximal m鰃lichen Tracks
      Result := Max((aHeight-NonClientHeight-MenuHeight-ClientPanel.Top-ListHeader.Height-2) div ListBox.ItemHeight,1);
   end;

   function CalcClientHeight(NumItems: integer): integer;
   begin
      // liefert die ben鰐igte ClientH鰄e f黵 NumTracks
      Result := ((NumItems*ListBox.ItemHeight)+NonClientHeight+MenuHeight+ClientPanel.Top+ListHeader.Height+2);
   end;

begin
   // The WM_SIZING message is sent to a window that the user is resizing.
   // By processing this message, an application can monitor the size and
   // position of the drag rectangle and, if needed, change its size or
   // position.

   with Msg.lpRect^ do
   case Msg.fwSide of
      WMSZ_BOTTOM,     	        // Bottom edge
      WMSZ_BOTTOMLEFT,	        // Bottom-left corner
      WMSZ_BOTTOMRIGHT:	        // Bottom-right corner
        Bottom := Top + CalcClientHeight(CalcMaxItems(Bottom-Top));

      WMSZ_TOP,	                // Top edge
      WMSZ_TOPLEFT,             // Top-left corner
      WMSZ_TOPRIGHT:	        // Top-right corner
        Top := Bottom - CalcClientHeight(CalcMaxItems(Bottom-Top));
   end;
   Msg.Result := 1;       // Tell windows you have changed sizing

   inherited;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.WMGetMinMaxInfo(Var Msg: TWMGetMinMaxInfo);
begin
   // Steuert die Maximal und Minimal H鰄e/Breite des Formulars
   if not (csLoading in ComponentState) then
   with Msg.MinMaxInfo^ do
   begin
      // Minimum width
      ptMinTrackSize.X := 290;
   end;
   Msg.Result := 0;       // Tell windows you have changed minmaxinfo

   inherited;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.FormResize(Sender: TObject);
begin
   ListBox.Invalidate;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.FormMouseMove(Sender: TObject;  Shift: TShiftState; X, Y: Integer);
begin
   if (ListBox.ItemIndex <= 0) then
   begin
      btnPaste.Enabled  := Clipboard.HasFormat(CF_BITMAP);
      menPaste.Enabled  := btnPaste.Enabled;
      btnReplace.Enabled:= btnPaste.Enabled and (ListBox.ItemIndex >= 0) and (ListBox.Items.Count > 0);
      menReplace.Enabled:= btnReplace.Enabled;
   end;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
   if (Key = VK_DELETE) then btnDeleteClick(nil);
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.ButtonTimerTimer(Sender: TObject);
begin
   ButtonTimer.Interval := 50;
   TMMBitmapButton(ButtonTimer.Tag).OnClick(nil);
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   ButtonTimer.Tag := integer(Sender);
   ButtonTimer.Interval := 400;
   ButtonTimer.Enabled := True;
end;

{-- TMMBitmapListEditor -------------------------------------------------------}
procedure TMMBitmapListEditor.btnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   ButtonTimer.Enabled := False;
end;

end.