frm_setline.pas

delphi语言开发的矢量图形处理对象

unit frm_SetLine;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,types;

type
  TfrmSetLine = class(TForm)
    GroupBox1: TGroupBox;
    cmoLineColor: TColorBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    cmoLineType: TComboBox;
    cmoLineWidth: TComboBox;
    Label4: TLabel;
    cmoLineArrow: TComboBox;
    Button1: TButton;
    Button2: TButton;
    lblWidth: TLabel;
    procedure cmoLineTypeMeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure cmoLineTypeDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
    procedure cmoLineWidthClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    lineTypeBitmap:array [0..5] of TBitmap;
    lineWidthBitmap:array [0..5] of TBitmap;
    lineArrowBitmap:array [0..6] of TBitmap;
    procedure loadBitmaps(cmoPara:TComboBox);//从资源文件里调出位图
    procedure destoryBitmap(bitmaps:array of TBitmap);
  public
    { Public declarations }
  end;

var
  frmSetLine: TfrmSetLine;

implementation

{$R *.dfm}

{ TfrmSetLine }

procedure TfrmSetLine.loadBitmaps(cmoPara: TComboBox);
var
  i:integer;
begin
  if cmoPara.Name ='cmoLineType' then
  begin
    for i:=0 to cmoPara.Items.Count -1 do
    begin
      lineTypeBitmap[i]:=TBitmap.Create;
      lineTypeBitMap[i].Handle :=loadBitmap(HInstance,pchar(cmoPara.Items.Strings[i]));
    end;
  end;
  if cmoPara.Name ='cmoLineWidth' then
  begin
    for i:=0 to cmoPara.Items.Count -1 do
    begin
      lineWidthBitmap[i]:=TBitmap.Create;
      lineWidthBitMap[i].Handle :=loadBitmap(HInstance,pchar(cmoPara.Items.Strings[i]));
    end;
  end;
  if cmoPara.Name ='cmoLineArrow' then
  begin
    for i:=0 to cmoPara.Items.Count -1 do
    begin
      lineArrowBitmap[i]:=TBitmap.Create;
      lineArrowBitMap[i].Handle :=loadBitmap(HInstance,pchar(cmoPara.Items.Strings[i]));
    end;
  end;
end;

procedure TfrmSetLine.cmoLineTypeMeasureItem(Control: TWinControl;
  Index: Integer; var Height: Integer);
begin
  if TComboBox(Control).Name='cmoLineType' then
  begin
    Height:=lineTypeBitmap[Index].Height;
    Width:=lineTypeBitmap[Index].Width;
  end;
  if TComboBox(Control).Name='cmoLineWidth' then
  begin
    Height:=lineWidthBitmap[Index].Height;
    Width:=lineWidthBitmap[Index].Width;
  end;
  if TComboBox(Control).Name='cmoLineArrow' then
  begin
    Height:=lineArrowBitmap[Index].Height;
    Width:=lineArrowBitmap[Index].Width;
  end;

end;

procedure TfrmSetLine.cmoLineTypeDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  t:TRect;
begin
  if odSelected in state	then
  begin
    TComboBox(Control).Canvas.Pen.Color :=clRed;
    TComboBox(Control).Canvas.Pen.Style :=psSolid;
  end;
  t.TopLeft :=Point(0,0);
  if TComboBox(Control).Name ='cmoLineType' then
  begin
    t.BottomRight :=Point(lineTypeBitmap[Index].Width,lineTypeBitmap[Index].Height);
    TComboBox(Control).Canvas.CopyRect(Rect,lineTypeBitmap[index].Canvas,t);
  end;
  if TComboBox(Control).Name ='cmoLineWidth' then
  begin
    t.BottomRight :=Point(lineWidthBitmap[Index].Width,lineWidthBitmap[Index].Height);
    TComboBox(Control).Canvas.CopyRect(Rect,lineWidthBitmap[index].Canvas,t);
  end;
  if TComboBox(Control).Name ='cmoLineArrow' then
  begin
    t.BottomRight :=Point(lineArrowBitmap[Index].Width,lineArrowBitmap[Index].Height);
    TComboBox(Control).Canvas.CopyRect(Rect,lineArrowBitmap[index].Canvas,t);
  end;
end;

procedure TfrmSetLine.FormCreate(Sender: TObject);
begin
  LoadBitmaps(cmoLineType);
  loadBitmaps(cmoLineWidth);
  loadBitmaps(cmoLineArrow);
end;

procedure TfrmSetLine.cmoLineWidthClick(Sender: TObject);
var
  lineWidth:string;
begin
  case cmoLineWidth.ItemIndex of
    0:lblWidth.Caption :='1P';
    1:lblWidth.Caption :='2P';
    2:lblWidth.Caption :='4P';
    3:lblWidth.Caption :='6P';
    4:lblWidth.Caption :='8P';
    5:begin
        lineWidth:=InputBox('输入对话框','线的宽度值','1');
        case strToint(lineWidth) of
          1:cmoLineWidth.ItemIndex :=0;
          2:cmoLineWidth.ItemIndex :=1;
          4:cmoLineWidth.ItemIndex :=2;
          6:cmoLineWidth.ItemIndex :=3;
          8:cmoLineWidth.ItemIndex :=4;
        end;
        lblWidth.Caption :=lineWidth+'P';
    end;
  end;
end;

procedure TfrmSetLine.destoryBitmap(bitmaps: array of TBitmap);
var
  i:integer;
begin
  for i:=low(bitmaps) to High(bitmaps) do
  bitmaps[i].Free;
end;

procedure TfrmSetLine.FormDestroy(Sender: TObject);
begin
  destoryBitmap(lineArrowBitmap);
  destoryBitmap(lineTypeBitmap);
  destoryBitmap(lineWidthBitmap);
end;

end.