CentrED/Client/Tools/UfrmFillSettings.pas

(*
 * CDDL HEADER START
 *
 * The contents of this file are subject to the terms of the
 * Common Development and Distribution License, Version 1.0 only
 * (the "License").  You may not use this file except in compliance
 * with the License.
 *
 * You can obtain a copy of the license at
 * http://www.opensource.org/licenses/cddl1.php.
 * See the License for the specific language governing permissions
 * and limitations under the License.
 *
 * When distributing Covered Code, include this CDDL HEADER in each
 * file and include the License file at
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
 * add the following below this CDDL HEADER, with the fields enclosed
 * by brackets "[]" replaced with your own identifying * information:
 *      Portions Copyright [yyyy] [name of copyright owner]
 *
 * CDDL HEADER END
 *
 *
 *      Portions Copyright 2009 Andreas Schneider
 *)
unit UfrmFillSettings;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Spin, ExtCtrls, LMessages, laz.VirtualTrees, VirtualList, UfrmToolWindow, UfrmMain;

type

  { TfrmFillSettings }

  TfrmFillSettings = class(TfrmToolWindow)
    cbFillReview: TCheckBox;
    cbFillConfirm: TCheckBox;
    cbCategory: TComboBox;
    gbHue: TGroupBox;
    lblFillType: TLabel;
    pbHue: TPaintBox;
    vdtLastPreview: TLazVirtualDrawTree;
    vdtEntryPreview: TLazVirtualDrawTree;
    procedure cbUseSurfaceAltitudeChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure pbHueClick(Sender: TObject);
    procedure pbHuePaint(Sender: TObject);
    procedure rbRandomChange(Sender: TObject);
    procedure seForceAltitudeChange(Sender: TObject);
    procedure seProbabilityChange(Sender: TObject);
    procedure seRandomHeightChange(Sender: TObject);
    procedure vdtPreviewDrawNode(Sender: TBaseVirtualTree;
      const PaintInfo: TVTPaintInfo);
  private
    FCanClose: Boolean;
    function CanClose: Boolean; override;
    procedure OnHueClose(Sender: TObject; var ACloseAction: TCloseAction);
  end; 

const
  vdtPreviewNodeWidth  = 44;
  vdtPreviewColumnsMax = 1920 div vdtPreviewNodeWidth;

var
  frmFillSettings: TfrmFillSettings;

implementation

uses
  UGameResources, UHue, UfrmHueSettings, Language;

type
  PTileInfo = ^TTileInfo;
  TTileInfo = record
    ID: LongWord;
    ptr: Pointer;
  end;

{ TfrmFillSettings }

procedure TfrmFillSettings.pbHueClick(Sender: TObject);
begin
  frmHueSettings.Left := Mouse.CursorPos.x - 8;
  frmHueSettings.Top := Mouse.CursorPos.y - 8;
  frmHueSettings.OnClose := @OnHueClose;
  frmHueSettings.Show;
  FCanClose := False;
end;

procedure TfrmFillSettings.FormCreate(Sender: TObject);
begin
  FCanClose := True;
  cbUseSurfaceAltitudeChange(Sender);
end;

procedure TfrmFillSettings.FormShow(Sender: TObject);
var
  item: PVirtualItem;
  tileInfo: PTileInfo;
  selectedID: LongWord;
begin
  LanguageTranslate(Self);
  item := frmMain.vdtTiles.GetFirstSelected;
  if item <> nil then
  begin
    tileInfo := frmMain.vdtTiles.GetNodeData(item);
    selectedID := tileInfo^.ID;
  end;

  (frmFillSettings as TfrmToolWindow).FormShow(Sender);
end;

procedure TfrmFillSettings.pbHuePaint(Sender: TObject);
var
  hue: THue;
begin
  if frmHueSettings <> nil then
  begin
    if frmHueSettings.lbHue.ItemIndex > 0 then
      hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1]
    else
      hue := nil;
    TfrmHueSettings.DrawHue(hue, pbHue.Canvas, pbHue.Canvas.ClipRect,
      frmHueSettings.lbHue.Items.Strings[frmHueSettings.lbHue.ItemIndex]);
  end;
end;

procedure TfrmFillSettings.rbRandomChange(Sender: TObject);
begin
  if frmMain.mnuAutoHideRandomList.Checked then
     frmMain.mnuAutoHideRandomListClick(Sender);
end;

procedure TfrmFillSettings.seProbabilityChange(Sender: TObject);
begin
 // cbProbability.Checked := (seProbability.Value < seProbability.MaxValue);
end;

procedure TfrmFillSettings.cbUseSurfaceAltitudeChange(Sender: TObject);
begin
//  cbForceAltitude.Enabled := not cbUseSurfaceAltitude.Checked;
//  seForceAltitude.Enabled := not cbUseSurfaceAltitude.Checked;
end;

procedure TfrmFillSettings.seForceAltitudeChange(Sender: TObject);
begin
//  cbForceAltitude.Checked := True;
end;

procedure TfrmFillSettings.seRandomHeightChange(Sender: TObject);
begin
//  cbRandomHeight.Checked := (seRandomHeight.Value <> 0);
end;

procedure TfrmFillSettings.vdtPreviewDrawNode(Sender: TBaseVirtualTree;
  const PaintInfo: TVTPaintInfo);
begin

end;

function TfrmFillSettings.CanClose: Boolean;
begin
  Result := FCanClose and inherited CanClose;
end;

procedure TfrmFillSettings.OnHueClose(Sender: TObject;
  var ACloseAction: TCloseAction);
var
  msg: TLMessage;
begin
  FCanClose := True;
  frmHueSettings.OnClose := nil;
  pbHue.Repaint;
  MouseLeave(msg);
end;

initialization
  {$I UfrmFillSettings.lrs}

end.