fthbtns.pas

Gestione Cellulari Nokia

  end;
end;

procedure TFourthStandardButtonOptions.SetLevel3Color(Value: TColor);
begin
  if FLevel3Color <> Value then
  begin
    FLevel3Color := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetTransparent(Value: Boolean);
begin
  if FTransparent <> Value then
  begin
    FTransparent := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetSeparatorStyle(Value: TFourthStandardButtonSeparatorStyle);
begin
  if FSeparatorStyle <> Value then
  begin
    FSeparatorStyle := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.SetVertLineColor(Value: TColor);
begin
  if FVertLineColor <> Value then
  begin
    FVertLineColor := Value;
    if Assigned(FOnChange) then FOnChange(Self);
  end;
end;

procedure TFourthStandardButtonOptions.FontChanged(Sender: TObject);
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

{ TFourthStandardButton }

constructor TFourthStandardButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csSetCaption, csCaptureMouse, csOpaque,
    csClickEvents, csReplicatable {$IFDEF FCL_D4}, csActionClient{$ENDIF}];
  FModalResult := mrNone;
  FMouseInControl := False;
  FOldCursor := Cursor;
  FOptions := TFourthStandardButtonOptions.Create;
  FOptions.OnChange := OptionsChange;
  Width := 73;
  Height := 20;
end;

destructor TFourthStandardButton.Destroy;
begin
  FOptions.Free;
  inherited Destroy;
end;

procedure TFourthStandardButton.SetCaption(Value: TCaption);
begin
  if FCaption <> Value then
  begin
    FCaption := Value;
    Invalidate;
  end;
end;

procedure TFourthStandardButton.Paint;
const
  DrawFlags: array[TAlignment] of Integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
  PaintRect: TRect;
  FLineHeight, FMarginTop, FMarginBottom: Integer;
begin
  if (not Enabled) then
  begin
    FState := bsDisabled;
    FDragging := False;
  end else
    if (FState = bsDisabled) then
      FState := bsUp;

  PaintRect := Rect(0, 0, Width, Height);
  if not FMouseInControl then
  begin
    if not FOptions.Transparent then
    begin
      Canvas.Brush.Color := FOptions.BackgroundColor;
      Canvas.Brush.Style := bsSolid;
      Canvas.FillRect(PaintRect);
    end else
    begin
      Canvas.Brush.Color := clNone;
      Canvas.Brush.Style := bsClear;
      Canvas.FillRect(PaintRect);
    end;

    FLineHeight := Canvas.TextHeight('QqWwEeRrTtYyUuIiOoPp[{AaSsDdFfGgHhJjKkLlZzXxCcVvBbNnMm');
    FMarginTop := (PaintRect.Bottom - FLineHeight) div 2;
    FMarginBottom := (PaintRect.Bottom - FLineHeight) mod 2;
    if FMarginBottom = 0 then
      FMarginBottom := FMarginTop else
      Inc(FMarginBottom, FMarginTop-1);
    Inc(FMarginTop, 1);

    if FOptions.FSeparatorStyle = ssVertLines then
    begin
      if FOptions.DrawLeftLine then
      begin
        Canvas.Pen.Color := FOptions.VertLineColor;
        Canvas.MoveTo(PaintRect.Left, PaintRect.Top + FMarginTop);
        Canvas.LineTo(PaintRect.Left, PaintRect.Bottom - FMarginBottom);
      end;

      if FOptions.DrawRightLine then
      begin
        Canvas.Pen.Color := FOptions.VertLineColor;
        Canvas.MoveTo(PaintRect.Right-1, PaintRect.Top + FMarginTop);
        Canvas.LineTo(PaintRect.Right-1, PaintRect.Bottom - FMarginBottom);
      end;
    end else
    begin
      Canvas.Pen.Color := FOptions.VertLineColor;
      Canvas.MoveTo(PaintRect.Left, PaintRect.Top);
      Canvas.LineTo(PaintRect.Left, PaintRect.Bottom);

      Canvas.MoveTo(PaintRect.Left, PaintRect.Bottom-1);
      Canvas.LineTo(PaintRect.Right-1, PaintRect.Bottom-1);

      Canvas.MoveTo(PaintRect.Right-1, PaintRect.Bottom-1);
      Canvas.LineTo(PaintRect.Right-1, PaintRect.Top);

      Canvas.MoveTo(PaintRect.Right-1, PaintRect.Top);
      Canvas.LineTo(PaintRect.Left, PaintRect.Top);
    end;

    if FState in [bsDisabled] then
      Canvas.Font.Assign(FOptions.DisabledFont) else
      Canvas.Font.Assign(FOptions.Font);
    InflateRect(PaintRect, -6, -2);
  end else
  begin
    if FState in [bsDisabled] then Exit;
    Canvas.Font.Assign(FOptions.HotTrackFont);
    Canvas.Brush.Color := FOptions.Level3Color;
    Canvas.FillRect(PaintRect);
    if (FState in [bsDown]) then
    begin
      Frame3D(Canvas, PaintRect, FOptions.Level1ShadowColor, FOptions.Level2LightColor, 1);
      Frame3D(Canvas, PaintRect, FOptions.Level2ShadowColor, FOptions.Level1LightColor, 1);
    end else
    begin
      Frame3D(Canvas, PaintRect, FOptions.Level1LightColor, FOptions.Level1ShadowColor, 1);
      Frame3D(Canvas, PaintRect, FOptions.Level2LightColor, FOptions.Level2ShadowColor, 1);
    end;
    InflateRect(PaintRect, -4, 0);
  end;
  SetBkMode(Canvas.Handle, TRANSPARENT);
  if FState in [bsDown] then
  begin
    Inc(PaintRect.Left, 2);
    Inc(PaintRect.Top, 2);
    Inc(PaintRect.Right, 2);
    Inc(PaintRect.Bottom, 2);
  end;
  DrawText(Canvas.Handle, PChar(FCaption), -1, PaintRect,
    DT_SINGLELINE or DrawFlags[FOptions.Alignment] or DT_VCENTER or DT_END_ELLIPSIS);
end;

procedure TFourthStandardButton.Loaded;
begin
  inherited Loaded;
  if Enabled then
    FState := bsUp else
    FState := bsDisabled;
end;

procedure TFourthStandardButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and Enabled then
  begin
    FState := bsDown;
    Invalidate;
  end;
  FDragging := True;
end;

procedure TFourthStandardButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewState: TFourthStandardButtonState;
begin
  inherited MouseMove(Shift, X, Y);
  if FDragging then
  begin
    NewState := bsUp;
    if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
    NewState := bsDown;
    if NewState <> FState then
    begin
      FState := NewState;
      Invalidate;
    end;
  end;
end;

procedure TFourthStandardButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  DoClick: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  FState := bsUp;
  Invalidate;
  if FDragging then
  begin
    FDragging := False;
    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
    if DoClick then
    begin
      Repaint;
      Click;
    end;
  end;
end;

procedure TFourthStandardButton.CMEnabledChanged(var Message: TMessage);
begin
  if not Enabled then FState := bsDisabled;
  Repaint;
end;

procedure TFourthStandardButton.CMSysColorChange(var Message: TMessage);
begin
  Invalidate;
end;

procedure TFourthStandardButton.CMButtonPressed(var Message: TMessage);
begin
  Invalidate;
end;

procedure TFourthStandardButton.Click;
begin
  inherited;
  if FDropMenu <> nil then
  begin
    FDropMenu.Popup(GetClientOrigin.x, GetClientOrigin.y + Self.Height);
    Perform(CM_MOUSELEAVE, 0, 0);
  end;
end;

procedure TFourthStandardButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TFourthStandardButton.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTALLKEYS;
end;

procedure TFourthStandardButton.CMMouseEnter(var Message:TMessage);
begin
  if not FMouseInControl then
  begin
    FOldCursor := Cursor;
    Cursor := FOptions.HotTrackCursor;
    FMouseInControl := True;
    Invalidate;
  end;
  if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;

procedure TFourthStandardButton.CMMouseLeave(var Message: TMessage);
begin
  if FMouseInControl then
  begin
    Cursor := FOldCursor;
    FMouseInControl := False;
    Invalidate;
  end;
  if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;

procedure TFourthStandardButton.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  if FOptions.Transparent then
    Message.Result := 0 else
    Message.Result := 1;
end;

procedure TFourthStandardButton.OptionsChange(Sender: TObject);
begin
  Invalidate;
end;

end.