watrem
Messages postés51Date d'inscriptionsamedi 15 octobre 2005StatutMembreDernière intervention17 août 2008
-
13 mai 2008 à 17:22
florenth
Messages postés1023Date d'inscriptiondimanche 1 août 2004StatutMembreDernière intervention17 août 2008
-
14 mai 2008 à 16:48
bonjour , certainement suite a une mauvaise manip j'ai une erreur dans le "source" du spin edit , j'ai reinstaller delphi et l'erreur est toujours presente,
j'ai le "end" finale qui est en rouge pourtant il ne m'en manque pas voici le fichier ;
{$I TMSDEFS.INC}
function TSpinButton.CreateButton: TTimerSpeedButton;
begin
Result := TTimerSpeedButton.Create (Self);
Result.OnClick := BtnClick;
Result.OnMouseDown := BtnMouseDown;
Result.Visible := True;
Result.Enabled := True;
Result.TimeBtnState := [tbAllowTimer];
Result.Parent := Self;
end;
procedure TSpinButton.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited Notification(AComponent, Operation); if (Operation opRemove) and (AComponent FFocusControl) then
FFocusControl := nil;
end;
procedure TSpinButton.AdjustSize (var W, H: Integer);
begin
if (FUpButton = nil) or (csLoading in ComponentState) then Exit;
if W < 15 then W := 15;
FUpButton.SetBounds (0, 0, W, H div 2);
FDownButton.SetBounds (0, FUpButton.Height - 1, W, H - FUpButton.Height + 1);
end;
procedure TSpinButton.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;
procedure TSpinButton.WMSize(var Message: TWMSize);
var
W, H: Integer;
begin
inherited;
{ check for minimum size }
W := Width;
H := Height;
AdjustSize (W, H);
if (W <> Width) or (H <> Height) then
inherited SetBounds(Left, Top, W, H);
Message.Result := 0;
end;
procedure TSpinButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
case Key of
VK_UP:
begin
SetFocusBtn (FUpButton);
FUpButton.Click;
end;
VK_DOWN:
begin
SetFocusBtn (FDownButton);
FDownButton.Click;
end;
VK_SPACE:
FFocusedButton.Click;
end;
end;
procedure TSpinButton.BtnMouseDown (Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
SetFocusBtn (TTimerSpeedButton (Sender));
if (FFocusControl <> nil) and FFocusControl.TabStop and
FFocusControl.CanFocus and (GetFocus <> FFocusControl.Handle) then
FFocusControl.SetFocus
else if TabStop and (GetFocus <> Handle) and CanFocus then
SetFocus;
end;
end;
procedure TSpinButton.BtnClick(Sender: TObject);
begin
if Sender = FUpButton then
begin
if Assigned(FOnUpClick) then FOnUpClick(Self);
end
else
if Assigned(FOnDownClick) then FOnDownClick(Self);
end;
procedure TSpinButton.SetFocusBtn (Btn: TTimerSpeedButton);
begin
if TabStop and CanFocus and (Btn <> FFocusedButton) then
begin
FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
FFocusedButton := Btn;
if (GetFocus = Handle) then
begin
FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
Invalidate;
end;
end;
end;
procedure TSpinButton.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
Message.Result := DLGC_WANTARROWS;
end;
procedure TSpinButton.Loaded;
var
W, H: Integer;
begin
inherited Loaded;
W := Width;
H := Height;
AdjustSize (W, H);
if (W <> Width) or (H <> Height) then
inherited SetBounds (Left, Top, W, H);
end;
function TSpinButton.GetUpGlyph: TBitmap;
begin
Result := FUpButton.Glyph;
end;
procedure TSpinButton.SetUpGlyph(Value: TBitmap);
begin
if Value <> nil then
FUpButton.Glyph := Value
else
begin
FUpButton.Glyph.Handle := LoadBitmap(HInstance, 'SpinUp');
FUpButton.NumGlyphs := 1;
FUpButton.Invalidate;
end;
end;
function TSpinButton.GetUpNumGlyphs: TNumGlyphs;
begin
Result := FUpButton.NumGlyphs;
end;
procedure TSpinButton.SetUpNumGlyphs(Value: TNumGlyphs);
begin
FUpButton.NumGlyphs := Value;
end;
function TSpinButton.GetDownGlyph: TBitmap;
begin
Result := FDownButton.Glyph;
end;
procedure TSpinButton.SetDownGlyph(Value: TBitmap);
begin
if Value <> nil then
FDownButton.Glyph := Value
else
begin
FDownButton.Glyph.Handle := LoadBitmap(HInstance, 'SpinDown');
FUpButton.NumGlyphs := 1;
FDownButton.Invalidate;
end;
end;
function TSpinButton.GetDownNumGlyphs: TNumGlyphs;
begin
Result := FDownButton.NumGlyphs;
end;
procedure TSpinButton.SetDownNumGlyphs(Value: TNumGlyphs);
begin
FDownButton.NumGlyphs := Value;
end;
destructor TSpinEdit.Destroy;
begin
FButton := nil;
inherited Destroy;
end;
procedure TSpinEdit.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
end;
procedure TSpinEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Key = VK_UP then UpClick (Self)
else if Key = VK_DOWN then DownClick (Self);
inherited KeyDown(Key, Shift);
end;
procedure TSpinEdit.KeyPress(var Key: Char);
begin
if not IsValidChar(Key) then
begin
Key := #0;
MessageBeep(0)
end;
if Key <> #0 then inherited KeyPress(Key);
end;
function TSpinEdit.IsValidChar(Key: Char): Boolean;
begin
{$IFNDEF TMSDOTNET}
Result := (Key in [DecimalSeparator, '+', '-', '0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)));
{$ENDIF}
{$IFDEF TMSDOTNET} Result :(Key DecimalSeparator) or (Key in ['+', '-', '0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)));
{$ENDIF}
if not FEditorEnabled and Result and ((Key >= #32) or (Key Char(VK_BACK)) or (Key Char(VK_DELETE))) then
Result := False;
end;
procedure TSpinEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
{ Params.Style := Params.Style and not WS_BORDER; }
Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN;
end;
procedure TSpinEdit.CreateWnd;
begin
inherited CreateWnd;
SetEditRect;
end;
procedure TSpinEdit.WMSize(var Message: TWMSize);
var
MinHeight: Integer;
begin
inherited;
MinHeight := GetMinHeight;
{ text edit bug: if size to less than minheight, then edit ctrl does
not display the text }
if Height < MinHeight then
Height := MinHeight
else if FButton <> nil then
begin
if NewStyleControls and Ctl3D then
FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 5)
else FButton.SetBounds (Width - FButton.Width, 1, FButton.Width, Height - 3);
SetEditRect;
end;
end;
function TSpinEdit.GetMinHeight: Integer;
var
DC: HDC;
SaveFont: HFont;
I: Integer;
SysMetrics, Metrics: TTextMetric;
begin
DC := GetDC(0);
GetTextMetrics(DC, SysMetrics);
SaveFont := SelectObject(DC, Font.Handle);
GetTextMetrics(DC, Metrics);
SelectObject(DC, SaveFont);
ReleaseDC(0, DC);
I := SysMetrics.tmHeight;
if I > Metrics.tmHeight then I := Metrics.tmHeight;
Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
end;
procedure TSpinEdit.UpClick (Sender: TObject);
begin
if ReadOnly then MessageBeep(0)
else Value := Value + FIncrement;
end;
procedure TSpinEdit.DownClick (Sender: TObject);
begin
if ReadOnly then MessageBeep(0)
else Value := Value - FIncrement;
end;
procedure TSpinEdit.WMPaste(var Message: TWMPaste);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
procedure TSpinEdit.WMCut(var Message: TWMPaste);
begin
if not FEditorEnabled or ReadOnly then Exit;
inherited;
end;
procedure TSpinEdit.CMExit(var Message: TCMExit);
begin
inherited;
if CheckValue (Value) <> Value then
SetValue (Value);
end;
function TSpinEdit.GetValue: LongInt;
begin
try
Result := StrToInt (Text);
except
Result := FMinValue;
end;
end;
procedure TSpinEdit.SetValue (NewValue: LongInt);
begin
Text := IntToStr (CheckValue (NewValue));
end;
function TSpinEdit.CheckValue (NewValue: LongInt): LongInt;
begin
Result := NewValue;
if (FMaxValue <> FMinValue) then
begin
if NewValue < FMinValue then
Result := FMinValue
else if NewValue > FMaxValue then
Result := FMaxValue;
end;
end;
procedure TSpinEdit.CMEnter(var Message: TCMGotFocus);
begin
if AutoSelect and not (csLButtonDown in ControlState) then
SelectAll;
inherited;
end;
{TTimerSpeedButton}
destructor TTimerSpeedButton.Destroy;
begin
if FRepeatTimer <> nil then
FRepeatTimer.Free;
inherited Destroy;
end;
procedure TTimerSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseDown (Button, Shift, X, Y);
if tbAllowTimer in FTimeBtnState then
begin
if FRepeatTimer = nil then
FRepeatTimer := TTimer.Create(Self);
procedure TTimerSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseUp (Button, Shift, X, Y);
if FRepeatTimer <> nil then
FRepeatTimer.Enabled := False;
end;
procedure TTimerSpeedButton.TimerExpired(Sender: TObject);
begin
FRepeatTimer.Interval := RepeatPause;
if (FState = bsDown) and MouseCapture then
begin
try
Click;
except
FRepeatTimer.Enabled := False;
raise;
end;
end;
end;
procedure TTimerSpeedButton.Paint;
var
R: TRect;
begin
inherited Paint;
if tbFocusRect in FTimeBtnState then
begin
R := Bounds(0, 0, Width, Height);
InflateRect(R, -3, -3);
if FState = bsDown then
OffsetRect(R, 1, 1);
DrawFocusRect(Canvas.Handle, R);
end;
end;
florenth
Messages postés1023Date d'inscriptiondimanche 1 août 2004StatutMembreDernière intervention17 août 20083 14 mai 2008 à 16:48
Si ça marche en suivant ma manip, c'est que c'est pas bien grave alors.
Vérifie que le fichier .dcu n'est pas en lecture seule (idem avec les répertoires)
et vérifies aussi que dans "Projet > Options > répertoires" tu n'aies rien d'anormal.
