wwexpandbutton.pas

胜天进销存源码,国产优秀的进销存

   if DynamicCaption then
   begin
      TempCaption:=  ValueChecked;
      if length(TempCaption)<length(ValueUnchecked) then
         TempCaption:= ValueUnchecked;
   end
   else TempCaption:= Caption;
   DrawTextEx(Canvas.Handle, PChar(TempCaption),
              Length(TempCaption), newdrawrect, DrawFlags or DT_CALCRECT, nil);
   DrawRect:= NewDrawRect;
   DrawRect.Top:= Indents.TextY + (ClientHeight -
                   (NewDrawRect.Bottom-NewDrawRect.Top)) div 2;
   DrawRect.Bottom:= DrawRect.Top + NewDrawRect.Bottom; //DrawRect.Bottom - (NewDrawRect.Bottom-NewDrawRect.Top) div 2;
   if wwIsClass(parent.classtype, 'TwwDBGrid') and
      (dgRowLines in TwwDBGrid(parent).Options) then
       DrawRect.Top:= DrawRect.Top +1;

end;

type
  TwwCheatGridCast = class(TwwDBGrid);

procedure TwwCustomCheckBox.Paint;
var checkboxSizex, checkboxsizey, offsetx, offsety: integer;
    pt: TPoint;
    TempIndentTextX, TempIndentCheckboxX: integer;
    r: TRect;

  function DrawHighlight: boolean;
  begin
     result:= False;
     if wwIsClass(parent.classtype, 'TwwDBGrid') then begin
       result:= parent.focused and
                not wwInPaintCopyState(ControlState)
     end
  end;

  procedure PaintText;
  var ARect, FocusRect: TRect;
      Flags: integer;
      HaveText: boolean;
      TempCaption: string;
      PaintFieldState : TCheckBoxState;
  begin
    ComputeTextRect(ARect);
    tempCaption:= Caption;

    if DynamicCaption then
    begin
       HaveText:= True;
       if csPaintCopy in ControlState then
       begin
          PaintFieldState:= GetFieldState;
          if (PaintFieldState = cbChecked) then TempCaption:= ValueChecked
          else if PaintFieldState=cbUnchecked then TempCaption:= ValueUnchecked
          else TempCaption:= ''
       end
    end
    else
       HaveText:= Caption<>'';

    if Focused and ShowFocusRect and HaveText and not (parent is TCustomGrid) then
    begin
      FocusRect:= Rect(ARect.Left - 2, ARect.Top - 2,
                     wwMin(ARect.Right+2, ARect.Left + Canvas.TextWidth(TempCaption) + 2),
                     ARect.Bottom + 2);
      Canvas.Brush.Color := Color;
      Canvas.Font.Color := clBlack;
      Canvas.FrameRect(FocusRect);
      Canvas.Brush.Color := clWhite;
      Canvas.Font.Color := clBlack;
      Canvas.DrawFocusRect(FocusRect);
    end;

    SetBkMode(Canvas.Handle, TRANSPARENT);
    Flags:= 0;
    if WordWrap then flags:= flags or DT_EDITCONTROL or DT_WORDBREAK;

    InflateRect(ARect, 0, 2);
    ARect.Top:= ARect.Top + 2;
    if DrawHighlight then begin
//       Canvas.Font.Color := clHighlightText;
    end
    else if not (csPaintCopy in ControlState) then
       Canvas.Font.Color:= Font.Color;

    if (not Focused) and IsTransparentEffective and
       (Frame.NonFocusTransparentFontColor<>clNone) then
        Canvas.Font.Color:= Frame.NonFocusTransparentFontColor;

    DrawTextEx(Canvas.Handle, Pchar(Tempcaption), length(Tempcaption), ARect, Flags, nil);
  end;

  procedure PaintCheckbox;
  var
      DrawRect, TempRect: TRect;
      FrameStateFlags, StateFlags: integer;
      cp: TPoint;
      TempState: TCheckboxState;
  begin
    ComputeGlyphRect(DrawRect);

    if State=cbChecked then
       StateFlags:= DFCS_BUTTONCHECK
    else
       StateFlags:= DFCS_BUTTON3STATE;

    if (cslbuttondown in controlstate) and Focused and not (csPaintCopy in ControlState) then
    begin
        if IsInGrid(self) then
        begin
           GetCursorPos(cp);
           cp:= ScreenToClient(cp);
           if IsMouseInControl then
              StateFlags := StateFlags or DFCS_PUSHED;
        end
        else begin
            if IsMouseInControl then
              StateFlags := StateFlags or DFCS_PUSHED;
        end
    end;

    if SpaceKeyPressed and (GetKeyState(vk_space)<0) and Focused then
       StateFlags := StateFlags or DFCS_PUSHED;

    if State=cbChecked then
       StateFlags := StateFlags or DFCS_CHECKED
    else if State = cbGrayed then
       StateFlags:= StateFlags or DFCS_CHECKED;

    if csPaintCopy in ControlState then
       TempState:= GetFieldState
    else
       TempState:= State;

    If (Images<>nil) and (Images.Count>0) and (FShowAsButton) then
    begin
          FrameStateFlags:= DFCS_BUTTONPUSH;
          if (StateFlags and DFCS_PUSHED <> 0) then
             FrameStateFlags:= FrameStateFlags or DFCS_PUSHED;
          TempRect:= DrawRect;
          InflateRect(TempRect, 2, 2);
          with DrawRect do
              DrawFrameControl(Canvas.Handle, TempRect,
                      DFC_BUTTON, FrameStateFlags);
    end;

    if TempState=cbChecked then
    begin
       if (Images<>nil) and (Images.count>1) then begin
          if FShowAsButton and (StateFlags and DFCS_PUSHED <> 0) then begin
             FImages.Draw(Canvas, drawrect.left+1, drawrect.top+1, 1, True);
          end
          else
             FImages.Draw(Canvas, drawrect.left, drawrect.top, 1, True);
          exit;
       end
    end
    else if TempState=cbUnchecked then
    begin
       if (Images<>nil) and (Images.count>0) then begin

          if FShowAsButton and (StateFlags and DFCS_PUSHED <> 0) then  // Add property - default does not press
          begin
             FImages.Draw(Canvas, drawrect.left+1, drawrect.top+1, 0, True);
          end
          else
             FImages.Draw(Canvas, drawrect.left, drawrect.top, 0, True);
          exit;
       end
    end
    else begin
       if (Images<>nil) and (Images.count>2) then begin
          FImages.Draw(Canvas, drawrect.left, drawrect.top, 2, True);
          exit;
       end
    end;

    Canvas.Brush.Color := clBtnFace;
    Canvas.FillRect(DrawRect);
    Canvas.Brush.Color := clBtnShadow;

    if Images=nil then
    begin
      with DrawRect do
         DrawFrameControl(Canvas.Handle, DrawRect,
             DFC_BUTTON, StateFlags);
    end
  end;

  Function Max(x,y: integer): integer;
  begin
     if x>y then result:=x else result:=y
  end;

  procedure EndPainting;
  begin
     if (FCanvas = Canvas) then exit;
     r:= ClientRect;
//     InflateRect(r, -2, -2); // Seems to cause glyph to not appear
     FCanvas.CopyRect(r, FPaintCanvas, r);
  end;

begin
   if False and Focused and (not AlwaysTransparent) then
   begin
      FPaintBitmap:= TBitmap.create;
      FPaintCanvas:= FPaintBitmap.canvas;
      FPaintBitmap.Width:= ClientWidth;
      FPaintBitmap.Height:= ClientHeight;
   end;

   try
     if (not (Frame.Enabled and Frame.Transparent)) or
       (not AlwaysTransparent) and (Focused) then
     begin
        if not (IsInGridPaint(self)) then
        begin
          r:= ClientRect;
//          InflateRect(r, -2, -2); // Seems to cause glyph to not appear
          Canvas.Brush.Color:= Color;
          if DrawHighlight then begin
             Canvas.Brush.Color := clHighlight;
             Canvas.Font.Color := clHighlightText;
          end;
          {  Honor grid's colors when painting cell }
          if DrawHighlight and (wwIsClass(parent.classtype, 'TwwCustomDBGrid')) then
          begin
             if (GetField<>nil) then
                TwwCheatGridCast(Parent).DoCalcCellColors(GetField, [], True, Canvas.Font, Canvas.Brush);
          end;
          Canvas.FillRect(r);
        end
     end;
     PaintCheckbox;
     PaintText;

    if DrawHighlight then
    begin
      r:= ClientRect;
      Canvas.Brush.Color := clHighlight;
      Canvas.Font.Color := clHighlightText;
      Canvas.Pen.Color:= clHighlight;
      Canvas.FrameRect(r);
      SetTextColor(Canvas.Handle, ColorToRGB(clHighlightText));
      SetBkColor(Canvas.Handle, ColorToRGB(clHighlight));
      Canvas.DrawFocusRect(r);
    end

   finally
     EndPainting;
     FPaintBitmap.Free;
     FPaintBitmap:=nil;
   end
end;

procedure TwwCustomCheckBox.WMLButtonUp(var Message: TWMLButtonUp);
var r: TRect;
begin
   inherited;
   if not IsInGrid(self) then begin
      if PtInRect(ClientRect, Point(Message.xpos,Message.ypos)) then
         Toggle;
   end
   else begin
      ComputeGlyphRect(r);
      InflateRect(r, 3, 3);
      if PtInRect(r, Point(Message.xpos,Message.ypos)) then
         Toggle;
   end
end;

procedure TwwCustomCheckBox.BMSetCheck(var Message: TMessage);
var r: TRect;
begin
   inherited;
   if DynamicCaption then begin
     if State=cbChecked then Caption:= ValueChecked
     else if State=cbUnchecked then Caption:= ValueUnchecked
     else Caption:= ''
   end
   else begin
      if IsTransparentEffective and
         ((not Focused) or AlwaysTransparent) then
      begin
        ComputeGlyphRect(r);
        r:= Rect(r.left + left, r.top + top, r.right+left, r.bottom+top);
        InvalidateRect(parent.handle, @r, False);
//       Frame.RefreshTransparentText(False, False);
      end
   end;

   invalidate;
end;

procedure TwwCustomCheckBox.PaintBorder;
begin
   if HandleAllocated then
   begin
     if not Frame.Enabled then exit;
     Frame.Ncpaint(Focused, AlwaysTransparent);
   end;
end;

procedure TwwCustomCheckBox.WMKillFocus(var Message: TWMKillFocus);
var
   exStyle, origStyle: longint;
   r: TRect;
begin
   inherited;

   if IsTransparentEffective then
   begin
     OrigStyle:= Windows.GetWindowLong(handle, GWL_EXSTYLE);
     exStyle:= OrigStyle or WS_EX_TRANSPARENT;
     Windows.SetWindowLong(handle, GWL_EXSTYLE, exStyle);
     Frame.RefreshTransparentText(True);
//     r:= BoundsRect;
//     InvalidateRect(Parent.handle, @r, False);
   end;

   invalidate;
//   InvalidateBorder;
end;

procedure TwwCheckBox.WMSetFocus(var Message: TWMSetFocus);
begin
   inherited;
   if (FDataLink.Field<>nil) then Modified:=False;
end;

procedure TwwCustomCheckBox.WMSetFocus(var Message: TWMSetFocus);
var r: TRect;
    exStyle, origStyle: longint;
begin
   inherited;

   SpaceKeyPressed:=False;

   if IsTransparentEffective and (not AlwaysTransparent) then begin
     OrigStyle:= Windows.GetWindowLong(handle, GWL_EXSTYLE);
     exStyle:= OrigStyle and not WS_EX_TRANSPARENT;
     Windows.SetWindowLong(handle, GWL_EXSTYLE, exStyle);
     invalidate;
   end;

{  if Frame.enabled then begin
     if IsTransparentEffective then begin
        r:= BoundsRect;
        InvalidateRect(Parent.Handle, @r, False);
     end;
     invalidate;
  end;
}

   if IsTransparentEffective and AlwaysTransparent then
   begin
     r:= BoundsRect;
     InvalidateRect(Parent.handle, @r, False);
   end;
   invalidate;

//   if Frame.Enabled then {(not AlwaysTransparent) then }InvalidateBorder;
end;

procedure TwwCustomCheckBox.WMNCPaint(var Message: TMessage);
begin
   inherited;
{   if not Frame.Enabled then exit;
   Frame.Ncpaint(Focused, AlwaysTransparent);
   message.result:= 0;
}
end;

constructor TwwCustomCheckBox.Create(AOwner: TComponent);
begin
   inherited;
   FShowAsButton:= True;
   FFrame:= TwwEditFrame.create(self);
   FIndents:= TwwWinButtonIndents.create(self);
   FValueChecked:= 'True';
   FValueUnchecked:= 'False';
   FShowFocusRect:= True;
end;

function TwwCustomCheckBox.isTransparentEffective: boolean;
begin
   result:= Frame.Transparent and Frame.IsFrameEffective
end;


Function TwwCustomCheckBox.IsMouseInControl: boolean;
var p: TPoint;
    AHandle: HWND;
begin
  GetCursorPos(p);
  p:= ScreenToClient(p);
  p.x:= p.x + Left;
  p.y:= p.y + Top;
  AHandle := ChildWindowFromPoint(Parent.Handle, p);
  result:= FindControl(AHandle) = self;
end;

procedure TwwCustomCheckBox.WMMouseMove(var Message: TWMMouseMove);
begin
  inherited;
end;