mmswitch.pas

一套及时通讯的原码

begin
   inherited;

   AdjustBounds;
end;
{$ENDIF}

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.SetKind(aValue: TMMSwitchKind);
begin
   if (aValue <> FKind) then
   begin
      FKind := aValue;
      if FStandardBit then LoadNewResource
      else AdjustBounds;
      Invalidate;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK1}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.SetNumPositions(aValue: integer);
begin
   if (aValue <> FNumPositions) and (aValue > 1) then
   begin
      FNumPositions := aValue;
      FPosition := Min(FPosition, FNumPositions-1);
      AdjustBounds;
   end;
   {$IFDEF WIN32}
   {$IFDEF TRIAL}
   {$DEFINE _HACK2}
   {$I MMHACK.INC}
   {$ENDIF}
   {$ENDIF}
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.SetPosition(aValue: integer);
begin
   aValue := MinMax(aValue, 0, FNumPositions-1);
   if aValue <> FPosition then
   begin
      FPosition := aValue;
      Change;
      if (csDesigning in ComponentState) then
          Invalidate
      else if Enabled then DrawSwitch;
   end
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.KeyDown(var Key: Word; Shift: TShiftState);
begin
   inherited KeyDown(Key, Shift);

   case Key of
     VK_END  : Position := FNumPositions-1;
     VK_HOME : Position := 0;
     VK_UP   : if FKind = skVertical then Position := Position -1;
     VK_DOWN : if FKind = skVertical then Position := Position + 1;
     VK_LEFT : if FKind = skHorizontal then Position := Position - 1;
     VK_RIGHT: if FKind = skHorizontal then Position := Position + 1;
   end;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
   Message.Result := DLGC_WANTARROWS;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   inherited MouseDown(Button, Shift, X, Y);

   if (Button = mbLeft) and Enabled then
   begin
      SetFocus;
      if PtInRect(FSwitchRect, Point(X, Y)) then
      begin
         FCapture := True;
         FCapturePoint := Point(X, Y);
         FCaptureValue := FPosition;
         Invalidate;
      end
      else
      begin
         if FKind = skVertical then
            Position := (Y - BevelExtend) div FGlyph.Height
         else
            Position := (X - BevelExtend) div (FGlyph.Width div FNumGlyphs);
      end;
   end;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   inherited MouseUp(Button, Shift, X, Y);

   if (Button = mbLeft) and FCapture then
   begin
      FCapture := False;
      Invalidate;
   end;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
   inherited MouseMove(Shift, X, Y);

   if FCapture then
   begin
      if FKind = skVertical then
         Position := FCaptureValue+FNumPositions*(Y-FCapturePoint.Y)div(Height-2*BevelExtend-FGlyph.Height)
      else
         Position := FCaptureValue+FNumPositions*(X-FCapturePoint.X)div(Width-2*BevelExtend-FGlyph.Width div FNumGlyphs);
   end;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.SetBounds(aLeft, aTop, aWidth, aHeight: Integer);
var
  W, H: Integer;

begin
   W := aWidth;
   H := aHeight;
   AdjustSize (W, H);
   inherited SetBounds(aLeft, aTop, W, H);
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.AdjustSize(var W, H: Integer);
begin
   if (csLoading in ComponentState) then Exit;

   if FKind = skVertical then
   begin
      W := FGlyph.Width div FNumGlyphs;
      H := FNumPositions * FGlyph.Height;
   end
   else
   begin
      W := FNumPositions * FGlyph.Width div FNumGlyphs;
      H := FGlyph.Height;
   end;
   inc(H,2*BevelExtend);
   inc(W,2*BevelExtend);
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.AdjustBounds;
var
  W, H: Integer;

begin
   W := Width;
   H := Height;
   AdjustSize(W, H);
   if (W <> Width) or (H <> Height) then
   begin
      FSwitchRect.Left := -1;
      inherited SetBounds(Left, Top, W, H);
   end
   else Invalidate;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.Changed;
begin
   AdjustBounds;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.Loaded;
begin
   inherited Loaded;
   AdjustBounds;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.DrawSwitch;
var
   SrcRect: TRect;

begin
   if Visible then
   with Canvas do
   begin
      Brush.Color := Color;
      { clear the old switch }
      if FSwitchRect.Left <> -1 then FillRect(FSwitchRect);

      if FKind = skVertical then
      begin
         FSwitchRect.Left := BevelExtend;
         FSwitchRect.Top := BevelExtend + FPosition * FGlyph.Height;
         FSwitchRect.Right := FSwitchRect.Left + FGlyph.Width div FNumGlyphs;
         FSwitchRect.Bottom := FSwitchRect.Top + FGlyph.Height;
      end
      else
      begin
         FSwitchRect.Left := BevelExtend + FPosition * FGlyph.Width div FNumGlyphs;
         FSwitchRect.Top := BevelExtend;
         FSwitchRect.Right := FSwitchRect.Left + FGlyph.Width div FNumGlyphs;
         FSwitchRect.Bottom := FSwitchRect.Top + FGlyph.Height;
      end;

      SrcRect := Rect(0,0,FGlyph.Width div FNumGlyphs,FGlyph.Height);
      if Not Enabled and (FNumGlyphs > 1) then
         OffsetRect(SrcRect, FGlyph.Width div FNumGlyphs, 0);
      if FCapture and (FNumGlyphs > 2) then
         OffsetRect(SrcRect, 2 * FGlyph.Width div FNumGlyphs, 0);

      { draw the new switch and change the backcolors }
      BrushCopy(FSwitchRect, FGlyph, SrcRect, FGlyph.Canvas.Pixels[0,0]);

      { draw the focus }
      if Focused then
      begin
         Pen.Color := clBlack;
         Brush.Style := bsClear;
         with BeveledRect do Rectangle(Left,Top,Right,Bottom);
      end;
   end;
end;

{-- TMMSwitch ------------------------------------------------------------}
procedure TMMSwitch.Paint;
begin
    { Draw the bevel }
    inherited Paint;
    DrawSwitch;
end;

end.