?? tflatspeedbuttonunit.pas
字號:
begin
if MouseTimer.Enabled then
MouseTimer.Enabled := False;
MouseInControl := Self;
MouseTimer.OnTimer := MouseTimerHandler;
MouseTimer.Enabled := True;
MouseEnter;
end;
end;
if FDragging then
begin
if not FDown then
NewState := bsUp
else
NewState := bsExclusive;
if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
if FDown then
NewState := bsExclusive
else
NewState := bsDown;
if NewState <> FState then
begin
FState := NewState;
Invalidate;
end;
end;
end;
procedure TFlatSpeedButton.MouseUp (Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
DoClick: Boolean;
begin
inherited MouseUp(Button, Shift, X, Y);
if FDragging then
begin
FDragging := False;
DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
if FGroupIndex = 0 then
begin
// Redraw face in-case mouse is captured
FState := bsUp;
FMouseInControl := False;
if DoClick and not (FState in [bsExclusive, bsDown]) then
Invalidate;
end
else
if DoClick then
begin
SetDown(not FDown);
if FDown then Repaint;
end
else
begin
if FDown then FState := bsExclusive;
Repaint;
end;
if DoClick then Click else MouseLeave;
UpdateTracking;
end;
end;
procedure TFlatSpeedButton.Click;
begin
if Parent <> nil then
GetParentForm(self).ModalResult := FModalResult;
inherited Click;
end;
function TFlatSpeedButton.GetPalette: HPALETTE;
begin
Result := FGlyph.Palette;
end;
procedure TFlatSpeedButton.SetColors (Index: Integer; Value: TColor);
begin
case Index of
0: FFocusedColor := Value;
1: FDownColor := Value;
2: FBorderColor := Value;
3: FColorHighlight := Value;
4: FColorShadow := Value;
end;
Invalidate;
end;
procedure TFlatSpeedButton.CalcAdvColors;
begin
if FUseAdvColors then
begin
FFocusedColor := CalcAdvancedColor(Color, FFocusedColor, FAdvColorFocused, lighten);
FDownColor := CalcAdvancedColor(Color, FDownColor, FAdvColorDown, darken);
FBorderColor := CalcAdvancedColor(Color, FBorderColor, FAdvColorBorder, darken);
end;
end;
procedure TFlatSpeedButton.SetAdvColors (Index: Integer; Value: TAdvColors);
begin
case Index of
0: FAdvColorFocused := Value;
1: FAdvColorDown := Value;
2: FAdvColorBorder := Value;
end;
CalcAdvColors;
Invalidate;
end;
procedure TFlatSpeedButton.SetUseAdvColors (Value: Boolean);
begin
if Value <> FUseAdvColors then
begin
FUseAdvColors := Value;
ParentColor := Value;
CalcAdvColors;
Invalidate;
end;
end;
procedure TFlatSpeedButton.SetGlyph (value: TBitmap);
begin
if value <> FGlyph then
begin
FGlyph.Assign(value);
if not FGlyph.Empty then
begin
if FGlyph.Width mod FGlyph.Height = 0 then
begin
FNumGlyphs := FGlyph.Width div FGlyph.Height;
if FNumGlyphs > 4 then FNumGlyphs := 1;
end;
end;
Invalidate;
end;
end;
procedure TFlatSpeedButton.SetNumGlyphs (value: TNumGlyphs);
begin
if value <> FNumGlyphs then
begin
FNumGlyphs := value;
Invalidate;
end;
end;
procedure TFlatSpeedButton.UpdateExclusive;
var
Msg: TMessage;
begin
if (FGroupIndex <> 0) and (Parent <> nil) then
begin
Msg.Msg := CM_BUTTONPRESSED;
Msg.WParam := FGroupIndex;
Msg.LParam := Longint(Self);
Msg.Result := 0;
Parent.Broadcast(Msg);
end;
end;
procedure TFlatSpeedButton.SetDown (Value: Boolean);
begin
if FGroupIndex = 0 then Value := False;
if Value <> FDown then
begin
if FDown and (not FAllowAllUp) then Exit;
FDown := Value;
if Value then
begin
if FState = bsUp then Invalidate;
FState := bsExclusive
end
else
begin
FState := bsUp;
Repaint;
end;
if Value then UpdateExclusive;
end;
end;
procedure TFlatSpeedButton.SetGroupIndex (Value: Integer);
begin
if FGroupIndex <> Value then
begin
FGroupIndex := Value;
UpdateExclusive;
end;
end;
procedure TFlatSpeedButton.SetLayout (Value: TButtonLayout);
begin
if FLayout <> Value then
begin
FLayout := Value;
Invalidate;
end;
end;
procedure TFlatSpeedButton.SetMargin (Value: Integer);
begin
if (Value <> FMargin) and (Value >= -1) then
begin
FMargin := Value;
Invalidate;
end;
end;
procedure TFlatSpeedButton.SetSpacing (Value: Integer);
begin
if Value <> FSpacing then
begin
FSpacing := Value;
Invalidate;
end;
end;
procedure TFlatSpeedButton.SetAllowAllUp (Value: Boolean);
begin
if FAllowAllUp <> Value then
begin
FAllowAllUp := Value;
UpdateExclusive;
end;
end;
procedure TFlatSpeedButton.WMLButtonDblClk (var Message: TWMLButtonDown);
begin
inherited;
if FDown then DblClick;
end;
procedure TFlatSpeedButton.CMEnabledChanged (var Message: TMessage);
begin
inherited;
if not Enabled then
begin
FMouseInControl := False;
FState := bsDisabled;
RemoveMouseTimer;
end;
UpdateTracking;
Invalidate;
end;
procedure TFlatSpeedButton.CMButtonPressed (var Message: TMessage);
var
Sender: TFlatSpeedButton;
begin
if Message.WParam = FGroupIndex then
begin
Sender := TFlatSpeedButton(Message.LParam);
if Sender <> Self then
begin
if Sender.Down and FDown then
begin
FDown := False;
FState := bsUp;
Invalidate;
end;
FAllowAllUp := Sender.AllowAllUp;
end;
end;
end;
procedure TFlatSpeedButton.CMDialogChar (var Message: TCMDialogChar);
begin
with Message do
if IsAccel(CharCode, Caption) and Enabled then
begin
Click;
Result := 1;
end else
inherited;
end;
procedure TFlatSpeedButton.CMFontChanged (var Message: TMessage);
begin
Invalidate;
end;
procedure TFlatSpeedButton.CMTextChanged (var Message: TMessage);
begin
Invalidate;
end;
procedure TFlatSpeedButton.CMSysColorChange (var Message: TMessage);
begin
if FUseAdvColors then
begin
ParentColor := True;
CalcAdvColors;
end;
Invalidate;
end;
procedure TFlatSpeedButton.CMParentColorChanged (var Message: TWMNoParams);
begin
inherited;
if FUseAdvColors then
begin
ParentColor := True;
CalcAdvColors;
end;
Invalidate;
end;
procedure TFlatSpeedButton.MouseEnter;
begin
if Enabled and not FMouseInControl then
begin
FMouseInControl := True;
Invalidate;
end;
end;
procedure TFlatSpeedButton.MouseLeave;
begin
if Enabled and FMouseInControl and not FDragging then
begin
FMouseInControl := False;
RemoveMouseTimer;
Invalidate;
end;
end;
procedure TFlatSpeedButton.MouseTimerHandler (Sender: TObject);
var
P: TPoint;
begin
GetCursorPos (P);
if FindDragTarget(P, True) <> Self then
MouseLeave;
end;
procedure TFlatSpeedButton.RemoveMouseTimer;
begin
if MouseInControl = Self then
begin
MouseTimer.Enabled := False;
MouseInControl := nil;
end;
end;
{$IFDEF DFS_DELPHI_4_UP}
procedure TFlatSpeedButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
begin
with Glyph do
begin
Width := ImageList.Width;
Height := ImageList.Height;
Canvas.Brush.Color := clFuchsia;//! for lack of a better color
Canvas.FillRect(Rect(0,0, Width, Height));
ImageList.Draw(Canvas, 0, 0, Index);
end;
end;
begin
inherited ActionChange(Sender, CheckDefaults);
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
{ Copy image from action's imagelist }
if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
(ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
CopyImage(ActionList.Images, ImageIndex);
end;
end;
{$ENDIF}
procedure TFlatSpeedButton.SetTransparent(const Value: TTransparentMode);
begin
FTransparent := Value;
Invalidate;
end;
procedure TFlatSpeedButton.CMMouseEnter(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseEnter) then
FOnMouseEnter(Self);
end;
procedure TFlatSpeedButton.CMMouseLeave(var Message: TMessage);
begin
inherited;
if Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -