scheckedcontrol.pas

AlphaControls是一个Delphi标准控件的集合

begin
  if FState <> Value then begin
    FState := Value;
    if FState = cbChecked then Checked := True
    else if FState = cbUnChecked then Checked := False;
  end;
end;

procedure TsCheckedControl.Toggle;
begin
  case State of
    cbChecked: State := cbUnchecked;
    cbGrayed: State := cbChecked;
  end;
end;

procedure TsCheckedControl.DrawParent;
var
  ci : TCacheInfo;
begin
  ci := sStyle.GetParentCache;
  if ci.Ready then begin
    FadeRect(ci.Bmp.Canvas,
             Rect(Left + ci.X, Top + ci.Y, Left + Width + ci.X, Top + Height + ci.Y),
             sStyle.FCacheBmp.Canvas.Handle,
             Point(0, 0), 100, clWhite, 0, ssRectangle);
  end
  else begin
    sStyle.FCacheBmp.Canvas.Pen.Style := psClear;
    sStyle.FCacheBmp.Canvas.Brush.Style := bsSolid;
    sStyle.FCacheBmp.Canvas.Brush.Color := ColorToRGB(sStyle.Painting.Color);
    sStyle.FCacheBmp.Canvas.Rectangle(Rect(0, 0, sStyle.FCacheBmp.Width + 1, sStyle.FCacheBmp.Height + 1));
  end;
end;

procedure TsCheckedControl.PaintControl;
var
  CI : TCacheInfo;
begin
  if True then begin
    DrawParent;
    DrawCheckText;
    DrawCheckArea;
  end;

  if not Enabled then begin
    CI := sStyle.GetParentCache;
    BmpDisabledKind(sStyle.FCacheBmp, FDisabledKind, Parent, CI, Point(Left, Top));
  end;
  BitBlt(Canvas.Handle, 0, 0, Width, Height, sStyle.FCacheBmp.Canvas.Handle, 0, 0, SRCCOPY);
//  sStyle.CopyFromCache(Canvas.Handle, 0, 0, Width, Height);
end;

procedure TsCheckedControl.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if not FPressed and Enabled then begin
    if (Key = VK_SPACE) then begin
//      SetCapture(Handle);
      FPressed := True;
      if not RestrictDrawing then sStyle.BGChanged := True;
      Repaint;
    end else
    inherited KeyDown(Key, Shift);
  end;
end;

procedure TsCheckedControl.KeyUp(var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_SPACE) and FPressed and not ReadOnly then begin
    Checked := not Checked;
    Toggle;
    if Assigned(FOnChange) then FOnChange(Self);
    if not RestrictDrawing then sStyle.BGChanged := True;
    FPressed := False;
//    ReleaseCapture;
  end
  else inherited;
end;

procedure TsCheckedControl.Paint;
begin
  if not (csDestroying in ComponentState) and not (csLoading in ComponentState) then begin
    if sStyle.FCacheBmp.Width <> Width then sStyle.FCacheBmp.Width := Width;
    if sStyle.FCacheBmp.Height <> Height then sStyle.FCacheBmp.Height := Height;
    sStyle.FCacheBmp.Canvas.Font.Assign(Font);
    PaintControl;
  end;
end;

procedure TsCheckedControl.AdjustSize;
begin
  inherited;
end;

function TsCheckedControl.CheckHeight: integer;
begin
  if Assigned(Images) then begin
    Result := Images.Height;
  end
  else if (sStyle.COC = COC_TsCheckBox) and Assigned(CHECK_CHECKED) then begin
    Result := CHECK_CHECKED.Height;
    if Result = 18 then
      Result := 14;
  end
  else if (sStyle.COC = COC_TsRadioButton) and Assigned(RADIO_CHECKED) then begin
    Result := RADIO_CHECKED.Height;
  end
  else begin
    Result := 14;
  end;
end;

function TsCheckedControl.CheckRect: TRect;
var
  h, w, i : integer;
begin
  i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, sSkinProps.GlyphChecked);
  if IsValidImgIndex(i) or (FGlyphChecked.Width > 0) then begin
    if Layout = calLeft then begin
      Result := Rect(0, (Height - GlyphHeight) div 2, GlyphWidth, GlyphHeight + (Height - GlyphHeight) div 2);
    end
    else begin
      Result := Rect(Width - GlyphWidth - 3, (Height - GlyphHeight) div 2, Width, GlyphHeight + (Height - GlyphHeight) div 2);
    end;
  end
  else begin
    h := CheckHeight;
    w := CheckWidth;
    if Layout = calLeft then begin
      Result := Rect(0, (Height - h) div 2, w, h + (Height - h) div 2);
    end
    else begin
      Result := Rect(Width - w - 3, (Height - h) div 2, Width, h + (Height - h) div 2);
    end;
  end;
end;

procedure TsCheckedControl.SetImageChecked(const Value: TsImageIndex);
begin
  if FImgChecked <> Value then begin
    FImgChecked := Value;
    if Checked then sStyle.Invalidate;
  end;
end;

procedure TsCheckedControl.SetImageUnChecked(const Value: TsImageIndex);
begin
  if FImgUnchecked <> Value then begin
    FImgUnchecked := Value;
    if not Checked then sStyle.Invalidate;
  end;
end;

procedure TsCheckedControl.SetImages(const Value: TCustomImageList);
begin
  if FImages <> Value then begin
    FImages := Value;
    sStyle.Invalidate;
  end;
end;

procedure TsCheckedControl.CreateWnd;
begin
  inherited;
end;

procedure TsCheckedControl.SetAlignment(const Value: TAlignment);
begin
  if FAlignment <> Value then begin
    FAlignment := Value;
    sStyle.invalidate;
  end;
end;

procedure TsCheckedControl.SetMultiLine(const Value: boolean);
begin
  if FMultiLine <> Value then begin
    FMultiLine := Value;
    sStyle.Invalidate;
  end;
end;

destructor TsCheckedControl.Destroy;
begin
  if Assigned(FGlyphChecked) then FreeAndNil(FGlyphChecked);
  if Assigned(FGlyphUnchecked) then FreeAndNil(FGlyphUnChecked);
  if Assigned(FsStyle) then FreeAndNil(FsStyle);
  OnKeyDown := nil;
  inherited Destroy;
end;

procedure TsCheckedControl.SetImageCheckedHot(const Value: TsImageIndex);
begin
  if FImgCheckedHot <> Value then begin
    FImgCheckedHot := Value;
  end;
end;

procedure TsCheckedControl.SetImageUnCheckedHot(const Value: TsImageIndex);
begin
  if FImgUnCheckedHot <> Value then begin
    FImgUnCheckedHot := Value;
  end;
end;

function TsCheckedControl.CheckWidth: integer;
begin
  if Assigned(Images) then begin
    Result := Images.Width;
  end
  else if (sStyle.COC = COC_TsCheckBox) and Assigned(CHECK_CHECKED) then begin
    Result := CHECK_CHECKED.Width;
    if Result = 18 then
      Result := 14;
  end
  else if (sStyle.COC = COC_TsRadioButton) and Assigned(RADIO_CHECKED) then begin
    Result := RADIO_CHECKED.Width;
  end
  else begin
    Result := 14;
  end;
end;

procedure TsCheckedControl.AfterConstruction;
begin
  inherited;
  sStyle.Loaded;
end;

procedure TsCheckedControl.SetGlyphChecked(const Value: TBitmap);
begin
  FGlyphChecked.Assign(Value);
  sStyle.Invalidate;
end;

procedure TsCheckedControl.SetGlyphUnChecked(const Value: TBitmap);
begin
  FGlyphUnChecked.Assign(Value);
  sStyle.Invalidate;
end;

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

function TsCheckedControl.GlyphHeight: integer;
var
  i : integer;
begin
  i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, sSkinProps.GLYPHCHECKED);
  if IsValidImgIndex(i) then begin
    Result := ma[i].Bmp.Height div 2;
  end
  else begin
    Result := GlyphChecked.Height div 2;
  end;
end;

function TsCheckedControl.GlyphWidth: integer;
var
  i : integer;
begin
  i := GetMaskIndex(sStyle.SkinIndex, sStyle.SkinSection, sSkinProps.GLYPHCHECKED);
  if IsValidImgIndex(i) then begin
    Result := ma[i].Bmp.Width div 3;
  end
  else begin
    Result := GlyphChecked.Width div 3;
  end;
end;

procedure TsCheckedControl.Loaded;
begin
  inherited;
  sStyle.Loaded;
end;

procedure TsCheckedControl.DrawSkinGlyph(i: integer);
var
  h, w : integer;
  R, MaskRect : TRect;
  function CurrentMaskRect : TRect; begin
    h := SkinGlyphHeight(i);
    w := SkinGlyphWidth(i);
    if FPressed then begin
      Result := Rect(2 * w, 0, 3 * w, h);
    end
    else if sStyle.ControlIsActive then begin
      Result := Rect(w, 0, 2 * w, h);
    end
    else begin
      Result := Rect(0, 0, w, h);
    end;
  end;
begin
  if sStyle.FCacheBmp.Width < 1 then exit;
  R := SkinCheckRect(i);
  MaskRect := CurrentMaskRect;
  CopyByMask(//!!!
             R,
             MaskRect,
             sStyle.FCacheBmp,
             ma[i].Bmp, EmptyCI
            );
end;

function TsCheckedControl.SkinGlyphHeight(i: integer): integer;
begin
  Result := ma[i].Bmp.Height div 2;
end;

function TsCheckedControl.SkinGlyphWidth(i: integer): integer;
begin
  Result := ma[i].Bmp.Width div 3;
end;

function TsCheckedControl.SkinCheckRect(i : integer): TRect;
begin
  if (i > -1) then begin
    if Layout = calLeft then begin
      Result := Rect(0, (Height - GlyphHeight) div 2, GlyphWidth, GlyphHeight + (Height - GlyphHeight) div 2);
    end
    else begin
      Result := Rect(Width - GlyphWidth - 3, (Height - GlyphHeight) div 2, Width, GlyphHeight + (Height - GlyphHeight) div 2);
    end;
  end
end;

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

function TsCheckedControl.GetReadOnly: boolean;
begin
  Result := FReadOnly;
end;

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

initialization

  RADIO_CHECKED := TBitmap.Create;
  RADIO_CHECKED.LoadFromResourceName(hInstance, 'RCC');

  RADIO_UNCHECKED := TBitmap.Create;
  RADIO_UNCHECKED.LoadFromResourceName(hInstance, 'RUC');

  RADIO_CHECKEDHOT := TBitmap.Create;
  RADIO_CHECKEDHOT.LoadFromResourceName(hInstance, 'RCH');

  RADIO_UNCHECKEDHOT := TBitmap.Create;
  RADIO_UNCHECKEDHOT.LoadFromResourceName(hInstance, 'RUH');

  // CheckBox
  CHECK_CHECKED := TBitmap.Create;
  CHECK_CHECKED.LoadFromResourceName(hInstance, 'CCC');

  CHECK_UNCHECKED := TBitmap.Create;
  CHECK_UNCHECKED.LoadFromResourceName(hInstance, 'CUC');

  CHECK_CHECKEDHOT := TBitmap.Create;
  CHECK_CHECKEDHOT.LoadFromResourceName(hInstance, 'CCH');

  CHECK_UNCHECKEDHOT := TBitmap.Create;
  CHECK_UNCHECKEDHOT.LoadFromResourceName(hInstance, 'CUH');

finalization

  if Assigned(RADIO_CHECKED) then FreeAndNil(RADIO_CHECKED);
  if Assigned(RADIO_UNCHECKED) then FreeAndNil(RADIO_UNCHECKED);
  if Assigned(RADIO_CHECKEDHOT) then FreeAndNil(RADIO_CHECKEDHOT);
  if Assigned(RADIO_UNCHECKEDHOT) then FreeAndNil(RADIO_UNCHECKEDHOT);

  if Assigned(CHECK_CHECKED) then FreeAndNil(CHECK_CHECKED);
  if Assigned(CHECK_UNCHECKED) then FreeAndNil(CHECK_UNCHECKED);
  if Assigned(CHECK_CHECKEDHOT) then FreeAndNil(CHECK_CHECKEDHOT);
  if Assigned(CHECK_UNCHECKEDHOT) then FreeAndNil(CHECK_UNCHECKEDHOT);

end.