▼ File: FinchCT.ctpr
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="FinchCT"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
<AnsiUTF8 Value="True"/>
<UseCompatibility Value="True"/>
<UseCompatibilityVista Value="True"/>
<UseCompatibilityWin7 Value="True"/>
<UseCompatibilityWin8 Value="True"/>
<UseCompatibilityWin81 Value="True"/>
<UseCompatibilityWin10 Value="True"/>
<UseCompatibilityWin11 Value="True"/>
</XPManifest>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
<SharedMatrixOptions Count="1">
<Item1 ID="210959794584" Modes="Default" Value="-dDisableUTF8RTL"/>
</SharedMatrixOptions>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="adLCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="FinchCT.ppr"/>
<FRMtype Value="0"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="quest.pas"/>
<FRMtype Value="200"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form_Quest"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Quest"/>
</Unit>
<Unit>
<Filename Value="shape.pas"/>
<FRMtype Value="200"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form_Shape"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Shape"/>
</Unit>
<Unit>
<Filename Value="about.pas"/>
<FRMtype Value="200"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form_About"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="About"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="FinchCT"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="12"/>
<BuildModes Active="Default"/>
<Units>
<Unit>
<Filename Value="FinchCT.ppr"/>
<FRMtype Value="0"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<CursorPos Y="26"/>
<UsageCount Value="28"/>
<Loaded Value="True"/>
</Unit>
<Unit>
<Filename Value="quest.pas"/>
<FRMtype Value="200"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form_Quest"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Quest"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="1377"/>
<CursorPos Y="1398"/>
<UsageCount Value="28"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit>
<Unit>
<Filename Value="shape.pas"/>
<FRMtype Value="200"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form_Shape"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Shape"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="3"/>
<UsageCount Value="28"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit>
<Unit>
<Filename Value="about.pas"/>
<FRMtype Value="200"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form_About"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="About"/>
<EditorIndex Value="3"/>
<WindowIndex Value="0"/>
<UsageCount Value="28"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit>
<Unit>
<Filename Value="shape.frm"/>
<FRMtype Value="0"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="0"/>
<TopLine Value="487"/>
<UsageCount Value="10"/>
<DefaultSyntaxHighlighter Value="FRM"/>
</Unit>
</Units>
<JumpHistory HistoryIndex="5">
<Position>
<Filename Value="quest.pas"/>
</Position>
<Position>
<Filename Value="shape.pas"/>
</Position>
<Position>
<Filename Value="about.pas"/>
</Position>
<Position>
<Filename Value="shape.pas"/>
</Position>
<Position>
<Filename Value="FinchCT.ppr"/>
<Caret Line="26"/>
</Position>
<Position>
<Filename Value="shape.pas"/>
</Position>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes ActiveMode=""/>
</RunParams>
</ProjectSession>
</CONFIG>
program FinchCT;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the CT adLCL widgetset
Forms, Quest, Shape, About
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TForm_Quest, Form_Quest);
Application.CreateForm(TForm_Shape, Form_Shape);
Application.CreateForm(TForm_About, Form_About);
Application.Run;
end.
unit Shape;
{$MODE Delphi}
interface
uses
Windows, SysUtils, Variants,
Classes, Graphics, Controls, Forms, Dialogs, Grids,
StdCtrls;
type
{ TForm_Shape }
TForm_Shape = class(TForm)
StrGrid_Profile: TStringGrid;
procedure StrGrid_ShapeDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
procedure AutoSizeCol(Grid: TStringGrid; Column: integer);
procedure AutoSizeColumns(Sender: TObject);
{ Public declarations }
end;
var
Form_Shape: TForm_Shape;
implementation
{$R *.frm}
uses
Quest;
procedure TForm_Shape.FormShow(Sender: TObject);
begin
Form_Shape.Color := Form_Quest.Color;
Form_Shape.Font := Form_Quest.Font;
end;
procedure TForm_Shape.AutoSizeCol(Grid: TStringGrid; Column: integer);
var
i, W, WMax: integer;
begin
WMax := 0;
for i := 0 to (Grid.RowCount - 1) do begin
W := Grid.Canvas.TextWidth(Grid.Cells[Column, i]);
if W > WMax then
WMax := W;
end;
Grid.ColWidths[Column] := WMax + 5;
end;
procedure TForm_Shape.AutoSizeColumns(Sender: TObject);
var
i: integer;
begin
for i := 0 to StrGrid_Profile.ColCount - 1 do
AutoSizeCol(StrGrid_Profile, i);
end;
procedure TForm_Shape.StrGrid_ShapeDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
grid: TStringGrid;
S: String;
drawrect: TRect;
bgFill: TColor;
begin
grid := Sender as TStringGrid;
if gdFixed in State then
bgFill := $FFF8F8
else
if gdSelected in State then
bgFill := $FFF0D0
else
bgFill := clWhite;
grid.Canvas.Brush.Color := bgFill;
grid.canvas.Brush.Style := bsSolid;
grid.canvas.fillrect(Rect);
S := grid.Cells[ACol, ARow];
if Length(S) > 0 then
begin
drawrect := Rect;
drawrect.Inflate(-4 , 0);
DrawText(grid.canvas.handle, Pchar(S), Length(S), drawrect,
dt_calcrect or dt_wordbreak or dt_left);
If (drawrect.bottom - drawrect.top) > grid.RowHeights[ARow] then
grid.RowHeights[ARow] := (drawrect.bottom - drawrect.top+2)
// changing the row height fires the event again!
else
begin
drawrect.Right := Rect.Right;
// grid.canvas.fillrect(drawrect);
DrawText(grid.canvas.handle, Pchar(S), Length(S), drawrect,
dt_wordbreak or dt_left);
end;
end;
if gdFocused in State then
grid.Canvas.DrawFocusRect(Rect);
end;
end.
object Form_Shape: TForm_Shape
Left = 1613
Height = 600
Top = 114
Width = 960
Caption = 'Профил оценка'
ClientHeight = 600
ClientWidth = 960
Color = clBtnFace
Font.CharSet = RUSSIAN_CHARSET
Font.Color = clBlack
Font.Height = -15
Font.Name = 'Tahoma'
Font.Pitch = fpVariable
Font.Quality = fqDraft
OnShow = FormShow
Position = poOwnerFormCenter
LCLVersion = '7.7'
object StrGrid_Profile: TStringGrid
Left = 0
Height = 600
Top = 0
Width = 960
Align = alClient
ColCount = 4
FixedCols = 0
RowCount = 14
TabOrder = 0
ColWidths = (
152
200
64
462
)
end
end