jvupdown.pas

East make Tray Icon in delphi

      begin
        if AcceptInteger then
          SendMessage(Handle, UDM_SETPOS32, 0, FPosition)
        else
          SendMessage(Handle, UDM_SETPOS, 0, FPosition);
      end;
    end;
  end;
  UpdateAssociate;
end;

procedure TJvCustomUpDown.CNNotify(var Msg: TWMNotify);
begin
  with Msg do
    if NMHdr^.code = UDN_DELTAPOS then
      if AcceptPosition(PNMUpDown(NMHdr).iPos + PNMUpDown(NMHdr).iDelta) then
      begin
        FPosition := PNMUpDown(NMHdr).iPos + PNMUpDown(NMHdr).iDelta;
        UpdateAssociate;
      end;
end;

procedure TJvCustomUpDown.SetAssociate(const Value: TWinControl);
begin
  FAssociate := Value;
  if HandleAllocated then
  begin
    if Value = nil then
      SendMessage(Handle, UDM_SETBUDDY, 0, 0)
    else
    begin
      UndoAutoResizing(Value);
      SendMessage(Handle, UDM_SETBUDDY, Value.Handle, 0);
    end;
    UpdateAssociate;
  end;
end;

procedure TJvCustomUpDown.UndoAutoResizing(Value: TWinControl);
var
  OrigWidth, NewWidth, DeltaWidth: Integer;
  OrigLeft, NewLeft, DeltaLeft: Integer;
begin
  { undo Window's auto-resizing }
  OrigWidth := Value.Width;
  OrigLeft := Value.Left;
  SendMessage(Handle, UDM_SETBUDDY, Value.Handle, 0);
  NewWidth := Value.Width;
  NewLeft := Value.Left;
  DeltaWidth := OrigWidth - NewWidth;
  DeltaLeft := NewLeft - OrigLeft;
  Value.Width := OrigWidth + DeltaWidth;
  Value.Left := OrigLeft - DeltaLeft;
end;

procedure TJvCustomUpDown.CreateWnd;
const
  cBase: array [TJvUpDownFormat] of Integer = (10, 16);
var
  OrigWidth: Integer;
  AccelArray: array [0..0] of TUDAccel;
begin
  OrigWidth := Width;
  inherited CreateWnd;
  Width := OrigWidth;
  if FAssociate <> nil then
  begin
    UndoAutoResizing(Associate);
    SendMessage(Handle, UDM_SETBUDDY, FAssociate.Handle, 0);
  end;
  SendMessage(Handle, UDM_SETRANGE32, FMin, FMax);
  SendMessage(Handle, UDM_SETBASE, cBase[Format], 0);
  SendMessage(Handle, UDM_GETACCEL, 1, Longint(@AccelArray));
  AccelArray[0].nInc := FIncrement;
  SendMessage(Handle, UDM_SETACCEL, 1, Longint(@AccelArray));
  SetPosition(Position);
  SetAssociate(FAssociate);
end;

function TJvCustomUpDown.AcceptPosition(Value: Integer): Boolean;
begin
  Result := (Value >= Min) and ((Value <= Max) or (Max = 0));
end;

procedure TJvCustomUpDown.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    if FHotTrack then
      Style := Style or UDS_HOTTRACK;
    if (Style and UDS_ALIGNRIGHT) = UDS_ALIGNRIGHT then
      Style := Style and not UDS_ALIGNRIGHT;
    if (Style and UDS_ALIGNLEFT) = UDS_ALIGNLEFT then
      Style := Style and not UDS_ALIGNLEFT;
    case FAlignButton of
      abLeft:
        Style := Style or UDS_ALIGNLEFT;
      abRight:
        Style := Style or UDS_ALIGNRIGHT;
    end;
  end;
end;

procedure TJvCustomUpDown.SetHotTrack(const Value: Boolean);
begin
  FHotTrack := Value;
  RecreateWnd;
end;

procedure TJvCustomUpDown.SetAlignButton(const Value: TJvAlignButton);
begin
  FAlignButton := Value;
  RecreateWnd;
end;

function TJvCustomUpDown.CanChange: Boolean;
begin
  Result := inherited CanChange;
  if Result then
    if Assigned(Associate) and (Associate is TCustomEdit) and
      Assigned(Associate.Parent) then
      PostMessage(Associate.Parent.Handle,
        WM_COMMAND, MakeWParam(0, EN_CHANGE), Associate.Handle);
end;

function TJvCustomUpDown.AcceptInteger: Boolean;
var
  Info: Pointer;
  InfoSize: DWORD;
  FileInfo: PVSFixedFileInfo;
  FileInfoSize: DWORD;
  Tmp: DWORD;
  Major, Minor: Integer;
begin
  // SETPOS32 is only supported with comctl32.dll version 5.80 or later
  if FFirstTime then
  begin
    Result := False;
    try
      InfoSize := GetFileVersionInfoSize('comctl32.dll', Tmp);
      if InfoSize = 0 then
        Exit;
      GetMem(Info, InfoSize);
      try
        GetFileVersionInfo('comctl32.dll', 0, InfoSize, Info);
        VerQueryValue(Info, '\', Pointer(FileInfo), FileInfoSize);
        Major := FileInfo^.dwFileVersionMS shr 16;
        Minor := FileInfo^.dwFileVersionMS and $FFFF;
        Result := (Major > 5) or ((Major = 5) and (Minor > 80));
      finally
        FreeMem(Info);
      end;
    except
    end;
    FAcceptsInteger := Result;
    FFirstTime := False;
  end
  else
    Result := FAcceptsInteger;
end;

procedure TJvCustomUpDown.SetFormat(const Value: TJvUpDownFormat);
const
  cBase: array [TJvUpDownFormat] of Integer = (10, 16);
begin
  if FFormat <> Value then
  begin
    if HandleAllocated then
      SendMessage(Handle, UDM_SETBASE, cBase[Value], 0);
    FFormat := Value;
    UpdateAssociate;
  end;
end;

procedure TJvCustomUpDown.UpdateAssociate;
begin
  // do nothing
end;

//=== { TJvUpDown } ==========================================================

procedure TJvUpDown.UpdateAssociate;
begin
  inherited UpdateAssociate;
  if FAssociate is TCustomEdit then
    if Format = ufHex then
      TCustomEdit(FAssociate).Text := '0x' + IntToHex(Position, 4)
    else
      TCustomEdit(FAssociate).Text := IntToStr(Position);
end;

//=== { TJvCustomDomainUpDown } ==============================================

constructor TJvCustomDomainUpDown.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FItems := TStringList.Create;
  FItems.OnChange := DoItemsChange;
end;

destructor TJvCustomDomainUpDown.Destroy;
begin
  FItems.Free;
  inherited Destroy;
end;

procedure TJvCustomDomainUpDown.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  Params.Style := Params.Style and (not UDS_SETBUDDYINT) or UDS_NOTHOUSANDS;
end;

procedure TJvCustomDomainUpDown.DoItemsChange(Sender: TObject);
begin
  // switch min and max around to scroll in the right direction
  Min := Items.Count - 1;
  Max := 0;
end;

function TJvCustomDomainUpDown.GetText: string;
begin
  if (Position >= 0) and (Position < Items.Count) then
  begin
    Result := Items[Position];
    FCurrentText := Result;
  end
  else
    Result := FCurrentText;
end;

function TJvCustomDomainUpDown.GetItems: TStrings;
begin
  Result := FItems;
end;

procedure TJvCustomDomainUpDown.SetItems(const Value: TStrings);
begin
  FItems.Assign(Value);
end;

procedure TJvCustomDomainUpDown.UpdateAssociate;
begin
  if FAssociate is TCustomEdit then
    TCustomEdit(FAssociate).Text := Text;
//  if (Associate <> nil) and Associate.HandleAllocated then
//    SendMessage(Associate.Handle, WM_SETTEXT, 0, Longint(PChar(Text)));
end;

procedure TJvCustomDomainUpDown.SetText(const Value: string);
begin
  Position := FItems.IndexOf(Value);
  FCurrentText := Value;
end;

procedure TJvCustomDomainUpDown.Click(Button: TUDBtnType);
begin
  inherited Click(Button);
  UpdateAssociate;
end;

procedure TJvCustomUpDown.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = Associate) then
    Associate := nil;
end;

function TJvCustomDomainUpDown.AcceptPosition(Value: Integer): Boolean;
begin
  Result := (Value >= 0) and (Value < Items.Count);
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.