explbtn.pas

地址档案管理系统

(*
 * After the loading of the properties, the grayscale version can be
 * safely created
 *)
procedure TExplorerButton.Loaded;
begin
  inherited Loaded;
{//  if not FBitmap.Empty and FNoFocusBitmap.Empty and not (csLoading in ComponentState) then}
{//    CreateGrayscaleBitmap(IBitmap, FBitmap);}
end;

procedure TExplorerButton.Notification(AComponent: TComponent; Operation: TOperation);
begin
  if Operation = opRemove then
  begin
    if AComponent = FDropDown then
      FDropDown := nil;
     if AComponent = FExplorerPopup then
       FExplorerPopup := nil;
  end;
end ;

(*
 * Painting of the button
 *)
const PADDING = 2; (* Space between the bitmap and the caption *)

function TExplorerButton.Obscured: boolean;
var
  p: TPoint;
begin
  p := ClientToScreen(Point(1, 1));

   if WindowFromPoint(p) <> Handle then
      result := True
   else
   begin
     p.x := p.x + Width - 3;
     if WindowFromPoint(p) <> Handle then
        result := True
     else
     begin
       p.y := p.y + Height - 3;
       if WindowFromPoint(p) <> Handle then
          result := True
       else
       begin
         p.x := p.x - Width + 3;
         if WindowFromPoint(p) <> Handle then
            result := True
         else
           result := False
         end
      end
   end
end;

procedure TExplorerButton.Regenerate;
begin
  (* Transparency with TWinControl-derived controls is a real headache.
    * This is the *only* way the transparency is correctly regenerated....
    * And I can ensure you I spent tens of hours on this particular point :)
    *)
   regenerating := True;
   try
    Width := Width + 1;
     Application.ProcessMessages;
    Width := Width - 1;
   finally
     regenerating := False;
   end;
end;

procedure TExplorerButton.Paint;
var xt, yt, wt, _wt, ht, xb, yb, wb, hb, thePadding, buttonWidth: Integer;
  TempCaption : Array[0..256] of char;
  TempRect    : TRect;
  OffScreen: TBitmap;
  p: TPoint;
  screenDC: HDC;
   drawCanvas: TCanvas;
   depressOffset: Integer;
begin
  if (not regenerating) or visible or (csDesigning in ComponentState) then
  begin
    if (boTransparent in FOptions) and (not backBitmapCreated) and not (csDesigning in ComponentState) then
    begin
        if wasObscured and not Obscured then
         begin
          (* the button was obscured and now is fully visible -> let's regenerate the
             * transparency
             *)
           wasObscured := false;
           Regenerate;
            Exit
         end;
      p := ClientToScreen(Point(0, 0));
      backBitmap.Width := Width;
      backBitmap.Height := Height;

      screenDC := GetDC(0);

      try
        BitBlt(backBitmap.Canvas.Handle, 0, 0, Width, Height, screenDC, p.x, p.y, SRCCOPY);
      finally
        ReleaseDC(0, screenDC);
         end;
         if not Obscured then
         begin
            (* the button is visible on screen-> the back bitmap is okay *)
        backBitmapCreated := true;
            wasObscured := false
         end
         else
           (* the button is (partially) obscured (maybe a stay-on-op window was over)
             * -> the back bitmap is not created and we mark a flag to try to generate
             * the back bitmap again the next time a redraw occurs
             *)
           wasObscured := true
    end;

    OffScreen := TBitmap.Create;
    try
      OffScreen.Width := Width;
      OffScreen.Height := Height;
      drawCanvas := OffScreen.Canvas;
      if (boTransparent in FOptions) and not (csDesigning in ComponentState) then
      begin
      if not backBitmapCreated then
            drawCanvas := Canvas;
         drawCanvas.CopyRect(Rect(0, 0, Width, Height), backBitmap.Canvas, Rect(0,0,Width,Height))
      end
      else
      begin
         drawCanvas.Brush.Color := Parent.Brush.Color;
         drawCanvas.FillRect(Rect(0,0,Width,Height));
      end;

      (* Just to stop compiler warnings *)
      xt := 0;
      yb := 0;
      xb := 0;
      wb := 0;
      hb := 0;

      buttonWidth := Width;

      if FDropDownStyle = ddsOffice then
         Dec(buttonWidth, 11);

      if FDown and (boShowDownPattern in FOptions) then
      begin
         if pattern = nil then
            CreatePattern;
         drawCanvas.Brush.Bitmap := pattern;
         drawCanvas.FillRect(Rect(0, 0, buttonWidth, Height));
      end;

      drawCanvas.Brush.Style := bsClear;
      drawCanvas.Font := Self.Font;

      if not (boIconOnly in FOptions) and (Length(FCaption) > 0) then
      begin
         thePadding := PADDING;
         TempRect.Top := 0;
         TempRect.Left := 0;
         TempRect.Right := buttonWidth - 4;
         TempRect.Bottom := 0;
         StrPCopy(TempCaption, Caption);
         ComputeExtent(TempCaption, TempRect, drawCanvas);
         wt := TempRect.Right;
         ht := TempRect.Bottom;
      end
      else
      begin
         thePadding := 0;
         wt := 0;
         ht := 0;
      end;

      if wt > buttonWidth - 4 then
         wt := buttonWidth - 4;

      case FButtonSize of
        bsCustom:
         begin
          wb := FBitmap.Width;
          hb := FBitmap.Height;
         end;
        bsSmall:
         begin
          wb := SMALLBITMAPWIDTH;
          hb := SMALLBITMAPHEIGHT;
         end;
        bsLarge:
         begin
          wb := LARGEBITMAPWIDTH;
          hb := LARGEBITMAPHEIGHT;
         end;
      end;

      { Reserve place for the drawing of the popup mark }
      if ((((boPopupMark in FOptions) and Assigned(FDropDown))
         or Assigned(FExplorerPopup)) and (FDropDownStyle = ddsIExplorer)) then
         wb := wb + 10;

      if FBitmap.Empty then
      begin
         if Assigned(FDropDown) and (boPopupMark in FOptions) then
         begin
            _wt := wt + 10;
            if wt > buttonWidth - 14 then
               wt := buttonWidth - 14;
         end
         else
            _wt := wt;

         yt := (Height - ht) div 2;
         case Alignment of
            taLeftJustify:    xt := 3;
            taRightJustify:  xt := buttonWidth - _wt - 3;
            taCenter:      xt := (buttonWidth - _wt) div 2
         end;
      end
      else if (Layout = blBitmapTop) or (Layout = blBitmapBottom) then
      begin
         if Layout = blBitmapTop then
         begin
            yb := (Height - (ht + hb + thePadding)) div 2;
            yt := yb + hb + thePadding
         end
         else
         begin
            yt := (Height - (ht + hb + thePadding)) div 2;
            yb := yt + ht + thePadding
         end;
         case Alignment of
            taLeftJustify:
               begin
                  xt := 3;
                  xb := 3
               end;
            taRightJustify:
               begin
                  xt := buttonWidth - wt - 3;
                  xb := buttonWidth - wb - 3
               end;
            taCenter:
               begin
                  xb := (buttonWidth - wb) div 2;
                  xt := (buttonWidth - wt) div 2
               end;
         end;
      end
      else
      if Layout = blBitmapLeft then
      begin
         if wt + wb + thePadding > buttonWidth - 4 then
            wt := buttonWidth - 4 - thePadding - wb;
         yb := (Height - hb) div 2;
         yt := (Height - ht) div 2;

         case Alignment of
         taLeftJustify:
            begin
               xb := 3;
               xt := xb + wb + thePadding
            end;
         taRightJustify:
            begin
               xt := buttonWidth - wt - 3;
               xb := xt - wb - thePadding
            end;
         taCenter:
            begin
               xb := (buttonWidth - (wb + wt + thePadding)) div 2;
               xt := xb + wb + thePadding
            end;
         end;
      end
      else (* blBitmapRight *)
      begin
         if wt + wb + thePadding > buttonWidth - 4 then
            wt := buttonWidth - 4 - thePadding - wb;
         yb := (Height - hb) div 2;
         yt := (Height - ht) div 2;
         case Alignment of
         taLeftJustify:
            begin
               xt := 3;
               xb := xt + wt + thePadding
            end;
         taRightJustify:
            begin
               xb := buttonWidth - wb - 3;
               xt := xb - wt - thePadding
            end;
         taCenter:
            begin
               xt := (buttonWidth - (wb + wt + thePadding)) div 2;
               xb := xt + wt + thePadding
            end;
         end;
      end;

      if csDesigning in ComponentState then
      begin
         drawCanvas.Pen.Color := clBlack;
         drawCanvas.Pen.Style := psSolid;
         drawCanvas.Brush.Style := bsClear;
         drawCanvas.Rectangle(0, 0, buttonWidth, Height);
         if FDropDownStyle = ddsOffice then
            drawCanvas.Rectangle(buttonWidth, 0, Width, Height);
      end;

      if (boWordWrap in Options) and (xt + wt > buttonWidth - 5) then
         wt := buttonWidth - xt - 5;

      with TempRect do
      begin
         left := xt;
         top  := yt;
         right:= xt + wt;
         bottom:= yt + ht;
      end;

      if Enabled then
      begin
         if not ((Pushed and MouseIn) or (popupOpened and (FDropDownStyle = ddsIExplorer))) and (not Down) then
         begin
            (* Unpushed state - Mouse in or out *)
            if MouseIn or popupOpened then
               DrawOutline(drawCanvas, False)
            else
               drawCanvas.Font.Color := UnselectedFontColor;
            if BevelStyle = bsLowered then
            begin
               Inc(TempRect.Left);
               Inc(TempRect.Top);
               Inc(TempRect.Right);
               Inc(TempRect.Bottom);
            end;
            if not (boIconOnly in FOptions) and (Length(Caption) > 0) then
               DrawTheText(drawCanvas, TempRect, TempCaption);
            if not FBitmap.Empty then
            begin
               (* Draw the normal or shaded bitmap.
                * Transparency color is at (0,0)
                *)
               if MouseIn or popupOpened or not (boMonoDisplay in FOptions) then
                  DrawTransparentBitmap(drawCanvas, FBitmap, xb, yb)
               else if FNoFocusBitmap.Empty then
                  DrawTransparentBitmap(drawCanvas, IBitmap, xb, yb)
               else
                  DrawTransparentBitmap(drawCanvas, FNoFocusBitmap, xb, yb);
               if (boPopupMark in FOptions) and (Assigned(FDropDown)
                  or Assigned(FExplorerPopup)) and (FDropDownStyle = ddsIExplorer) then
               begin
                  DrawPopupMark(drawCanvas, xb + FBitmap.Width + 3, yb + (hb div 2));
               end;
            end
            else if (boPopupMark in FOptions) and (Assigned(FDropDown)
                 or Assigned(FExplorerPopup)) and (FDropDownStyle = ddsIExplorer) then
                        DrawPopupMark(drawCanvas, xt + wt + 3, yt + (ht div 2));
         end
         else
         begin
            if boNoDepress in FOptions then
                depressOffset := 0
            else
                 depressOffset := 1;

            (* Pushed state *)
            DrawOutline(drawCanvas, True);
            if (BevelStyle = bsRaised) and not(boNoDepress in FOptions) then
            begin
               Inc(TempRect.Left);
               Inc(TempRect.Top);
               Inc(TempRect.Right);
               Inc(TempRect.Bottom);
            end;
            if not (boIconOnly in FOptions) and (Length(Caption) > 0) then
               DrawTheText(drawCanvas, TempRect, TempCaption);
            if not FBitmap.Empty then
            begin
               DrawTransparentBitmap(drawCanvas, FBitmap, xb+depressOffset, yb+depressOffset);
               if (boPopupMark in FOptions) and (Assigned(FDropDown)
                  or Assigned(FExplorerPopup)) and (FDropDownStyle = ddsIExplorer) then
                  DrawPopupMark(drawCanvas, xb + FBitmap.Width + 3 + depressOffset, yb + (hb div 2) + depressOffset);
            end
            else if (boPopupMark in FOptions) and (Assigned(FDropDown)
                 or Assigned(FExplorerPopup)) and (FDropDownStyle = ddsIExplorer) then
               DrawPopupMark(drawCanvas, xt + wt + 3 + depressOffset, yt + (ht div 2) + depressOffset);
         end
      end
      else
      begin
         (* Disabled state *)
         if Down then
            DrawOutline(drawCanvas, True);
         if not FDisabledBitmap.Empty then
            DrawTransparentBitmap(drawCanvas, FDisabledBitmap, xb, yb)
         else
            DrawDisabledBitmap(drawCanvas, xb, yb, FBitmap);
         if not (boIconOnly in FOptions) and (Length(Caption) > 0) then
            DrawDisabledText(drawCanvas, TempRect, TempCaption);
      end;

      if FDropDownStyle = ddsOffice then
      begin
         if popupPushed or popupOpened then
            DrawPopupMark(drawCanvas, Width - 8, Height div 2 + 1)
         else
            DrawPopupMark(drawCanvas, Width - 9, Height div 2)
      end;

      if OffScreen.Canvas = drawCanvas then
        Canvas.CopyRect(Rect(0,0,Width,Height), drawCanvas, Rect(0,0,Width,Height));

    finally
       OffScreen.Free;
    end;

    if not FBitmap.Empty then
      FBitmap.Dormant;
    if not FDisabledBitmap.Empty then
      FDisabledBitmap.Dormant;
    if not FNoFocusBitmap.Empty then
       FNoFocusBitmap.Dormant;
    if not IBitmap.Empty then
       IBitmap.Dormant;
    if not backBitmap.Empty then
       backBitmap.Dormant;
  end;
  painted := True;
end;