teependlg.pas

BCB第三方组件

    {$ENDIF}

    TextOut(Rect.Left+34,Rect.Top+{$IFDEF CLX}1{$ELSE}2{$ENDIF},CBStyle.Items[Index]);
  end;
end;

{ TButtonPen }
function TButtonPen.GetEditor:TPenDialog;
begin
  if not Assigned(FEditor) then
  begin
    FEditor:=CreatePenDialog(Self,TChartPen(Instance),HideColor);
    FOldDestroy:=FEditor.OnDestroy;
    FEditor.OnDestroy:=EditorDestroy;
  end;

  result:=FEditor;
end;

procedure TButtonPen.EditorDestroy(Sender:TObject);
begin
  if Assigned(FOldDestroy) then
     FOldDestroy(FEditor);

  FEditor:=nil;
end;

procedure TButtonPen.Click;
var tmp : Boolean;
begin
  if Assigned(Instance) then
  begin
    tmp:=Editor.ShowModal=mrOk;
    try
      if tmp then
      begin
        Repaint;
        inherited;
      end;
    finally
      FreeAndNil(FEditor);
    end;
  end
  else inherited;
end;

procedure TButtonPen.DrawSymbol(ACanvas: TTeeCanvas);
Const tmpWidth={$IFDEF CLX}13{$ELSE}17{$ENDIF};
var OldChange : TNotifyEvent;
    OldWidth  : Integer;
begin
  if Enabled and Assigned(Instance) then
  begin
    // allow maximum 6 pixels for symbol height...
    with TChartPen(Instance) do
    if Width>6 then
    begin
      OldChange:=OnChange;
      OnChange:=nil;
      OldWidth:=Width;
      Width:=6;
    end
    else
    begin
      OldChange:=nil;
      OldWidth:=0;
    end;

    // draw line
    With ACanvas do
    begin
      Brush.Style:=bsClear;
      AssignVisiblePen(TChartPen(Instance));
      MoveTo(Width-tmpWidth,Height div 2);
      LineTo(Width-6,Height div 2);
    end;

    // reset back old pen width
    if Assigned(OldChange) then
    with TChartPen(Instance) do
    begin
      Width:=OldWidth;
      OnChange:=OldChange;
    end;
  end;
end;

procedure TButtonPen.LinkPen(APen: TChartPen);
begin
  LinkProperty(APen,'');
  Invalidate;
end;

function TButtonPen.GetPen:TChartPen; // 7.01
begin
  result:=TChartPen(Instance);
end;

{ Utility functions }
Procedure ShowControls(Show:Boolean; Const AControls:Array of TControl);
var t : Integer;
begin
  for t:=Low(AControls) to High(AControls) do AControls[t].Visible:=Show;
end;

Function TeeYesNo(Const Message:String; Owner:TControl=nil):Boolean;
var x : Integer;
    y : Integer;
Begin
  Screen.Cursor:=crDefault;
  if Assigned(Owner) then
  begin
    x:=Owner.ClientOrigin.X+20;
    y:=Owner.ClientOrigin.Y+30;
    result:=MessageDlgPos(Message,mtConfirmation,[mbYes,mbNo],0,x,y)=mrYes;
  end
  else result:=MessageDlg(Message,mtConfirmation,[mbYes,mbNo],0)=mrYes;
End;

Function TeeYesNoDelete(Const Message:String; Owner:TControl=nil):Boolean;
begin
  result:=TeeYesNo(Format(TeeMsg_SureToDelete,[Message]),Owner);
end;

{$IFDEF CLX}
Procedure TeeFixParentedForm(AForm:TForm);
var tmpPoint : TPoint;
    tmpFlags : Integer;
begin
  with AForm do
  begin   
    if not Parent.Showing then Parent.Show;
    tmpPoint:=Point(Left,Top);
    tmpFlags:=Integer( WidgetFlags_WStyle_NoBorder ) or
              Integer( WidgetFlags_WStyle_Customize );

    QWidget_reparent(Handle, ParentWidget, Cardinal(tmpFlags), @tmpPoint, Showing);
    QOpenWidget_clearWFlags(QOpenWidgetH(Handle), Integer($FFFFFFFF));
    QOpenWidget_setWFlags(QOpenWidgetH(Handle), Cardinal(tmpFlags));
    Left:=tmpPoint.X;
    Top:=tmpPoint.Y;
  end;
end;    
{$ENDIF}

Procedure AddFormTo(AForm:TForm; AParent:TWinControl);
begin
  AddFormTo(AForm,AParent,nil);
end;

{$IFNDEF CLR}
Procedure AddFormTo(AForm:TForm; AParent:TWinControl; ATag:Integer);
begin
  AddFormTo(AForm,AParent,TComponent(ATag));
end;
{$ENDIF}

{$IFNDEF CLR}
type
  TCustomFormAccess=class(TCustomForm);
{$ENDIF}

Procedure AddFormTo(AForm:TForm; AParent:TWinControl; ATag:TPersistent);
{$IFNDEF CLX}
var OldVisibleFlag : Boolean;
{$ENDIF}
begin

  {$IFNDEF CLR}
  with TCustomFormAccess(AForm) do
  begin
    {$IFNDEF CLX}
    {$IFDEF D7}
    ParentBackground:=True;
    {$ENDIF}
    {$ENDIF}

    ParentColor:=True;
  end;
  {$ENDIF}

  With AForm do
  begin
    {$IFNDEF CLX}
    Position:=poDesigned;
    {$ENDIF}
    
    BorderStyle:=TeeFormBorderStyle;
    BorderIcons:=[];
    Tag:={$IFDEF CLR}Variant{$ELSE}Integer{$ENDIF}(ATag);

    Parent:=AParent;

    {$IFNDEF CLX}
    OldVisibleFlag:=Parent.Visible;
    Parent.Visible:=True;
    {$ENDIF}

    Left:=4; { ((AParent.ClientWidth-ClientWidth) div 2); }
    Top:=Math.Min(4,Abs(AParent.ClientHeight-ClientHeight) div 2);

    {$IFDEF CLX}
    Align:=alClient;
    TeeFixParentedForm(AForm);
    {$ENDIF}

    // dont here: TeeTranslateControl(AForm);

    TeeScaleForm(AForm);

    Show;

    {$IFNDEF CLX}
    Parent.Visible:=OldVisibleFlag;
    {$ENDIF}
  end;
end;

{ Utils }
Procedure AddDefaultValueFormats(AItems:TStrings);
begin
  AItems.Add(TeeMsg_DefValueFormat);
  AItems.Add('0');
  AItems.Add('0.0');
  AItems.Add('0.#');
  AItems.Add('#.#');
  AItems.Add('#,##0.00;(#,##0.00)');
  AItems.Add('00e-0');
  AItems.Add('#.0 "x10" E+0');
  AItems.Add('#.# x10E-#');
end;

Procedure TeeLoadArrowBitmaps(AUp,ADown: TBitmap);
begin
  TeeLoadBitmap(AUp,'TeeArrowUp','');
  TeeLoadBitmap(ADown,'TeeArrowDown','');
end;

{ Helper Listbox methods... }
procedure MoveList(Source,Dest:TCustomListBox);
var t:Integer;
begin
  with Source do
  begin
    for t:=0 to Items.Count-1 do
        if Selected[t] then Dest.Items.AddObject(Items[t],Items.Objects[t]);
    t:=0;
    While t<Items.Count do
    begin
      if Selected[t] then Items.Delete(t)
                     else Inc(t);
    end;
  end;
end;

procedure MoveListAll(Source,Dest:TStrings);
var t : Integer;
begin
  With Source do
  for t:=0 to Count-1 do Dest.AddObject(Strings[t],Objects[t]);
  Source.Clear;
end;

{ Routines to support "crTeeHand" cursor type }
Function TeeIdentToCursor(Const AName:String; Var ACursor:Integer):Boolean;
begin
  if AName=TeeMsg_TeeHand then
  begin
    ACursor:=crTeeHand;
    result:=True;
  end
  else result:=IdentToCursor(AName,ACursor);
end;

Const TeeCursorPrefix='cr';

Function TeeSetCursor(ACursor:TCursor; const S:String):TCursor;
var tmpCursor : Integer;
begin
  if TeeIdentToCursor(TeeCursorPrefix+S,tmpCursor) then
     result:=tmpCursor
  else
     result:=ACursor;
end;

Function TeeCursorToIdent(ACursor:Integer; Var AName:String):Boolean;
begin
  if ACursor=crTeeHand then
  begin
    AName:=TeeMsg_TeeHand;
    result:=True;
  end
  else result:=CursorToIdent(ACursor,AName);
end;

type
  TTempCursors=class
  private
    FCombo : TComboFlat;
    procedure ProcGetCursors(const S: string);
  end;

Function DeleteCursorPrefix(Const S:String):String;
begin
  result:=S;
  if Copy(result,1,2)=TeeCursorPrefix then Delete(result,1,2);
end;

procedure TTempCursors.ProcGetCursors(const S: string);
begin
  FCombo.Items.Add(DeleteCursorPrefix(S));
end;

procedure TeeFillCursors(ACombo:TComboFlat; ACursor:TCursor);
var tmp   : TTempCursors;
    tmpSt : String;
begin
  With ACombo do
  begin
    Items.BeginUpdate;
    Clear;

//  Sorted:=True;  6.02, breaks new "Tree mode" chart editor
//  Set Sorted to True at design-time in forms, not here.

    tmp:=TTempCursors.Create;
    try
      tmp.FCombo:=ACombo;
      GetCursorValues(tmp.ProcGetCursors);
      tmp.ProcGetCursors(TeeMsg_TeeHand);
    finally
      tmp.Free;
    end;

    Items.EndUpdate;

    if TeeCursorToIdent(ACursor,tmpSt) then
       ItemIndex:=Items.IndexOf(DeleteCursorPrefix(tmpSt))
    else
       ItemIndex:=-1;
  end;
end;

procedure TPenDialog.FormDestroy(Sender: TObject);
begin
  BackupPen.Free;
end;

procedure TeePreviewCursor(ACursor:TCursor; APicture:TPicture);
{$IFNDEF CLX}
var
  tmpCursor : {$IFDEF CLX}QCursorH{$ELSE}THandle{$ENDIF};
  tmpBitmap : TBitmap;
{$ENDIF}
begin
  {$IFNDEF CLX}
  tmpCursor:=Screen.Cursors[ACursor];

  if tmpCursor<>0 then
  begin
    tmpBitmap:=TBitmap.Create;
    try
      TeeSetBitmapSize(tmpBitmap,GetSystemMetrics(SM_CXCURSOR),
                                 GetSystemMetrics(SM_CYCURSOR));

      DrawIconEx(tmpBitmap.Canvas.Handle,0,0,tmpCursor,
                 0,0,0,0,DI_NORMAL or DI_DEFAULTSIZE);
      APicture.Graphic:=tmpBitmap;
    finally
      tmpBitmap.Free;
    end;
  end
  else
    APicture.Graphic:=nil;
  {$ENDIF}
end;

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

  function GetFirstParentForm(Control:TControl):TCustomForm;
  begin
    result:=nil;

    while Assigned(Control.Parent) do
    begin
      Control:=Control.Parent;

      if Control is TCustomForm then
      begin
        result:=TCustomForm(Control);
        break;
      end;
    end;
  end;

var tmpForm : TCustomForm;
begin
  tmpForm:=GetFirstParentForm(AForm);

  if Assigned(tmpForm) and (tmpForm is TForm) and
     (TForm(tmpForm).PixelsPerInch<>AForm.PixelsPerInch) then
  begin
    {$IFNDEF LCL} // No ScaleBy method in LCL

    AForm.ScaleBy(TForm(tmpForm).PixelsPerInch,AForm.PixelsPerInch);

    {$ENDIF}

    AForm.PixelsPerInch:=TForm(tmpForm).PixelsPerInch;
  end;
end;

procedure TPenDialog.ESpaceChange(Sender: TObject);
begin
  if Showing and (ThePen is TChartPen) then
  begin
    TChartPen(ThePen).SmallSpace:=UDSpace.Position;
    ModifiedPen:=True;
  end;
end;

end.