fr_ctrls.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

    PaintRect := DrawButtonFace(CacheCanvas, Rect(0, 0, Width, Height), 1, bsNew,
      False, FState in [fbsDown, fbsExclusive], False);

  if FFlat then
    Transparent := Enabled and (((FState = fbsExclusive) or
       ((AState = fbsExclusive) and (FState = fbsInactive))) and not FMouseInControl)
  else
    Transparent := FState = fbsExclusive;
  if Transparent then
  begin
    CacheCanvas.Brush.Bitmap := Pattern;
    CacheCanvas.FillRect(PaintRect);
  end;

  TButtonGlyph(FGlyph).Draw(CacheCanvas, PaintRect, Caption, FLayout, FMargin,
    FSpacing, FState, Transparent);

  if FFlat and Enabled then
  begin
    PaintRect := Rect(0, 0, Width, Height);
    if FMouseInControl or (AState = fbsExclusive) then
      if AState in [fbsDown, fbsExclusive] then
        Frame3D(CacheCanvas, PaintRect, clBtnShadow, clBtnHighlight, 1) else
        Frame3D(CacheCanvas, PaintRect, clBtnHighlight, clBtnShadow, 1);
  end;

  R := Rect(0, 0, Width, Height);
  if Canvas.Handle <> CacheCanvas.Handle then
    Canvas.CopyRect(R, CacheCanvas, R);

  if FFlat and (FState = fbsUp) and (csDesigning in ComponentState) then
    Frame3D(Canvas, R, clBtnHighlight, clBtnShadow, 1);
  FState := AState;
end;

procedure TfrSpeedButton.UpdateTracking;
var
  P: TPoint;
begin
  if FFlat then
  begin
    GetCursorPos(P);
    FMouseInControl := Enabled and (FindDragTarget(P, True) = Self);
  end;
end;

procedure TfrSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and Enabled then
  begin
    if not FDown then
    begin
      FState := fbsDown;
      Repaint;
    end;
    FDragging := True;
  end;
end;

procedure TfrSpeedButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewState: TfrButtonState;
begin
  inherited MouseMove(Shift, X, Y);
  if FDragging then
  begin
    if not FDown then NewState := fbsUp
    else NewState := fbsExclusive;
    if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
      if FDown then NewState := fbsExclusive else NewState := fbsDown;
    if NewState <> FState then
    begin
      FState := NewState;
      Repaint;
    end;
  end;
end;

procedure TfrSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  DoClick: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDragging then
  begin
    FDragging := False;
    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
    if FGroupIndex = 0 then
    begin
      { Redraw face in-case mouse is captured }
      FState := fbsUp;
      FMouseInControl := False;
      if not (FState in [fbsExclusive, fbsDown]) then Repaint;
    end
    else
      if DoClick then SetDown(not FDown)
      else
      begin
        if FDown then FState := fbsExclusive;
        Repaint;
      end;
    UpdateTracking;
    Invalidate;
    if DoClick then Click;
  end;
end;

procedure TfrSpeedButton.Click;
begin
  inherited Click;
end;

procedure TfrSpeedButton.DrawGlyph(Canvas: TCanvas; X, Y: Integer; Enabled: Boolean);
const
  NewState: array[Boolean] of TfrButtonState = (fbsDisabled, fbsUp);
begin
  TButtonGlyph(FGlyph).DrawButtonGlyph(Canvas, X, Y, NewState[Enabled], False);
end;

function TfrSpeedButton.GetGlyph: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).Glyph;
end;

procedure TfrSpeedButton.SetGlyph(Value: TBitmap);
begin
  TButtonGlyph(FGlyph).Glyph := Value;
  Invalidate;
end;

function TfrSpeedButton.GetNumGlyphs: TNumGlyphs;
begin
  Result := TButtonGlyph(FGlyph).NumGlyphs;
end;

procedure TfrSpeedButton.SetNumGlyphs(Value: TNumGlyphs);
begin
  if Value < 0 then Value := 1
  else if Value > 4 then Value := 4;
  if Value <> TButtonGlyph(FGlyph).NumGlyphs then
  begin
    TButtonGlyph(FGlyph).NumGlyphs := Value;
    Invalidate;
  end;
end;

procedure TfrSpeedButton.GlyphChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TfrSpeedButton.UpdateExclusive;
var
  Msg: TMessage;
begin
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_BUTTONPRESSED;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;
    Parent.Broadcast(Msg);
  end;
end;

procedure TfrSpeedButton.SetDown(Value: Boolean);
begin
  if FGroupIndex = 0 then Value := False;
  if Value <> FDown then
  begin
    if FDown and (not FAllowAllUp) then Exit;
    FDown := Value;
    if Value then FState := fbsExclusive
    else FState := fbsUp;
    Invalidate;
    if Value then UpdateExclusive;
  end;
end;

procedure TfrSpeedButton.SetFlat(Value: Boolean);
begin
  if Value <> FFlat then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;

procedure TfrSpeedButton.SetGroupIndex(Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;

procedure TfrSpeedButton.SetLayout(Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

procedure TfrSpeedButton.SetAllowAllUp(Value: Boolean);
begin
  if FAllowAllUp <> Value then
  begin
    FAllowAllUp := Value;
    UpdateExclusive;
  end;
end;

procedure TfrSpeedButton.WMLButtonDblClk(var Message: TWMLButtonDown);
begin
  inherited;
  if FDown then DblClick;
end;

procedure TfrSpeedButton.CMEnabledChanged(var Message: TMessage);
const
  NewState: array[Boolean] of TfrButtonState = (fbsDisabled, fbsUp);
begin
  TButtonGlyph(FGlyph).CreateButtonGlyph(NewState[Enabled]);
  UpdateTracking;
  Invalidate;
end;

procedure TfrSpeedButton.CMButtonPressed(var Message: TMessage);
var
  Sender: TfrSpeedButton;
begin
  if Message.WParam = FGroupIndex then
  begin
    Sender := TfrSpeedButton(Message.LParam);
    if Sender <> Self then
    begin
      if Sender.Down and FDown then
      begin
        FDown := False;
        FState := fbsUp;
        Invalidate;
      end;
      FAllowAllUp := Sender.AllowAllUp;
    end;
  end;
end;

procedure TfrSpeedButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Enabled then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;

procedure TfrSpeedButton.CMFontChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TfrSpeedButton.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TfrSpeedButton.CMSysColorChange(var Message: TMessage);
begin
  Invalidate;
end;

procedure TfrSpeedButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if FFlat and (not FMouseInControl) and Enabled then
  begin
    if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
    FMouseInControl := True;
    Invalidate;
  end;
end;

procedure TfrSpeedButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if FFlat and FMouseInControl and Enabled then
  begin
    if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
    FMouseInControl := False;
    Invalidate;
  end;
end;

function TfrSpeedButton.GetPalette: HPALETTE;
begin
  Result := Glyph.Palette;
end;

procedure TfrSpeedButton.SetMargin(Value: Integer);
begin
  if (Value <> FMargin) and (Value >= -1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;

procedure TfrSpeedButton.SetSpacing(Value: Integer);
begin
  if Value <> FSpacing then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

procedure TfrSpeedButton.SetInactiveGrayed(Value: Boolean);
begin
  if Value <> FInactiveGrayed then begin
    FInactiveGrayed := Value;
    Invalidate;
  end;
end;


{ TfrComboEdit }

constructor TfrComboEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Style := csSimple;
  Height := 21;
  FPanel := TPanel.Create(Self);
  FPanel.Parent := Self;
  FPanel.SetBounds(Width - Height + 2, 2, Height - 4, Height - 4);
  FButton := TfrSpeedButton.Create(Self);
  FButton.Parent := FPanel;
  FButton.SetBounds(0, 0, FPanel.Width, FPanel.Height);
  FButton.OnClick := ButtonClick;
  FButtonEnabled := True;
end;

procedure TfrComboEdit.SetPos;
begin
  SetWindowPos(EditHandle, 0, 0, 0, Width - Height - 4, ItemHeight,
    SWP_NOMOVE or SWP_NOZORDER or SWP_NOACTIVATE)
end;

procedure TfrComboEdit.CreateWnd;
begin
  inherited CreateWnd;
  SetPos;
end;

procedure TfrComboEdit.WMSize(var Message: TWMSize);
begin
  inherited;
  FPanel.SetBounds(Width - Height + 2, 2, Height - 4, Height - 4);
end;

procedure TfrComboEdit.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  FButton.Enabled := Enabled;
end;

procedure TfrComboEdit.KeyPress(var Key: Char);
begin
  if (Key = Char(vk_Return)) or (Key = Char(vk_Escape)) then
    GetParentForm(Self).Perform(CM_DIALOGKEY, Byte(Key), 0);
  inherited KeyPress(Key);
end;

function TfrComboEdit.GetGlyph: TBitmap;
begin
  Result := FButton.Glyph;
end;

procedure TfrComboEdit.SetGlyph(Value: TBitmap);
begin
  FButton.Glyph := Value;
end;

function TfrComboEdit.GetButtonHint: String;
begin
  Result := FButton.Hint;
end;

procedure TfrComboEdit.SetButtonHint(Value: String);
begin
  FButton.Hint := Value;
end;

procedure TfrComboEdit.SetButtonEnabled(Value: Boolean);
begin
  FButtonEnabled := Value;
  FButton.Enabled := Value;
end;

procedure TfrComboEdit.ButtonClick(Sender: TObject);
begin
  SetFocus;
  if Assigned(FOnButtonClick) then
    FOnButtonClick(Self);
end;



end.