Subversion Repositories spacemission

Rev

Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed

  1. unit DXMapEditProperties;
  2. //(c)2007 Jaro Benes
  3. //All Rights Reserved
  4.  
  5. {
  6. Complex application for users of unDelphiX as component editor:
  7.  
  8. Supported:
  9.  a) set up or change for each chip parameters by drawing or collision brick.
  10.  b) integrated into map editor.
  11.  
  12. }
  13. interface
  14.  
  15. {$INCLUDE DelphiXcfg.inc}              
  16.  
  17. uses
  18.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  19.   Dialogs, StdCtrls, ExtCtrls, Buttons, DXSprite, DXDraws;
  20.  
  21. type
  22.   {injected class}
  23.   TEdit = class(StdCtrls.TEdit)
  24.   private
  25.     FButton: TSpeedButton;
  26.     FEditorEnabled: Boolean;
  27.     FOnBtnClick: TNotifyEvent;
  28.     procedure SetGlyph(Pic: TBitmap);
  29.     function GetGlyph: TBitmap;
  30.     procedure SetNumGlyphs(ANumber: Integer);
  31.     function GetNumGlyphs: Integer;
  32.     //function GetMinHeight: Integer;
  33.     procedure SetEditRect;
  34.     function GetAsInteger: Integer;
  35.     procedure SetAsInteger(const Value: Integer);
  36.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  37.     procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
  38.     procedure CMExit(var Message: TCMExit); message CM_EXIT;
  39.     procedure WMPaste(var Message: TWMPaste); message WM_PASTE;
  40.     procedure WMCut(var Message: TWMCut); message WM_CUT;
  41.     function GetAsFloat: Double;
  42.     procedure SetAsFloat(const Value: Double);
  43.     function GetBtnVisible: Boolean;
  44.     procedure SetBtnVisible(const Value: Boolean);
  45.   protected
  46.     function IsValidChar(Key: Char): Boolean; virtual;
  47.     procedure aClick(Sender: TObject); virtual;
  48.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  49.     procedure KeyPress(var Key: Char); override;
  50.     procedure CreateParams(var Params: TCreateParams); override;
  51.     procedure CreateWnd; override;
  52.   public
  53.     constructor Create(AOwner: TComponent); override;
  54.     destructor Destroy; override;
  55.     property Button: TSpeedButton read FButton;
  56.     property AsInteger: Integer read GetAsInteger write SetAsInteger;
  57.     property AsFloat: Double read GetAsFloat write SetAsFloat;
  58.     procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  59.   published
  60.     property BtnVisible: Boolean read GetBtnVisible write SetBtnVisible default False;
  61.     property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
  62.     property Glyph: TBitmap read GetGlyph write SetGlyph;
  63.     property NumGlyphs: Integer read GetNumGlyphs write SetNumGlyphs;
  64.     property OnBtnClick: TNotifyEvent read FOnBtnClick write FOnBtnClick;
  65.   end;
  66.  
  67.   {  TDelphiXMapEditPropertiesForm  }
  68.  
  69.   TDelphiXMapEditPropertiesForm = class(TForm)
  70.     Panel1: TPanel;
  71.     LAlpha: TLabel;
  72.     LAnimCount: TLabel;
  73.     LAnimSpeed: TLabel;
  74.     LAnimStart: TLabel;
  75.     LAnimPos: TLabel;
  76.     EAlpha: TEdit;
  77.     EAnimCount: TEdit;
  78.     EAnimSpeed: TEdit;
  79.     EAnimStart: TEdit;
  80.     EAnimPos: TEdit;
  81.     Panel2: TPanel;
  82.     chbCollisioned: TCheckBox;
  83.     chbAnimated: TCheckBox;
  84.     rgBlendMode: TRadioGroup;
  85.     btnOK: TBitBtn;
  86.     btnCancel: TBitBtn;
  87.     GroupBox1: TGroupBox;
  88.     chbFlip: TCheckBox;
  89.     chbMirror: TCheckBox;
  90.     procedure btnCancelClick(Sender: TObject);
  91.     procedure btnOKClick(Sender: TObject);
  92.   private
  93.     { Private declarations }
  94.     LocalMapType: TMapType;
  95.     FCol, FRow: Integer;
  96.   public
  97.     { Public declarations }
  98.     procedure LoadCellToForm(MapType: TMapType; ACol, ARow: Integer);
  99.     function SaveCellFromForm(ACol, ARow: Integer): TMapType;
  100.     property Col: Integer read FCol write FCol;
  101.     property Row: Integer read FRow write FRow;
  102.   end;
  103.  
  104. implementation
  105.  
  106. {$R *.dfm}
  107.  
  108. uses DXMapEdit;
  109.  
  110. {  TEdit  }
  111.  
  112. constructor TEdit.Create(AOwner: TComponent);
  113. begin
  114.   inherited Create(AOwner);
  115.   FButton := TSpeedButton.Create(Self);
  116.   FButton.Align := alRight;
  117.   FButton.Caption := '...';
  118.   //FButton.Height := Self.Height-4;
  119.   FButton.Width := FButton.Height div 2;
  120. //  if csDesigning in ComponentState then
  121. //    FButton.Visible := True
  122. //  else FButton.Visible := False;
  123.   FButton.Parent := Self;
  124.   FButton.OnClick := aClick;
  125.   FButton.Cursor := crArrow;
  126.   ControlStyle := ControlStyle - [csSetCaption];
  127.   FButton.Visible := False; {button is not visible as default}
  128.   FEditorEnabled := True;
  129. end;
  130.  
  131. destructor TEdit.Destroy;
  132. begin
  133.   FButton.Free; FButton := nil;
  134.   inherited Destroy;
  135. end;
  136.  
  137. procedure TEdit.GetChildren(Proc: TGetChildProc; Root: TComponent);
  138. begin
  139. end;
  140.  
  141. procedure TEdit.KeyDown(var Key: Word; Shift: TShiftState);
  142. begin
  143.   inherited KeyDown(Key, Shift);
  144. end;
  145.  
  146. procedure TEdit.SetGlyph(Pic: TBitmap);
  147. begin
  148.   FButton.Glyph.Assign(Pic);
  149. end;
  150.  
  151. function TEdit.GetGlyph: TBitmap;
  152. begin
  153.   Result := FButton.Glyph;
  154. end;
  155.  
  156. procedure TEdit.SetNumGlyphs(ANumber: Integer);
  157. begin
  158.   FButton.NumGlyphs := ANumber;
  159. end;
  160.  
  161. function TEdit.GetNumGlyphs: Integer;
  162. begin
  163.   Result := FButton.NumGlyphs;
  164. end;
  165.  
  166. procedure TEdit.KeyPress(var Key: Char);
  167. begin
  168.   if not IsValidChar(Key) then
  169.   begin
  170.     Key := #0;
  171.     MessageBeep(0)
  172.   end;
  173.   if Key <> #0 then inherited KeyPress(Key);
  174. end;
  175.  
  176. function TEdit.IsValidChar(Key: Char): Boolean;
  177. begin
  178.   Result := True;
  179. end;
  180.  
  181. procedure TEdit.CreateParams(var Params: TCreateParams);
  182. begin
  183.   inherited CreateParams(Params);
  184.   Params.Style := Params.Style or ES_MULTILINE or WS_CLIPCHILDREN {and not WS_BORDER};
  185. end;
  186.  
  187. procedure TEdit.CreateWnd;
  188. begin
  189.   inherited CreateWnd;
  190.   SetEditRect;
  191. end;
  192.  
  193. procedure TEdit.SetEditRect;
  194. var
  195.   Loc: TRect;
  196.   W: Integer;
  197. begin
  198.   W := FButton.Width;
  199.   if not FButton.Visible then W := 0;
  200.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc));
  201.   Loc.Bottom := ClientHeight + 1; {+1 is workaround for windows paint bug}
  202.   Loc.Right := ClientWidth - W - 2;
  203.   Loc.Top := 0;
  204.   Loc.Left := 0;
  205.   SendMessage(Handle, EM_SETRECTNP, 0, LongInt(@Loc));
  206.   SendMessage(Handle, EM_GETRECT, 0, LongInt(@Loc)); {debug}
  207. end;
  208.  
  209. procedure TEdit.WMSize(var Message: TWMSize);
  210. var
  211.   MinHeight: Integer;
  212. begin
  213.   inherited;
  214.   MinHeight := 5;
  215.   { text edit bug: if size to less than minheight, then edit ctrl does not display the text }
  216.   if Height < MinHeight then
  217.     Height := MinHeight
  218.   else
  219.   if Assigned(FButton) and FButton.Visible then
  220.   begin
  221.     FButton.Width := FButton.Height;
  222.     if NewStyleControls and Ctl3D then
  223.       FButton.SetBounds(Width - FButton.Width - 5, 0, FButton.Width, Height - 5)
  224.     else FButton.SetBounds(Width - FButton.Width, 1, FButton.Width, Height - 1);
  225.     SetEditRect;
  226.   end
  227.   else SetEditRect;
  228. end;
  229. {
  230. function TEdit.GetMinHeight: Integer;
  231. var
  232.   DC: HDC;
  233.   SaveFont: HFont;
  234.   I: Integer;
  235.   SysMetrics, Metrics: TTextMetric;
  236. begin
  237.   DC := GetDC(0);
  238.   GetTextMetrics(DC, SysMetrics);
  239.   SaveFont := SelectObject(DC, Font.Handle);
  240.   GetTextMetrics(DC, Metrics);
  241.   SelectObject(DC, SaveFont);
  242.   ReleaseDC(0, DC);
  243.   I := SysMetrics.tmHeight;
  244.   if I > Metrics.tmHeight then I := Metrics.tmHeight;
  245.   Result := Metrics.tmHeight + I div 4 + GetSystemMetrics(SM_CYBORDER) * 4 + 2;
  246. end;
  247. }
  248. procedure TEdit.aClick(Sender: TObject);
  249. begin
  250.   if ReadOnly then MessageBeep(0)
  251.   else if Assigned(FOnBtnClick) then FOnBtnClick(Self);
  252. end;
  253.  
  254. procedure TEdit.WMPaste(var Message: TWMPaste);
  255. begin
  256.   if not FEditorEnabled or ReadOnly then Exit;
  257.   inherited;
  258. end;
  259.  
  260. procedure TEdit.WMCut(var Message: TWMPaste);
  261. begin
  262.   if not FEditorEnabled or ReadOnly then Exit;
  263.   inherited;
  264. end;
  265.  
  266. procedure TEdit.CMExit(var Message: TCMExit);
  267. begin
  268.   //FButton.Visible := False;
  269.   inherited;
  270. end;
  271.  
  272. procedure TEdit.CMEnter(var Message: TCMGotFocus);
  273. begin
  274.   //FButton.Visible := True;
  275.   if AutoSelect and not (csLButtonDown in ControlState) then
  276.     SelectAll;
  277.   inherited;
  278. end;
  279.  
  280. function TEdit.GetAsInteger: Integer;
  281. begin
  282.   try
  283.     Result := StrToInt(Self.Text);
  284.   except
  285.     Result := 0;
  286.   end;
  287. end;
  288.  
  289. function TEdit.GetBtnVisible: Boolean;
  290. begin
  291.   Result := FButton.Visible
  292. end;
  293.  
  294. procedure TEdit.SetAsInteger(const Value: Integer);
  295. begin
  296.   Self.Text := IntToStr(Value)
  297. end;
  298.  
  299. procedure TEdit.SetBtnVisible(const Value: Boolean);
  300. begin
  301.   FButton.Visible := Value;
  302. end;
  303.  
  304. function TEdit.GetAsFloat: Double;
  305. begin
  306.   try
  307.     Result := StrToFloat(Self.Text);
  308.   except
  309.     Result := 0;
  310.   end;
  311. end;
  312.  
  313. procedure TEdit.SetAsFloat(const Value: Double);
  314. begin
  315.   Self.Text := FloatToStr(Value)
  316. end;
  317.  
  318. {  TDelphiXMapEditPropertiesForm  }
  319.  
  320. procedure TDelphiXMapEditPropertiesForm.LoadCellToForm(MapType: TMapType; ACol, ARow: Integer);
  321. begin
  322.   LocalMapType := MapType;
  323.   Panel2.Caption := Format('Chip (%d, %d)', [ACol, ARow]);
  324.   chbCollisioned.Checked := MapType.CollisionChip;
  325.   chbAnimated.Checked := MapType.AnimLooped;
  326.   EAnimStart.AsInteger := MapType.AnimStart;
  327.   EAnimCount.AsInteger := MapType.AnimCount;
  328.   EAnimSpeed.AsFloat := MapType.AnimSpeed;
  329.   EAnimPos.AsFloat := MapType.AnimPos;
  330.   rgBlendMode.ItemIndex := Ord(MapType.Rendered);
  331.   EAlpha.AsInteger := MapType.Alpha;
  332.   chbFlip.Checked := (rmfFlip in MapType.MirrorFlip);
  333.   chbMirror.Checked := (rmfMirror in MapType.MirrorFlip);
  334. end;
  335.  
  336. function TDelphiXMapEditPropertiesForm.SaveCellFromForm(ACol, ARow: Integer): TMapType;
  337. begin
  338.   Result := LocalMapType;
  339.   Result.CollisionChip := chbCollisioned.Checked;
  340.   Result.AnimLooped := chbAnimated.Checked;
  341.   Result.AnimStart := EAnimStart.AsInteger;
  342.   Result.AnimCount := EAnimCount.AsInteger;
  343.   Result.AnimSpeed := EAnimSpeed.AsInteger;
  344.   Result.AnimPos := EAnimPos.AsInteger;
  345.   Result.Rendered := TRenderType(rgBlendMode.ItemIndex);
  346.   Result.Alpha := EAlpha.AsInteger;
  347.   Result.MirrorFlip := [];
  348.   if chbFlip.Checked then Result.MirrorFlip := Result.MirrorFlip + [rmfFlip];
  349.   if chbMirror.Checked then Result.MirrorFlip := Result.MirrorFlip + [rmfMirror];
  350. end;
  351.  
  352. procedure TDelphiXMapEditPropertiesForm.btnOKClick(Sender: TObject);
  353. begin
  354.   Tag := 1;
  355.   Panel2.Color := {$IFDEF VER6UP}clMoneyGreen{$ELSE}clGreen{$ENDIF};
  356.   DelphiXMapEditForm.DXBackgroundSprite.Map[FCol, FRow] := SaveCellFromForm(FCol, FRow);
  357.   DelphiXMapEditForm.MapArea.Invalidate;
  358.   btnCancelClick(Sender);
  359.   Hide;
  360. end;
  361.  
  362. procedure TDelphiXMapEditPropertiesForm.btnCancelClick(Sender: TObject);
  363. begin
  364.   Tag := 0;
  365.   Panel2.Color := {$IFDEF VER6UP}clSkyBlue{$ELSE}clBlue{$ENDIF};
  366. end;
  367.  
  368. end.
  369.