scheckbox.pas

Alpha Controls 界面控件包

function TsCheckBox.GlyphWidth: integer;
begin
  if Assigned(Images) and (ImgChecked > -1) and (ImgUnChecked > -1) then begin
    Result := Images.Width div 3;
  end
  else Result := GlyphChecked.Width div 3;
end;

procedure TsCheckBox.Invalidate;
begin
  inherited;
  if AutoSize then WordWrap := False;
end;

{$IFDEF TNTUNICODE}
function TsCheckBox.IsCaptionStored: Boolean;
begin
  Result := TntControl_IsCaptionStored(Self)
end;

function TsCheckBox.IsHintStored: Boolean;
begin
  Result := TntControl_IsHintStored(Self)
end;
{$ENDIF}

procedure TsCheckBox.Loaded;
begin
  inherited;
  SkinData.Loaded;
  AdjustSize;
end;

procedure TsCheckBox.PaintControl(DC : HDC);
begin
  if not FCommonData.Updating and not (Assigned(FadeTimer) and FadeTimer.Enabled {and (FadeTimer.Iterations > FadeTimer.FadeLevel)}) then begin
    PrepareCache;
    UpdateCorners(FCommonData, 0);
    BitBlt(DC, 0, 0, Width, Height, FCommonData.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
  end;
end;

procedure TsCheckBox.PaintGlyph(Bmp: TBitmap);
var
  R : TRect;
  function CurrentMaskRect : TRect; begin
    if FPressed
      then Result := Rect(2 * GlyphWidth, 0, 3 * GlyphWidth, GlyphHeight)
      else if ControlIsActive(FCommonData) and not ReadOnly
                then Result := Rect(GlyphWidth, 0, 2 * GlyphWidth, GlyphHeight)
                else Result := Rect(0, 0, GlyphWidth, GlyphHeight);
  end;
begin
  if FCommonData.FCacheBmp.Width < 1 then exit;
  Bmp.PixelFormat := pf24bit;
  R := CheckRect;
  CopyByMask(Rect(R.Left, R.Top, R.Right, R.Bottom),
             CurrentMaskRect,
             FCommonData.FCacheBmp,
             Bmp, EmptyCI, True);
end;

procedure TsCheckBox.PaintHandler(M: TWMPaint);
var
  PS: TPaintStruct;
  DC : hdc;
  SavedDC: hdc;
begin
  CtrlParentColor := TsHackedControl(Parent).Color;
  DC := M.DC;
  if DC = 0 then DC := BeginPaint(Handle, PS);
  SavedDC := SaveDC(DC);
  try
    if not FCommonData.Updating then PaintControl(DC) else FCommonData.Updating := True;
  finally
    CtrlParentColor := clFuchsia;
    RestoreDC(DC, SavedDC);
    if M.DC = 0 then EndPaint(Handle, PS);
  end;
end;

procedure TsCheckBox.PrepareCache;
var
  CI : TCacheInfo;
begin
  FCommonData.InitCacheBmp;
  FCommonData.FCacheBmp.Canvas.Font.Assign(Font);
  try
    CI := GetParentCache(FCommonData);
    PaintItem(FCommonData, CI, True, integer(ControlIsActive(FCommonData) and not ReadOnly),
                Rect(0, 0, FCommonData.FCacheBmp.Width, Height), Point(Left, Top), FCommonData.FCacheBmp, False);
    DrawCheckText;
    DrawCheckArea;
    if not Enabled then BmpDisabledKind(FCommonData.FCacheBmp, FDisabledKind, Parent, CI, Point(Left, Top));
    FCommonData.BGChanged := False
  finally
  end;
end;

{$IFDEF TNTUNICODE}
procedure TsCheckBox.SetCaption(const Value: TWideCaption);
begin
  TntControl_SetText(Self, Value);
end;
{$ENDIF}

procedure TsCheckBox.SetChecked(Value: Boolean);
begin
  if not (csLoading in ComponentState) then begin
    if (Value <> Checked) then FCommonData.BGChanged := True;
    inherited;
    if FCommonData.BGChanged then Repaint;
  end;
end;

{$IFNDEF DELPHI7UP}
procedure TsCheckBox.SetWordWrap(const Value: boolean);
begin
  if FWordWrap <> Value then begin
    FWordWrap := Value;
    FCommonData.BGChanged := True;
    if AutoSize then AutoSize := False;
    Repaint;
  end;
end;
{$ENDIF}

procedure TsCheckBox.SetDisabledKind(const Value: TsDisabledKind);
begin
  if FDisabledKind <> Value then begin
    FDisabledKind := Value;
    FCommonData.Invalidate;
  end;
end;

procedure TsCheckBox.SetGlyphChecked(const Value: TBitmap);
begin
  FGlyphChecked.Assign(Value);
  if AutoSize then AdjustSize;
  FCommonData.Invalidate;
end;

procedure TsCheckBox.SetGlyphUnChecked(const Value: TBitmap);
begin
  FGlyphUnChecked.Assign(Value);
  if AutoSize then AdjustSize;
  Invalidate;
end;

{$IFDEF TNTUNICODE}
procedure TsCheckBox.SetHint(const Value: WideString);
begin
  TntControl_SetHint(Self, Value);
end;
{$ENDIF}

procedure TsCheckBox.SetImageChecked(const Value: TsImageIndex);
begin
  if FImgChecked <> Value then begin
    FImgChecked := Value;
    if AutoSize then AdjustSize;
    if Checked then SkinData.Invalidate;
  end;
end;

procedure TsCheckBox.SetImages(const Value: TCustomImageList);
begin
  if FImages <> Value then begin
    FImages := Value;
    if AutoSize then AdjustSize;
    SkinData.Invalidate;
  end;
end;

procedure TsCheckBox.SetImageUnChecked(const Value: TsImageIndex);
begin
  if FImgUnchecked <> Value then begin
    FImgUnchecked := Value;
    if AutoSize then AdjustSize;
    if not Checked then SkinData.Invalidate;
  end;
end;

procedure TsCheckBox.SetMargin(const Value: integer);
begin
  if FMargin <> Value then begin
    FMargin := Value;
    if AutoSize then AdjustSize;
    Invalidate;
  end;
end;

procedure TsCheckBox.SetReadOnly(const Value: boolean);
begin
  FReadOnly := Value;
end;

procedure TsCheckBox.SetShowFocus(const Value: Boolean);
begin
  if FShowFocus <> Value then begin
    FShowFocus := Value;
    Invalidate;
  end;
end;

procedure TsCheckBox.SetTextIndent(const Value: integer);
begin
  if FTextIndent <> Value then begin
    FTextIndent := Value;
    if AutoSize then AdjustSize;
    Invalidate;
  end;
end;

function TsCheckBox.SkinCheckRect(i: integer): TRect;
var
  h, w, hdiv : integer;
begin
  h := SkinGlyphHeight(i);
  w := SkinGlyphWidth(i);
  hdiv := (Height - h) div 2;
  if Alignment = taRightJustify then begin
    Result := Rect(Margin, hdiv, Margin + w, h + hdiv);
  end
  else begin
    Result := Rect(Width - w - Margin, hdiv, Width - Margin, h + hdiv);
  end;
end;

function TsCheckBox.SkinGlyphHeight(i: integer): integer;
begin
  with FCommonData.SkinManager do if Assigned(ma[i].Bmp) then Result := ma[i].Bmp.Height div 2 else Result := HeightOf(ma[i].R) div (ma[i].MaskType + 1);
end;

function TsCheckBox.SkinGlyphWidth(i: integer): integer;
begin
  with FCommonData.SkinManager do if Assigned(ma[i].Bmp) then Result := ma[i].Bmp.Width div 3 else Result := WidthOf(ma[i].R) div ma[i].ImageCount;
end;

procedure TsCheckBox.WndProc(var Message: TMessage);
begin
{$IFDEF LOGGED}
  AddToLog(Message);
{$ENDIF}
  if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
    AC_CTRLHANDLED : begin Message.LParam := 1; Exit end; // AlphaSkins supported
    AC_GETAPPLICATION : begin Message.Result := longint(Application); Exit end;
    AC_REMOVESKIN : if LongWord(Message.LParam) = LongWord(SkinData.SkinManager) then begin
      StopFading(FadeTimer, FCommonData);
      CommonWndProc(Message, FCommonData);
      if HandleAllocated then SendMessage(Handle, BM_SETCHECK, Integer(State), 0);
      if (@Ac_SetWindowTheme <> nil) then Ac_SetWindowTheme(Handle, nil, nil);
      Repaint;
      exit
    end;
    AC_REFRESH : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      StopFading(FadeTimer, FCommonData);
      CommonWndProc(Message, FCommonData);
      AdjustSize;
      Repaint;
      exit
    end;
    AC_PREPARECACHE : PrepareCache;
    AC_STOPFADING : begin StopFading(FadeTimer, FCommonData); Exit end;
    AC_SETNEWSKIN : if (LongWord(Message.LParam) = LongWord(SkinData.SkinManager)) then begin
      StopFading(FadeTimer, FCommonData);
      CommonWndProc(Message, FCommonData);
      exit
    end
  end;
  if (FCommonData <> nil) and FCommonData.Skinned(True) then case Message.Msg of
    CM_MOUSEENTER : if Enabled and not (csDesigning in ComponentState) and not FCommonData.FMouseAbove then begin
      FCommonData.FMouseAbove := True;
      DoChangePaint(FadeTimer, FCommonData, False, EventEnabled(aeMouseEnter, FAnimatEvents));
    end;
    CM_MOUSELEAVE : if Enabled and not (csDesigning in ComponentState) then begin
      FCommonData.FMouseAbove := False;
      FPressed := False;
      DoChangePaint(FadeTimer, FCommonData, False, EventEnabled(aeMouseLeave, FAnimatEvents));
    end;
    WM_SETFOCUS, CM_ENTER : if not (csDesigning in ComponentState) then begin
      if Enabled then begin
        inherited;
        FCommonData.BGChanged := True;
        if FadeTimer = nil then Repaint else FadeTimer.Change; // Fast repaint
      end;
      Exit;
    end;
    WM_KILLFOCUS, CM_EXIT: if not (csDesigning in ComponentState) then begin
      if Enabled then begin
        if FadeTimer <> nil then StopFading(FadeTimer, FCommonData);
        inherited;
        FCommonData.FFocused := False;
        FCommonData.FMouseAbove := False;
        FCommonData.Invalidate;
        Exit
      end;
    end;
  end;
  if not ControlIsReady(Self) then inherited else begin
    CommonWndProc(Message, FCommonData);
    if FCommonData.Skinned(True) then begin
      if Message.Msg = SM_ALPHACMD then case Message.WParamHi of
        AC_ENDPARENTUPDATE : if FCommonData.Updating or FCommonData.HalfVisible then begin
          FCommonData.Updating := False;
          Repaint;
        end
      end
      else case Message.Msg of
        WM_ENABLE, WM_NCPAINT : Exit; // Disabling of blinking when switched
{$IFDEF CHECKXP}
        WM_UPDATEUISTATE : if SkinData.Skinned and UseThemes and (@Ac_SetWindowTheme <> nil) then begin
          Ac_SetWindowTheme(Handle, ' ', ' ');
          Exit;
        end;
{$ENDIF}
        CM_ENABLEDCHANGED : begin
          inherited;
          Repaint;
          Exit
        end;
        CM_CHANGED : begin // v4.70
          if not (csDesigning in ComponentState) then begin
            if Checked
              then DoChangePaint(FadeTimer, FCommonData, True, EventEnabled(aeMouseUp, FAnimatEvents), fdUp)
              else DoChangePaint(FadeTimer, FCommonData, True, EventEnabled(aeMouseUp, FAnimatEvents));
          end
          else FCommonData.Invalidate;
        end;
        BM_SETCHECK : begin
          if (FadeTimer <> nil) and (FadeTimer.FadeLevel < FadeTimer.Iterations) then StopFading(FadeTimer, FCommonData);
          Exit;
        end;
        WM_ERASEBKGND : begin
          Message.Result := 1;
          Exit;
        end;
        WM_PRINT : begin
          SkinData.Updating := False;
          PaintHandler(TWMPaint(Message));
        end;
        WM_PAINT : begin
          PaintHandler(TWMPaint(Message));
          if not (csDesigning in ComponentState) then Exit;
        end;
        CM_TEXTCHANGED : begin
          if AutoSize then AdjustSize;
          Repaint;
          Exit;
        end;
        WM_KEYDOWN : if Enabled and not (csDesigning in ComponentState) and (TWMKey(Message).CharCode = VK_SPACE) then begin
          if ReadOnly then Exit;
          FPressed := True;
          if not Focused then begin
            ClicksDisabled := True;
            Windows.SetFocus(Handle);
            ClicksDisabled := False;
          end;
          Repaint;
          if Assigned(OnKeyDown) then OnKeydown(Self, TWMKeyDown(Message).CharCode, KeysToShiftState(word(TWMKeyDown(Message).KeyData)));
          Exit;
        end {v4.30 else Exit};
        WM_LBUTTONDBLCLK, WM_LBUTTONDOWN : if not (csDesigning in ComponentState) and Enabled then begin
          if ReadOnly then Exit;
          FPressed := True;
          DoChangePaint(FadeTimer, FCommonData, True, EventEnabled(aeMouseDown, FAnimatEvents));

          if not Focused then begin
            ClicksDisabled := True;
            Windows.SetFocus(Handle);
            ClicksDisabled := False;
          end;

          if WM_LBUTTONDBLCLK = Message.Msg then begin
            if Assigned(OnDblClick) then OnDblClick(Self)
          end
          else if Assigned(OnMouseDown) then OnMouseDown(Self, mbLeft, KeysToShiftState(TWMMouse(Message).Keys), TWMMouse(Message).XPos, TWMMouse(Message).YPos);
          Exit;
        end;
        WM_KEYUP : if not (csDesigning in ComponentState) and Enabled then begin
          if ReadOnly then Exit;
          if FPressed then begin
            FPressed := False;
            Toggle;
          end else FPressed := False;
          if Assigned(OnKeyUp) then OnKeyUp(Self, TWMKey(Message).CharCode, KeysToShiftState(TWMKey(Message).KeyData));
          Exit;
        end;
        WM_LBUTTONUP : if not (csDesigning in ComponentState) and Enabled then begin
          if ReadOnly then Exit;
          if FPressed then begin
            FPressed := False;
            Toggle;
          end
          else FPressed := False;
          if Assigned(OnMouseUp) then OnMouseUp(Self, mbLeft, KeysToShiftState(TWMMouse(Message).Keys), TWMMouse(Message).XPos, TWMMouse(Message).YPos);
          Exit;
        end;
      end
    end else case Message.Msg of
      WM_KEYDOWN, WM_LBUTTONDOWN : FPressed := True;
      WM_KEYUP, WM_LBUTTONUP : FPressed := False;
      WM_LBUTTONDBLCLK : if ReadOnly then Exit;
      BM_SETSTATE, BM_SETCHECK : if not (csCreating in ControlState) and FPressed and ReadOnly then Exit;
    end;
    inherited;
    case Message.Msg of
      WM_MOVE : begin
//        FCommonData.BGChanged := True;
      end;
    end;
  end;
end;

end.