Toon posts:

[Delphi] DateTimePicker maar dan met Weeknummers

Pagina: 1
Acties:
  • 124 views sinds 30-01-2008
  • Reageer

Verwijderd

Topicstarter
Het component TDateTimePicker heeft in Delphi geen property weeknumbers. Het gekke is dat het component MonthCalendar die wel heeft. Als je de combobox uitklapt (TDateTimePicker) krijg je een MonthCalendar te zien. Dus waarom zit die niet in die DateTimePicker :? :? :? :? (waarschijnlijk omdat microsoft het gemaakt heeft >:) )

Maar deze 2 componenten zijn volgens mij standaard windows contols, want ik heb nergens code gezien in de vcl source waar ze getekend worden.

Nu wil ik dus perse wel weeknummers hebben. Nu dacht ik dat ik gewoon zelf een nieuw component maak en die baseer op TDateTimePicker en vervolgens een property weeknumbers aanmaak:

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
unit DateTimePickerEx;

interface

uses Windows, Messages, SysUtils, Classes, Controls, StdCtrls, ComCtrls, CommCtrl;

type
  TDateTimePickerEx = class(TDateTimePicker)
  private
    FWeekNumbers: Boolean;
    procedure SetWeekNumbers(Value: Boolean);
    procedure SetComCtlStyle(Ctl: TWinControl; Value: Integer; UseStyle: Boolean);
    { Private declarations }
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
    property WeekNumbers: Boolean read FWeekNumbers write SetWeekNumbers default False;
  end;

procedure Register;

implementation

procedure TDateTimePickerEx.SetComCtlStyle(Ctl: TWinControl;
  Value: Integer; UseStyle: Boolean);
var
  Style: Integer;
begin
  if Ctl.HandleAllocated then
  begin
    Style := GetWindowLong(Ctl.Handle, GWL_STYLE);
    if not UseStyle then Style := Style and not Value
    else Style := Style or Value;
    SetWindowLong(Ctl.Handle, GWL_STYLE, Style);
  end;
end;

procedure TDateTimePickerEx.SetWeekNumbers(Value: Boolean);
begin
  if FWeekNumbers <> Value then
  begin
    FWeekNumbers := Value;
    SetComCtlStyle(Self, MCS_WEEKNUMBERS, Value);
  end;
end;

procedure Register;
begin
  RegisterComponents('Additional', [TDateTimePickerEx]);
end;

end.


Maar dit wil jammer genoeg niet werken. Zal dit nooit gaan werken (omdat het een windows control is en die het niet toestaat bijv) of is het wel mogelijk?

Verwijderd

Ik denk dat het wel kan, maar dan zul je meer moeten coden dan dit. Ik denk dat je als je een TCustomComboBox pakt en daarop gaat uitbreiden (d.m.v. customdraw enzo) het wel moet lukken. Ik denk niet dat je de TDateTimePicker kunt uitbreiden.

  • LordLarry
  • Registratie: Juli 2001
  • Niet online

LordLarry

Aut disce aut discede

je moet even op msnd.microsft.com zoeken naar het component, want het is inderdaad een windows component. Daar kan je vinden of het wel weeknummers aankan en welke messages je moet gebruiken dan.

We adore chaos because we like to restore order - M.C. Escher


  • hamburger
  • Registratie: April 2000
  • Niet online

hamburger

BOOOM!!!

Met deze op dejanews gevonden code werkt het iedergeval.

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
type
 THackCommonCalendar = class(TCommonCalendar);


procedure TForm1.DateTimePicker1DropDown(Sender: TObject);
var
 Style: Integer;
 ReqRect: TRect;
 MaxTodayWidth: Integer;
begin
 with THackCommonCalendar(DateTimePicker1) do
 begin
   // set style to include week numbers
   Style := GetWindowLong(CalendarHandle, GWL_STYLE);
   SetWindowLong(CalendarHandle, GWL_STYLE, Style or MCS_WEEKNUMBERS);
   FillChar(ReqRect, SizeOf(TRect), 0);
   // get required rect
   Win32Check(MonthCal_GetMinReqRect(CalendarHandle, ReqRect));
   // get max today string width
   MaxTodayWidth := MonthCal_GetMaxTodayWidth(CalendarHandle);
   // adjust rect width to fit today string
   if MaxTodayWidth > ReqRect.Right then
     ReqRect.Right := MaxTodayWidth;
   // set new height & width
   SetWindowPos(CalendarHandle, 0, 0, 0, ReqRect.Right, ReqRect.Bottom,
SWP_NOACTIVATE or SWP_NOMOVE
or SWP_NOZORDER);
 end;
end;

Verwijderd

Topicstarter
Bedankt hamburger,

het werkt perfect!

(Blijf het toch vreemd vinden waarom het niet standaard aanwezig is)

  • hamburger
  • Registratie: April 2000
  • Niet online

hamburger

BOOOM!!!

ja maar zo zitten er wel meer vreemde dingen in de vcl :/

Verwijderd

hamburger schreef op 06 augustus 2002 @ 22:17:
ja maar zo zitten er wel meer vreemde dingen in de vcl :/
Klopt :/
En steeds denk je: Bij de volgende versie zal het wel opgelost zijn, maar nee hoor, weer niet. |:(
Pagina: 1