{*********************************************************} {* VPEDSHAPE.PAS 1.03 *} {*********************************************************} {* ***** BEGIN LICENSE BLOCK ***** *} {* Version: MPL 1.1 *} {* *} {* The contents of this file are subject to the Mozilla Public License *} {* Version 1.1 (the "License"); you may not use this file except in *} {* compliance with the License. You may obtain a copy of the License at *} {* http://www.mozilla.org/MPL/ *} {* *} {* Software distributed under the License is distributed on an "AS IS" basis, *} {* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *} {* for the specific language governing rights and limitations under the *} {* License. *} {* *} {* The Original Code is TurboPower Visual PlanIt *} {* *} {* The Initial Developer of the Original Code is TurboPower Software *} {* *} {* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *} {* TurboPower Software Inc. All Rights Reserved. *} {* *} {* Contributor(s): *} {* *} {* ***** END LICENSE BLOCK ***** *} {$I Vp.INC} unit VpEdShape; interface uses {$IFDEF LCL} LMessages,LCLProc,LCLType,LCLIntf, {$ELSE} Windows,Messages,ColorGrd, {$ENDIF} SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, TypInfo, ComCtrls, VpPrtFmt; type TfrmEditShape = class(TForm) btnCancel: TButton; btnOk: TButton; cbBrushStyle: TComboBox; cbPenMode: TComboBox; cbPenStyle: TComboBox; gbBrush: TGroupBox; gbPen: TGroupBox; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; rgShapeType: TRadioGroup; udPenWidth: TUpDown; edPenWidth: TEdit; procedure btnOkClick(Sender: TObject); procedure btnCancelClick(Sender: TObject); procedure cbBrushStyleDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure FormCreate(Sender: TObject); procedure cbPenStyleDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); private procedure FillBrushStyleList; procedure FillPenStyleList; procedure FillPenModeList; protected procedure SaveData(AShape: TVpPrintShape); procedure SetData(AShape: TVpPrintShape); { Private declarations } public function Execute(AShape : TVpPrintShape) : Boolean; { Public declarations } end; implementation {$IFNDEF LCL} {$R *.DFM} {$ENDIF} { TfrmEditShape } procedure TfrmEditShape.FormCreate(Sender: TObject); begin FillBrushStyleList; FillPenStyleList; FillPenModeList; end; {=====} function TfrmEditShape.Execute(AShape: TVpPrintShape): Boolean; begin SetData(AShape); Result := ShowModal = mrOk; if Result then SaveData(AShape); end; {=====} procedure TfrmEditShape.btnOkClick(Sender: TObject); begin ModalResult := mrOk; end; {=====} procedure TfrmEditShape.btnCancelClick(Sender: TObject); begin ModalResult := mrCancel; end; {=====} procedure TfrmEditShape.FillBrushStyleList; var Style : TBrushStyle; StyleName : string; begin for Style := Low(TBrushStyle) to High(TBrushStyle) do begin StyleName := GetEnumName(TypeInfo(TBrushStyle), Ord(Style)); cbBrushStyle.Items.Add(StyleName); end; end; {=====} procedure TfrmEditShape.FillPenModeList; var Mode : TPenMode; ModeName : string; begin for Mode := Low(TPenMode) to High(TPenMode) do begin ModeName := GetEnumName(TypeInfo(TPenMode), Ord(Mode)); cbPenMode.Items.Add(ModeName); end; end; {=====} procedure TfrmEditShape.FillPenStyleList; var Style : TPenStyle; StyleName : string; begin for Style := Low(TPenStyle) to High(TPenStyle) do begin StyleName := GetEnumName(TypeInfo(TPenStyle), Ord(Style)); cbPenStyle.Items.Add(StyleName); end; end; {=====} procedure TfrmEditShape.SaveData(AShape: TVpPrintShape); begin AShape.Shape := TVpShapeType(rgShapeType.ItemIndex); AShape.Pen.Width := udPenWidth.Position; end; {=====} procedure TfrmEditShape.SetData(AShape: TVpPrintShape); var StyleStr : string; begin rgShapeType.ItemIndex := Ord(AShape.Shape); { pen settings } udPenWidth.Position := AShape.Pen.Width; // cgPenColor.ForegroundIndex := cgPenColor.ColorToIndex(AShape.Pen.Color); StyleStr := GetEnumName(TypeInfo(TPenStyle), Ord(AShape.Pen.Style)); cbPenStyle.ItemIndex := cbPenStyle.Items.IndexOf(StyleStr); StyleStr := GetEnumName(TypeInfo(TPenMode), Ord(AShape.Pen.Mode)); cbPenMode.ItemIndex := cbPenMode.Items.IndexOf(StyleStr); { brush settings } // cgBrushColor.ForegroundIndex := cgBrushColor.ColorToIndex(AShape.Brush.Color); StyleStr := GetEnumName(TypeInfo(TBrushStyle), Ord(AShape.Brush.Style)); cbBrushStyle.ItemIndex := cbBrushStyle.Items.IndexOf(StyleStr); end; {=====} procedure TfrmEditShape.cbBrushStyleDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var SavePenColor, SaveBrushColor: TColor; Rgt: Integer; SaveBrushStyle: TBrushStyle; Item : string; TxtRect : TRect; begin Item := cbBrushStyle.Items[Index]; Rgt := (Rect.Bottom - Rect.Top) + Rect.Left; with cbBrushStyle.Canvas do try { keep old settings } SavePenColor := Pen.Color; SaveBrushColor := Brush.Color; SaveBrushStyle := Brush.Style; { draw frame } Pen.Color := Brush.Color; Brush.Color := cbBrushStyle.Brush.Color; Rectangle(Rect.Left, Rect.Top, Rgt, Rect.Bottom); { set up for drawing sample } Brush.Style := TBrushStyle(GetEnumValue(TypeInfo(TBrushStyle), Item)); Pen.Color := cbBrushStyle.Font.Color; { special handling for bsClear } if Brush.Style = bsClear then begin Brush.Color := cbBrushStyle.Brush.Color; Brush.Style := bsSolid; end else Brush.Color := cbBrushStyle.Font.Color; { Draw sample } Rectangle(Rect.Left + 1, Rect.Top + 1, Rgt - 1, Rect.Bottom - 1); { restore settings } Brush.Color := SaveBrushColor; Brush.Style := SaveBrushStyle; Pen.Color := SavePenColor; finally { draw the item text } TxtRect := Classes.Rect(Rgt, Rect.Top, Rect.Right, Rect.Bottom); TextRect(TxtRect, TxtRect.Left + 1, TxtRect.Top + 1, Item); end; end; {=====} procedure TfrmEditShape.cbPenStyleDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var SavePenColor, SaveBrushColor: TColor; Rgt, Top: Integer; SavePenStyle: TPenStyle; Item: string; TxtRect : TRect; begin Item := cbPenStyle.Items[Index]; Rgt := (Rect.Bottom - Rect.Top) * 2 + Rect.Left; Top := (Rect.Bottom - Rect.Top) div 2 + Rect.Top; with cbPenStyle.Canvas do try { keep old settings } SavePenColor := Pen.Color; SaveBrushColor := Brush.Color; SavePenStyle := Pen.Style; { draw frame } Pen.Color := Brush.Color; Rectangle(Rect.Left, Rect.Top, Rgt, Rect.Bottom); { set up for drawing sample } Brush.Color := cbPenStyle.Brush.Color; Pen.Color := cbPenStyle.Font.Color; Rectangle(Rect.Left + 1, Rect.Top + 1, Rgt - 1, Rect.Bottom - 1); { Draw sample } Pen.Style := TPenStyle(GetEnumValue(TypeInfo(TPenStyle), Item)); Pen.Color := cbPenStyle.Font.Color; { Sample Line } MoveTo(Rect.Left + 1, Top); LineTo(Rgt - 1, Top); MoveTo(Rect.Left + 1, Top + 1); LineTo(Rgt - 1, Top + 1); { restore settings } Brush.Color := SaveBrushColor; Pen.Style := SavePenStyle; Pen.Color := SavePenColor; finally { draw the item text } TxtRect := Classes.Rect(Rgt, Rect.Top, Rect.Right, Rect.Bottom); TextRect(TxtRect, TxtRect.Left + 1, TxtRect.Top + 1, Item); end; end; {=====} end.