fcstatusbar.pas

一套及时通讯的原码

{    if FSizeGrip then
      Style := Style or SBARS_SIZEGRIP else
      Style := Style or CCS_TOP;}
    if fcUseThemes(self) then //ThemeServices.ThemesEnabled then
      WindowClass.style := WindowClass.style or CS_HREDRAW or CS_VREDRAW
    else
      WindowClass.style := WindowClass.style and not CS_HREDRAW;
  end;
end;

procedure TfcCustomStatusBar.Loaded;
begin
  inherited;
  Resize;
end;

procedure TfcCustomStatusBar.DestroyWnd;
begin
  SendMessage(Handle, SB_SETTEXT, 0, Integer(PChar('')));
  KillTimer(Handle, TIMER_ID);
  KillTimer(Handle, HINT_TIMER_ID);
  KillTimer(Handle, RICHEDIT_TIMER_ID);
  inherited DestroyWnd;
end;

procedure TfcCustomStatusBar.CreateWnd;
var i: Integer;
    FoundDate, FoundHint, FoundRichEdit: boolean;
begin
  inherited CreateWnd;
  UpdatePanels;

  if FSimpleText <> '' then SendMessage(Handle, SB_SETTEXT, 255, Integer(PChar(FSimpleText)));
  if FSimplePanel then SendMessage(Handle, SB_SIMPLE, 1, 0);

  FoundRichEdit:= False;
  FoundHint:= False;
  FoundDate:= False; { 4/27/99 - RSW (Fix bug where only one timer was set }
  if not (csDesigning in ComponentState) then
    for i := 0 to Panels.Count - 1 do
      if (not FoundHint) and ((Panels[i].Style = psHint)or(Panels[i].Style=psHintContainerOnly)) then
      begin
        SetTimer(Handle, HINT_TIMER_ID, 100, nil);
        FoundHint:= True;
      end //3/11/99 - PYW - Timer for datetime styles never set so set it.
      else if (not FoundDate) and (Panels[i].Style in [psDate,psTime,psDateTime]) then
      begin
        //4/27/99 - PYW - Update Timer to 1000 to be consistent.
        SetTimer(Handle, TIMER_ID, 1000, nil);
        FoundDate:= True;
      end
      else if (not FoundRichEdit) and (Panels[i].Style = psRichEditStatus) then
      begin
        SetTimer(Handle, RICHEDIT_TIMER_ID, 100, nil);
        FoundRichEdit:= True;
      end
end;

procedure TfcCustomStatusBar.DrawPanel(Panel: TfcStatusPanel; Rect: TRect);
begin
  Panel.FCanvas := Canvas;
  Panel.FRect := Rect;
  //4/26/99 - Only shrink width if last panel and sizegrip is true.
  if SizeGrip and (Panels[Panels.Count-1]=Panel) then
     Rect.Right := Rect.Right-fcMin(23,GetSystemMetrics(SM_CXVSCROLL)+1);
  Panel.Draw(Canvas, Rect);
  if Assigned(FOnDrawPanel) then FOnDrawPanel(Self, Panel, Rect);
end;

procedure TfcCustomStatusBar.Click;
var Panel: TfcStatusPanel;
begin
  Panel := GetPanelFromPt(-1, -1);
  if (Panel <> nil) then Panel.Click;
  inherited;
end;

procedure TfcCustomStatusBar.DblClick;
var Panel: TfcStatusPanel;
begin
  Panel := GetPanelFromPt(-1, -1);
  if (Panel <> nil) then Panel.DblClick;
  inherited;
end;

procedure TfcCustomStatusBar.SetPanels(Value: TfcStatusPanels);
begin
  FPanels.Assign(Value);
end;

procedure TfcCustomStatusBar.SetSimplePanel(Value: Boolean);
begin
  if FSimplePanel <> Value then
  begin
    FSimplePanel := Value;
    if HandleAllocated then
      SendMessage(Handle, SB_SIMPLE, Ord(FSimplePanel), 0);
  end;
end;

procedure TfcCustomStatusBar.SetSimpleText(const Value: string);
begin
  if FSimpleText <> Value then
  begin
    FSimpleText := Value;
    if HandleAllocated then
      SendMessage(Handle, SB_SETTEXT, 255, Integer(PChar(FSimpleText)));
  end;
end;

//4/26/99 - PYW - Show sizegrip only if sizeable window.
function TfcCustomStatusBar.GetSizeGrip:Boolean;
begin
   result := FSizeGrip and (Parent is TCustomForm) and
      (TForm(Parent).BorderStyle in [bsSizeable, bsSizeToolWin]);
end;

procedure TfcCustomStatusBar.SetSizeGrip(Value: Boolean);
begin
  if FSizeGrip <> Value then
  begin
    FSizeGrip := Value;
    {if not (csLoading in ComponentState) then }RecreateWnd;
  end;
end;

procedure TfcCustomStatusBar.UpdatePanel(Index: Integer; DoInvalidate: Boolean);
var
  Flags: Integer;
  S: string;
  r: TRect;
begin
  if HandleAllocated then
    with Panels[Index] do
    begin
      Flags := 0;
      case Bevel of
        pbNone: Flags := SBT_NOBORDERS;
        pbRaised: Flags := SBT_POPOUT;
      end;
      Flags := Flags or SBT_OWNERDRAW;
      s := Text;
      case TextOptions.Alignment of
        taCenter: s := #9 + S;
        taRightJustify: s := #9#9 + S;
      end;
      SendMessage(Handle, SB_SETTEXT, Index or Flags, Integer(PChar(S)));
      if DoInvalidate then
      begin
        r := GetRect;
        InvalidateRect(Handle, @r, True);
      end;
    end;
end;

procedure TfcCustomStatusBar.UpdatePanels;
const
  MaxPanelCount = 128;
var
  I, Count, PanelPos: Integer;
  PanelEdges: array[0..MaxPanelCount - 1] of Integer;
begin
  if HandleAllocated then
  begin
    Count := Panels.Count;
    if Count > MaxPanelCount then Count := MaxPanelCount;
    if Count = 0 then
    begin
      PanelEdges[0] := -1;
      SendMessage(Handle, SB_SETPARTS, 1, Integer(@PanelEdges));
      SendMessage(Handle, SB_SETTEXT, 0, Integer(PChar('')));
    end else
    begin
      PanelPos := 0;
      for I := 0 to Count - 2 do
      begin
        Inc(PanelPos, Panels[I].PaintWidth);
        PanelEdges[I] := PanelPos;
      end;
      PanelEdges[Count - 1] := -1;
      SendMessage(Handle, SB_SETPARTS, Count, Integer(@PanelEdges));
      for I := 0 to Count - 1 do UpdatePanel(I, False);
//      InvalidateRect(Handle, nil, True);
//      Invalidate;
    end;
  end;
end;

procedure TfcCustomStatusBar.CMShowingChanged(var Message: TMessage);
begin
  inherited;
end;

procedure TfcCustomStatusBar.CNDrawItem(var Message: TWMDrawItem);
var
  SaveIndex: Integer;
  PanelEdges: array[0..255 - 1] of Integer;
  ACount: Integer;
begin
  FillChar(PanelEdges, SizeOf(PanelEdges), 0);
  ACount := SendMessage(Handle, SB_GETPARTS, Panels.Count, Integer(@PanelEdges));
  if ACount <> Panels.Count then RecreateWnd;

  with Message.DrawItemStruct^ do
  begin
    SaveIndex := SaveDC(hDC);
    FCanvas.Handle := hDC;
    FCanvas.Font := Font;
    FCanvas.Brush.Color := clBtnFace;
    FCanvas.Brush.Style := bsSolid;
    DrawPanel(Panels[itemID], rcItem);//Rect(Left, Top - 1, Right, Bottom));
    FCanvas.Handle := 0;
    RestoreDC(hDC, SaveIndex);
  end;
  Message.Result := 1;
end;

procedure TfcCustomStatusBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  {$ifdef fcUseThemeManager}
var
  Details: TThemedElementDetails;
  {$endif}
begin
  {$ifdef fcUseThemeManager}
  if ThemeServices.ThemesEnabled then
  begin
    Details := ThemeServices.GetElementDetails(tsStatusRoot);
    ThemeServices.DrawElement(Message.DC, Details, ClientRect, nil);
    Message.Result := 1;
  end
  else
  {$endif}
    inherited;
end;

procedure TfcCustomStatusBar.WMSize(var Message: TWMSize);
var i: Integer;
begin
  FSizing := True;
  if (Parent = nil) or ([csLoading, csDestroying] * ComponentState <> []) then Exit;
  if not (csLoading in ComponentState) then Resize;
  for i := 0 to Panels.Count - 1 do
    if (Panels[i].Control = nil) or (Panels[i].Control is TCustomRichEdit) then
      Panels[i].Invalidate;
  FSizing := False;
//      DrawPanel(Panels[i],Panels[i].FRect);

//3/5/99-PYW-Causes a lot of unnecessary flicker.  Does not seem to be needed.
{  with FPanels do
    for i := 0 to Count - 1 do
      if (Items[i] as TfcStatusPanel).Control <> nil then
        DrawPanel(Items[i] as TfcStatusPanel,
          Rect((Items[i] as TfcStatusPanel).FRect.Left + (fpanels.items[i] as TfcStatusPanel).Margin,
               (Items[i] as TfcStatusPanel).FRect.Top + (fpanels.items[i] as TfcStatusPanel).Margin,
               (Items[i] as TfcStatusPanel).FRect.right-(fpanels.items[i] as TfcStatusPanel).Margin,
               (Items[i] as TfcStatusPanel).FRect.Bottom-(fpanels.items[i] as TfcStatusPanel).Margin));}
end;

procedure TfcCustomStatusBar.Notification(AComponent: TComponent; Operation: TOperation);
var i: Integer;
begin
  inherited Notification(AComponent, Operation);

  if AComponent <> self then
    for i := 0 to Panels.Count - 1 do Panels[i].Notification(AComponent, Operation);

  if (Operation = opRemove) and (FImageList = AComponent) then
    Images := nil;
end;

procedure TfcCustomStatusBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var Panel: TfcStatusPanel;
begin
  Panel := GetPanelFromPt(-1, -1);
  if (Panel <> nil) then Panel.MouseUp(Button, Shift, X, Y);
  inherited;
end;

procedure TfcCustomStatusBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var Panel: TfcStatusPanel;
begin
  Panel := GetPanelFromPt(-1, -1);
  if (Panel <> nil) then Panel.MouseDown(Button, Shift, X, Y);
  inherited;
end;

procedure TfcCustomStatusBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var Panel: TfcStatusPanel;
begin
  Panel := GetPanelFromPt(-1, -1);
  if (Panel <> nil) then Panel.MouseMove(Shift, X, Y);
  inherited;
end;

procedure TfcCustomStatusBar.WndProc(var Message: TMessage);
begin
  if (csDesigning in ComponentState) then
    if (Message.Msg = WM_LBUTTONDOWN) then
     Invalidate;

  inherited;
end;

function TfcCustomStatusBar.GetPanelFromPt(x, y: Integer): TfcStatusPanel;
var i: integer;
begin
  result := nil;

  if (x = -1) and (y = -1) then
    with fcGetCursorPos do
      with ScreenToClient(Point(x, y)) do
        result := GetPanelFromPt(x, y)
  else for i := 0 to Panels.Count - 1 do
    if PtInRect(Panels[i].GetRect, Point(x, y)) then
    begin
      result := Panels[i];
      Break;
    end;
end;

procedure TfcCustomStatusBar.WMTimer(var Message: TWMTimer);
var i: Integer;
    RichEdit: TCustomRichEdit;
    TempRow, TempCol, TempColBasedOnRow: integer;
//    cmp:TComponent;
begin
  case Message.TimerID of
    TIMER_ID: for i := 0 to Panels.Count - 1 do
      if Panels[i].Style in [psDate, psTime, psDateTime] then
        Panels[i].Invalidate;
    RICHEDIT_TIMER_ID: for i := 0 to Panels.Count - 1 do
      if (Panels[i].Style = psRichEditStatus) and
         (Panels[i].Component is TCustomRichEdit) then
      begin
         RichEdit:= TCustomRichEdit(Panels[i].Component);
         with Panels[i] do begin
            TempRow := SendMessage(RichEdit.Handle, EM_LINEFROMCHAR, RichEdit.SelStart, 0);
            TempCol := RichEdit.SelStart - SendMessage(RichEdit.Handle, EM_LINEINDEX, -1, 0);

            { 5/7/99 - RSW - Fix bug in RichEdit control where it makes row 1 too big }
            { This can happen if you enter vk_home on a line that does not end a paragraph}
            TempColBasedOnRow := RichEdit.SelStart - SendMessage(RichEdit.Handle, EM_LINEINDEX, TempRow, 0);
            if TempCol<>TempColBasedOnRow then dec(TempRow);

            if (TempRow<>FRow) or (TempCol<>FCol) then
            begin
               FRow:= TempRow;
               FCol:= TempCol;
               Panels[i].Invalidate;
            end;
         end
      end;

    HINT_TIMER_ID:
      begin
        for i := 0 to Panels.Count - 1 do
        if (Panels[i].Style = psHint) or (Panels[i].Style=psHintContainerOnly) then
        begin
          if Panels[i].Style = psHintContainerOnly then
             if not fcCanGetHint(Self) then continue;

          Panels[i].Text := Application.Hint;
        end;
      end;
  end;
end;

function TfcCustomStatusBar.GetCollectionClass: TfcStatusPanelsClass;
begin
  result := TfcStatusPanels;
end;

procedure TfcCustomStatusBar.ComponentExclusive(Value: TComponent; Panel: TfcStatusPanel; ThisStatusBarOnly: Boolean);
var i: Integer;
begin
  // Check to see if another panel already contains this Control.  If so, then
  // Remove it from the other panel and let this procedure reassign it.
  for i := 0 to Panels.Count - 1 do
    if (Panels[i].Component = Value) and (Panels[i] <> Panel) then
      Panels[i].Component := nil;

  // Check to see if a different StatusBar Panel already contains this Control.
  // If so, then remove it from the other panel and let this procedure reassign it.
  if not ThisStatusBarOnly then for i := 0 to StatusBars.Count - 1 do
    if StatusBars[i] <> self then
      TfcStatusBar(StatusBars[i]).ComponentExclusive(Value, Panel, True);
end;
{
function TfcCustomStatusBar.GetPriorityPanel(APriority: Integer): TfcStatusPanel;
var i: Integer;
begin
  result := nil;
  for i := 0 to Panels.Count - 1 do
  begin
    if Panels[i].Priority = APriority then
    begin
      result := Panels[i];
      Break;
    end;
  end;
end;
}
procedure TfcCustomStatusBar.Resize;
var TotalWidths: Integer;
    i: Integer;
    r: TRect;
    UpdateFlag: Boolean;
begin
  {$ifdef fcDelphi3}
  if Assigned(FOnResize) then FOnResize(Self);
  {$else}
  inherited;
  {$endif}

  if (csLoading in ComponentState) or (Width = 0) then Exit;

  TotalWidths := 0;
  for i := 0 to Panels.Count - 1 do
  begin
    Panels[i].PaintWidth := fcMin(Width - TotalWidths, StrtoIntDef(Panels[i].Width, -1));
    if Panels[i].PaintWidth <> -1 then
      inc(TotalWidths, Panels[i].PaintWidth);
  end;
  for i := 0 to Panels.Count - 1 do
    if (Panels[i].PaintWidth = -1) and (Width - TotalWidths > 0) then
      Panels[i].PaintWidth := (Width - TotalWidths) * StrtoInt(Copy(Panels[i].Width, 1, Length(Panels[i].Width) - 1)) div 100;

  if fcSizeEqual(FLastSize, fcSize(0, 0)) or (FLastSize.cy <> Height) then
    Panels.Update(nil)
  else begin
    r := Rect(Width - 25, 0, Width, Height);
    if Width > FLastSize.cx then
      r.Left := FLastSize.cx - 25;
    InvalidateRect(Handle, @r, True);
  end;

  FLastSize := fcSize(Width, Height);

  UpdateFlag := False;
  for i := 0 to Panels.Count - 1 do if Pos('%', Panels[i].Width) <> 0 then UpdateFlag := True;
  if UpdateFlag then UpdatePanels;
end;

var Hook: HHOOK = 0;

function KeyboardProc(code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var AStyle: TfcStatusPanelStyle;
    i: integer;
begin
  result := CallNextHookEx(Hook, code, wParam, lParam);
  AStyle := psTextOnly;
  case wParam of
    VK_INSERT: AStyle := psOverwrite;
    VK_CAPITAL: AStyle := psCapsLock;
    VK_NUMLOCK: AStyle := psNumLock;
    VK_SCROLL: AStyle := psScrollLock;
  end;
  if AStyle <> psTextOnly then
    for i := 0 to StatusBars.Count - 1 do
      TfcCustomStatusBar(StatusBars[i]).Panels.RedrawIfNeeded(AStyle);
end;

procedure TfcCustomStatusBar.Invalidate;
begin
  if not (csLoading in ComponentState) then inherited;
end;

initialization
  StatusBars := TList.Create;
  Hook := SetWindowsHookEx(WH_KEYBOARD, @KeyboardProc, 0, GetCurrentThreadID);
finalization
  UnhookWindowsHookEx(Hook);
  StatusBars.Free;
  StatusBars:= nil; { 7/11/99 }
end.