Delphi控件源码

开发平台：
Delphi

MMCCon.pas：源码内容
							{========================================================================}
{=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
{========================================================================}
{=                          All Rights Reserved                         =}
{========================================================================}
{=  D 01099 Dresden             = Fax.: +49 (0)351-8037944              =}
{=  Loewenstr.7a                = info@swiftsoft.de                     =}
{========================================================================}
{=  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: 13.08.98 - 20:52:39 $                                        =}
{========================================================================}
unit MMCCon;
{$I COMPILER.INC}
interface
uses
{$IFDEF WIN32}
    Windows,
{$ELSE}
    WinTypes,
    WinProcs,
{$ENDIF}
    Forms,
    Messages,
    Classes,
    SysUtils,
    StdCtrls,
    ExtCtrls,
    Controls,
    MMObj,
    MMUtils,
    MMMath,
    MMLevel
    {$IFNDEF LEVEL_ONLY}
    ,MMMeter
    {$ENDIF}
    ;
const
    {$IFDEF CBUILDER3} {$EXTERNALSYM defInterval} {$ENDIF}
    defInterval = 25;
type
    EMMLevelConnectorError = class(Exception);
    TMMCurrentValue     = array[TMMChannel] of LongInt;
    {-- TMMCustomLevelConnector -----------------------------------------}
    TMMCustomLevelConnector = class(TMMNonVisualComponent)
    private
        FTimerID    : Longint;
        FInterval   : Integer;
        FLevel1     : TMMCustomLevel;
        FLevel2     : TMMCustomLevel;
        {$IFNDEF LEVEL_ONLY}
        FMeter1     : TMMCustomMeter;
        FMeter2     : TMMCustomMeter;
        {$ENDIF}
        FAuto       : Boolean;
        FEnabled    : Boolean;
        FMessageDone: Boolean;
        FOnTrigger  : TNotifyEvent;
        procedure SetLevel(Index: Integer; Value: TMMCustomLevel);
        {$IFNDEF LEVEL_ONLY}
        procedure SetMeter(Index: Integer; Value: TMMCustomMeter);
        {$ENDIF}
        procedure SetAuto(Value: Boolean);
        procedure SetInterval(Value: Integer);
        procedure SetEnabled(Value: Boolean);
    protected
        FPrev       : TMMCurrentValue;
        FPrevValid  : Boolean;
        procedure Loaded; override;
        procedure SetupConnector; virtual;
        procedure UpdateValue; virtual;
        procedure UpdateControl; virtual;
        procedure GetLevelValues(var LeftValue, RightValue,BothValue: integer); virtual;
        procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    public
        constructor Create(AOwner: TComponent); override;
        destructor  Destroy; override;
        procedure   ChangeDesigning(aValue: Boolean); override;
        procedure   Trigger; virtual;
    protected
        property OnTrigger: TNotifyEvent read FOnTrigger write FOnTrigger;
        property Level1: TMMCustomLevel index 1 read FLevel1 write SetLevel;
        property Level2: TMMCustomLevel index 2 read FLevel2 write SetLevel;
        {$IFNDEF LEVEL_ONLY}
        property Meter1: TMMCustomMeter index 1 read FMeter1 write SetMeter;
        property Meter2: TMMCustomMeter index 2 read FMeter2 write SetMeter;
        {$ENDIF}
        property AutoTrigger: Boolean  read FAuto write SetAuto default True;
        property Interval: Integer  read FInterval write SetInterval default defInterval;
        property Enabled: Boolean read FEnabled write SetEnabled default True;
    end;
implementation
uses MMTimer;
var
   ConnectorWindow: HWND    = 0;
   ConnectorCount : Integer = 0;
   Connectors     : TList   = nil;
{------------------------------------------------------------------------------}
procedure TimeCallBack(uTimerID, dwUser: Longint); export;
begin
   { D3: Rely on MMTimer unit }
   if (dwUser <> 0) then
   with TMMCustomLevelConnector(dwUser) do
   begin
      if Enabled and not (csDestroying in ComponentState) then
      begin
         if FMessageDone then
         begin
            FMessageDone := False;
            PostMessage(ConnectorWindow,MM_TIMER,0,dwUser);
         end;
      end;
   end;
end;
{------------------------------------------------------------------------------}
function TimerWndProc(Window: HWND; Message, wParam: UINT; lParam: Longint): Longint;
export;{$IFDEF WIN32}stdcall;{$ENDIF}
begin
   Result := 0;
   try
      if (Message = MM_TIMER) and (lParam <> 0) then
      begin
         with TMMCustomLevelConnector(lParam) do
         begin
            if (Connectors <> nil) and (Connectors.IndexOf(Pointer(lParam)) <> -1) then
                Trigger;
            FMessageDone := True;
         end;
         Exit;
      end;
      Result := DefWindowProc(Window, Message, wParam, lParam);
   except
      Application.HandleException(nil);
   end;
end;
const
  TMMLevelConnectorWindowClass: TWndClass = (
    style: 0;
    lpfnWndProc: @TimerWndProc;
    cbClsExtra: 0;
    cbWndExtra: 0;
    hInstance: 0;
    hIcon: 0;
    hCursor: 0;
    hbrBackground: 0;
    lpszMenuName: nil;
    lpszClassName: 'TMMLevelConnectorWindow');
{------------------------------------------------------------------------------}
function AllocateConnectorWindow: HWND;
var
   TempClass: TWndClass;
   ClassRegistered: Boolean;
begin
   TMMLevelConnectorWindowClass.hInstance := HInstance;
   ClassRegistered := GetClassInfo(HInstance,
                      TMMLevelConnectorWindowClass.lpszClassName, TempClass);
    if not ClassRegistered or (TempClass.lpfnWndProc <> @TimerWndProc) then
    begin
       if ClassRegistered then
          Windows.UnregisterClass(TMMLevelConnectorWindowClass.lpszClassName, HInstance);
       Windows.RegisterClass(TMMLevelConnectorWindowClass);
    end;
    Result := CreateWindow(TMMLevelConnectorWindowClass.lpszClassName, '', 0,
                           0, 0, 0, 0, 0, 0, HInstance, nil);
end;
{------------------------------------------------------------------------------}
procedure AddConnector(C: TMMCustomLevelConnector);
begin
   if ConnectorCount = 0 then
   begin
      ConnectorWindow := AllocateConnectorWindow;
      Connectors      := TList.Create;
   end;
   Connectors.Add(C);
   inc(ConnectorCount);
end;
{------------------------------------------------------------------------------}
procedure RemoveConnector(C: TMMCustomLevelConnector);
begin
   Connectors.Remove(C);
   dec(ConnectorCount);
   if ConnectorCount = 0 then
   begin
      DestroyWindow(ConnectorWindow);
      Connectors.Free;
      Connectors := nil;
   end;
end;
{== TMMCustomLevelConnector ===================================================}
constructor TMMCustomLevelConnector.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   FInterval    := defInterval;
   FEnabled     := True;
   FMessageDone := True;
   FAuto        := True;
   AddConnector(Self);
   if not (csDesigning in ComponentState) then
   begin
      { create the timer }
      FTimerID:= MMTimeSetEvent(FInterval, not FAuto, TimeCallBack, Longint(Self));
   end;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
destructor TMMCustomLevelConnector.Destroy;
var
   Msg: TMsg;
begin
    if (FTimerID <> 0) then
    begin
       { destroy the timer }
       MMTimeKillEvent(FTimerID);
       { remove pending messages }
       while PeekMessage(Msg, ConnectorWindow, MM_TIMER, MM_TIMER, PM_REMOVE) do;
    end;
    RemoveConnector(Self);
    inherited Destroy;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.ChangeDesigning(aValue: Boolean);
begin
   inherited;
   if not (csDesigning in ComponentState) then
   begin
      { create the timer }
      FTimerID:= MMTimeSetEvent(FInterval, not FAuto, TimeCallBack, Longint(Self));
   end;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.SetEnabled(Value: Boolean);
begin
   if FEnabled <> Value then
   begin
      FEnabled:= Value;
      UpdateControl;
   end;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.SetupConnector;
begin
   { must be overwritten }
   FPrevValid:= False;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.Loaded;
begin
   inherited Loaded;
   UpdateControl;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.Notification(AComponent: TComponent; Operation: TOperation);
begin
   inherited Notification(AComponent,Operation);
   if Operation = opRemove then
      if AComponent = Level1 then
         Level1 := nil
      else if AComponent = Level2 then
         Level2 := nil
      {$IFNDEF LEVEL_ONLY}
      else if AComponent = Meter1 then
         Meter1 := nil
      else if AComponent = Meter2 then
         Meter2 := nil
      {$ENDIF}
      ;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.UpdateValue;
begin
   if not FAuto then Trigger;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.UpdateControl;
begin
   if Assigned(FLevel1) then
      TMMLevel(FLevel1).BitLength := b16bit;
   if Assigned(FLevel2) then
      TMMLevel(FLevel2).BitLength := b16bit;
   {$IFNDEF LEVEL_ONLY}
   if Assigned(FMeter1) then
      TMMLevel(FMeter1).BitLength := b16bit;
   if Assigned(FMeter2) then
      TMMLevel(FMeter2).BitLength := b16bit;
   {$ENDIF}
   SetupConnector;
   UpdateValue;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.SetLevel(Index: Integer; Value: TMMCustomLevel);
begin
   if (Longint(Value) = Longint(Self)) then exit;
   case Index of
      1: if (Value = nil) or ((Value <> nil) and (FLevel2 <> Value)) then
             FLevel1:= Value
         else Exit;
      2: if (Value = nil) or ((Value <> nil) and (FLevel1 <> Value)) then
             FLevel2:= Value
         else Exit;
   end;
   if Value <> nil then
      Value.FreeNotification(Self);
   UpdateControl;
end;
{$IFNDEF LEVEL_ONLY}
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.SetMeter(Index: Integer; Value: TMMCustomMeter);
begin
   if (Longint(Value) = Longint(Self)) then exit;
   case Index of
      1: if (Value = nil) or ((Value <> nil) and (FMeter2 <> Value)) then
             FMeter1:= Value
         else Exit;
      2: if (Value = nil) or ((Value <> nil) and (FMeter1 <> Value)) then
             FMeter2:= Value
         else Exit;
   end;
   if Value <> nil then
      Value.FreeNotification(Self);
   UpdateControl;
end;
{$ENDIF}
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.SetAuto(Value: Boolean);
begin
   if Value <> FAuto then
   begin
      FAuto := Value;
      if not (csDesigning in ComponentState) then
      begin
         if FAuto then
            MMTimeResumeEvent(FTimerID)
         else
            MMTimeSuspendEvent(FTimerID)
      end;
   end;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.SetInterval(Value: Integer);
begin
   if Value <= 0 then
      { TODO: Should be resource id }
      raise EMMLevelConnectorError.Create('Interval should be > 0');
   if Value <> FInterval then
   begin
      FInterval:= Value;
      if not (csDesigning in ComponentState) then
         MMTimeSetInterval(FTimerID,FInterval);
   end;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.GetLevelValues(var LeftValue, RightValue, BothValue: integer);
begin
   LeftValue  := 0;
   RightValue := 0;
   BothValue  := 0;
end;
{-- TMMCustomLevelConnector --------------------------------------------}
procedure TMMCustomLevelConnector.Trigger;
var
   LeftValue, RightValue, BothValue: integer;
   procedure SetLevelValue(Level: TMMCustomLevel; Val: Integer);
   begin
      TMMLevel(Level).SetData(Val);
   end;
   {$IFNDEF LEVEL_ONLY}
   procedure SetMeterValue(Meter: TMMCustomMeter; Val: Integer);
   begin
      TMMMeter(Meter).SetData(Val);
   end;
   {$ENDIF}
begin
   if not (csLoading in ComponentState) and
      not (csReading in ComponentState) then
   begin
      GetLevelValues(LeftValue, RightValue, BothValue);
      if assigned(FLevel1) then
         if assigned(FLevel2) then
            SetLevelValue(FLevel1, LeftValue)
         else
            SetLevelValue(Level1, BothValue);
      if assigned(FLevel2) then SetLevelValue(FLevel2, RightValue);
      {$IFNDEF LEVEL_ONLY}
      if assigned(FMeter1) then
         if assigned(FMeter2) then
            SetMeterValue(FMeter1, LeftValue)
         else
            SetMeterValue(FMeter1, BothValue);
      if assigned(FMeter2) then SetMeterValue(FMeter2, RightValue);
      {$ENDIF}
      if assigned(FOnTrigger) then FOnTrigger(Self);
   end;
end;
end.

						