⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 teependlg.pas

📁 BCB第三方组件
💻 PAS
📖 第 1 页 / 共 2 页
字号:
{**********************************************}
{   TPenDialog                                 }
{   Copyright (c) 1996-2007 by David Berneda   }
{**********************************************}
unit TeePenDlg;
{$I TeeDefs.inc}

interface

uses {$IFNDEF LINUX}
     Windows, Messages,
     {$ENDIF}
     SysUtils, Classes,
     {$IFDEF CLX}
     Qt, QGraphics, QControls, QForms, QDialogs, QStdCtrls, QExtCtrls, QComCtrls,
     Types,
     {$ELSE}
     Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls,
     {$ENDIF}
     {$IFDEF LCL}
     Buttons,
     {$ENDIF}
     TeCanvas, TeeProcs;

type
  TPenDialog = class(TForm)
    CBVisible: TCheckBox;
    SEWidth: TEdit;
    LWidth: TLabel;
    BOk: TButton;
    BCancel: TButton;
    UDWidth: TUpDown;
    LStyle: TLabel;
    CBStyle: TComboFlat;
    BColor: TButtonColor;
    CBEndStyle: TComboFlat;
    LSpace: TLabel;
    ESpace: TEdit;
    UDSpace: TUpDown;
    procedure FormShow(Sender: TObject);
    procedure SEWidthChange(Sender: TObject);
    procedure CBVisibleClick(Sender: TObject);
    procedure BCancelClick(Sender: TObject);
    procedure CBStyleChange(Sender: TObject);
    {$IFDEF CLX}
    procedure CBStyleDrawItem(Sender: TObject; Index: Integer;
      Rect: TRect; State: TOwnerDrawState; var Handled:Boolean);
    {$ELSE}
    procedure CBStyleDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    {$ENDIF}
    procedure BColorClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CBEndStyleChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ESpaceChange(Sender: TObject);
  private
    { Private declarations }
    BackupPen   : TChartPen;
    ModifiedPen : Boolean;
    Procedure EnablePenStyle;
  public
    { Public declarations }
    ThePen : TPen;
  end;

Function EditChartPen(AOwner:TComponent; ChartPen:TChartPen; HideColor:Boolean=False):Boolean;

{ Show / Hide controls in array }
Procedure ShowControls(Show:Boolean; Const AControls:Array of TControl);

{ Asks the user a question and returns Yes or No }
Function TeeYesNo(Const Message:String; Owner:TControl=nil):Boolean;
{ Same as above, but using predefined "Sure to Delete?" message }
Function TeeYesNoDelete(Const Message:String; Owner:TControl=nil):Boolean;

type
  TButtonPen=class(TTeeButton)
  private
    FEditor     : TPenDialog;
    FOldDestroy : TNotifyEvent;

    procedure EditorDestroy(Sender:TObject);
    function GetPen:TChartPen;
    function GetEditor:TPenDialog;
  protected
    procedure DrawSymbol(ACanvas:TTeeCanvas); override;
  public
    HideColor : Boolean;
    procedure Click; override;
    procedure LinkPen(APen:TChartPen);

    property Editor:TPenDialog read GetEditor;
    property Pen:TChartPen read GetPen write LinkPen; // 7.01
  end;

{$IFDEF CLX}
Procedure TeeFixParentedForm(AForm:TForm);
{$ENDIF}

Procedure AddFormTo(AForm:TForm; AParent:TWinControl); overload;
Procedure AddFormTo(AForm:TForm; AParent:TWinControl; ATag:TPersistent); overload;

{$IFNDEF CLR}
Procedure AddFormTo(AForm:TForm; AParent:TWinControl; ATag:Integer); overload;
{$ENDIF}

Procedure AddDefaultValueFormats(AItems:TStrings);

Procedure TeeLoadArrowBitmaps(AUp,ADown:TBitmap);

{ Helper listbox items routines }
procedure MoveList(Source,Dest:TCustomListBox);
procedure MoveListAll(Source,Dest:TStrings);

// Adds all cursors and special "crTeeHand" cursor to ACombo.
// Sets combo ItemIndex to ACursor.
procedure TeeFillCursors(ACombo:TComboFlat; ACursor:TCursor);
Function TeeSetCursor(ACursor:TCursor; const S:String):TCursor;

Const
  TeeFormBorderStyle={$IFDEF CLX}fbsNone{$ELSE}bsNone{$ENDIF};

// Creates a new form, sets form Align to none, centers it to screen
// or owner.center, and changes Form border style to "bsDialog".
Function TeeCreateForm(FormClass:TFormClass; AOwner:TComponent):TForm;

// Returns the name representation of ACursor in AName parameter.
// Returns "True" if succeed.
Function TeeCursorToIdent(ACursor:Integer; Var AName:String):Boolean;

// Returns the Cursor index that corresponds to AName string parameter.
// Returns "True" if succeed.
Function TeeIdentToCursor(Const AName:String; Var ACursor:Integer):Boolean;

// Sets Form parameter position to center of screen or center of Form.Owner,
// if available and for Delphi v5 and up.
procedure PositionToCenter(const Form:TForm);

// Fills a Picture with a Cursor image
procedure TeePreviewCursor(ACursor:TCursor; APicture:TPicture);

// Scales AForm PixelsPerInch to match it's Parent Form, if any
procedure TeeScaleForm(AForm:TForm);

implementation

{$IFNDEF CLX}
{$IFNDEF LCL}
{$R *.DFM}
{$ENDIF}
{$ELSE}
{$R *.xfm}
{$ENDIF}

Uses {$IFNDEF CLX}
     ExtDlgs,
     {$ENDIF}
     {$IFDEF CLR}
     Variants,
     {$ENDIF}
     {$IFDEF LCL}
     LCLType, // Pending to move odSelected to StdCtrls unit
     {$ENDIF}
     Math, TypInfo, TeeConst;

{$IFDEF CLR}
{$R TeeArrowDown.bmp}
{$R TeeArrowUp.bmp}
{$ENDIF}

procedure PositionToCenter(const Form:TForm);
begin
  {$IFDEF D5}
  if Assigned(Form.Owner) then
     Form.Position:=poOwnerFormCenter
  else
  {$ENDIF}
     Form.Position:=poScreenCenter;
end;

Function TeeCreateForm(FormClass:TFormClass; AOwner:TComponent):TForm;

  Function TeeGetParentForm(AOwner:TComponent):TComponent;
  begin
    result:=AOwner;
    if Assigned(result) and (result is TControl) then
    begin
      result:=GetParentForm(TControl(result));
      if not Assigned(result) then result:=AOwner;
    end;
  end;

begin
  result:=FormClass.Create(TeeGetParentForm(AOwner));

  with result do
  begin
    Align:=alNone;
    PositionToCenter(result);
    BorderStyle:=TeeBorderStyle;
  end;
end;

function CreatePenDialog(AOwner:TComponent; ChartPen:TChartPen; HideColor:Boolean=False):TPenDialog;
begin
  result:=TeeCreateForm(TPenDialog,AOwner) as TPenDialog;
  result.ThePen:=ChartPen;
  if HideColor then
     result.BColor.Hide;
end;

Function EditChartPen(AOwner:TComponent; ChartPen:TChartPen; HideColor:Boolean=False):Boolean;
Begin
  with CreatePenDialog(AOwner,ChartPen,HideColor) do
  try
    result:=ShowModal=mrOk;
  finally
    Free;
  end;
end;

procedure TPenDialog.FormShow(Sender: TObject);
var tmpFirstTime : Boolean;
begin
  tmpFirstTime:=not Assigned(BackupPen);

  if tmpFirstTime then
     BackupPen:=TChartPen.Create(nil);

  if Assigned(ThePen) then
  begin
    BackupPen.Assign(ThePen);

    if ThePen is TChartPen then
    begin
      CBVisible.Checked:=TChartPen(ThePen).Visible;
      BackupPen.Visible:=CBVisible.Checked;

      if IsWindowsNT then
         CBStyle.Items.Add(TeeMsg_SmallDotsPen);

      if TChartPen(ThePen).SmallDots then
      begin
        CBStyle.ItemIndex:=CBStyle.Items.Count-1;

        UDWidth.Enabled:=False;
        SEWidth.Enabled:=False;

        UDSpace.Enabled:=True;
        ESpace.Enabled:=True;
      end
      else
        CBStyle.ItemIndex:=Ord(ThePen.Style);

      if IsWindowsNT then
      begin
        CBEndStyle.ItemIndex:=Ord(TChartPen(ThePen).EndStyle);
        {$IFDEF CLX}
        CBEndStyle.OnSelect:=CBEndStyleChange;
        {$ENDIF}
      end
      else
        CBEndStyle.Visible:=False;

      UDSpace.Position:=TChartPen(ThePen).SmallSpace;
    end
    else
    begin
      CBVisible.Visible:=False;
      CBStyle.ItemIndex:=Ord(ThePen.Style);
    end;

    UDWidth.Position:=ThePen.Width;

    EnablePenStyle;

    BColor.LinkProperty(ThePen,'Color');
  end;

  if tmpFirstTime then
     TeeTranslateControl(Self);

  ModifiedPen:=False;
end;

Procedure TPenDialog.EnablePenStyle;
begin
  {$IFNDEF CLX}
  if not IsWindowsNT then
     CBStyle.Enabled:=ThePen.Width=1;
  {$ENDIF}
end;

procedure TPenDialog.SEWidthChange(Sender: TObject);
begin
  if Showing then
  begin
    ThePen.Width:=UDWidth.Position;
    EnablePenStyle;
    ModifiedPen:=True;
  end;
end;

procedure TPenDialog.CBEndStyleChange(Sender: TObject);
begin
  TChartPen(ThePen).EndStyle:=TPenEndStyle(CBEndStyle.ItemIndex);
  ModifiedPen:=True;
end;

procedure TPenDialog.CBVisibleClick(Sender: TObject);
begin
  if Showing then
  begin
    TChartPen(ThePen).Visible:=CBVisible.Checked;
    ModifiedPen:=True;
  end;
end;

procedure TPenDialog.BCancelClick(Sender: TObject);
begin
  if ModifiedPen then
  begin
    ThePen.Assign(BackupPen);

    if ThePen is TChartPen then
    begin
      TChartPen(ThePen).Visible:=BackupPen.Visible;

      if Assigned(ThePen.OnChange) then
         ThePen.OnChange(Self);
    end;
  end;

  ModalResult:=mrCancel;
end;

procedure TPenDialog.FormCreate(Sender: TObject);
begin
  BorderStyle:=TeeBorderStyle;
end;

procedure TPenDialog.CBStyleChange(Sender: TObject);
var tmp : Boolean;
begin
  if (ThePen is TChartPen) and IsWindowsNT and
     (CBStyle.ItemIndex=CBStyle.Items.Count-1) then
  begin
    TChartPen(ThePen).SmallDots:=True;
    tmp:=False;
  end
  else
  begin
    tmp:=True;
    ThePen.Style:=TPenStyle(CBStyle.ItemIndex);

    if ThePen is TChartPen then
       TChartPen(ThePen).SmallDots:=False;
  end;

  UDWidth.Enabled:=tmp; { 5.01 }
  SEWidth.Enabled:=tmp;

  UDSpace.Enabled:=not tmp;
  ESpace.Enabled:=not tmp;

  ModifiedPen:=True;
end;

procedure TPenDialog.BColorClick(Sender: TObject);
begin
  CBStyle.Repaint;
  ModifiedPen:=True;
end;

{$IFDEF CLX}
procedure TPenDialog.CBStyleDrawItem(Sender: TObject; Index: Integer;
  Rect: TRect; State: TOwnerDrawState; var Handled:Boolean);
{$ELSE}
procedure TPenDialog.CBStyleDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
{$ENDIF}
var tmp : TColor;
begin
  With TControlCanvas(CBStyle.Canvas) do
  begin
    {$IFDEF CLX}
    Brush.Style:=bsSolid;
    if (odFocused in State) or (odSelected in State) then
       Brush.Color:=clHighLight;
    {$ENDIF}

    FillRect(Rect);

    {$IFNDEF CLX}
    if Index<>CBStyle.Items.Count-1 then
    {$ENDIF}
       Pen.Style:=TPenStyle(Index);

    Pen.Color:=ThePen.Color;
    if odSelected in State then tmp:=clHighLight
                           else tmp:=CBStyle.Color;
    if Pen.Color=ColorToRGB(tmp) then
       if Pen.Color=clWhite then Pen.Color:=clBlack
                            else Pen.Color:=clWhite;

    {$IFNDEF CLX}
    if IsWindowsNT and (Index=CBStyle.Items.Count-1) then { 5.01 }
       Pen.Handle:=TeeCreatePenSmallDots(Pen.Color);
    {$ENDIF}

    MoveTo(Rect.Left+2,Rect.Top+8);
    LineTo(Rect.Left+30,Rect.Top+8);
    Brush.Style:=bsClear;
    
    {$IFDEF CLX}
    if not (odSelected in State) then
       Font.Color:=ColorToRGB(clText);
    {$ELSE}
    {$IFDEF LCL}
    if not (odSelected in State) then
       Font.Color:=ColorToRGB(clText);
    {$ELSE}
    UpdateTextFlags;
    {$ENDIF}

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -