fcstatusbar.pas

一套及时通讯的原码

              FCurDateTime := Trunc(Date);
            end;
    psTime: begin
//              AText := TimeToStr(Time);
              DateTimeToString(AText,ShortTimeFormat,Now);
              FCurDateTime := Frac(Time);
            end;
    psDateTime:
            begin
//              AText := DateTimeToStr(Now);
              DateTimeToString(AText,ShortDateFormat+' ' + ShortTimeFormat,Now);
              FCurDateTime := Now;
            end;
  end;
  result := False;
  if FText <> AText then
  begin
    FText := AText;
    result := True;
    PanelTextChanged(AText);
  end;
end;

procedure TfcStatusPanel.DrawRichEditStatus;
var AText: string;
begin
  AText := 'Ln: ' + IntToStr(FRow+1) + ', Col: ' + IntToStr(FCol+1);
  DrawText(AText,FRect,Enabled);
end;

procedure TfcStatusPanel.DrawGlyph;
var aLeft,aTop:Integer;
begin
  if (StatusBar.Images <> nil) and
  (FImageIndex >= 0) and (FImageIndex < StatusBar.Images.Count) then
  begin
    ALeft := FRect.Left+FMargin;
    ATop := FRect.Top+(((FRect.Bottom-FRect.Top)-TImageList(StatusBar.Images).height)div 2);
    { RSW - 5/27/99 - Don't use StatusBar Canvas, but use StatusPanel Canvas }
    fcImageListDraw(StatusBar.Images,FImageIndex,{StatusBar.}Canvas,ALeft,ATop,ILD_NORMAL,FEnabled);
    FRect := Rect(FRect.Left+TImageList(StatusBar.Images).Width+5,FRect.Top,FRect.Right,FRect.Bottom);
  end;
  DrawText(FText,FRect,Enabled);
end;

function TfcStatusPanel.GetControl: TControl;
begin
  result := nil;
  if Component is TControl then result := Component as TControl;
end;

function TfcStatusPanel.GetDisplayName: string;
begin
  Result := Name;
  if Result = '' then Result := inherited GetDisplayName;
end;

{
procedure TfcStatusPanel.SetPriority(Value: Integer);
var APanel: TfcStatusPanel;
begin
  if Value < 1 then Value := 1;
  if Value > StatusBar.Panels.Count then Value := StatusBar.Panels.Count;
  if FPriority <> Value then
  begin
    StatusBar.Panels.BeginUpdate;
    APanel := StatusBar.GetPriorityPanel(Value);
    FPriority := Value;
    if APanel <> nil then APanel.Priority := Value + 1;
    StatusBar.Panels.EndUpdate;
    Changed(True);
  end;
end;
}
procedure TfcStatusPanel.SetBevel(Value: TfcStatusPanelBevel);
begin
  if FBevel <> Value then
  begin
    FBevel := Value;
    Changed(False);
  end;
end;

procedure TfcStatusPanel.SetColor(Value: TColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    Changed(False);
  end;
end;

procedure TfcStatusPanel.SetComponent(Value: TComponent);
begin
  if (Value = nil) and (Component = nil) then Exit;

  if (Value = StatusBar) then
    raise EInvalidOperation.Create('Control cannot equal parent StatusBar');

  //8/14/2000 - PYW - Don't change the parents for richedit controls.
  if (Control <> nil) and not (csDestroying in Control.ComponentState) and
     (Style <> psRichEditStatus) then
    if GetParentForm(StatusBar)<>nil then // 1/24/01 - RSW
       Control.Parent := GetParentForm(StatusBar);

  FComponent := Value;

  if FComponent = nil then FStyle := psTextOnly
  else if (FComponent is TCustomRichEdit) then
  begin
    Style := psRichEditStatus;
  end else if (FComponent is TControl) then begin
    if (Control <> Value) and (StatusBar <> nil) then
      Control.Parent := StatusBar.Parent;
    Style := psControl;
  end;

  Changed(False);
end;

procedure TfcStatusPanel.SetEnabled(Value: Boolean);
begin
  if FEnabled <> Value then
  begin
    FEnabled := Value;
    if (FStyle = psControl) and (Control <> nil) then
      Control.Enabled := Value;
    Changed(False);
  end;
end;

procedure TfcStatusPanel.SetImageIndex(Value: Integer);
begin
  if FImageIndex <> Value then
  begin
    FImageIndex := Value;
    Changed(False);
  end;
end;

procedure TfcStatusPanel.SetMargin(Value: Integer);
begin
  if FMargin <> Value then
  begin
    FMargin := Value;
    Changed(False);
  end;
end;

procedure TfcStatusPanel.SetIndent(Value: Integer);
begin
  if FIndent <> Value then
  begin
    FIndent := Value;
    Changed(False);
  end;
end;

procedure TfcStatusPanel.SetStyle(Value: TfcStatusPanelStyle);
var i:integer;
    TimerNeeded:Boolean;
begin
  if FStyle <> Value then
  begin
    //3/11/99 - Only kill richedit timer if no longer needed.
    if (StatusBar.HandleAllocated) and (FStyle = psRichEditStatus) then
    begin
       TimerNeeded := False;
       for i:= 0 to StatusBar.Panels.Count-1 do
          if (StatusBar.Panels[i]<>Self) and
             (StatusBar.Panels[i].Style = psRichEditStatus) then
                TimerNeeded := True;
       if not TimerNeeded then KillTimer(StatusBar.Handle, RICHEDIT_TIMER_ID);
    end;

    //3/11/99 - Only kill hint timer if no longer needed.
    if (StatusBar.HandleAllocated) and ((FStyle = psHint) or (FStyle=psHintContainerOnly)) then
    begin
       TimerNeeded := False;
       for i:= 0 to StatusBar.Panels.Count-1 do
          if (StatusBar.Panels[i]<>Self) and
             ((StatusBar.Panels[i].Style = psHint) or (StatusBar.Panels[i].Style=psHintContainerOnly))then
                TimerNeeded := True;
       if not TimerNeeded then KillTimer(StatusBar.Handle, HINT_TIMER_ID);
    end;

    //3/11/99 -PYW- Only kill date/time timer if no longer needed.
    if (StatusBar.HandleAllocated) and (FStyle in [psDate,psTime,psDateTime]) then
    begin
       TimerNeeded := False;
       for i:= 0 to StatusBar.Panels.Count-1 do
          if (StatusBar.Panels[i]<>Self) and
             (StatusBar.Panels[i].Style in [psDate,psTime,psDateTime]) then
                TimerNeeded := True;
       if not TimerNeeded then KillTimer(StatusBar.Handle, TIMER_ID);
    end;

    FStyle := Value;
    case FStyle of
      psOverwrite:; //FText := 'Overwrite';  //3/11/99 -PYW- No longer needed. Handled in DrawKeyboardState
      psCapslock:; //FText := 'Caps';
      psNumlock:; //FText := 'Num';
      psScrollLock:; //FText := 'Scroll';
      psControl: StatusBar.ComponentExclusive(FComponent, self, False);
      psHint,psHintContainerOnly: if StatusBar.HandleAllocated and not (csDesigning in StatusBar.ComponentState) then
        SetTimer(StatusBar.Handle, HINT_TIMER_ID, 100, nil);
      psDate,psTime,psDateTime: if StatusBar.HandleAllocated and not (csDesigning in StatusBar.ComponentState) then
        SetTimer(StatusBar.Handle, TIMER_ID, 1000, nil);
      psRichEditStatus:
        if StatusBar.HandleAllocated and not (csDesigning in StatusBar.ComponentState) then
           SetTimer(StatusBar.Handle, RICHEDIT_TIMER_ID, 100, nil);
    end;
    Changed(False);
  end;
end;

(*procedure TfcStatusPanel.ParentWndProc(var Message: TMessage);
//var MenuItem: TMenuItem;
begin
  { RSW - 2/1/99 }
  if (csDestroying in TfcStatusPanels(Collection).StatusBar.ComponentState) then exit;

  case Message.Msg of
    WM_NOTIFY: if Component is TCustomRichEdit then
      with TWMNotify(Message).NMHdr^,
           (Control as TCustomRichEdit) do
        if (Code = EN_SELCHANGE) and
           (HwndFrom = Handle) then
        begin
          FRow := SendMessage(Handle, EM_LINEFROMCHAR, SelStart, 0);
          FCol := SelStart - SendMessage(Handle, EM_LINEINDEX, FRow, 0);
          self.Invalidate;
        end;
{    WM_MENUSELECT: if (Style = psMenu) and (Component is TMainMenu) then
      with TWMMenuSelect(Message) do
    begin
      if ((MenuFlag and $FFFF) = $FFFF) and (Menu = 0) then Text := ''
      else begin
        if not ((MenuFlag and MF_POPUP) = MF_POPUP) then MenuItem := (FComponent as TMainMenu).FindItem(IDItem, fkCommand)
        else begin
          if (FComponent as TMainMenu).Handle = Menu then MenuItem := (FComponent as TMainMenu).Items
          else MenuItem := (FComponent as TMainMenu).FindItem(Menu, fkHandle);
          if MenuItem <> nil then MenuItem := MenuItem.Items[IDItem];
        end;
        if MenuItem <> nil then Text := GetLongHint(MenuItem.Hint);
      end;
    end;}
  end;
end;
*)
function TfcStatusPanel.GetTextEnabled: Boolean;
begin
  result := FDrawTextEnabled;
end;

procedure TfcStatusPanel.AdjustBounds;
begin
end;

procedure TfcStatusPanel.SetName(const Value: string);
begin
  if FName <> Value then
  begin
    if (StatusBar.Panels.PanelByName(Value) <> nil) then
      raise EInvalidOperation.CreateFmt('A panel named %s already exists.', [Value]);
    FName := Value;
    Changed(False);
    if Assigned(FOnSetName) then FOnSetName(self);
  end;
end;

procedure TfcStatusPanel.SetText(const Value: string);
begin
  if FText <> Value then
  begin
    FText := Value;
    PanelTextChanged(Value);
    Invalidate;
  end;
end;

procedure TfcStatusPanel.SetFont(Value: TFont);
begin
  if FFont <> Value then
  begin
    FFont.Assign(Value);
    //3/5/99 -PYW - Also set the Control's Font property.
    if (FStyle = psControl) and (Control <> nil) then
       TEdit(Control).Font.Assign(Value);
    Changed(False);
  end;
end;

procedure TfcStatusPanel.SetHint(Value: String);
begin
  if FHint <> Value then
  begin
    FHint := Value;
    //3/5/99 -PYW - Also set the Control's Hint property.
    if (FStyle = psControl) and (Control <> nil) then
       Control.Hint := Value;
    Changed(False);
  end;
end;

procedure TfcStatusPanel.SetWidth(Value: string);
var AWidth: Integer;
begin
  if FWidth <> Value then
  begin
    // Validate Width
    AWidth := StrToIntDef(Value, -1);
    if AWidth = -1 then
    begin
      AWidth := StrToIntDef(Copy(Value, 1, Length(Value) - 1), -1);
      if (AWidth = -1) or (Copy(Value, Length(Value), 1) <> '%') then
        raise EInvalidOperation.Create('Width must be a valid, positive integer, or must be an integer followed by a "%" sign.');
    end;

    FWidth := Value;
    PaintWidth := StrToIntDef(Value, 0);
    StatusBar.Resize;
    Changed(True);
  end;
end;

function TfcStatusPanel.GetRect: TRect;
begin
  SendMessage(StatusBar.Handle, SB_GETRECT, Index, LPARAM(@result));
end;

procedure TfcStatusPanel.Invalidate;
var r: TRect;
    DrawBitmap: TBitmap;
    ACanvas: TCanvas;
    TempWidth: Integer;
begin
  if csLoading in StatusBar.ComponentState then Exit;
  r := GetRect;
  if not StatusBar.FSizing then if Style in [psDate, psDateTime, psTime] then
    case FStyle of
      psDate: if Trunc(Date) = FCurDateTime then Exit;
      psTime: if Frac(Date) = FCurDateTime then Exit;
      psDateTime: if Now = FCurDateTime then Exit;
    end;

  DrawBitmap := TBitmap.Create;
  ACanvas := TCanvas.Create;
  try
    //3/5/99-Need to get the system metrics for the scrollbar thumb.
    //4/26/99 - Only shrink width if last panel and sizegrip is true.
    if StatusBar.SizeGrip and (StatusBar.Panels[StatusBar.Panels.Count-1]=self) then
       TempWidth := fcRectWidth(FRect) - fcMin(23,GetSystemMetrics(SM_CXVSCROLL)+1)
    else TempWidth := fcRectWidth(FRect);

    if TempWidth > 0 then DrawBitmap.Width := TempWidth else Exit;

    DrawBitmap.Height := fcRectHeight(FRect);

    Draw(DrawBitmap.Canvas, Rect(0, 0, DrawBitmap.Width, DrawBitmap.Height));
    ACanvas.Handle := GetDC(StatusBar.Handle);
    ACanvas.Draw(FRect.Left, FRect.Top, DrawBitmap);
    ReleaseDC(StatusBar.Handle, ACanvas.Handle);
  finally
    ACanvas.Free;
    DrawBitmap.Free;
  end;
end;

{ TfcStatusPanels }

constructor TfcStatusPanels.Create(StatusBar: TfcCustomStatusBar; AStatusPanelClass: TfcStatusPanelClass);
begin
  inherited Create(AStatusPanelClass);
  FStatusBar := StatusBar;
end;

procedure TfcStatusPanels.RedrawIfNeeded(StyleToCheck: TfcStatusPanelStyle);
var i: integer;
begin
  for i := 0 to Count - 1 do
    if Items[i].FStyle = StyleToCheck then
      Items[i].Invalidate;
end;

function TfcStatusPanels.PanelByName(AName:String): TfcStatusPanel;
var i: Integer;
begin
  result := nil;
  for i := 0 to Count - 1 do
    if Items[i].Name = AName then
      result := Items[i];
end;

function TfcStatusPanels.Add: TfcStatusPanel;
begin
  result := TfcStatusPanel(inherited Add);
end;

function TfcStatusPanels.GetItem(Index: Integer): TfcStatusPanel;
begin
  result := TfcStatusPanel(inherited GetItem(Index));
end;

function TfcStatusPanels.GetOwner: TPersistent;
begin
  result := FStatusBar;
end;

procedure TfcStatusPanels.SetItem(Index: Integer; Value: TfcStatusPanel);
begin
  inherited SetItem(Index, Value);
end;

procedure TfcStatusPanels.Update(Item: TCollectionItem);
begin
  if Item <> nil then
    FStatusBar.UpdatePanel(Item.Index, True) else
    FStatusBar.UpdatePanels;
end;

{ TfcCustomStatusBar }

constructor TfcCustomStatusBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csOpaque];
  // 5/06/99 - PYW - Added StatusBarText property.
  FStatusBarText:= TfcStatusBarText.Create(Self);
  with FStatusBarText do
  begin
     CapsLock := 'Caps';
     Overwrite := 'Overwrite';
     NumLock := 'Num';
     ScrollLock := 'Scroll';
  end;
  Color := clBtnFace;
  Height := 20;
  Align := alBottom;
  FPanels := GetCollectionClass.Create(self, TfcStatusPanel);
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  FSizeGrip := True;
  StatusBars.Add(self);
end;

destructor TfcCustomStatusBar.Destroy;
begin
  if StatusBars<>nil then { 7/11/99 }
     StatusBars.Delete(StatusBars.IndexOf(self));
  FPanels.Free;
  FCanvas.Free;
  // 5/06/99 - PYW - Added StatusBarText property.
  FStatusBarText.Free;
  inherited Destroy;
end;

function InitCommonControl(CC: Integer): Boolean;
var
  ICC: TInitCommonControlsEx;
begin
  ICC.dwSize := SizeOf(TInitCommonControlsEx);
  ICC.dwICC := CC;
  Result := InitCommonControlsEx(ICC);
  if not Result then InitCommonControls;
end;

procedure TfcCustomStatusBar.CreateParams(var Params: TCreateParams);
const
  GripStyles: array[Boolean] of DWORD = (CCS_TOP, SBARS_SIZEGRIP);
begin
  InitCommonControl(ICC_BAR_CLASSES);
  inherited CreateParams(Params);
  CreateSubClass(Params, STATUSCLASSNAME);
  with Params do
  begin
    //4/26/99 - PYW - Show sizegrip only if sizeable window.
    Style := Style or GripStyles[FSizeGrip and (Parent is TCustomForm) and
             (TForm(Parent).BorderStyle in [bsSizeable, bsSizeToolWin])];