fcstatusbar.pas

一套及时通讯的原码

    property OnDrawKeyboardState;
    property OnDrawPanel;
    property OnResize;
    property OnStartDrag;
  end;

implementation

{$ifdef fcDelphi7Up}
uses themes;
{$endif}

{$ifdef ThemeManager}
uses thememgr, themesrv, uxtheme;
{$endif}

var StatusBars: TList;

function fcCanGetHint(StatusBar:TfcCustomStatusBar):boolean;
var InFrame:Boolean;
    cmp:TComponent;
    r:TRect;
begin
  result := False;
  //First check to see if the form for the statusbar is active.
  if (GetParentForm(StatusBar)<>nil) and (not GetParentForm(StatusBar).Active) then exit;

  //First check to see if the StatusBar is in a Frame.
  InFrame := False;
  cmp := StatusBar.GetParentComponent as TComponent;
  while (cmp <> nil) and (not(cmp is TCustomForm)) do begin
    if (cmp is TFrame) then begin
       InFrame := True;
       break;
    end;
    cmp := cmp.GetParentComponent as TComponent;
  end;

  //If statusbar is in frame then check if mouse is over this frame, otherwise check if mouse is over the form.
  if InFrame then begin
    if (cmp<>nil) and (cmp is TFrame) then begin
       r:= TFrame(cmp).ClientRect;
       MapWindowPoints(TFrame(cmp).handle, 0, R, 2);
       if not ptinrect(r,Mouse.CursorPos) then exit;
    end;
  end
  else if not ptinrect(getParentform(StatusBar).BoundsRect,Mouse.CursorPos) then exit;

  //If we got this far, then it is valid to show this hint.
  result := True;
end;

function fcGetComputerName : string;
var ComputerName:String;
    nsize:{$ifdef fcDelphi4up}Cardinal{$else}Dword{$endif};
begin
  nsize := 25;
  SetLength(ComputerName,nsize);
  if GetComputerName(PChar(ComputerName),nsize) then
  begin
     SetLength(ComputerName,nsize);
     result := ComputerName;
  end
  else result := '';
end;


{ TfcStatusBarText }
// 5/06/99 - PYW - Added StatusBarText property.
constructor TfcStatusBarText.Create(AOwner: TfcCustomStatusBar);
begin
  inherited Create;
  FOwner := AOwner;
end;

procedure TfcStatusBarText.SetCapsLock(Value: String);
begin
  if FCapsLock <> Value then
  begin
    FCapsLock := Value;
    FOwner.Invalidate;
  end;
end;

procedure TfcStatusBarText.SetOverwrite(Value: String);
begin
  if FOverwrite <> Value then
  begin
    FOverwrite := Value;
    FOwner.Invalidate;
  end;
end;

procedure TfcStatusBarText.SetNumLock(Value: String);
begin
  if FNumLock <> Value then
  begin
    FNumLock := Value;
    FOwner.Invalidate;
  end;
end;

procedure TfcStatusBarText.SetScrollLock(Value: String);
begin
  if FScrollLock <> Value then
  begin
    FScrollLock := Value;
    FOwner.Invalidate;
  end;
end;

{ TfcStatusPanel }

constructor TfcStatusPanel.Create(Collection: TCollection);
begin
  Collection.BeginUpdate;
  inherited Create(Collection);
  FWidth := '50';
  FPaintWidth := StrtoInt(FWidth);
  FBevel := pbLowered;
  FEnabled := True;
  FColor := clBtnFace;
  FName := GenerateName;
  FFont := TFont.Create;
  FFont.OnChange := FontChanged;
  FFont.Assign(StatusBar.Font);
  FTextOptions := TfcCaptionText.Create(MakeCallbacks(Invalidate, AdjustBounds, GetTextEnabled),
    FCanvas, FFont);
  FTextOptions.VAlignment := vaVCenter;
  FIndent := 0;
  OnSetName := SetButtonName;
  Collection.EndUpdate;
end;

destructor TfcStatusPanel.Destroy;
begin
  FTextOptions.Free;
  FFont.OnChange := FontChanged;
  FFont.Free;
  FFont:= nil;
  inherited;
end;

function TfcStatusPanel.GenerateName: string;
var i:integer;
begin
  i := 0;
  repeat
    result := 'Panel' + IntToStr(i);
    inc(i);
  until StatusBar.Panels.PanelByName(result) = nil;
end;

procedure TfcStatusPanel.FontChanged(Sender: TObject);
begin
   inherited;
   Changed(False);
end;

procedure TfcStatusPanel.AssignTo(Dest: TPersistent);
begin
  if Dest is TfcStatusPanel then
    with TfcStatusPanel(Dest) do
    begin
      FBevel := self.Bevel;
      FColor := self.Color;

      // 4/16/03 - Don't set component if in ancestor
      if (StatusBar=nil) or
         not (csUpdating in StatusBar.ComponentState) then
         FComponent := self.Component;

      FEnabled := self.Enabled;
      FFont.Assign(self.Font);
      FHint := self.Hint;
      FImageIndex := self.ImageIndex;
      FIndent := self.Indent;
      FMargin := self.Margin;
      FPopupMenu := self.PopupMenu;
      FStyle := self.Style;
      FText := self.Text;
      FWidth := self.Width;
      FTextOptions.Assign(self.TextOptions);

      FOnClick := self.OnClick;
      FOnDblClick := self.OnDblClick;
      FOnDrawText := self.OnDrawText;
      FOnMouseDown := self.OnMouseDown;
      FOnMouseMove := self.OnMouseMove;
      FOnMouseUp := self.OnMouseUp;
      FOnTextChanged := self.OnTextChanged;
//      FComponent := self.Component;
    end
  else inherited AssignTo(Dest);
end;

procedure TfcStatusPanel.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if (Operation = opRemove) and (AComponent = FComponent) then
    Component := nil;
  if (Operation = opRemove) and (AComponent = FPopupMenu) then
    PopupMenu := nil;
end;

procedure TfcStatusPanel.Click;
begin
  if Assigned(FOnClick) then FOnClick(Self);
end;

procedure TfcStatusPanel.DblClick;
var   KeyBuffer:TKeyboardState;
      TmpScan:Integer;
      KeyCode: Integer;
begin
  if Assigned(FOnDblClick) then FOnDblClick(Self);
  KeyCode := -1;
  case FStyle of
    psNumLock: KeyCode := VK_NUMLOCK;
    psCapsLock: KeyCode := VK_CAPITAL;
    psOverWrite: KeyCode := VK_INSERT;
    psScrollLock: KeyCode := VK_SCROLL;
  end;
  if KeyCode <> -1 then
  begin
    GetKeyboardState(KeyBuffer);
    TmpScan := MapVirtualKey(KeyCode,0);
    Keybd_event(KeyCode, TmpScan, 0, 0);
    Keybd_event(KeyCode, TmpScan, KEYEVENTF_KEYUP, 0);
    SetKeyboardState(KeyBuffer);
  end
end;

function TfcStatusPanel.GetStatusBar: TfcCustomStatusBar;
begin
  result := TfcStatusPanels(Collection).FStatusBar;
end;

function TfcStatusPanel.StoreWidth: Boolean;
begin
  result := Width <> '0';
end;

procedure TfcStatusPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X, Y);
end;

procedure TfcStatusPanel.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
  if Assigned(FOnMouseMove) then FOnMouseMove(Self,Shift,X,Y);

  if StatusBar.Hint <> Hint then
  begin
    Application.CancelHint;
    StatusBar.Hint := Hint;
  end;
end;

procedure TfcStatusPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var p: TPoint;
begin
  if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y);
  if Button = mbRight then
  begin
    //3/5/99 -PYW- Use the StatusBar's ClientToScreen conversion.
    p := StatusBar.ClientToScreen(Point(x,y));
    if PopupMenu <> nil then PopupMenu.Popup(p.x, p.y);
  end;
end;

procedure TfcStatusPanel.PanelTextChanged(const Text:String);
begin
  if Assigned(FOnTextChanged) then FOnTextChanged(Self, Text);
end;

function TfcStatusPanel.ClientToScreen(p: TPoint): TPoint;
var r: TRect;
begin
  r := GetRect;
  result := Point(p.x + r.Left, p.y + r.Top);
  result := StatusBar.ClientToScreen(result);
end;

procedure TfcStatusPanel.Draw(ACanvas: TCanvas; ARect: TRect);
var RealCanvas: TCanvas;
    RealRect: TRect;
    {$ifdef fcUseThemeManager}
    Details: TThemedElementDetails;
    {$endif}
begin
  RealCanvas := FCanvas;
  RealRect := FRect;
  FCanvas := ACanvas;
  FRect := ARect;
  if ((FStyle in [psDate, psDateTime, psTime]) and DoDrawDateTime) or (FStyle <> psControl) then
  begin
    FCanvas.Brush.Color := FColor;
    FCanvas.FillRect(FRect);
  end;

  {$ifdef fcUseThemeManager}
  if fcUseThemes(StatusBar) then
//  if ThemeServices.ThemesEnabled then
  begin
     Details := ThemeServices.GetElementDetails(tsPane);
     ThemeServices.DrawElement(FCanvas.Handle, Details, FRect);
  end;
  {$endif}

  case FStyle of
    psTextOnly, psDate, psTime, psDateTime: DrawText(FText, FRect, Enabled);
    psControl: DrawControl;
    psOverWrite, psCapsLock, psNumLock, psScrollLock: DrawKeyboardState;
    psGlyph: DrawGlyph;
    psRichEditStatus: DrawRichEditStatus;
    psHint,psHintContainerOnly: DrawHint;
    psUserName: DrawUserName;
    psComputerName: DrawComputerName;
  end;
  FCanvas := RealCanvas;
  FRect := RealRect;
end;

procedure TfcStatusPanel.DrawText(AText: string; ARect: TRect; AEnabled:Boolean);
const
  Alignments: array[TAlignment] of Integer = (DT_LEFT, DT_RIGHT, DT_CENTER);
begin
  InflateRect(ARect, -2, 0);
  inc(ARect.Left, Indent);
  if FFont = nil then FCanvas.Font.Assign(StatusBar.Font) else FCanvas.Font.Assign(Font);

  FTextOptions.Canvas := FCanvas;
  FTextOptions.TextRect := ARect;
  if FinDrawText then exit;
  try
    FInDrawText := True;
    //3/11/99-PYW-Allow TextOptions to change in DrawText event without invalidating.
    //4/7/99 - ksw - Fix bug that didn't reassign the invalidate callback
    with FTextOptions,CallBacks do
    begin
      CallBacks := MakeCallBacks(nil,AdjustBounds,GetTextEnabled);
      try
        if Assigned(FOnDrawText) then FOnDrawText(self, AText, AEnabled);
      finally
        CallBacks := MakeCallBacks(self.Invalidate, self.AdjustBounds, self.GetTextEnabled);
      end;
    end;

    FTextOptions.Canvas := FCanvas;
    FTextOptions.Text := AText;

    if AEnabled then FDrawTextEnabled := True
    else FDrawTextEnabled := False;

    FCanvas.Brush.Style := bsClear;
    FTextOptions.Draw;
  finally
    FInDrawText := False;
  end;
  if AText <> FText then
     PanelTextChanged(AText);
end;

procedure TfcStatusPanel.DrawControl;
var r: TRect;
  procedure InvalidateChildren(Control: TWinControl);
  var i: integer;
  begin
    if fcUseThemes(StatusBar) then exit;  // 4/3/03 - Otherwise code below causes flicker
                                     // Code below seems uncessary, but we leave it for now
                                     // to be safe and not break any backwards functionality.
                                     // Can later consider removing this.

    Control.Invalidate;
    for i := 0 to Control.ControlCount - 1 do
       if Control.Controls[i] is TWinControl then
          InvalidateChildren(Control.Controls[i] as TWinControl);
  end;
begin
  if (Control = nil) or ((Statusbar <> nil) and (csLoading in StatusBar.ComponentState)) then
    Exit;

  if Control.Parent <> StatusBar then
    Control.Parent := StatusBar;

  DrawText(Text, FRect, Enabled);

  r := FRect;
  if Text <> '' then
  begin
    if TextOptions.Alignment = taLeftJustify then r.Left := TextOptions.TextRect.Right + 2  // !! Hard Code?
    else if TextOptions.Alignment = taRightJustify then r.Right := TextOptions.TextRect.Left - 2;
  end;
  //3/5/99-PYW-Resize to Margin.
  InflateRect(r,-Margin,-Margin);
  if (fcRectWidth(r) > 0) and (fcRectHeight(r) > 0) then
    Control.BoundsRect := r;

{  with Control.BoundsRect do
    if (Left <> r.Left) or (Right <> r.right) or
       (Top <> r.top) or (Bottom <> r.Bottom) then
      Control.BoundsRect := r;}

  if (Control is TWinControl) then InvalidateChildren(Control as TWinControl);
end;

procedure TfcStatusPanel.DrawKeyboardState;
var
  Key: Integer;
  AText: string;
begin
  Key := 0;
  //3/11/99-PYW-Force TextChanged in DrawText to get called by making
  //            sure FText<>AText
  AText := FText;
  FText := '';

  case FStyle of
    psOverwrite:  begin
                    Key := VK_INSERT;
                    AText := StatusBar.StatusBarText.Overwrite;
                  end;
    psCapsLock:   begin
                    Key := VK_CAPITAL;
                    AText := StatusBar.StatusBarText.CapsLock;
                  end;
    psNumLock:    begin
                    Key := VK_NUMLOCK;
                    AText := StatusBar.StatusBarText.NumLock;
                  end;
    psScrollLock: begin
                    Key := VK_SCROLL;
                    AText := StatusBar.StatusBarText.ScrollLock;
                  end;
  end;

//  FEnabled := System.Odd(GetKeyState(Key));

  if Assigned(StatusBar.FOnDrawKeyboardState) then
     StatusBar.FOnDrawKeyboardState(StatusBar, self, System.Odd(GetKeyState(Key)), FRect, AText);

  DrawText(AText,FRect, System.Odd(GetKeyState(Key)));
end;

procedure TfcStatusPanel.DrawHint;
begin
  if Style = psHintContainerOnly then
    if not fcCanGetHint(StatusBar) then exit;

  DrawText(Application.Hint, FRect, Enabled);
//  Text := Application.Hint;
end;

procedure TfcStatusPanel.DrawUserName;
var nsize:{$ifdef fcDelphi4up}Cardinal{$else}DWord{$endif};
    UserName:String;
begin
  nsize := 25;
  SetLength(UserName,nsize);
  if GetUserName(PChar(UserName), nsize) then
  begin
     SetLength(UserName,nsize-1);
     DrawText(UserName,FRect,Enabled);
  end;
end;

procedure TfcStatusPanel.DrawComputerName;
begin
  DrawText(fcGetComputerName,FRect,Enabled);
end;

function TfcStatusPanel.DoDrawDateTime: Boolean;
var AText: string;
begin
  AText := '';
  //3/11/99-PYW-Make sure short date and short time formats are respected.
  case FStyle of
    psDate: begin
              AText := DateToStr(Date);