wwcheckbox.pas

InfoPower_Studio 2007 v5.0.1.3 banben

     Windows.SetWindowLong(handle, GWL_EXSTYLE, exStyle);
     Frame.RefreshTransparentText(True, True, True);
//     r:= BoundsRect;
//     InvalidateRect(Parent.handle, @r, False);
   end;

   invalidate;
//   InvalidateBorder;
end;

procedure TwwExpandButton.WMKillFocus(var Message: TWMKillFocus);
var r: TRect;
begin
   if parent is TCustomGrid then
   begin
      r:= Rect(Left, Top, Left+width, top+height);
      InvalidateRect(parent.handle, @r, False);
   end;
end;

procedure TwwDBCustomCheckbox.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;
   FShowText:=True;
//   FShowAsButton:= True;
   FFrame:= TwwEditFrame.create(self);
   FIndents:= TwwWinButtonIndents.create(self);
   FValueChecked:= 'True';
   FValueUnchecked:= 'False';
   FShowFocusRect:= True;
   FCenterTextVertically:= True;
   FTextAlignment:= taLeftJustify;
end;

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


Function TwwCustomCheckBox.IsMouseInControl(CheckAreaOnly: boolean = False): boolean;
var p: TPoint;
    AHandle: HWND;
//    c: TControl;
    r: TRect;
begin
  GetCursorPos(p);
  p:= ScreenToClient(p);
  p.x:= p.x + Left;
  p.y:= p.y + Top;
  AHandle := ChildWindowFromPointEx(Parent.Handle, p, CWP_SKIPINVISIBLE);
//  c:= FindControl(AHandle);
  result:= FindControl(AHandle) = self;
  if CheckAreaOnly then
  begin
     ComputeGlyphRect(r);
     InflateRect(r, 3, 3);
     GetCursorPos(p);
     p:= ScreenToClient(p);
     if not PtInRect(r, p) then result:= False;
  end;
end;

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

procedure TwwCustomCheckBox.DataChange(Sender: TObject);
begin
end;

procedure TwwCustomCheckBox.CMTextChanged(var Message: TMessage);
begin
  if IsTransparentEffective and
    ((not Focused) or AlwaysTransparent) then
     Frame.RefreshTransparentText(False, False);

  inherited;
end;

procedure TwwCustomCheckBox.SetValueChecked(const Value: string);
begin
  FValueChecked := Value;
  DataChange(Self);
end;

procedure TwwCustomCheckBox.SetValueUnchecked(const Value: string);
begin
  FValueUnchecked := Value;
  DataChange(Self);
end;

procedure TwwCustomCheckbox.SetDisplayValueChecked(const Value: string);
begin
  FDisplayValueChecked := Value;
  invalidate;
end;

procedure TwwCustomCheckbox.SetDisplayValueUnchecked(const Value: string);
begin
  FDisplayValueUnchecked := Value;
  invalidate;
end;

function TwwCustomCheckbox.GetDisplayValueChecked: string;
begin
  if FDisplayValueChecked <> '' then result:= FDisplayValueChecked
  else result:= ValueChecked;
end;

function TwwCustomCheckbox.GetDisplayValueUnchecked: string;
begin
  if FDisplayValueUnchecked <> '' then result:= FDisplayValueUnchecked
  else result:= ValueUnchecked;
end;

constructor TwwDBCustomCheckbox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csReplicatable];
  State := cbUnchecked;
  FDataLink := TFieldDataLink.Create;
  FDataLink.Control := Self;
  FDataLink.OnDataChange := DataChange;
  FDataLink.OnUpdateData := UpdateData;
//  FPaintControl := TPaintControl.Create(Self, 'BUTTON');
//  FPaintControl.Ctl3DButton := True;
end;

destructor TwwDBCustomCheckbox.Destroy;
begin
//  FPaintControl.Free;
  FDataLink.Free;
  FDataLink := nil;
  inherited Destroy;
end;

procedure TwwDBCustomCheckbox.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (FDataLink <> nil) and
    (AComponent = DataSource) then DataSource := nil;

end;

function TwwDBCustomCheckbox.UseRightToLeftAlignment: Boolean;
begin
  Result := DBUseRightToLeftAlignment(Self, Field);
end;

function TwwCustomCheckBox.GetFieldState: TCheckBoxState;
begin
   result:= State;
end;

function TwwDBCustomCheckbox.GetFieldState: TCheckBoxState;
var
  Text: string;
begin
  if FDatalink.Field <> nil then
    if FDataLink.Field.IsNull then
      Result := NullAndBlankState
    else if FDataLink.Field.DataType = ftBoolean then
      if FDataLink.Field.AsBoolean then
        Result := cbChecked
      else
        Result := cbUnchecked
    else
    begin
//      Result := cbGrayed;
      Text := FDataLink.Field.Text;
      if ValueMatch(FValueChecked, Text) then Result := cbChecked
      else
        if ValueMatch(FValueUnchecked, Text) then Result := cbUnchecked
      else
         Result:= NullAndBlankState;

    end
  else
  begin
    // 5/29/2002 - If Databound and not active then use NullAndBlankState.
    if isDataBound then Result:= NullAndBlankState
    else Result:= State;
  end;

//    Result := cbUnchecked;
end;

procedure TwwDBCustomCheckbox.DataChange(Sender: TObject);
begin
  State := GetFieldState;
  if (DataSource<>nil) and (DataSource.State=dsBrowse) then FModified:=False;
end;

procedure TwwDBCustomCheckbox.UpdateData(Sender: TObject);
var
  Pos: Integer;
  S: string;
begin
  if State = cbGrayed then
    FDataLink.Field.Clear
  else
    if FDataLink.Field.DataType = ftBoolean then
      FDataLink.Field.AsBoolean := Checked
    else
    begin
      if Checked then S := FValueChecked else S := FValueUnchecked;
      Pos := 1;
      {$Warnings Off}
      FDataLink.Field.Text := ExtractFieldName(S, Pos);
      {$Warnings On}
    end;
end;

function TwwDBCustomCheckbox.ValueMatch(const ValueList, Value: string): Boolean;
var
  Pos: Integer;
begin
  Result := False;
  Pos := 1;
  while Pos <= Length(ValueList) do
    {$Warnings Off}
    if AnsiCompareText(ExtractFieldName(ValueList, Pos), Value) = 0 then
   {$Warnings On}
   begin
      Result := True;
      Break;
    end;
end;

Function TwwDBCustomCheckbox.IsDataBound: boolean;
begin
   result:= (DataSource<>nil) and
            (DataField<>'');
end;

function TwwCustomCheckbox.GetModified: Boolean;
begin
  Result := FModified;
end;

procedure TwwCustomCheckbox.SetModified(Value: Boolean);
begin
   FModified := Value;
end;

procedure TwwDBCustomCheckbox.Toggle;
begin
  if IsDataBound then
  begin
     if FDataLink.Edit then
     begin
       FDataLink.Modified;
       Modified:= True;
       inherited Toggle; // 6/29/04 - Move after setting datalink so state is accurate when event is fired
//       if not (csPaintCopy in ControlState) then modified:=True;
     end;
  end
  else if not ReadOnly then inherited Toggle
end;

function TwwDBCustomCheckbox.GetDataSource: TDataSource;
begin
  Result := FDataLink.DataSource;
end;

procedure TwwDBCustomCheckbox.SetDataSource(Value: TDataSource);
begin
  if not (FDataLink.DataSourceFixed and (csLoading in ComponentState)) then
    FDataLink.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TwwDBCustomCheckbox.GetDataField: string;
begin
  Result := FDataLink.FieldName;
end;

procedure TwwDBCustomCheckbox.SetDataField(const Value: string);
begin
  FDataLink.FieldName := Value;
end;

function TwwDBCustomCheckbox.GetReadOnly: Boolean;
begin
  Result := FDataLink.ReadOnly;
end;

procedure TwwDBCustomCheckbox.SetReadOnly(Value: Boolean);
begin
  FDataLink.ReadOnly := Value;
end;

function TwwDBCustomCheckbox.GetField: TField;
begin
  Result := FDataLink.Field;
end;

procedure TwwDBCustomCheckbox.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  case Key of
    #8, ' ':
      FDataLink.Edit;
    #27:
      begin
        FDataLink.Reset;
        Modified:= False;
      end
  end;
end;

procedure TwwDBCustomCheckbox.WndProc(var Message: TMessage);
begin
  inherited;
end;

procedure TwwDBCustomCheckbox.WMPaint(var Message: TWMPaint);
//var OldState: TCheckboxState;
var tc: TColor;
  procedure CanvasNeeded;
  begin
    if FCanvas = nil then
    begin
      FCanvas := TControlCanvas.Create;
      FCanvas.Control := Self;
    end;
  end;

begin
  if not (csPaintCopy in ControlState) then
  begin
     inherited;
     PaintBorder;
  end
  else
  begin
//      OldState:= State;
      ClicksDisabled:= True;
      Try
        // This code works for inspector
        tc:= Font.Color; // Make compiler happy
        if IsInGridPaint(self) and (message.dc<>0) then
        begin
           tc:= GetTextColor(message.dc);
//           bc:= GetBkColor(message.dc);
        end;
        CanvasNeeded;
        FCanvas.Handle := Message.dc;
        FCanvas.Font:= Font;
        if IsInGridPaint(self) and (message.dc<>0) then
        begin
           FCanvas.Font.Color:= tc;
//           FCanvas.Brush.Color:= bc;
        end;
        Paint;
        FCanvas.Handle := 0;

      finally
        ClicksDisabled:= False;
      end;
  end;
end;

procedure TwwDBCustomCheckbox.CMExit(var Message: TCMExit);
begin
  try
    FDataLink.UpdateRecord;
  except
    SetFocus;
    raise;
  end;