mmtrnprp.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:42 $                                        =}
{========================================================================}
unit MMTrnPrp;

{$I COMPILER.INC}

interface

uses
{$IFDEF DELPHI6}
  DesignIntf,
  DesignEditors,
  VCLEditors,
{$ELSE}
  DsgnIntf,
{$ENDIF}
  Windows,
  Messages,
  SysUtils,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ExtCtrls,
  MMObj,
  MMUtils,
  MMBmpLst;

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

type
    {-- TMMTransparentForm ----------------------------------------------------}
    TMMTransparentForm = class(TForm)
       Image: TImage;
       procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
                              Shift: TShiftState; X, Y: Integer);

    public
       constructor Create(aOwner: TComponent); override;

    private
       FColor    : TColor;
       ImageScale: integer;
       procedure WMSizing(var Msg: TWMSizing); message WM_SIZING;
    end;

    {-- TMMTransparentColorProperty -------------------------------------------}
    TMMTransparentColorProperty = class(TColorProperty)
    public
       procedure Edit; override;
    end;

var
  MMTransparentForm: TMMTransparentForm;

function ExecuteTransColorEditor(Comp: TMMCustomBitmapListControl; var Clr: TColor): Boolean;

implementation

{$R *.DFM}

{------------------------------------------------------------------------------}
function ExecuteTransColorEditor(Comp: TMMCustomBitmapListControl; var Clr: TColor): Boolean;
begin
   Result := False;
   Clr := crDefault;

   if (Comp <> nil) and Comp.BitmapValid then
   with TMMTransparentForm.Create(Application) do
   try
      Image.Picture.Bitmap := Comp.Bitmap;
      FColor := Comp.TransparentColor;
      ClientWidth  := Comp.Bitmap.Width;
      ClientHeight := Comp.Bitmap.Height;
      if (ShowModal = mrOK) then
      begin
         Result := True;
         Clr := FColor;
      end;

   finally
      Free;
   end;
end;

{== TMMTransparentColorProperty ===============================================}
procedure TMMTransparentColorProperty.Edit;
var
   Clr: TColor;
   Comp: TMMCustomBitmapListControl;

begin
   if (GetComponent(0) is TMMCustomBitmapListControl) then
   begin
      Comp := (GetComponent(0) as TMMCustomBitmapListControl);
      if Comp.BitmapValid then
      begin
         if ExecuteTransColorEditor(Comp, Clr) then
            SetOrdValue(Clr);
      end
      else inherited;
  end;
end;

{== TMMTransparentForm ========================================================}
constructor TMMTransparentForm.Create(aOwner: TComponent);
begin
   inherited Create(aOwner);

   ImageScale := 1;
   Image.Cursor := crsTrans;
end;

{-- TMMTransparentForm --------------------------------------------------------}
procedure TMMTransparentForm.WMSizing(var Msg: TWMSizing);
var
   i: integer;

   function CaptionHeight: integer;
   begin
      Result := GetSystemMetrics(SM_CYSMCAPTION)+2*GetSystemMetrics(SM_CYSIZEFRAME);
   end;

   function CalcMaxHeightItems(aHeight: integer): integer;
   begin
      Result := Max((aHeight-CaptionHeight-1) div Image.Picture.Bitmap.Height,1);
   end;

   function CalcClientHeight(NumItems: integer): integer;
   begin
      Result := ((NumItems*Image.Picture.Bitmap.Height)+CaptionHeight+1);
   end;

   function CalcMaxWidthItems(aWidth: integer): integer;
   begin
      Result := Max((aWidth-2*GetSystemMetrics(SM_CXSIZEFRAME)-1) div Image.Picture.Bitmap.Width,1);
   end;

   function CalcClientWidth(NumItems: integer): integer;
   begin
      Result := ((NumItems*Image.Picture.Bitmap.Width)+2*GetSystemMetrics(SM_CXSIZEFRAME)+1);
   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.
   i := ImageScale;

   with Msg.lpRect^ do
   case Msg.fwSide of
      WMSZ_BOTTOM,     	        // Bottom edge
      WMSZ_BOTTOMLEFT,	        // Bottom-left corner
      WMSZ_BOTTOMRIGHT,	        // Bottom-right corner
      WMSZ_TOP,	                // Top edge
      WMSZ_TOPLEFT,             // Top-left corner
      WMSZ_TOPRIGHT:            // Top-right corner
      begin
         i := CalcMaxHeightItems(Bottom-Top);
         if (Msg.fwSide = WMSZ_BOTTOMLEFT) or (Msg.fwSide = WMSZ_TOPLEFT) then
            Left   := Right - CalcClientWidth(i)
         else
            Right  := Left + CalcClientWidth(i);

         if (Msg.fwSide = WMSZ_TOP) or (Msg.fwSide = WMSZ_TOPLEFT) or (Msg.fwSide = WMSZ_TOPRIGHT) then
             Top := Bottom - CalcClientHeight(i)
         else
             Bottom := Top + CalcClientHeight(i);
      end;

      WMSZ_RIGHT,
      WMSZ_LEFT :
      begin
         i := CalcMaxWidthItems(Right-Left);
         if (Msg.fwSide = WMSZ_LEFT) then
            Left := Right - CalcClientWidth(i)
         else
            Right  := Left + CalcClientWidth(i);

         Bottom := Top + CalcClientHeight(i);
      end;
   end;
   ImageScale := i;

   Msg.Result := 1;       // Tell windows you have changed sizing

   inherited;
end;

{-- TMMTransparentForm --------------------------------------------------------}
procedure TMMTransparentForm.ImageMouseUp(Sender: TObject; Button: TMouseButton;
                                          Shift: TShiftState; X, Y: Integer);
begin
   if PtInRect(Image.ClientRect,Point(X,Y)) then
   begin
      X := X div ImageScale;
      Y := Y div ImageScale;
      FColor := Image.Picture.Bitmap.Canvas.Pixels[X,Y];
      ModalResult := mrOK;
   end;
end;

end.