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

📄 teebrushdlg.pas

📁 complete source code for teechart 7
💻 PAS
字号:
{******************************************}
{    TeeChart. TBrushDialog                }
{ Copyright (c) 1996-2004 by David Berneda }
{******************************************}
unit TeeBrushDlg;
{$I TeeDefs.inc}

interface

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

type
  TBrushDialog = class(TForm)
    Button2: TButton;
    BColor: TButtonColor;
    Button3: TButton;
    GroupBox2: TGroupBox;
    Button1: TButton;
    Image1: TImage;
    LStyle: TListBox;
    ImageMetal: TImage;
    ImageWood: TImage;
    ImageStone: TImage;
    ImageClouds: TImage;
    ImageGrass: TImage;
    ImageFire: TImage;
    ImageSnow: TImage;
    procedure FormShow(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure LStyleClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    {$IFDEF CLX}
    procedure LStyleDrawItem(Sender: TObject; Index: Integer;
        Rect: TRect;  State: TOwnerDrawState; var Handled: Boolean);
    {$ELSE}
    procedure LStyleDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    {$ENDIF}
  private
    { Private declarations }
    BackupBrush : TChartBrush;
    Procedure CheckImageButton;
    Function GetInternalBrush(Index:Integer):TBitmap;
    procedure RedrawShape;
  public
    { Public declarations }
    TheBrush : TChartBrush;
  end;

Function EditChartBrush( AOwner:TComponent;
                          ChartBrush:TChartBrush):Boolean;

Function EditTeeFont(AOwner:TComponent; AFont:TFont):Boolean;

Function TeeGetPictureFileName(AOwner:TComponent):String;

procedure TeeLoadClearImage(AOwner:TComponent; AImage:TPicture);

Procedure GetTeeBrush(Index:Integer; ABitmap:TBitmap);

implementation

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

{$IFDEF CLR}
{$R 'TeeBrush1.bmp'}
{$R 'TeeBrush2.bmp'}
{$R 'TeeBrush3.bmp'}
{$R 'TeeBrush4.bmp'}
{$R 'TeeBrush5.bmp'}
{$R 'TeeBrush6.bmp'}
{$R 'TeeBrush7.bmp'}
{$R 'TeeBrush8.bmp'}
{$R 'TeeBrush9.bmp'}
{$R 'TeeBrush10.bmp'}
{$R 'TeeBrush11.bmp'}
{$R 'TeeBrush12.bmp'}

{$ELSE}
{$R TeeBrushes.res}
{$ENDIF}

Uses {$IFNDEF CLX}
     ExtDlgs,
     {$ENDIF}
     {$IFDEF CLR}
     Variants,
     {$ENDIF}
     TeeConst, TeeProcs;

Function EditTeeFont(AOwner:TComponent; AFont:TFont):Boolean;
Begin
  result:=False;
  With TFontDialog.Create(AOwner) do
  try
    Font.Assign(AFont);
    if Execute then
    begin
      AFont.Assign(Font);
      result:=True;
    end;
  finally
    Free;
  end;
end;

Function EditChartBrush( AOwner:TComponent;
                         ChartBrush:TChartBrush):Boolean;
var tmp : TBrushDialog;
Begin
  tmp:=TeeCreateForm(TBrushDialog,AOwner) as TBrushDialog;
  with tmp do
  try
    TheBrush:=ChartBrush;
    TeeTranslateControl(tmp);
    result:=ShowModal=mrOk;
  finally
    Free;
  end;
end;

Function TeeGetPictureFileName(AOwner:TComponent):String;
begin
  result:='';
  With {$IFDEF CLX}TOpenDialog{$ELSE}TOpenPictureDialog{$ENDIF}.Create(AOwner) do
  try
    {$IFDEF CLX}
    DefaultExt:='bmp';
    Filter:='All (*.bmp; *.ico; *.png; *.xpm)|Bitmaps (*.bmp)|Icons (*.ico)|'+
            'Portable Network Graphics (*.png)|X Pixmaps (*.xpm)';
    Options:=[ofAllowMultiSelect];
    Title:='Add Images';
    {$ENDIF}
    if Execute then result:=FileName;
  finally
    Free;
  end;
end;

procedure TeeLoadClearImage(AOwner:TComponent; AImage:TPicture);
var tmp : String;
begin
  if Assigned(AImage.Graphic) then AImage.Assign(nil)
  else
  begin
    tmp:=TeeGetPictureFileName(AOwner);
    if tmp<>'' then AImage.LoadFromFile(tmp);
  end;
end;

{ TBrushDialog }
procedure TBrushDialog.RedrawShape;
begin
  BColor.Enabled:=TheBrush.Style<>bsClear;
end;

procedure TBrushDialog.FormShow(Sender: TObject);
begin
  BackupBrush:=TChartBrush.Create(nil);

  if Assigned(TheBrush) then
  begin
    BackupBrush.Assign(TheBrush);

    if Assigned(TheBrush.Image.Graphic) then
       LStyle.ItemIndex:=-1
    else
       LStyle.ItemIndex:=Ord(TheBrush.Style);

    BColor.LinkProperty(TheBrush,'Color');

    CheckImageButton;
    RedrawShape;
  end;
end;

procedure TBrushDialog.Button3Click(Sender: TObject);
begin
  TheBrush.Assign(BackupBrush);
  ModalResult:=mrCancel;
end;

procedure TBrushDialog.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  BackupBrush.Free;
end;

procedure TBrushDialog.Button1Click(Sender: TObject);
var tmp       : String;
    tmpBitmap : TBitmap;
begin
  LStyle.ItemIndex:=Ord(TheBrush.Style);

  if Button1.Tag=1 then
     TheBrush.Image.Assign(nil)
  else
  begin
    tmp:=TeeGetPictureFileName(Self);
    if tmp<>'' then
    begin
      TheBrush.Image.LoadFromFile(tmp);
      if not (TheBrush.Image.Graphic is TBitmap) then
      begin
        tmpBitmap:=TBitmap.Create;
        with tmpBitmap do
        begin
          Width:=TheBrush.Image.Width;
          Height:=TheBrush.Image.Height;
          Canvas.Draw(0,0,TheBrush.Image.Graphic);
        end;

        TheBrush.Image.Bitmap:=tmpBitmap; // 5.03
      end;
    end;
  end;

  CheckImageButton;
end;

Procedure TBrushDialog.CheckImageButton;
begin
  if Assigned(TheBrush.Image.Graphic) then
  begin
    Button1.Tag:=1;
    Button1.Caption:=TeeMsg_ClearImage;
    Image1.Picture.Assign(TheBrush.Image);
  end
  else
  begin
    Button1.Tag:=0;
    Button1.Caption:=TeeMsg_BrowseImage;
    Image1.Picture:=nil;
  end;
end;

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

{$IFDEF CLX}
procedure TBrushDialog.LStyleDrawItem(Sender: TObject; Index: Integer;
  Rect: TRect; State: TOwnerDrawState; var Handled: Boolean);
{$ELSE}
procedure TBrushDialog.LStyleDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
{$ENDIF}
Var Old : TColor;
begin
  With TControlCanvas(LStyle.Canvas) do
  begin
    FillRect(Rect);

    if Index<>1 then
    begin
      if Index<=7 then
      begin
        Brush.Style:=TBrushStyle(Index);
        Brush.Color:=clBlack;
      end;

      {$IFDEF CLX}
      Old:=Font.Color;
      Font.Color:=clBlack;
      {$ELSE}
      SetBkColor(Handle,clWhite);
      SetBkMode(Handle,Transparent);
      Old:=GetTextColor(Handle);
      SetTextColor(Handle,clBlack);
      {$ENDIF}

      with Rect do Rect:=TeeRect(Left+2,Top+2,Left+16,Bottom-2);

      if Index>7 then
         StretchDraw(Rect,GetInternalBrush(Index-8))
      else
         FillRect(Rect);

      {$IFDEF CLX}
      Font.Color:=Old;
      {$ELSE}
      Brush.Bitmap.Free;
      SetTextColor(Handle,Old);
      {$ENDIF}
    end;

    Brush.Style:=bsClear;
    {$IFDEF CLX}
    Font.Color:=clBlack;
    {$ELSE}
    UpdateTextFlags;
    {$ENDIF}
    TextOut(Rect.Left+20,Rect.Top,LStyle.Items[Index]);
  end;
end;

procedure TBrushDialog.LStyleClick(Sender: TObject);
var tmpBitmap : TBitmap;
begin
  if LStyle.ItemIndex>7 then
  begin
    tmpBitmap:=GetInternalBrush(LStyle.ItemIndex-8);
    try
      TheBrush.Image.Graphic:=tmpBitmap;
    finally
      tmpBitmap.Free;
    end;
  end
  else
  begin
    TheBrush.Style:=TBrushStyle(LStyle.ItemIndex);
    TheBrush.Image:=nil;
  end;

  CheckImageButton;
  RedrawShape;
end;

Function TBrushDialog.GetInternalBrush(Index:Integer):TBitmap;
begin
  result:=TBitmap.Create;

  case Index of
    12: result.Assign(ImageMetal.Picture);
    13: result.Assign(ImageWood.Picture);
    14: result.Assign(ImageStone.Picture);
    15: result.Assign(ImageClouds.Picture);
    16: result.Assign(ImageGrass.Picture);
    17: result.Assign(ImageFire.Picture);
    18: result.Assign(ImageSnow.Picture);
  else
    GetTeeBrush(Index,result);
  end;
end;

Procedure GetTeeBrush(Index:Integer; ABitmap:TBitmap);
begin
  {$IFDEF CLR}
  TeeLoadBitmap(ABitmap,'TeeBrush'+TeeStr(1+Index),'');
  {$ELSE}
  with ABitmap do
  begin
    LoadFromResourceName(HInstance,'TeeBrush'+TeeStr(1+Index));
    TransparentMode:=tmFixed;
    TransparentColor:=clWhite;
  end;
  {$ENDIF}
end;

end.

⌨️ 快捷键说明

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