jvqpanel.pas

East make Tray Icon in delphi

var
  ATextRect: TRect;
  BevelSize: Integer;
  Flags: Longint;
begin
  with ACanvas do
  begin
    if Caption <> '' then
    begin
      SetBkMode(Handle, BkModeTransparent);
      Font := Self.Font;
      ATextRect := GetClientRect;
      InflateRect(ATextRect, -BorderWidth, -BorderWidth);
      BevelSize := 0;
      if BevelOuter <> bvNone then
        Inc(BevelSize, BevelWidth);
      if BevelInner <> bvNone then
        Inc(BevelSize, BevelWidth);
      InflateRect(ATextRect, -BevelSize, -BevelSize);
      Flags := DT_EXPANDTABS or WordWrap[MultiLine] or Alignments[Alignment];
      Flags := DrawTextBiDiModeFlags(Flags);
      //calculate required rectangle size
      DrawText(ACanvas.Handle, Caption, -1, ATextRect, Flags or DT_CALCRECT);
      // adjust the rectangle placement
      OffsetRect(ATextRect, 0, -ATextRect.Top + (Height - (ATextRect.Bottom - ATextRect.Top)) div 2);
      case Alignment of
        taRightJustify:
          OffsetRect(ATextRect, -ATextRect.Left + (Width - (ATextRect.Right - ATextRect.Left) - BorderWidth -
            BevelSize), 0);
        taCenter:
          OffsetRect(ATextRect, -ATextRect.Left + (Width - (ATextRect.Right - ATextRect.Left)) div 2, 0);
      end; 
      if DrawingMask then
        Font.Color := clDontMask
      else 
        if not Enabled then
          Font.Color := clGrayText;
      //draw text
      if Transparent and not IsThemed then
        SetBkMode(ACanvas.Handle, BkModeTransparent);
      DrawText(ACanvas.Handle, Caption, -1, ATextRect, Flags);
    end;
  end;
end;

procedure TJvPanel.ParentColorChanged;
begin
  Invalidate;
  inherited ParentColorChanged;
end;

procedure TJvPanel.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if not MouseOver and (Control = nil) then
  begin
    FOldColor := Color;
    if not Transparent or IsThemed then
    begin
      Color := HotColor;
      MouseTimer.Attach(Self);
    end;
  end;
  inherited MouseEnter(Control);
end;

procedure TJvPanel.MouseLeave(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if MouseOver and (Control = nil) then
  begin
    if not Transparent or IsThemed then
    begin
      Color := FOldColor;
      MouseTimer.Detach(Self);
    end;
  end;
  inherited MouseLeave(Control);
end;

procedure TJvPanel.SetTransparent(const Value: Boolean);
begin
  if Value <> FTransparent then
  begin
    FTransparent := Value;
    if not IsThemed then
    begin  
      Masked := FTransparent;
      if FTransparent then
        ControlStyle := ControlStyle - [csOpaque]
      else
        ControlStyle := ControlStyle + [csOpaque] 
    end;
  end;
end;

procedure TJvPanel.SetFlatBorder(const Value: Boolean);
begin
  if Value <> FFlatBorder then
  begin
    FFlatBorder := Value;
    Invalidate;
  end;
end;

procedure TJvPanel.SetFlatBorderColor(const Value: TColor);
begin
  if Value <> FFlatBorderColor then
  begin
    FFlatBorderColor := Value;
    Invalidate;
  end;
end;

function TJvPanel.DoPaintBackground(Canvas: TCanvas; Param: Integer): Boolean;
begin
  if Transparent and not IsThemed then
    Result := True
  else
    Result := inherited DoPaintBackground(Canvas, Param);
end;

procedure TJvPanel.SetMultiLine(const Value: Boolean);
begin
  if FMultiLine <> Value then
  begin
    FMultiLine := Value;
    Invalidate;
  end;
end;

procedure TJvPanel.TextChanged;
begin
  inherited TextChanged;
  Invalidate;
end;

procedure TJvPanel.Invalidate;
begin
{  if Transparent and Visible and Assigned(Parent) and Parent.HandleAllocated and HandleAllocated then
    RedrawWindow(Parent.Handle, nil, 0, RDW_ERASE or RDW_FRAME or RDW_INTERNALPAINT or
      RDW_INVALIDATE or RDW_ERASENOW or RDW_UPDATENOW or RDW_ALLCHILDREN); }
  inherited Invalidate;
end;

procedure TJvPanel.SetHotColor(const Value: TColor);
begin
  if FHotColor <> Value then
  begin
    FHotColor := Value;
    if not Transparent or IsThemed then
      Invalidate;
  end;
end;

procedure TJvPanel.SetSizeable(const Value: Boolean);
begin
  if FSizeable <> Value then
  begin
    FSizeable := Value; 
    if Value then
      CreateSizeGrip
    else
      FreeAndNil(FGripBmp); 
    Invalidate;
  end;
end;

procedure TJvPanel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin  
  if Sizeable and (Button = mbLeft) and IsInsideGrip(X, Y) then
  begin
    FDragging := True;
    FLastPos := Point(X, Y);
    MouseCapture := True;
    Screen.Cursor := crSizeNWSE;
  end
  else
    if FMovable and QWindows.PtInRect(Rect( 5, 5, Width - 5, Height -5), X, Y) and DoBeforeMove( X, Y ) then
    begin
      FMoving := True;
      FLastPos := Point(X, Y);
      MouseCapture := True;
      Screen.Cursor := crDrag;
    end
    else
      inherited MouseDown(Button, Shift, X, Y); 
end;

procedure TJvPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  R: TRect;
  X1, Y1: Integer;
begin
  if FDragging and Sizeable then
  begin
    R := BoundsRect;
    X1 := R.Right - R.Left + X - FLastPos.X;
    Y1 := R.Bottom - R.Top + Y - FLastPos.Y;
    if (X1 > 1) and (Y1 > 1) then
    begin
      if X1 >= 0 then
        FLastPos.X := X;
      if Y1 >= 0 then
        FLastPos.Y := Y;
      SetBounds(Left, Top, X1, Y1);
      Refresh;
    end;
  end
  else 
  begin 
    if Movable and FMoving then
    begin
      SetBounds(Left + X - FLastPos.X, Top + Y - FLastPos.Y, Width, Height);
      FWasMoved := True;
    end
    else
    begin
      inherited MouseMove(Shift, X, Y);
      if Sizeable and IsInsideGrip(X, Y) then
        Cursor := crSizeNWSE
      else
        Cursor := crDefault;
    end; 
  end;
end;

procedure TJvPanel.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  if FDragging and Sizeable then
  begin
    FDragging := False;
    MouseCapture := False;
    Screen.Cursor := crDefault;
    Refresh;
  end 
  else
  if FMoving and Movable then
  begin
    FMoving := False;
    MouseCapture := False;
    Screen.Cursor := crDefault;
    if FWasMoved then
      DoAfterMove;
    FWasMoved := False;
    Refresh;
  end 
  else
    inherited MouseUp(Button, Shift, X, Y);
end;

procedure TJvPanel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if Transparent and not IsThemed then
    Invalidate;
end;

procedure TJvPanel.Resize;
begin
  if Assigned(FArrangeSettings) then // (asn) 
    if FArrangeSettings.AutoArrange then
      ArrangeControls;
  inherited Resize;
end;

procedure TJvPanel.EnableArrange;
begin
  EnableAlign;
  if FEnableArrangeCount > 0 then
    Dec(FEnableArrangeCount);
end;

procedure TJvPanel.DisableArrange;
begin
  Inc(FEnableArrangeCount);
  DisableAlign;
end;

function TJvPanel.ArrangeEnabled: Boolean;
begin
  Result := FEnableArrangeCount <= 0;
end;

procedure TJvPanel.Loaded;
begin
  inherited Loaded;
  if FArrangeSettings.AutoArrange then
    ArrangeControls;
end;

procedure TJvPanel.AlignControls(AControl: TControl; var Rect: TRect);
begin
  inherited AlignControls(AControl, Rect);
  if FArrangeSettings.AutoArrange then
    ArrangeControls;
end;

function TJvPanel.GetNextControlByTabOrder(ATabOrder: Integer): TWinControl;
var
  I: Integer;
begin
  Result := nil;
  for I := 0 to ControlCount - 1 do
    if Controls[I] is TWinControl then
      if TWinControl(Controls[I]).TabOrder = ATabOrder then
      begin
        Result := TWinControl(Controls[I]);
        Break;
      end;
end;

procedure TJvPanel.ArrangeControls;
var
  AktX, AktY, NewX, NewY, MaxY, NewMaxX: Integer;
  ControlMaxX, ControlMaxY: Integer;
  TmpWidth, TmpHeight: Integer;
  LastTabOrder: Integer;
  CurrControl: TWinControl;
  I: Integer;
  OldHeight, OldWidth: Integer;
begin
  if (not ArrangeEnabled) or FArrangeControlActive or (ControlCount = 0) then
    Exit;
  if [csLoading, csReading] * ComponentState <> [] then
    Exit;
  FArrangeWidth := 0;
  FArrangeHeight := 0;
  FArrangeControlActive := True;
  try
    OldHeight := Height;
    OldWidth := Width;
    TmpHeight := Height;
    TmpWidth := Width;
    AktY := FArrangeSettings.BorderTop;
    AktX := FArrangeSettings.BorderLeft;
    LastTabOrder := -1;
    MaxY := -1;
    if (FArrangeSettings.AutoSize in [asWidth, asBoth]) then
      ControlMaxX := TmpWidth - 2 * FArrangeSettings.BorderLeft
    else
      ControlMaxX := -1;
    if (FArrangeSettings.AutoSize in [asHeight, asBoth]) then
      ControlMaxY := TmpHeight - 2 * FArrangeSettings.BorderTop
    else
      ControlMaxY := -1;

    for I := 0 to ControlCount - 1 do
      if Controls[I] is TWinControl then
      begin
        if Controls[I] is TJvPanel then
          TJvPanel(Controls[I]).ArrangeSettings.Rearrange;
        if (Controls[I].Width + 2 * FArrangeSettings.BorderLeft > TmpWidth) then
          TmpWidth := Controls[I].Width + 2 * FArrangeSettings.BorderLeft;
      end;

    if (TmpWidth > FArrangeSettings.MaxWidth) and (FArrangeSettings.MaxWidth > 0) then
      TmpWidth := FArrangeSettings.MaxWidth ;
    CurrControl := GetNextControlByTabOrder(LastTabOrder+1);
    while Assigned(CurrControl) do
    begin
      LastTabOrder := CurrControl.TabOrder;
      if CurrControl.Visible or
        ((csDesigning in ComponentState) and FArrangeSettings.ShowNotVisibleAtDesignTime) then
      begin
        NewMaxX := AktX + CurrControl.Width + FArrangeSettings.DistanceHorizontal +
          FArrangeSettings.BorderLeft;
        if (((NewMaxX > TmpWidth) and not (FArrangeSettings.AutoSize in [asWidth, asBoth])) or
            ((NewMaxX > FArrangeSettings.MaxWidth) and (FArrangeSettings.MaxWidth > 0))) and
           (AktX > FArrangeSettings.BorderLeft) and // Only Valid if there is one control in the current line
           FArrangeSettings.WrapControls then
        begin
          AktX := FArrangeSettings.BorderLeft;
          AktY := AktY + MaxY + FArrangeSettings.DistanceVertical;
          MaxY := -1;
          NewX := AktX;
          NewY := AktY;
        end
        else
        begin
          NewX := AktX;
          NewY := AktY;
        end;
        AktX := AktX + CurrControl.Width;
        if AktX > ControlMaxX then
          ControlMaxX := AktX;
        AktX := AktX + FArrangeSettings.DistanceHorizontal;
        CurrControl.Left := NewX;
        CurrControl.Top := NewY;
        if CurrControl.Height > MaxY then
          MaxY := CurrControl.Height;
        ControlMaxY := AktY + MaxY;
      end;
      CurrControl := GetNextControlByTabOrder(LastTabOrder+1);
    end;

    if not (csLoading in ComponentState) then
    begin
      if (FArrangeSettings.AutoSize in [asWidth, asBoth]) then
        if ControlMaxX >= 0 then
          if (FArrangeSettings.MaxWidth > 0) and (ControlMaxX >= FArrangeSettings.MaxWidth) then
            TmpWidth := FArrangeSettings.MaxWidth
          else
            TmpWidth := ControlMaxX + FArrangeSettings.BorderLeft
        else
          TmpWidth := 0;
      if (FArrangeSettings.AutoSize in [asHeight, asBoth]) then
        if ControlMaxY >= 0 then
          TmpHeight := ControlMaxY + FArrangeSettings.BorderTop
        else
          TmpHeight := 0;
      Width := TmpWidth;
      Height := TmpHeight;
    end;
    FArrangeWidth := ControlMaxX + 2 * FArrangeSettings.BorderLeft;
    FArrangeHeight := ControlMaxY + 2 * FArrangeSettings.BorderTop;
    if (OldWidth <> TmpWidth) or (OldHeight <> Height) then  
      UpdateWindow(GetFocus); 
  finally
    FArrangeControlActive := False;
  end;
end;

procedure TJvPanel.SetWidth(Value: Integer);
var
  Changed: Boolean;
begin
  Changed := inherited Width <> Value;
  inherited Width := Value;
  if Changed then
  begin
    if Assigned(FOnChangedWidth) then
      FOnChangedWidth (Self, Value);
    if Assigned(FOnResizeParent) then
      FOnResizeParent(Self, Left, Top, Value, Height)
    else
    if Parent is TJvPanel then
      TJvPanel(Parent).ArrangeSettings.Rearrange;
  end;
end;

function TJvPanel.GetWidth: Integer;
begin
  Result := inherited Width;
end;

procedure TJvPanel.SetHeight(Value: Integer);
var
  Changed: Boolean;
begin
  Changed := inherited Height <> Value;
  inherited Height := Value;
  if Changed then
  begin
    if Assigned(FOnChangedHeight) then
      FOnChangedHeight (Self, Value);
    if Assigned(FOnResizeParent) then
      FOnResizeParent(Self, Left, Top, Width, Value)
    else
    if Parent is TJvPanel then
      TJvPanel(Parent).ArrangeSettings.Rearrange;
  end;
end;

function TJvPanel.GetHeight: Integer;
begin
  Result := inherited Height;
end;

procedure TJvPanel.SetArrangeSettings(Value: TJvArrangeSettings);
begin
  if (Value <> nil) and (Value <> FArrangeSettings) then
    FArrangeSettings.Assign(Value);
end;


procedure TJvPanel.CreateSizeGrip;
var
  I: Integer;
begin
  FGripBmp := TBitmap.Create;
  FGripBmp.Width := 13; //GetSystemMetrics(SM_CXVSCROLL);
  FGripBmp.Height := 13; //GetSystemMetrics(SM_CXYSCROLL);
  with FGripBmp.Canvas do
  begin
    Brush.Color := clBackground;
    FillRect(Bounds(0, 0, Width, Height));
    Pen.Width := 1;
    for I := 0 to 2 do
    begin
      Pen.Color := clLight;
      MoveTo(3 * I, FGripBmp.Height);
      LineTo(FGripBmp.Width, 3 * I);
      Pen.Color := clDark;
      MoveTo(3 * I + 1, FGripBmp.Height);
      LineTo(FGripBmp.Width, 3 * I + 1);
//      Pen.Color := clMid;
      MoveTo(3 * I + 2, FGripBmp.Height);
      LineTo(FGripBmp.Width, 3 * I + 2);
    end;
  end;
  FGripBmp.TransparentColor := clBackground;
  FGripBmp.TransparentMode := tmFixed;
  FGripBmp.Transparent := True;
end;


{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQPanel.pas,v $';
    Revision: '$Revision: 1.26 $';
    Date: '$Date: 2005/02/06 14:06:16 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.